ghc-mod root.

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

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

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 ()

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)

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