From c0652c0321ea3ad51ef6a6ee19435baf9a765c4b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Tue, 12 Aug 2014 18:08:28 +0200 Subject: [PATCH 01/12] Move GhcModError to Types.hs --- Language/Haskell/GhcMod/Monad.hs | 10 ---------- Language/Haskell/GhcMod/Types.hs | 15 +++++++++++++++ 2 files changed, 15 insertions(+), 10 deletions(-) diff --git a/Language/Haskell/GhcMod/Monad.hs b/Language/Haskell/GhcMod/Monad.hs index 36aabdd..44e9dd0 100644 --- a/Language/Haskell/GhcMod/Monad.hs +++ b/Language/Haskell/GhcMod/Monad.hs @@ -122,16 +122,6 @@ data CompilerMode = Simple | Intelligent deriving (Eq,Show,Read) defaultState :: GhcModState defaultState = GhcModState Simple -data GhcModError = GMENoMsg - | GMEString String - | GMECabal - | GMEGhc - deriving (Eq,Show,Read) - -instance Error GhcModError where - noMsg = GMENoMsg - strMsg = GMEString - ---------------------------------------------------------------- -- | A constraint alias (-XConstraintKinds) to make functions dealing with diff --git a/Language/Haskell/GhcMod/Types.hs b/Language/Haskell/GhcMod/Types.hs index b42b018..5bab199 100644 --- a/Language/Haskell/GhcMod/Types.hs +++ b/Language/Haskell/GhcMod/Types.hs @@ -2,9 +2,24 @@ module Language.Haskell.GhcMod.Types where import Data.List (intercalate) import qualified Data.Map as M +import Control.Monad.Error (Error(..)) import PackageConfig (PackageConfig) +-- | +data GhcModError = GMENoMsg + -- ^ Unknown error + | GMEString String + -- ^ Some Error with a message. These are produced mostly by + -- 'fail' calls on GhcModT. + | GMECabal String + | GMEGhc + deriving (Eq,Show,Read) + +instance Error GhcModError where + noMsg = GMENoMsg + strMsg = GMEString + -- | Output style. data OutputStyle = LispStyle -- ^ S expression style. | PlainStyle -- ^ Plain textstyle. From e345c92edb4a2b2f60a9b0adaa68fff76f0d0c4e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Tue, 12 Aug 2014 18:09:31 +0200 Subject: [PATCH 02/12] Make GhcModT's MonadState instance pass through ..to the underlying monad --- Language/Haskell/GhcMod/Monad.hs | 29 +++++++++++++++++++---------- Language/Haskell/GhcMod/Target.hs | 2 +- 2 files changed, 20 insertions(+), 11 deletions(-) diff --git a/Language/Haskell/GhcMod/Monad.hs b/Language/Haskell/GhcMod/Monad.hs index 44e9dd0..6df8380 100644 --- a/Language/Haskell/GhcMod/Monad.hs +++ b/Language/Haskell/GhcMod/Monad.hs @@ -30,8 +30,6 @@ module Language.Haskell.GhcMod.Monad ( , withOptions -- ** Exporting convenient modules , module Control.Monad.Reader.Class - , module Control.Monad.Writer.Class - , module Control.Monad.State.Class , module Control.Monad.Journal.Class ) where @@ -85,10 +83,10 @@ import Control.Monad.Trans.Control (MonadBaseControl(..), StM, liftBaseWith, import Control.Monad.Trans.Class import Control.Monad.Reader.Class -import Control.Monad.Writer.Class -import Control.Monad.State.Class +import Control.Monad.Writer.Class (MonadWriter) +import Control.Monad.State.Class (MonadState(..)) -import Control.Monad.Error (Error(..), MonadError, ErrorT, runErrorT) +import Control.Monad.Error (MonadError, ErrorT, runErrorT) import Control.Monad.Reader (ReaderT, runReaderT) import Control.Monad.State.Strict (StateT, runStateT) import Control.Monad.Trans.Journal (JournalT, runJournalT) @@ -155,13 +153,18 @@ newtype GhcModT m a = GhcModT { #endif , MonadReader GhcModEnv , MonadWriter w - , MonadState GhcModState , MonadError GhcModError ) instance MonadTrans GhcModT where lift = GhcModT . lift . lift . lift . lift +instance MonadState s m => MonadState s (GhcModT m) where + get = GhcModT $ lift $ lift $ lift $ get + put = GhcModT . lift . lift . lift . put + state = GhcModT . lift . lift . lift . state + + #if MONADIO_INSTANCES instance MonadIO m => MonadIO (StateT s m) where liftIO = lift . liftIO @@ -283,17 +286,23 @@ toGhcModT a = do ---------------------------------------------------------------- +gmsGet :: IOish m => GhcModT m GhcModState +gmsGet = GhcModT get + +gmsPut :: IOish m => GhcModState -> GhcModT m () +gmsPut = GhcModT . put + options :: IOish m => GhcModT m Options options = gmOptions <$> ask cradle :: IOish m => GhcModT m Cradle cradle = gmCradle <$> ask -getCompilerMode :: (Functor m, MonadState GhcModState m) => m CompilerMode -getCompilerMode = gmCompilerMode <$> get +getCompilerMode :: IOish m => GhcModT m CompilerMode +getCompilerMode = gmCompilerMode <$> gmsGet -setCompilerMode :: MonadState GhcModState m => CompilerMode -> m () -setCompilerMode mode = (\s -> put s { gmCompilerMode = mode } ) =<< get +setCompilerMode :: IOish m => CompilerMode -> GhcModT m () +setCompilerMode mode = (\s -> gmsPut s { gmCompilerMode = mode } ) =<< gmsGet ---------------------------------------------------------------- diff --git a/Language/Haskell/GhcMod/Target.hs b/Language/Haskell/GhcMod/Target.hs index 572388b..1744a72 100644 --- a/Language/Haskell/GhcMod/Target.hs +++ b/Language/Haskell/GhcMod/Target.hs @@ -15,7 +15,7 @@ setTargetFiles :: IOish m => [FilePath] -> GhcModT m () setTargetFiles files = do targets <- forM files $ \file -> G.guessTarget file Nothing G.setTargets targets - mode <- gmCompilerMode <$> get + mode <- getCompilerMode if mode == Intelligent then loadTargets Intelligent else do From 87c587993aaf1d73d25e7f57a07df37c3d011b02 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Tue, 12 Aug 2014 18:11:32 +0200 Subject: [PATCH 03/12] Make `parseCabalFile` use MonadError --- Language/Haskell/GhcMod/CabalApi.hs | 21 +++++++++++++-------- Language/Haskell/GhcMod/Debug.hs | 4 ++-- Language/Haskell/GhcMod/Monad.hs | 4 ++-- test/CabalApiSpec.hs | 15 +++++++++------ test/MonadSpec.hs | 4 ++-- test/TestUtils.hs | 17 +++++++++++++++++ 6 files changed, 45 insertions(+), 20 deletions(-) diff --git a/Language/Haskell/GhcMod/CabalApi.hs b/Language/Haskell/GhcMod/CabalApi.hs index e312488..4978d65 100644 --- a/Language/Haskell/GhcMod/CabalApi.hs +++ b/Language/Haskell/GhcMod/CabalApi.hs @@ -11,14 +11,16 @@ module Language.Haskell.GhcMod.CabalApi ( ) where import Language.Haskell.GhcMod.CabalConfig -import Language.Haskell.GhcMod.Gap (benchmarkBuildInfo, benchmarkTargets, toModuleString) +import Language.Haskell.GhcMod.Gap (benchmarkBuildInfo, benchmarkTargets, + toModuleString) import Language.Haskell.GhcMod.GhcPkg import Language.Haskell.GhcMod.Types import Control.Applicative ((<$>)) import qualified Control.Exception as E import Control.Monad (filterM) -import CoreMonad (liftIO) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Error.Class (MonadError(..)) import Data.Maybe (maybeToList) import Data.Set (fromList, toList) import Distribution.Package (Dependency(Dependency) @@ -71,17 +73,20 @@ includeDirectories cdir wdir dirs = uniqueAndSort (extdirs ++ [cdir,wdir]) -- | Parsing a cabal file and returns 'PackageDescription'. -- 'IOException' is thrown if parsing fails. -parseCabalFile :: FilePath -> IO PackageDescription +parseCabalFile :: (MonadIO m, MonadError GhcModError m) + => FilePath + -> m PackageDescription parseCabalFile file = do - cid <- getGHCId - epgd <- readPackageDescription silent file + cid <- liftIO $ getGHCId + epgd <- liftIO $ readPackageDescription silent file case toPkgDesc cid epgd of - Left deps -> E.throwIO $ userError $ show deps ++ " are not installed" + Left deps -> throwError $ GMECabal $ show deps ++ " are not installed" Right (pd,_) -> if nullPkg pd - then E.throwIO $ userError $ file ++ " is broken" + then throwError $ GMECabal $ file ++ " is broken" else return pd where - toPkgDesc cid = finalizePackageDescription [] (const True) buildPlatform cid [] + toPkgDesc cid = + finalizePackageDescription [] (const True) buildPlatform cid [] nullPkg pd = name == "" where PackageName name = C.pkgName (P.package pd) diff --git a/Language/Haskell/GhcMod/Debug.hs b/Language/Haskell/GhcMod/Debug.hs index d9cd186..82685f3 100644 --- a/Language/Haskell/GhcMod/Debug.hs +++ b/Language/Haskell/GhcMod/Debug.hs @@ -31,9 +31,9 @@ debugInfo = cradle >>= \c -> convert' =<< do where simpleCompilerOption = options >>= \op -> return $ CompilerOptions (ghcOpts op) [] [] - fromCabalFile c = options >>= \opts -> liftIO $ do + fromCabalFile c = options >>= \opts -> do pkgDesc <- parseCabalFile $ fromJust $ cradleCabalFile c - getCompilerOptions (ghcOpts opts) c pkgDesc + liftIO $ getCompilerOptions (ghcOpts opts) c pkgDesc ---------------------------------------------------------------- diff --git a/Language/Haskell/GhcMod/Monad.hs b/Language/Haskell/GhcMod/Monad.hs index 6df8380..3b99b1a 100644 --- a/Language/Haskell/GhcMod/Monad.hs +++ b/Language/Haskell/GhcMod/Monad.hs @@ -187,7 +187,7 @@ instance MonadIO m => MonadIO (MaybeT m) where -- | Initialize the 'DynFlags' relating to the compilation of a single -- file or GHC session according to the 'Cradle' and 'Options' -- provided. -initializeFlagsWithCradle :: GhcMonad m +initializeFlagsWithCradle :: (GhcMonad m, MonadError GhcModError m) => Options -> Cradle -> m () @@ -199,7 +199,7 @@ initializeFlagsWithCradle opt c cabal = isJust mCradleFile ghcopts = ghcOpts opt withCabal = do - pkgDesc <- liftIO $ parseCabalFile $ fromJust mCradleFile + pkgDesc <- parseCabalFile $ fromJust mCradleFile compOpts <- liftIO $ getCompilerOptions ghcopts c pkgDesc initSession CabalPkg opt compOpts withSandbox = initSession SingleFile opt compOpts diff --git a/test/CabalApiSpec.hs b/test/CabalApiSpec.hs index d7b1d13..a43488d 100644 --- a/test/CabalApiSpec.hs +++ b/test/CabalApiSpec.hs @@ -13,6 +13,7 @@ import System.Directory import System.FilePath import Dir +import TestUtils import Config (cProjectVersionInt) -- ghc version @@ -23,14 +24,16 @@ spec :: Spec spec = do describe "parseCabalFile" $ do it "throws an exception if the cabal file is broken" $ do - parseCabalFile "test/data/broken-cabal/broken.cabal" `shouldThrow` (\(_::IOException) -> True) + shouldReturnError $ + runD' $ parseCabalFile "test/data/broken-cabal/broken.cabal" + describe "getCompilerOptions" $ do it "gets necessary CompilerOptions" $ do cwd <- getCurrentDirectory withDirectory "test/data/subdir1/subdir2" $ \dir -> do cradle <- findCradle - pkgDesc <- parseCabalFile $ fromJust $ cradleCabalFile cradle + pkgDesc <- runD $ parseCabalFile $ fromJust $ cradleCabalFile cradle res <- getCompilerOptions [] cradle pkgDesc let res' = res { ghcOptions = ghcOptions res @@ -45,18 +48,18 @@ spec = do describe "cabalDependPackages" $ do it "extracts dependent packages" $ do - pkgs <- cabalDependPackages . cabalAllBuildInfo <$> parseCabalFile "test/data/cabalapi.cabal" + pkgs <- cabalDependPackages . cabalAllBuildInfo <$> runD (parseCabalFile "test/data/cabalapi.cabal") pkgs `shouldBe` ["Cabal","base","template-haskell"] describe "cabalSourceDirs" $ do it "extracts all hs-source-dirs" $ do - dirs <- cabalSourceDirs . cabalAllBuildInfo <$> parseCabalFile "test/data/check-test-subdir/check-test-subdir.cabal" + dirs <- cabalSourceDirs . cabalAllBuildInfo <$> runD (parseCabalFile "test/data/check-test-subdir/check-test-subdir.cabal") dirs `shouldBe` ["src", "test"] it "extracts all hs-source-dirs including \".\"" $ do - dirs <- cabalSourceDirs . cabalAllBuildInfo <$> parseCabalFile "test/data/cabalapi.cabal" + dirs <- cabalSourceDirs . cabalAllBuildInfo <$> runD (parseCabalFile "test/data/cabalapi.cabal") dirs `shouldBe` [".", "test"] describe "cabalAllBuildInfo" $ do it "extracts build info" $ do - info <- cabalAllBuildInfo <$> parseCabalFile "test/data/cabalapi.cabal" + info <- cabalAllBuildInfo <$> runD (parseCabalFile "test/data/cabalapi.cabal") show info `shouldBe` "[BuildInfo {buildable = True, buildTools = [], cppOptions = [], ccOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = [], hsSourceDirs = [\".\"], otherModules = [ModuleName [\"Browse\"],ModuleName [\"CabalApi\"],ModuleName [\"Cabal\"],ModuleName [\"CabalDev\"],ModuleName [\"Check\"],ModuleName [\"ErrMsg\"],ModuleName [\"Flag\"],ModuleName [\"GHCApi\"],ModuleName [\"GHCChoice\"],ModuleName [\"Gap\"],ModuleName [\"Info\"],ModuleName [\"Lang\"],ModuleName [\"Lint\"],ModuleName [\"List\"],ModuleName [\"Paths_ghc_mod\"],ModuleName [\"Types\"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [(GHC,[\"-Wall\"])], ghcProfOptions = [], ghcSharedOptions = [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName \"Cabal\") (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,10], versionTags = []})) (LaterVersion (Version {versionBranch = [1,10], versionTags = []}))),Dependency (PackageName \"base\") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4,0], versionTags = []})) (LaterVersion (Version {versionBranch = [4,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []}))),Dependency (PackageName \"template-haskell\") AnyVersion]},BuildInfo {buildable = True, buildTools = [], cppOptions = [], ccOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = [], hsSourceDirs = [\"test\",\".\"], otherModules = [ModuleName [\"Expectation\"],ModuleName [\"BrowseSpec\"],ModuleName [\"CabalApiSpec\"],ModuleName [\"FlagSpec\"],ModuleName [\"LangSpec\"],ModuleName [\"LintSpec\"],ModuleName [\"ListSpec\"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [], ghcProfOptions = [], ghcSharedOptions = [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName \"Cabal\") (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,10], versionTags = []})) (LaterVersion (Version {versionBranch = [1,10], versionTags = []}))),Dependency (PackageName \"base\") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4,0], versionTags = []})) (LaterVersion (Version {versionBranch = [4,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []})))]}]" diff --git a/test/MonadSpec.hs b/test/MonadSpec.hs index 74404f1..938f763 100644 --- a/test/MonadSpec.hs +++ b/test/MonadSpec.hs @@ -3,6 +3,7 @@ module MonadSpec where import Test.Hspec import Dir +import TestUtils import Control.Applicative import Control.Monad.Error.Class import Language.Haskell.GhcMod.Types @@ -23,5 +24,4 @@ spec = do describe "runGhcModT" $ it "complains if the cabal file fails to parse while a sandbox is present" $ withDirectory_ "test/data/broken-cabal" $ do - (a,_) <- runGhcModT defaultOptions (gmCradle <$> ask) - a `shouldSatisfy` (\(Left _) -> True) + shouldReturnError $ runD' (gmCradle <$> ask) diff --git a/test/TestUtils.hs b/test/TestUtils.hs index 02ce0e3..4732ffe 100644 --- a/test/TestUtils.hs +++ b/test/TestUtils.hs @@ -1,10 +1,12 @@ module TestUtils ( run , runD + , runD' , runI , runID , runIsolatedGhcMod , isolateCradle + , shouldReturnError , module Language.Haskell.GhcMod.Monad , module Language.Haskell.GhcMod.Types ) where @@ -12,6 +14,8 @@ module TestUtils ( import Language.Haskell.GhcMod.Monad import Language.Haskell.GhcMod.Types +import Test.Hspec + isolateCradle :: IOish m => GhcModT m a -> GhcModT m a isolateCradle action = local modifyEnv $ action @@ -42,3 +46,16 @@ run opt a = extract $ runGhcModT opt a -- | Run GhcMod with default options runD :: GhcModT IO a -> IO a runD = extract . runGhcModT defaultOptions + +runD' :: GhcModT IO a -> IO (Either GhcModError a, GhcModLog) +runD' = runGhcModT defaultOptions + +shouldReturnError :: Show a + => IO (Either GhcModError a, GhcModLog) + -> Expectation +shouldReturnError action = do + (a,_) <- action + a `shouldSatisfy` isLeft + where + isLeft (Left _) = True + isLeft _ = False From 9922cf08e18199baca59f545a35c3d627c17b526 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Tue, 12 Aug 2014 18:12:12 +0200 Subject: [PATCH 04/12] Generate cabal.sandbox.config in test/data/broken-cabal --- test/Main.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/test/Main.hs b/test/Main.hs index 0948f3a..93bdb76 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -11,7 +11,9 @@ import TestUtils main = do let sandboxes = [ "test/data", "test/data/check-packageid" - , "test/data/duplicate-pkgver/" ] + , "test/data/duplicate-pkgver/" + , "test/data/broken-cabal/" + ] genSandboxCfg dir = withDirectory dir $ \cwd -> do system ("sed 's|@CWD@|" ++ cwd ++ "|g' cabal.sandbox.config.in > cabal.sandbox.config") pkgDirs = From fa65d7269ecac86fcb76d4944b5c9b9edbff958a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Tue, 12 Aug 2014 18:22:28 +0200 Subject: [PATCH 05/12] Add a test for gmsGet/Put --- Language/Haskell/GhcMod/Monad.hs | 2 ++ test/MonadSpec.hs | 5 +++++ 2 files changed, 7 insertions(+) diff --git a/Language/Haskell/GhcMod/Monad.hs b/Language/Haskell/GhcMod/Monad.hs index 3b99b1a..92e6ac2 100644 --- a/Language/Haskell/GhcMod/Monad.hs +++ b/Language/Haskell/GhcMod/Monad.hs @@ -23,6 +23,8 @@ module Language.Haskell.GhcMod.Monad ( -- ** Conversion , toGhcModT -- ** Accessing 'GhcModEnv' and 'GhcModState' + , gmsGet + , gmsPut , options , cradle , getCompilerMode diff --git a/test/MonadSpec.hs b/test/MonadSpec.hs index 938f763..49f8198 100644 --- a/test/MonadSpec.hs +++ b/test/MonadSpec.hs @@ -25,3 +25,8 @@ spec = do describe "runGhcModT" $ it "complains if the cabal file fails to parse while a sandbox is present" $ withDirectory_ "test/data/broken-cabal" $ do shouldReturnError $ runD' (gmCradle <$> ask) + + describe "gmsGet/Put" $ + it "work" $ do + (runD $ gmsPut (GhcModState Intelligent) >> gmsGet) + `shouldReturn` (GhcModState Intelligent) From edeb57a6a4575e7741afb2be00d5e0dd0b825008 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Tue, 12 Aug 2014 18:23:23 +0200 Subject: [PATCH 06/12] note --- Language/Haskell/GhcMod/Monad.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Language/Haskell/GhcMod/Monad.hs b/Language/Haskell/GhcMod/Monad.hs index 92e6ac2..66b35f7 100644 --- a/Language/Haskell/GhcMod/Monad.hs +++ b/Language/Haskell/GhcMod/Monad.hs @@ -153,7 +153,8 @@ newtype GhcModT m a = GhcModT { #if DIFFERENT_MONADIO , Control.Monad.IO.Class.MonadIO #endif - , MonadReader GhcModEnv + , MonadReader GhcModEnv -- TODO: make MonadReader instance + -- pass-through like MonadState , MonadWriter w , MonadError GhcModError ) From 0fa870efa67cb42abd5c7b58849e609866e0ad9b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Tue, 12 Aug 2014 18:54:48 +0200 Subject: [PATCH 07/12] Fix ghc<=7.6 --- Language/Haskell/GhcMod/Monad.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/Language/Haskell/GhcMod/Monad.hs b/Language/Haskell/GhcMod/Monad.hs index 66b35f7..25214eb 100644 --- a/Language/Haskell/GhcMod/Monad.hs +++ b/Language/Haskell/GhcMod/Monad.hs @@ -94,6 +94,7 @@ import Control.Monad.State.Strict (StateT, runStateT) import Control.Monad.Trans.Journal (JournalT, runJournalT) #ifdef MONADIO_INSTANCES import Control.Monad.Trans.Maybe (MaybeT) +import Control.Monad.Error (Error(..)) #endif import Control.Monad.Journal.Class From 3dfd04c7fe744f00e953174e238866cc09563e4e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Tue, 12 Aug 2014 19:06:04 +0200 Subject: [PATCH 08/12] Use the right MonadIO class --- Language/Haskell/GhcMod/CabalApi.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Language/Haskell/GhcMod/CabalApi.hs b/Language/Haskell/GhcMod/CabalApi.hs index 4978d65..b97a168 100644 --- a/Language/Haskell/GhcMod/CabalApi.hs +++ b/Language/Haskell/GhcMod/CabalApi.hs @@ -16,10 +16,10 @@ import Language.Haskell.GhcMod.Gap (benchmarkBuildInfo, benchmarkTargets, import Language.Haskell.GhcMod.GhcPkg import Language.Haskell.GhcMod.Types +import MonadUtils (MonadIO, liftIO) import Control.Applicative ((<$>)) import qualified Control.Exception as E import Control.Monad (filterM) -import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Error.Class (MonadError(..)) import Data.Maybe (maybeToList) import Data.Set (fromList, toList) From c4ae9bc58900068b25fd87a991af31762777fc7e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Tue, 12 Aug 2014 21:00:06 +0200 Subject: [PATCH 09/12] Expose GhcModError --- Language/Haskell/GhcMod.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/Language/Haskell/GhcMod.hs b/Language/Haskell/GhcMod.hs index 5362ea8..69c00bd 100644 --- a/Language/Haskell/GhcMod.hs +++ b/Language/Haskell/GhcMod.hs @@ -18,6 +18,7 @@ module Language.Haskell.GhcMod ( -- * Monad Types , GhcModT , IOish + , GhcModError(..) -- * Monad utilities , runGhcModT , withOptions From e0bbd91eba8ae5185091ed1fa043016e6123f02f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Tue, 12 Aug 2014 21:07:12 +0200 Subject: [PATCH 10/12] Remove GMECabal, GMEGhc constructors from GhcModError for now --- Language/Haskell/GhcMod/CabalApi.hs | 11 +++++------ Language/Haskell/GhcMod/Types.hs | 2 -- 2 files changed, 5 insertions(+), 8 deletions(-) diff --git a/Language/Haskell/GhcMod/CabalApi.hs b/Language/Haskell/GhcMod/CabalApi.hs index b97a168..8483691 100644 --- a/Language/Haskell/GhcMod/CabalApi.hs +++ b/Language/Haskell/GhcMod/CabalApi.hs @@ -20,7 +20,7 @@ import MonadUtils (MonadIO, liftIO) import Control.Applicative ((<$>)) import qualified Control.Exception as E import Control.Monad (filterM) -import Control.Monad.Error.Class (MonadError(..)) +import Control.Monad.Error.Class (Error, MonadError(..)) import Data.Maybe (maybeToList) import Data.Set (fromList, toList) import Distribution.Package (Dependency(Dependency) @@ -71,18 +71,17 @@ includeDirectories cdir wdir dirs = uniqueAndSort (extdirs ++ [cdir,wdir]) ---------------------------------------------------------------- --- | Parsing a cabal file and returns 'PackageDescription'. --- 'IOException' is thrown if parsing fails. -parseCabalFile :: (MonadIO m, MonadError GhcModError m) +-- | Parse a cabal file and return a 'PackageDescription'. +parseCabalFile :: (MonadIO m, Error e, MonadError e m) => FilePath -> m PackageDescription parseCabalFile file = do cid <- liftIO $ getGHCId epgd <- liftIO $ readPackageDescription silent file case toPkgDesc cid epgd of - Left deps -> throwError $ GMECabal $ show deps ++ " are not installed" + Left deps -> fail $ show deps ++ " are not installed" Right (pd,_) -> if nullPkg pd - then throwError $ GMECabal $ file ++ " is broken" + then fail $ file ++ " is broken" else return pd where toPkgDesc cid = diff --git a/Language/Haskell/GhcMod/Types.hs b/Language/Haskell/GhcMod/Types.hs index 5bab199..b92b32c 100644 --- a/Language/Haskell/GhcMod/Types.hs +++ b/Language/Haskell/GhcMod/Types.hs @@ -12,8 +12,6 @@ data GhcModError = GMENoMsg | GMEString String -- ^ Some Error with a message. These are produced mostly by -- 'fail' calls on GhcModT. - | GMECabal String - | GMEGhc deriving (Eq,Show,Read) instance Error GhcModError where From 4def562179fbda231a22c3f39a8c9c38c0a6b8c9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Tue, 12 Aug 2014 21:20:36 +0200 Subject: [PATCH 11/12] Add version number to symbol table cache filename --- Language/Haskell/GhcMod/Find.hs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/Language/Haskell/GhcMod/Find.hs b/Language/Haskell/GhcMod/Find.hs index b923917..37d10c6 100644 --- a/Language/Haskell/GhcMod/Find.hs +++ b/Language/Haskell/GhcMod/Find.hs @@ -59,8 +59,13 @@ newtype SymbolDb = SymbolDb (Map Symbol [ModuleString]) ---------------------------------------------------------------- +-- | When introducing incompatible changes to the 'symbolCache' file format +-- increment this version number. +symbolCacheVersion = 0 + +-- | Filename of the symbol table cache file. symbolCache :: String -symbolCache = "ghc-mod.cache" +symbolCache = "ghc-mod-"++ show symbolCacheVersion ++".cache" packageCache :: String packageCache = "package.cache" @@ -130,7 +135,6 @@ getSymbolCachePath = do -- if the file does not exist or is invalid. -- The file name is printed. --- TODO: Before releaseing add a version number to the name of the cache file dumpSymbol :: IOish m => GhcModT m String dumpSymbol = do dir <- getSymbolCachePath From 2a1fd287715537e8fdb1032438c0fbfa2e584076 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Tue, 12 Aug 2014 21:21:08 +0200 Subject: [PATCH 12/12] docs for `ghcModExecutable` --- Language/Haskell/GhcMod/Find.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Language/Haskell/GhcMod/Find.hs b/Language/Haskell/GhcMod/Find.hs index 37d10c6..c6a3a6b 100644 --- a/Language/Haskell/GhcMod/Find.hs +++ b/Language/Haskell/GhcMod/Find.hs @@ -94,6 +94,8 @@ lookupSym sym (SymbolDb db) = fromMaybe [] $ M.lookup sym db loadSymbolDb :: IO SymbolDb loadSymbolDb = SymbolDb <$> readSymbolDb +-- | Returns the path to the currently running ghc-mod executable. With ghc<7.6 +-- this is a guess but >=7.6 uses 'getExecutablePath'. ghcModExecutable :: IO FilePath #ifndef SPEC ghcModExecutable = do