Merge branch 'master' (early part) into release

Conflicts:
	Language/Haskell/GhcMod/Utils.hs

Language/Haskell/GhcMod/Cradle.hs

@@ -2,6 +2,7 @@ module Language.Haskell.GhcMod.Cradle (
     findCradle
   , findCradle'
   , findCradleWithoutSandbox
+  , cleanupCradle
   ) where
 
 import Language.Haskell.GhcMod.Types
@@ -12,8 +13,10 @@ import qualified Control.Exception as E
 import Control.Exception.IOChoice ((||>))
 import Control.Monad (filterM)
 import Data.List (isSuffixOf)
-import System.Directory (getCurrentDirectory, getDirectoryContents, doesFileExist)
+import System.Directory (getCurrentDirectory, getDirectoryContents, doesFileExist, getTemporaryDirectory, removeDirectoryRecursive)
 import System.FilePath ((</>), takeDirectory)
+import System.IO.Temp
+
 
 ----------------------------------------------------------------
 
@@ -27,13 +30,26 @@ findCradle = findCradle' =<< getCurrentDirectory
 findCradle' :: FilePath -> IO Cradle
 findCradle' dir = cabalCradle dir ||> sandboxCradle dir ||> plainCradle dir
 
+newTempDir :: FilePath -> IO FilePath
+newTempDir dir =
+    flip createTempDirectory uniqPathName =<< getTemporaryDirectory
+ where
+   uniqPathName = "ghc-mod" ++ map escapeSlash dir
+   escapeSlash '/' = '-'
+   escapeSlash c = c
+
+cleanupCradle :: Cradle -> IO ()
+cleanupCradle crdl = removeDirectoryRecursive $ cradleTempDir crdl
+
 cabalCradle :: FilePath -> IO Cradle
 cabalCradle wdir = do
     (rdir,cfile) <- cabalDir wdir
     pkgDbStack <- getPackageDbStack rdir
+    tmpDir <- newTempDir rdir
     return Cradle {
         cradleCurrentDir = wdir
       , cradleRootDir    = rdir
+      , cradleTempDir    = tmpDir
       , cradleCabalFile  = Just cfile
       , cradlePkgDbStack = pkgDbStack
       }
@@ -42,17 +58,22 @@ sandboxCradle :: FilePath -> IO Cradle
 sandboxCradle wdir = do
     rdir <- getSandboxDir wdir
     pkgDbStack <- getPackageDbStack rdir
+    tmpDir <- newTempDir rdir
     return Cradle {
         cradleCurrentDir = wdir
       , cradleRootDir    = rdir
+      , cradleTempDir    = tmpDir
       , cradleCabalFile  = Nothing
       , cradlePkgDbStack = pkgDbStack
       }
 
 plainCradle :: FilePath -> IO Cradle
