From ee6dc2fc47ca7a02764ad8c79c0c9583d20702a9 Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Thu, 20 Mar 2014 16:21:48 +0900
Subject: [PATCH] ghc-mod root.

---
 Language/Haskell/GhcMod.hs       |  1 +
 Language/Haskell/GhcMod/Debug.hs | 23 ++++++++++++++++++++++-
 elisp/ghc-check.el               |  5 ++---
 elisp/ghc-command.el             |  4 +++-
 src/GHCMod.hs                    |  2 ++
 5 files changed, 30 insertions(+), 5 deletions(-)

diff --git a/Language/Haskell/GhcMod.hs b/Language/Haskell/GhcMod.hs
index a0ac17e..9e2750b 100644
--- a/Language/Haskell/GhcMod.hs
+++ b/Language/Haskell/GhcMod.hs
@@ -22,6 +22,7 @@ module Language.Haskell.GhcMod (
   , listLanguages
   , listFlags
   , debugInfo
+  , rootInfo
   -- * Converting the 'Ghc' monad to the 'IO' monad
   , withGHC
   , withGHCDummyFile
diff --git a/Language/Haskell/GhcMod/Debug.hs b/Language/Haskell/GhcMod/Debug.hs
index 7be3e8f..adb8b10 100644
--- a/Language/Haskell/GhcMod/Debug.hs
+++ b/Language/Haskell/GhcMod/Debug.hs
@@ -1,4 +1,4 @@
-module Language.Haskell.GhcMod.Debug (debugInfo, debug) where
+module Language.Haskell.GhcMod.Debug (debugInfo, debug, rootInfo, root) where
 
 import Control.Applicative
 import Control.Exception.IOChoice
@@ -54,3 +54,24 @@ debug opt cradle fileName = do
     fromCabalFile = parseCabalFile file >>= getCompilerOptions origGopts cradle
       where
         file = fromJust mCabalFile
+
+----------------------------------------------------------------
+
+-- | Obtaining root information.
+rootInfo :: Options
+          -> Cradle
+          -> FilePath   -- ^ A target file.
+          -> IO String
+rootInfo opt cradle fileName = withGHC fileName (root opt cradle fileName)
+
+-- | Obtaining root information.
+root :: Options
+      -> Cradle
+      -> FilePath     -- ^ A target file.
+      -> Ghc String
+root _ cradle _ = do
+    return $ rootDir ++ "\n"
+  where
+    currentDir = cradleCurrentDir cradle
+    mCabalDir = cradleCabalDir cradle
+    rootDir = fromMaybe currentDir mCabalDir
diff --git a/elisp/ghc-check.el b/elisp/ghc-check.el
index eedf205..6ebdf19 100644
--- a/elisp/ghc-check.el
+++ b/elisp/ghc-check.el
@@ -9,7 +9,6 @@
 ;;; Code:
 
 ;; other files' errors should go to 0
-;; ghc-flymake-display-errors -> line column
 ;; ghc-flymake-jump
 
 (require 'ghc-func)
@@ -22,9 +21,9 @@
 (defun ghc-check-get-process-name ()
   (let ((file (buffer-file-name)))
     (with-temp-buffer
-      (ghc-call-process ghc-module-command nil t nil "debug" file)
+      (ghc-call-process ghc-module-command nil t nil "root" file)
       (goto-char (point-min))
-      (when (re-search-forward "^Root directory: +\\(.*\\)$" nil t)
+      (when (looking-at "^\\(.*\\)$")
 	(match-string-no-properties 1)))))
 
 (defun ghc-check-syntax ()
diff --git a/elisp/ghc-command.el b/elisp/ghc-command.el
index f7c8b0c..b36f92a 100644
--- a/elisp/ghc-command.el
+++ b/elisp/ghc-command.el
@@ -40,7 +40,9 @@
 
 (defun ghc-save-buffer ()
   (interactive)
-  (if (buffer-modified-p) (call-interactively 'save-buffer))
+  ;; fixme: better way then saving?
+  (set-buffer-modified-p t)
+  (call-interactively 'save-buffer)
   (ghc-check-syntax))
 
 (provide 'ghc-command)
diff --git a/src/GHCMod.hs b/src/GHCMod.hs
index 39b07a4..2e87cee 100644
--- a/src/GHCMod.hs
+++ b/src/GHCMod.hs
@@ -35,6 +35,7 @@ usage =    "ghc-mod version " ++ showVersion version ++ "\n"
         ++ "\t ghc-mod type" ++ ghcOptHelp ++ "<HaskellFile> <module> <line-no> <column-no>\n"
         ++ "\t ghc-mod lint [-h opt] <HaskellFile>\n"
         ++ "\t ghc-mod boot\n"
+        ++ "\t ghc-mod root <HaskellFile>\n"
         ++ "\t ghc-mod help\n"
 
 ----------------------------------------------------------------
@@ -107,6 +108,7 @@ main = flip catches handlers $ do
       "check"  -> checkSyntax opt cradle remainingArgs
       "expand" -> checkSyntax opt { expandSplice = True } cradle remainingArgs
       "debug"  -> nArgs 1 $ debugInfo opt cradle cmdArg1
+      "root"   -> nArgs 1 $ rootInfo opt cradle cmdArg1
       "type"   -> nArgs 4 $ typeExpr opt cradle cmdArg1 cmdArg2 (read cmdArg3) (read cmdArg4)
       "info"   -> nArgs 3 infoExpr opt cradle cmdArg1 cmdArg2 cmdArg3
       "lint"   -> nArgs 1 withFile (lintSyntax opt) cmdArg1