ghc-mod 5.1.1.0 → 5.2.0.0

raw patch · 11 files changed

+114/−43 lines, 11 filesdep +temporaryPVP ok

version bump matches the API change (PVP)

Dependencies added: temporary

API changes (from Hackage documentation)

Files

• ChangeLog +10/−0
• Language/Haskell/GhcMod/Cradle.hs +23/−2
• Language/Haskell/GhcMod/Find.hs +5/−7
• Language/Haskell/GhcMod/GhcPkg.hs +9/−4
• Language/Haskell/GhcMod/Monad.hs +6/−1
• Language/Haskell/GhcMod/Monad.hs-boot +21/−0
• Language/Haskell/GhcMod/Types.hs +5/−2
• Language/Haskell/GhcMod/Utils.hs +6/−9
• elisp/ghc.el +1/−1
• ghc-mod.cabal +3/−1
• src/GHCMod.hs +25/−16

@@ -1,3 +1,13 @@+2014-10-30 v5.2.0.0+        * Return type of `loadSymbolDb` is now in GhcModT+        * Function `dumpSymbol` now takes the path of the target directory+        * Fix #387, Pattern match failure in GhcPkg+        * Fix #386, `ghc-mod version` should not check `cabal configure`+        * Fix #391, Error on command `-g` when used before command despite+          --help output saying this is valid+        * Fix formatting of `ghc-version` constant in the elisp code.  in+          version 5.1.1.0 the string was "v5.1.1.0" instead of "5.1.1.0".+ 2014-10-04 v5.1.1.0         * Handle various consistency related issues: #222, #224, #326, #332         * Add `isOutdated` to Language.Haskell.GhcMod

@@ -2,6 +2,7 @@     findCradle   , findCradle'   , findCradleWithoutSandbox+  , cleanupCradle   ) where  import Language.Haskell.GhcMod.Types@@ -12,9 +13,11 @@ 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 + ----------------------------------------------------------------  -- | Finding 'Cradle'.@@ -27,13 +30,26 @@ 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 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]       }

@@ -17,7 +17,6 @@  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 @@ ---------------------------------------------------------------  -- | 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 @@ --   if the file does not exist or is invalid. --   The file name is printed. -dumpSymbol :: IOish m => GhcModT m String-dumpSymbol = do-    crdl <- cradle-    dir <- liftIO $ getPackageCachePath crdl+dumpSymbol :: IOish m => FilePath -> GhcModT m String+dumpSymbol dir = do     let cache = dir </> symbolCache         pkgdb = dir </> packageCache 

@@ -16,16 +16,19 @@ 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 @@ packageConfDir :: String packageConfDir = "package.conf.d" --- fixme: error handling getPackageCachePath :: Cradle -> IO FilePath getPackageCachePath crdl = do-    let u:_ = filter (/= GlobalDb) $ cradlePkgDbStack crdl-    Just db <- resolvePath u-    return db+    let mu = listToMaybe $ filter (/= GlobalDb) $ cradlePkgDbStack crdl+    mdb <- join <$> resolvePath `T.traverse` mu+    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)

@@ -244,6 +244,9 @@         , gmCradle = c         } +cleanupGhcModEnv :: GhcModEnv -> IO ()+cleanupGhcModEnv env = cleanupCradle $ gmCradle env+ -- | Run a @GhcModT m@ computation. runGhcModT :: IOish m            => Options@@ -251,11 +254,13 @@            -> 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

@@ -0,0 +1,21 @@+{-# LANGUAGE RoleAnnotations #-}++module Language.Haskell.GhcMod.Monad where++import DynFlags (HasDynFlags)+import Control.Monad.IO.Class (MonadIO)+import Control.Applicative (Applicative)++data GhcModT m a+type role GhcMod nominal++data GhcModEnv+data GhcModState+type GhcModWriter = ()++instance Functor GhcMod+instance Applicative GhcMod+instance Monad GhcMod++instance HasDynFlags GhcMod+instance MonadIO GhcMod

@@ -19,9 +19,10 @@ -- | 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 @@   -- | If 'True', 'browse' will return fully qualified name   , qualified     :: Bool   , hlintOpts     :: [String]-  }+  } deriving (Show)   -- | A default 'Options'.@@ -65,6 +66,8 @@     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

@@ -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 = 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 @@ # else     getExecutablePath' = return "" # endif+#else+ghcModExecutable = return "dist/build/ghc-mod/ghc-mod"+#endif

@@ -28,7 +28,7 @@ 	       (< emacs-minor-version minor)))       (error "ghc-mod requires at least Emacs %d.%d" major minor))) -(defconst ghc-version "v5.1.1.0")+(defconst ghc-version "5.2.0.0")  ;; (eval-when-compile ;;  (require 'haskell-mode))

@@ -1,5 +1,5 @@ Name:                   ghc-mod-Version:                5.1.1.0+Version:                5.2.0.0 Author:                 Kazu Yamamoto <kazu@iij.ad.jp>                         Daniel Gröber <dxld@darkboxed.org>                         Alejandro Serrano <trupill@gmail.com>@@ -109,6 +109,7 @@                       , pretty                       , process                       , syb+                      , temporary                       , time                       , transformers                       , transformers-base@@ -212,6 +213,7 @@                       , pretty                       , process                       , syb+                      , temporary                       , time                       , transformers                       , transformers-base

@@ -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 @@     hSetEncoding stdout utf8     args <- getArgs -    let (ghcArgs, modArgs) = second stripSeperator $ span (/="--") args-        _realGhcArgs = filter (/="--ghc-mod") ghcArgs+    -- let (ghcArgs, modArgs) = second stripSeperator $ span (/="--") args+    --     _realGhcArgs = filter (/="--ghc-mod") ghcArgs -        (globalOptions,_cmdArgs) = parseGlobalArgs modArgs+    --     (globalOptions,_cmdArgs) = parseGlobalArgs modArgs -        stripSeperator ("--":rest) = rest-        stripSeperator l = l+    --     stripSeperator ("--":rest) = rest+    --     stripSeperator l = l      case args of       _@@ -323,10 +322,15 @@             | otherwise -> do-              (res, _) <- runGhcModT globalOptions $ commands args-              case res of-                Right s -> putStr s-                Left e -> exitError $ render (gmeDoc e)+              let (globalOptions,cmdArgs) = parseGlobalArgs args+              res      <- simpleCommands cmdArgs+              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               -- @cabal repl@@@ -339,14 +343,19 @@                -- rawSystem "cabal" cabalArgs >>= exitWith -commands :: IOish m => [String] -> GhcModT m String-commands []         = fatalError "No command given (try --help)\n"-commands (cmd:args) = fn args+simpleCommands :: [String] -> IO (Maybe String)+simpleCommands []      = return Nothing+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 @@ 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