-plainCradle wdir = return Cradle {
+plainCradle wdir = do
+    tmpDir <- newTempDir wdir
+    return Cradle {
         cradleCurrentDir = wdir
       , cradleRootDir    = wdir
+      , cradleTempDir    = tmpDir
       , cradleCabalFile  = Nothing
       , cradlePkgDbStack = [GlobalDb, UserDb]
       }

Language/Haskell/GhcMod/Find.hs

@@ -17,7 +17,6 @@ module Language.Haskell.GhcMod.Find
 
 import Control.Applicative ((<$>))
 import Control.Monad (when, void)
-import Control.Monad.Error.Class
 import Data.Function (on)
 import Data.List (groupBy, sort)
 import Data.Maybe (fromMaybe)
@@ -87,10 +86,11 @@ lookupSym sym db = fromMaybe [] $ M.lookup sym $ table db
 ---------------------------------------------------------------
 
 -- | Loading a file and creates 'SymbolDb'.
-loadSymbolDb :: (IOish m, MonadError GhcModError m) => m SymbolDb
+loadSymbolDb :: IOish m => GhcModT m SymbolDb
 loadSymbolDb = do
     ghcMod <- liftIO ghcModExecutable
-    file <- chop <$> readProcess' ghcMod ["dumpsym"]
+    tmpdir <- liftIO . getPackageCachePath =<< cradle
+    file <- chop <$> readProcess' ghcMod ["dumpsym", tmpdir]
     !db <- M.fromAscList . map conv . lines <$> liftIO (readFile file)
     return $ SymbolDb {
         table = db
@@ -110,10 +110,8 @@ loadSymbolDb = do
 --   if the file does not exist or is invalid.
 --   The file name is printed.
 
-dumpSymbol :: IOish m => GhcModT m String
+dumpSymbol :: IOish m => FilePath -> GhcModT m String
-dumpSymbol = do
+dumpSymbol dir = do
-    crdl <- cradle
-    dir <- liftIO $ getPackageCachePath crdl
     let cache = dir </> symbolCache
         pkgdb = dir </> packageCache
 

Language/Haskell/GhcMod/GhcPkg.hs

@@ -16,16 +16,19 @@ module Language.Haskell.GhcMod.GhcPkg (
 import Config (cProjectVersion, cTargetPlatformString, cProjectVersionInt)
 import Control.Applicative ((<$>))
 import Control.Exception (SomeException(..))
+import Control.Monad
 import qualified Control.Exception as E
 import Data.Char (isSpace)
 import Data.List (isPrefixOf, intercalate)
 import Data.List.Split (splitOn)
+import Data.Maybe
 import Distribution.Package (InstalledPackageId(..))
 import Exception (handleIO)
 import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Utils
 import System.Directory (doesDirectoryExist, getAppUserDataDirectory)
 import System.FilePath ((</>))
+import qualified Data.Traversable as T
 
 ghcVersion :: Int
 ghcVersion = read cProjectVersionInt
@@ -117,12 +120,14 @@ packageCache = "package.cache"
 packageConfDir :: String
 packageConfDir = "package.conf.d"
 
--- fixme: error handling
 getPackageCachePath :: Cradle -> IO FilePath
 getPackageCachePath crdl = do
-    let u:_ = filter (/= GlobalDb) $ cradlePkgDbStack crdl
+    let mu = listToMaybe $ filter (/= GlobalDb) $ cradlePkgDbStack crdl
-    Just db <- resolvePath u
+    mdb <- join <$> resolvePath `T.traverse` mu
-    return db
+    let dir = case mdb of
+               Just db -> db
+               Nothing -> cradleTempDir crdl
+    return dir
 
 --- Copied from ghc module `Packages' unfortunately it's not exported :/
 resolvePath :: GhcPkgDb -> IO (Maybe FilePath)

Language/Haskell/GhcMod/Monad.hs

@@ -244,6 +244,9 @@ newGhcModEnv opt dir = do
         , gmCradle = c
         }
 
+cleanupGhcModEnv :: GhcModEnv -> IO ()
+cleanupGhcModEnv env = cleanupCradle $ gmCradle env
+
 -- | Run a @GhcModT m@ computation.
 runGhcModT :: IOish m
            => Options
@@ -251,11 +254,13 @@ runGhcModT :: IOish m
            -> m (Either GhcModError a, GhcModLog)
 runGhcModT opt action = do
     env <- liftBase $ newGhcModEnv opt =<< getCurrentDirectory
-    first (fst <$>) <$> (runGhcModT' env defaultState $ do
+    r <- first (fst <$>) <$> (runGhcModT' env defaultState $ do
         dflags <- getSessionDynFlags
         defaultCleanupHandler dflags $ do
             initializeFlagsWithCradle opt (gmCradle env)
             action)
+    liftBase $ cleanupGhcModEnv env
+    return r
 
 -- | @hoistGhcModT result@. Embed a GhcModT computation's result into a GhcModT
 -- computation. Note that if the computation that returned @result@ modified the

Language/Haskell/GhcMod/Types.hs

@@ -19,9 +19,10 @@ type IOish m = (Functor m, MonadIO m, MonadBaseControl IO m, ExceptionMonad m)
 -- | Output style.
 data OutputStyle = LispStyle  -- ^ S expression style.
                  | PlainStyle -- ^ Plain textstyle.
+                   deriving (Show)
 
 -- | The type for line separator. Historically, a Null string is used.
-newtype LineSeparator = LineSeparator String
+newtype LineSeparator = LineSeparator String deriving (Show)
 
 data Options = Options {
     outputStyle   :: OutputStyle
@@ -40,7 +41,7 @@ data Options = Options {
   -- | If 'True', 'browse' will return fully qualified name
   , qualified     :: Bool
   , hlintOpts     :: [String]
-  }
+  } deriving (Show)
 
 
 -- | A default 'Options'.
@@ -65,6 +66,8 @@ data Cradle = Cradle {
     cradleCurrentDir :: FilePath
   -- | The project root directory.
   , cradleRootDir    :: FilePath
+  -- | Per-Project temporary directory
+  , cradleTempDir    :: FilePath
   -- | The file name of the found cabal file.
   , cradleCabalFile  :: Maybe FilePath
   -- | Package database stack

Language/Haskell/GhcMod/Utils.hs

@@ -1,16 +1,15 @@
 {-# LANGUAGE CPP #-}
 module Language.Haskell.GhcMod.Utils where
 
-import Control.Applicative ((<$>))
 import Language.Haskell.GhcMod.Error
 import MonadUtils (MonadIO, liftIO)
 import System.Directory (getCurrentDirectory, setCurrentDirectory)
 import System.Exit (ExitCode(..))
 import System.Process (readProcessWithExitCode)
-import System.FilePath (takeDirectory)
-import System.Environment
 #ifndef SPEC
-import System.FilePath ((</>))
+import Control.Applicative ((<$>))
+import System.Environment
+import System.FilePath ((</>),takeDirectory)
 #endif
 
 -- dropWhileEnd is not provided prior to base 4.5.0.0.
@@ -56,11 +55,6 @@ ghcModExecutable :: IO FilePath
 ghcModExecutable = do
     dir <- getExecutablePath'
     return $ dir </> "ghc-mod"
-#else
-ghcModExecutable = do _ <- getExecutablePath' -- get rid of unused warning when
-                                              -- compiling spec
-                      return "dist/build/ghc-mod/ghc-mod"
-#endif
  where
     getExecutablePath' :: IO FilePath
 # if __GLASGOW_HASKELL__ >= 706
@@ -68,3 +62,6 @@ ghcModExecutable = do _ <- getExecutablePath' -- get rid of unused warning when
 # else
     getExecutablePath' = return ""
 # endif
+#else
+ghcModExecutable = return "dist/build/ghc-mod/ghc-mod"
+#endif

ghc-mod.cabal

@@ -109,6 +109,7 @@ Library
                       , pretty
                       , process
                       , syb
+                      , temporary
                       , time
                       , transformers
                       , transformers-base
@@ -212,6 +213,7 @@ Test-Suite spec
                       , pretty
                       , process
                       , syb
+                      , temporary
                       , time
                       , transformers
                       , transformers-base

hcar-ghc-mod.tex

@@ -1,40 +1,25 @@
 % ghcmodHappyHaskellProgram-Kg.tex
 \begin{hcarentry}[updated]{ghc-mod --- Happy Haskell Programming}
-\report{Kazu Yamamoto}%05/14
+\report{Kazu Yamamoto}%11/14
 \status{open source, actively developed}
 \makeheader
 
-{\tt ghc-mod} is a package to enrich Haskell programming on editors including Emacs, Vim and Sublime. The {\tt ghc-mod} package on Hackage includes the {\tt ghc-mod} command, new {\tt ghc-modi} command and Emacs front-end. 
+For a long time, Kazu Yamamoto was the only active developer of ghc-mod, now two
+new developers have joined:
 
-Emacs front-end provides the following features:
+Alejandro Serrano merged the results of his Google Summer of Code project. He
+implemented case splitting and sophisticated typed hole handling.  Daniel Gröber
+brushed up the internal code and introduced the GhcModT monad now used
+throughout the exported API. As a result the API of \texttt{ghc-mod} drastically
+changed with version 5.0.0.
 
-\begin{description}
+\texttt{ghc-modi} used to suffer from various consistency related issues
-\item[Completion] You can complete a name of keyword, module, class, function, types, language extensions, etc.
+triggered by changes in the environment, for instance: changing file names of
+modules, adding dependencies to the cabal file and installing new libraries.
+\texttt{ghc-modi} v5.1.1 or later handles changes in the environment by
+restarting the GHC session when this is detected.
 
-\item[Code template] You can insert a code template according to the position of the cursor. For instance, {\tt import Foo (bar)} is inserted if {\tt bar} is missing.
+Kazu stepped down as release manager and Daniel took over.
-
-\item[Syntax check] Code lines with error messages are automatically highlighted. You can display the error message of the current line in another window. {\tt hlint} %\cref{hlint} 
-can be used instead of GHC to check Haskell syntax. 
-
-\item[Document browsing] You can browse the module document of the current line either locally or on Hackage.
-
-\item[Expression type] You can display the type/information of the expression on the cursor. 
-\end{description}
-
-\noindent
-There are two Vim plugins:
-\begin{itemize}
-\item ghcmod-vim
-\item syntastic
-\end{itemize}
-
-\noindent
-Here are new features:
-\begin{itemize}
-\item New {\tt ghc-modi} command provides a persistent session to make response time drastically faster. So, now you can use Emacs front-end without stress.
-\item Emacs front-end provides a way to solve the import hell.
-\item GHC 7.8 is supported.
-\end{itemize}
 
 \FurtherReading
   \url{http://www.mew.org/~kazu/proj/ghc-mod/en/}

src/GHCMod.hs

@@ -3,7 +3,6 @@
 module Main where
 
 import Config (cProjectVersion)
-import Control.Arrow
 import Control.Applicative
 import Control.Exception (Exception, Handler(..), catches, throw)
 import Data.Typeable (Typeable)
@@ -295,13 +294,13 @@ main = handler $ do
     hSetEncoding stdout utf8
     args <- getArgs
 
-    let (ghcArgs, modArgs) = second stripSeperator $ span (/="--") args
+    -- let (ghcArgs, modArgs) = second stripSeperator $ span (/="--") args
-        _realGhcArgs = filter (/="--ghc-mod") ghcArgs
+    --     _realGhcArgs = filter (/="--ghc-mod") ghcArgs
 
-        (globalOptions,_cmdArgs) = parseGlobalArgs modArgs
+    --     (globalOptions,_cmdArgs) = parseGlobalArgs modArgs
 
-        stripSeperator ("--":rest) = rest
+    --     stripSeperator ("--":rest) = rest
-        stripSeperator l = l
+    --     stripSeperator l = l
 
     case args of
       _
@@ -323,9 +322,14 @@ main = handler $ do
 
 
           | otherwise -> do
-              (res, _) <- runGhcModT globalOptions $ commands args
+              let (globalOptions,cmdArgs) = parseGlobalArgs args
-              case res of
+              res      <- simpleCommands cmdArgs
-                Right s -> putStr s
+              putStr =<< case res of
+                Just s -> return s
+                Nothing -> do
+                  (res',_) <- runGhcModT globalOptions $ ghcCommands cmdArgs
+                  case res' of
+                    Right s -> return s
                     Left e -> exitError $ render (gmeDoc e)
 
               -- Obtain ghc options by letting ourselfs be executed by
@@ -339,14 +343,19 @@ main = handler $ do
 
               -- rawSystem "cabal" cabalArgs >>= exitWith
 
-commands :: IOish m => [String] -> GhcModT m String
+simpleCommands :: [String] -> IO (Maybe String)
-commands []         = fatalError "No command given (try --help)\n"
+simpleCommands []      = return Nothing
-commands (cmd:args) = fn args
+simpleCommands (cmd:_) = return $ case cmd of
+    _ | cmd == "help" || cmd == "--help"  -> Just usage
+    "version" -> Just progVersion
+    _         -> Nothing
+
+ghcCommands :: IOish m => [String] -> GhcModT m String
+ghcCommands []         = fatalError "No command given (try --help)\n"
+ghcCommands (cmd:args) = fn args
  where
    fn = case cmd of
      _ | cmd == "list" || cmd == "modules" -> modulesCmd
-     _ | cmd == "help" || cmd == "--help"  -> const $ return usage
-     "version" -> const $ return progVersion
      "lang"    -> languagesCmd
      "flag"    -> flagsCmd
      "browse"  -> browseCmd
@@ -400,9 +409,9 @@ flagsCmd      = withParseCmd [] $ \[] -> flags
 debugInfoCmd  = withParseCmd [] $ \[] -> debugInfo
 rootInfoCmd   = withParseCmd [] $ \[] -> rootInfo
 -- internal
-dumpSymbolCmd = withParseCmd [] $ \[] -> dumpSymbol
 bootCmd       = withParseCmd [] $ \[] -> boot
 
+dumpSymbolCmd     = withParseCmd [] $ \[tmpdir] -> dumpSymbol tmpdir
 findSymbolCmd     = withParseCmd [] $ \[sym]  -> findSymbol sym
 pkgDocCmd         = withParseCmd [] $ \[mdl]  -> pkgDoc mdl
 lintCmd           = withParseCmd s  $ \[file] -> lint file

test/CradleSpec.hs

@@ -17,31 +17,27 @@ spec = do
             withDirectory_ "/" $ do
                 curDir <- stripLastDot <$> canonicalizePath "/"
                 res <- findCradle
-                res `shouldBe` Cradle {
+                cradleCurrentDir res `shouldBe` curDir
-                    cradleCurrentDir = curDir
+                cradleRootDir    res `shouldBe` curDir
-                  , cradleRootDir    = curDir
+                cradleCabalFile  res `shouldBe` Nothing
-                  , cradleCabalFile  = Nothing
+                cradlePkgDbStack res `shouldBe` [GlobalDb,UserDb]
-                  , cradlePkgDbStack = [GlobalDb,UserDb]
+
-                  }
         it "finds a cabal file and a sandbox" $ do
             cwd <- getCurrentDirectory
             withDirectory "test/data/subdir1/subdir2" $ \dir -> do
                 res <- relativeCradle dir <$> findCradle
-                res `shouldBe` Cradle {
+                cradleCurrentDir res `shouldBe` "test" </> "data" </> "subdir1" </> "subdir2"
-                    cradleCurrentDir = "test" </> "data" </> "subdir1" </> "subdir2"
+                cradleRootDir    res `shouldBe` "test" </> "data"
-                  , cradleRootDir    = "test" </> "data"
+                cradleCabalFile  res `shouldBe` Just ("test" </> "data" </> "cabalapi.cabal")
-                  , cradleCabalFile  = Just ("test" </> "data" </> "cabalapi.cabal")
+                cradlePkgDbStack res `shouldBe` [GlobalDb, PackageDb (cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d")]
-                  , cradlePkgDbStack = [GlobalDb, PackageDb (cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d")]
+
-                  }
         it "works even if a sandbox config file is broken" $ do
             withDirectory "test/data/broken-sandbox" $ \dir -> do
                 res <- relativeCradle dir <$> findCradle
-                res `shouldBe` Cradle {
+                cradleCurrentDir res `shouldBe` "test" </> "data" </> "broken-sandbox"
-                    cradleCurrentDir = "test" </> "data" </> "broken-sandbox"
+                cradleRootDir    res `shouldBe` "test" </> "data" </> "broken-sandbox"
-                  , cradleRootDir    = "test" </> "data" </> "broken-sandbox"
+                cradleCabalFile  res `shouldBe` Just ("test" </> "data" </> "broken-sandbox" </> "dummy.cabal")
-                  , cradleCabalFile  = Just ("test" </> "data" </> "broken-sandbox" </> "dummy.cabal")
+                cradlePkgDbStack res `shouldBe` [GlobalDb, UserDb]
-                  , cradlePkgDbStack = [GlobalDb, UserDb]
-                  }
 
 relativeCradle :: FilePath -> Cradle -> Cradle
 relativeCradle dir cradle = cradle {