Add in-memory caching otherwise everything is slow

This commit is contained in:
Daniel Gröber 2015-08-11 06:35:14 +02:00
parent 05360e0660
commit 11243e5304
9 changed files with 182 additions and 120 deletions

View File

@ -26,9 +26,9 @@ module Language.Haskell.GhcMod.CabalHelper
import Control.Applicative import Control.Applicative
import Control.Monad import Control.Monad
import Control.Category ((.))
import Data.Maybe import Data.Maybe
import Data.Monoid import Data.Monoid
import Data.Version
import Data.Serialize (Serialize) import Data.Serialize (Serialize)
import Data.Traversable import Data.Traversable
import Distribution.Helper import Distribution.Helper
@ -40,15 +40,16 @@ import Language.Haskell.GhcMod.Utils
import Language.Haskell.GhcMod.PathsAndFiles import Language.Haskell.GhcMod.PathsAndFiles
import Language.Haskell.GhcMod.Logging import Language.Haskell.GhcMod.Logging
import System.FilePath import System.FilePath
import Prelude import Prelude hiding ((.))
import Paths_ghc_mod as GhcMod import Paths_ghc_mod as GhcMod
-- | Only package related GHC options, sufficient for things that don't need to -- | Only package related GHC options, sufficient for things that don't need to
-- access home modules -- access home modules
getGhcMergedPkgOptions :: (Applicative m, IOish m, GmEnv m, GmLog m) getGhcMergedPkgOptions :: (Applicative m, IOish m, GmEnv m, GmState m, GmLog m)
=> m [GHCOption] => m [GHCOption]
getGhcMergedPkgOptions = chCached Cached { getGhcMergedPkgOptions = chCached Cached {
cacheLens = Just (lGmcMergedPkgOptions . lGmCaches),
cacheFile = mergedPkgOptsCacheFile, cacheFile = mergedPkgOptsCacheFile,
cachedAction = \ _tcf (progs, rootdir, distdir, _) _ma -> do cachedAction = \ _tcf (progs, rootdir, distdir, _) _ma -> do
opts <- withCabal $ runQuery' progs rootdir distdir $ ghcMergedPkgOptions opts <- withCabal $ runQuery' progs rootdir distdir $ ghcMergedPkgOptions
@ -67,13 +68,14 @@ getCustomPkgDbStack = do
mCusPkgDbFile <- liftIO . (traverse readFile <=< findCustomPackageDbFile) . cradleRootDir =<< cradle mCusPkgDbFile <- liftIO . (traverse readFile <=< findCustomPackageDbFile) . cradleRootDir =<< cradle
return $ parseCustomPackageDb <$> mCusPkgDbFile return $ parseCustomPackageDb <$> mCusPkgDbFile
getPackageDbStack :: (IOish m, GmEnv m, GmLog m) => m [GhcPkgDb] getPackageDbStack :: (IOish m, GmEnv m, GmState m, GmLog m) => m [GhcPkgDb]
getPackageDbStack = do getPackageDbStack = do
mCusPkgStack <- getCustomPkgDbStack mCusPkgStack <- getCustomPkgDbStack
flip fromMaybe mCusPkgStack <$> getPackageDbStack' flip fromMaybe mCusPkgStack <$> getPackageDbStack'
getPackageDbStack' :: (IOish m, GmEnv m, GmLog m) => m [GhcPkgDb] getPackageDbStack' :: (IOish m, GmEnv m, GmState m, GmLog m) => m [GhcPkgDb]
getPackageDbStack' = chCached Cached { getPackageDbStack' = chCached Cached {
cacheLens = Just (lGmcPackageDbStack . lGmCaches),
cacheFile = pkgDbStackCacheFile, cacheFile = pkgDbStackCacheFile,
cachedAction = \ _tcf (progs, rootdir, distdir, _) _ma -> do cachedAction = \ _tcf (progs, rootdir, distdir, _) _ma -> do
dbs <- withCabal $ map chPkgToGhcPkg <$> runQuery' progs rootdir distdir packageDbStack dbs <- withCabal $ map chPkgToGhcPkg <$> runQuery' progs rootdir distdir packageDbStack
@ -90,14 +92,10 @@ chPkgToGhcPkg (ChPkgSpecific f) = PackageDb f
-- --
-- The Component\'s 'gmcHomeModuleGraph' will be empty and has to be resolved by -- The Component\'s 'gmcHomeModuleGraph' will be empty and has to be resolved by
-- 'resolveGmComponents'. -- 'resolveGmComponents'.
getComponents :: (Applicative m, IOish m, GmEnv m, GmLog m) getComponents :: (Applicative m, IOish m, GmEnv m, GmState m, GmLog m)
=> m [GmComponent 'GMCRaw ChEntrypoint] => m [GmComponent 'GMCRaw ChEntrypoint]
getComponents = chCached cabalHelperCache getComponents = chCached Cached {
cacheLens = Just (lGmcComponents . lGmCaches),
cabalHelperCache
:: (Functor m, Applicative m, MonadIO m)
=> Cached m (Programs, FilePath, FilePath, (Version, String)) [GmComponent 'GMCRaw ChEntrypoint]
cabalHelperCache = Cached {
cacheFile = cabalHelperCacheFile, cacheFile = cabalHelperCacheFile,
cachedAction = \ _tcf (progs, rootdir, distdir, _vers) _ma -> cachedAction = \ _tcf (progs, rootdir, distdir, _vers) _ma ->
runQuery' progs rootdir distdir $ do runQuery' progs rootdir distdir $ do
@ -144,6 +142,8 @@ withCabal action = do
cusPkgStack <- maybe [] ((PackageDb "clear"):) <$> getCustomPkgDbStack cusPkgStack <- maybe [] ((PackageDb "clear"):) <$> getCustomPkgDbStack
--TODO: also invalidate when sandboxConfig file changed
when (isSetupConfigOutOfDate mCabalFile mCabalConfig) $ when (isSetupConfigOutOfDate mCabalFile mCabalConfig) $
gmLog GmDebug "" $ strDoc $ "setup configuration is out of date, reconfiguring Cabal project." gmLog GmDebug "" $ strDoc $ "setup configuration is out of date, reconfiguring Cabal project."
when pkgDbStackOutOfSync $ when pkgDbStackOutOfSync $
@ -194,8 +194,8 @@ helperProgs opts = Programs {
ghcPkgProgram = T.ghcPkgProgram opts ghcPkgProgram = T.ghcPkgProgram opts
} }
chCached :: (Applicative m, IOish m, GmEnv m, GmLog m, Serialize a) chCached :: (Applicative m, IOish m, GmEnv m, GmState m, GmLog m, Serialize a)
=> Cached m (Programs, FilePath, FilePath, (Version, [Char])) a -> m a => Cached m GhcModState ChCacheData a -> m a
chCached c = do chCached c = do
root <- cradleRootDir <$> cradle root <- cradleRootDir <$> cradle
d <- cacheInputData root d <- cacheInputData root

View File

@ -1,11 +1,16 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Language.Haskell.GhcMod.Caching where module Language.Haskell.GhcMod.Caching (
module Language.Haskell.GhcMod.Caching
, module Language.Haskell.GhcMod.Caching.Types
) where
import Control.Arrow (first) import Control.Arrow (first)
import Control.Monad
import Control.Monad.Trans.Maybe import Control.Monad.Trans.Maybe
import Data.Maybe import Data.Maybe
import Data.Serialize import Data.Serialize (Serialize, encode, decode)
import Data.Version import Data.Version
import Data.Label
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8 import qualified Data.ByteString.Char8 as BS8
import System.FilePath import System.FilePath
@ -13,54 +18,13 @@ import Utils (TimedFile(..), timeMaybe, mightExist)
import Paths_ghc_mod (version) import Paths_ghc_mod (version)
import Language.Haskell.GhcMod.Monad.Types import Language.Haskell.GhcMod.Monad.Types
import Language.Haskell.GhcMod.Caching.Types
import Language.Haskell.GhcMod.Logging import Language.Haskell.GhcMod.Logging
data Cached m d a = Cached {
cacheFile :: FilePath,
cachedAction :: TimedCacheFiles
-> d
-> Maybe a
-> m ([FilePath], a)
-- ^ @cachedAction tcf data ma@
--
-- * @tcf@: Input file timestamps. Not technically necessary, just an
-- optimizazion when knowing which input files changed can make updating the
-- cache faster
--
-- * @data@: Arbitrary static input data to cache action. Can be used to
-- invalidate the cache using something other than file timestamps
-- i.e. environment tool version numbers
--
-- * @ma@: Cached data if it existed
--
-- Returns:
--
-- * @fst@: Input files used in generating the cache
--
-- * @snd@: Cache data, will be stored alongside the static input data in the
-- 'cacheFile'
--
-- The cached action, will only run if one of the following is true:
--
-- * 'cacheFile' doesn\'t exist yet
-- * 'cacheFile' exists and 'inputData' changed
-- * any files returned by the cached action changed
}
data TimedCacheFiles = TimedCacheFiles {
tcCacheFile :: Maybe TimedFile,
-- ^ 'cacheFile' timestamp
tcFiles :: [TimedFile]
-- ^ Timestamped files returned by the cached action
}
-- | Cache a MonadIO action with proper invalidation. -- | Cache a MonadIO action with proper invalidation.
cached :: forall m a d. (MonadIO m, GmLog m, Serialize a, Eq d, Serialize d, Show d) cached :: forall m a d. (MonadIO m, GmLog m, GmState m, Serialize a, Eq d, Serialize d, Show d)
=> FilePath -- ^ Directory to prepend to 'cacheFile' => FilePath -- ^ Directory to prepend to 'cacheFile'
-> Cached m d a -- ^ Cache descriptor -> Cached m GhcModState d a -- ^ Cache descriptor
-> d -> d
-> m a -> m a
cached dir cd d = do cached dir cd d = do
@ -86,23 +50,42 @@ cached dir cd d = do
(ifs', a) <- (cachedAction cd) tcf d ma (ifs', a) <- (cachedAction cd) tcf d ma
gmLog GmDebug "" $ (text "regenerating cache") <+>: text (cacheFile cd) gmLog GmDebug "" $ (text "regenerating cache") <+>: text (cacheFile cd)
<+> parens (text cause) <+> parens (text cause)
case cacheLens cd of
Nothing -> return ()
Just label -> do
gmLog GmDebug "" $ (text "writing memory cache") <+>: text (cacheFile cd)
setLabel label $ Just (ifs', d, a)
liftIO $ BS.writeFile (dir </> cacheFile cd) $ liftIO $ BS.writeFile (dir </> cacheFile cd) $
BS.append cacheHeader $ encode (ifs', d, a) BS.append cacheHeader $ encode (ifs', d, a)
return a return a
setLabel l x = do
s <- gmsGet
gmsPut $ set l x s
readCache :: m (Maybe ([FilePath], d, a)) readCache :: m (Maybe ([FilePath], d, a))
readCache = runMaybeT $ do readCache = runMaybeT $ do
f <- MaybeT $ liftIO $ mightExist $ cacheFile cd case cacheLens cd of
MaybeT $ readCache' f Just label -> do
where c <- MaybeT (get label `liftM` gmsGet) `mplus` readCacheFromFile
readCache' f = do setLabel label $ Just c
gmLog GmDebug "" $ (text "reading cache") <+>: text (cacheFile cd) return c
cc <- liftIO $ BS.readFile f Nothing ->
case first BS8.words $ BS8.span (/='\n') cc of readCacheFromFile
(["Written", "by", "ghc-mod", ver], rest)
| BS8.unpack ver == showVersion version -> readCacheFromFile = do
return $ either (const Nothing) Just $ decode $ BS.drop 1 rest f <- MaybeT $ liftIO $ mightExist $ cacheFile cd
_ -> return Nothing readCacheFromFile' f
readCacheFromFile' f = MaybeT $ do
gmLog GmDebug "" $ (text "reading cache") <+>: text (cacheFile cd)
cc <- liftIO $ BS.readFile f
case first BS8.words $ BS8.span (/='\n') cc of
(["Written", "by", "ghc-mod", ver], rest)
| BS8.unpack ver == showVersion version ->
return $ either (const Nothing) Just $ decode $ BS.drop 1 rest
_ -> return Nothing
timeCacheInput :: MonadIO m => FilePath -> FilePath -> [FilePath] -> m TimedCacheFiles timeCacheInput :: MonadIO m => FilePath -> FilePath -> [FilePath] -> m TimedCacheFiles
timeCacheInput dir cfile ifs = liftIO $ do timeCacheInput dir cfile ifs = liftIO $ do

View File

@ -0,0 +1,52 @@
module Language.Haskell.GhcMod.Caching.Types where
import Utils
import Data.Label
import Data.Version
import Distribution.Helper
type CacheContents d a = Maybe ([FilePath], d, a)
type CacheLens s d a = s :-> CacheContents d a
data Cached m s d a = Cached {
cacheFile :: FilePath,
cacheLens :: Maybe (CacheLens s d a),
cachedAction :: TimedCacheFiles
-> d
-> Maybe a
-> m ([FilePath], a)
-- ^ @cachedAction tcf data ma@
--
-- * @tcf@: Input file timestamps. Not technically necessary, just an
-- optimizazion when knowing which input files changed can make updating the
-- cache faster
--
-- * @data@: Arbitrary static input data to cache action. Can be used to
-- invalidate the cache using something other than file timestamps
-- i.e. environment tool version numbers
--
-- * @ma@: Cached data if it existed
--
-- Returns:
--
-- * @fst@: Input files used in generating the cache
--
-- * @snd@: Cache data, will be stored alongside the static input data in the
-- 'cacheFile'
--
-- The cached action, will only run if one of the following is true:
--
-- * 'cacheFile' doesn\'t exist yet
-- * 'cacheFile' exists and 'inputData' changed
-- * any files returned by the cached action changed
}
data TimedCacheFiles = TimedCacheFiles {
tcCacheFile :: Maybe TimedFile,
-- ^ 'cacheFile' timestamp
tcFiles :: [TimedFile]
-- ^ Timestamped files returned by the cached action
}
type ChCacheData = (Programs, FilePath, FilePath, (Version, [Char]))

View File

@ -14,7 +14,7 @@ import qualified GHC as G
---------------------------------------------------------------- ----------------------------------------------------------------
-- | Listing installed modules. -- | Listing installed modules.
modules :: (IOish m, GmEnv m, GmLog m) => m String modules :: (IOish m, GmEnv m, GmState m, GmLog m) => m String
modules = do modules = do
Options { detailed } <- options Options { detailed } <- options
df <- runGmPkgGhc G.getSessionDynFlags df <- runGmPkgGhc G.getSessionDynFlags

View File

@ -30,6 +30,7 @@ module Language.Haskell.GhcMod.Monad.Types (
-- * Environment, state and logging -- * Environment, state and logging
, GhcModEnv(..) , GhcModEnv(..)
, GhcModState(..) , GhcModState(..)
, GhcModCaches(..)
, defaultGhcModState , defaultGhcModState
, GmGhcSession(..) , GmGhcSession(..)
, GmComponent(..) , GmComponent(..)
@ -78,7 +79,7 @@ import Control.Monad.Reader (ReaderT(..))
import Control.Monad.Error (ErrorT(..), MonadError(..)) import Control.Monad.Error (ErrorT(..), MonadError(..))
import Control.Monad.State.Strict (StateT(..)) import Control.Monad.State.Strict (StateT(..))
import Control.Monad.Trans.Journal (JournalT) import Control.Monad.Trans.Journal (JournalT)
import Control.Monad.Trans.Maybe (MaybeT) import Control.Monad.Trans.Maybe (MaybeT(..))
import Control.Monad.Base (MonadBase(..), liftBase) import Control.Monad.Base (MonadBase(..), liftBase)
import Control.Monad.Trans.Control import Control.Monad.Trans.Control
@ -95,51 +96,13 @@ import qualified Control.Monad.IO.Class as MTL
import Data.Monoid (Monoid) import Data.Monoid (Monoid)
#endif #endif
import Data.Set (Set)
import Data.Map as Map (Map, empty)
import Data.Maybe import Data.Maybe
import Data.Monoid import Data.Monoid
import Data.IORef import Data.IORef
import Distribution.Helper
import Text.PrettyPrint (Doc)
import Prelude import Prelude
import qualified MonadUtils as GHC (MonadIO(..)) import qualified MonadUtils as GHC (MonadIO(..))
data GhcModEnv = GhcModEnv {
gmOptions :: Options
, gmCradle :: Cradle
}
data GhcModLog = GhcModLog {
gmLogLevel :: Maybe GmLogLevel,
gmLogVomitDump :: Last Bool,
gmLogMessages :: [(GmLogLevel, String, Doc)]
} deriving (Show)
instance Monoid GhcModLog where
mempty = GhcModLog (Just GmPanic) (Last Nothing) mempty
GhcModLog ml vd ls `mappend` GhcModLog ml' vd' ls' =
GhcModLog (ml' `mplus` ml) (vd `mappend` vd') (ls `mappend` ls')
data GmGhcSession = GmGhcSession {
gmgsOptions :: ![GHCOption],
gmgsSession :: !(IORef HscEnv)
}
data GhcModState = GhcModState {
gmGhcSession :: !(Maybe GmGhcSession)
, gmComponents :: !(Map ChComponentName (GmComponent 'GMCResolved (Set ModulePath)))
, gmCompilerMode :: !CompilerMode
}
defaultGhcModState :: GhcModState
defaultGhcModState = GhcModState Nothing Map.empty Simple
data CompilerMode = Simple | Intelligent deriving (Eq,Show,Read)
----------------------------------------------------------------
-- | This is basically a newtype wrapper around 'StateT', 'ErrorT', 'JournalT' -- | This is basically a newtype wrapper around 'StateT', 'ErrorT', 'JournalT'
-- and 'ReaderT' with custom instances for 'GhcMonad' and it's constraints that -- and 'ReaderT' with custom instances for 'GhcMonad' and it's constraints that
-- means you can run (almost) all functions from the GHC API on top of 'GhcModT' -- means you can run (almost) all functions from the GHC API on top of 'GhcModT'
@ -270,6 +233,11 @@ instance Monad m => GmState (GhcModT m) where
gmsPut = GhcModT . put gmsPut = GhcModT . put
gmsState = GhcModT . state gmsState = GhcModT . state
instance GmState m => GmState (MaybeT m) where
gmsGet = MaybeT $ Just `liftM` gmsGet
gmsPut = MaybeT . (Just `liftM`) . gmsPut
gmsState = MaybeT . (Just `liftM`) . gmsState
class Monad m => GmLog m where class Monad m => GmLog m where
gmlJournal :: GhcModLog -> m () gmlJournal :: GhcModLog -> m ()
gmlHistory :: m GhcModLog gmlHistory :: m GhcModLog

View File

@ -19,6 +19,7 @@ module Language.Haskell.GhcMod.Target where
import Control.Arrow import Control.Arrow
import Control.Applicative import Control.Applicative
import Control.Category ((.))
import Control.Monad.Reader (runReaderT) import Control.Monad.Reader (runReaderT)
import GHC import GHC
import GHC.Paths (libdir) import GHC.Paths (libdir)
@ -53,7 +54,7 @@ import qualified Data.Map as Map
import Data.Set (Set) import Data.Set (Set)
import qualified Data.Set as Set import qualified Data.Set as Set
import Distribution.Helper import Distribution.Helper
import Prelude import Prelude hiding ((.))
import System.Directory import System.Directory
import System.FilePath import System.FilePath
@ -86,7 +87,7 @@ runLightGhc env action = do
renv <- newIORef env renv <- newIORef env
flip runReaderT renv $ unLightGhc action flip runReaderT renv $ unLightGhc action
runGmPkgGhc :: (IOish m, GmEnv m, GmLog m) => LightGhc a -> m a runGmPkgGhc :: (IOish m, GmEnv m, GmState m, GmLog m) => LightGhc a -> m a
runGmPkgGhc action = do runGmPkgGhc action = do
pkgOpts <- packageGhcOptions pkgOpts <- packageGhcOptions
withLightHscEnv pkgOpts $ \env -> liftIO $ runLightGhc env action withLightHscEnv pkgOpts $ \env -> liftIO $ runLightGhc env action
@ -203,10 +204,11 @@ targetGhcOptions crdl sefnmn = do
let cn = pickComponent candidates let cn = pickComponent candidates
return $ gmcGhcOpts $ fromJust $ Map.lookup cn mcs return $ gmcGhcOpts $ fromJust $ Map.lookup cn mcs
resolvedComponentsCache :: IOish m => Cached (GhcModT m) resolvedComponentsCache :: IOish m => Cached (GhcModT m) GhcModState
[GmComponent 'GMCRaw (Set.Set ModulePath)] [GmComponent 'GMCRaw (Set.Set ModulePath)]
(Map.Map ChComponentName (GmComponent 'GMCResolved (Set.Set ModulePath))) (Map.Map ChComponentName (GmComponent 'GMCResolved (Set.Set ModulePath)))
resolvedComponentsCache = Cached { resolvedComponentsCache = Cached {
cacheLens = Just (lGmcResolvedComponents . lGmCaches),
cacheFile = resolvedComponentsCacheFile, cacheFile = resolvedComponentsCacheFile,
cachedAction = \tcfs comps ma -> do cachedAction = \tcfs comps ma -> do
Cradle {..} <- cradle Cradle {..} <- cradle
@ -282,7 +284,8 @@ findCandidates scns = foldl1 Set.intersection scns
pickComponent :: Set ChComponentName -> ChComponentName pickComponent :: Set ChComponentName -> ChComponentName
pickComponent scn = Set.findMin scn pickComponent scn = Set.findMin scn
packageGhcOptions :: (Applicative m, IOish m, GmEnv m, GmLog m) => m [GHCOption] packageGhcOptions :: (Applicative m, IOish m, GmEnv m, GmState m, GmLog m)
=> m [GHCOption]
packageGhcOptions = do packageGhcOptions = do
crdl <- cradle crdl <- cradle
case cradleCabalFile crdl of case cradleCabalFile crdl of

View File

@ -1,5 +1,5 @@
{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, {-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, DeriveGeneric,
StandaloneDeriving, DefaultSignatures, FlexibleInstances #-} StandaloneDeriving, DefaultSignatures, FlexibleInstances, TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-deprecations #-} {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-deprecations #-}
module Language.Haskell.GhcMod.Types ( module Language.Haskell.GhcMod.Types (
module Language.Haskell.GhcMod.Types module Language.Haskell.GhcMod.Types
@ -13,6 +13,7 @@ import Control.Monad.Error (Error(..))
import qualified Control.Monad.IO.Class as MTL import qualified Control.Monad.IO.Class as MTL
import Control.Exception (Exception) import Control.Exception (Exception)
import Control.Applicative import Control.Applicative
import Control.Monad
import Data.Serialize import Data.Serialize
import Data.Version import Data.Version
import Data.List (intercalate) import Data.List (intercalate)
@ -23,16 +24,22 @@ import qualified Data.Set as Set
import Data.Monoid import Data.Monoid
import Data.Maybe import Data.Maybe
import Data.Typeable (Typeable) import Data.Typeable (Typeable)
import Data.IORef
import Data.Label.Derive
import Distribution.Helper import Distribution.Helper
import Exception (ExceptionMonad) import Exception (ExceptionMonad)
#if __GLASGOW_HASKELL__ < 708 #if __GLASGOW_HASKELL__ < 708
import qualified MonadUtils as GHC (MonadIO(..)) import qualified MonadUtils as GHC (MonadIO(..))
#endif #endif
import GHC (ModuleName, moduleNameString, mkModuleName) import GHC (ModuleName, moduleNameString, mkModuleName)
import HscTypes (HscEnv)
import PackageConfig (PackageConfig) import PackageConfig (PackageConfig)
import GHC.Generics import GHC.Generics
import Text.PrettyPrint (Doc)
import Prelude import Prelude
import Language.Haskell.GhcMod.Caching.Types
-- | A constraint alias (-XConstraintKinds) to make functions dealing with -- | A constraint alias (-XConstraintKinds) to make functions dealing with
-- 'GhcModT' somewhat cleaner. -- 'GhcModT' somewhat cleaner.
-- --
@ -114,6 +121,50 @@ data Cradle = Cradle {
, cradleCabalFile :: Maybe FilePath , cradleCabalFile :: Maybe FilePath
} deriving (Eq, Show) } deriving (Eq, Show)
data GhcModEnv = GhcModEnv {
gmOptions :: Options
, gmCradle :: Cradle
}
data GhcModLog = GhcModLog {
gmLogLevel :: Maybe GmLogLevel,
gmLogVomitDump :: Last Bool,
gmLogMessages :: [(GmLogLevel, String, Doc)]
} deriving (Show)
instance Monoid GhcModLog where
mempty = GhcModLog (Just GmPanic) (Last Nothing) mempty
GhcModLog ml vd ls `mappend` GhcModLog ml' vd' ls' =
GhcModLog (ml' `mplus` ml) (vd `mappend` vd') (ls `mappend` ls')
data GmGhcSession = GmGhcSession {
gmgsOptions :: ![GHCOption],
gmgsSession :: !(IORef HscEnv)
}
data GhcModCaches = GhcModCaches {
gmcPackageDbStack :: CacheContents ChCacheData [GhcPkgDb]
, gmcMergedPkgOptions :: CacheContents ChCacheData [GHCOption]
, gmcComponents :: CacheContents ChCacheData [GmComponent 'GMCRaw ChEntrypoint]
, gmcResolvedComponents :: CacheContents
[GmComponent 'GMCRaw (Set.Set ModulePath)]
(Map.Map ChComponentName (GmComponent 'GMCResolved (Set.Set ModulePath)))
}
data GhcModState = GhcModState {
gmGhcSession :: !(Maybe GmGhcSession)
, gmComponents :: !(Map ChComponentName (GmComponent 'GMCResolved (Set ModulePath)))
, gmCompilerMode :: !CompilerMode
, gmCaches :: !GhcModCaches
}
data CompilerMode = Simple | Intelligent deriving (Eq,Show,Read)
defaultGhcModState :: GhcModState
defaultGhcModState =
GhcModState n Map.empty Simple (GhcModCaches n n n n)
where n = Nothing
---------------------------------------------------------------- ----------------------------------------------------------------
-- | GHC package database flags. -- | GHC package database flags.
@ -303,3 +354,6 @@ instance Serialize Programs
instance Serialize ChModuleName instance Serialize ChModuleName
instance Serialize ChComponentName instance Serialize ChComponentName
instance Serialize ChEntrypoint instance Serialize ChEntrypoint
mkLabel ''GhcModCaches
mkLabel ''GhcModState

View File

@ -87,7 +87,7 @@ Library
GHC-Options: -Wall -fno-warn-deprecations GHC-Options: -Wall -fno-warn-deprecations
Default-Extensions: ScopedTypeVariables, RecordWildCards, NamedFieldPuns, Default-Extensions: ScopedTypeVariables, RecordWildCards, NamedFieldPuns,
ConstraintKinds, FlexibleContexts, ConstraintKinds, FlexibleContexts,
DataKinds, KindSignatures DataKinds, KindSignatures, TypeOperators
Exposed-Modules: Language.Haskell.GhcMod Exposed-Modules: Language.Haskell.GhcMod
Language.Haskell.GhcMod.Internal Language.Haskell.GhcMod.Internal
Other-Modules: Paths_ghc_mod Other-Modules: Paths_ghc_mod
@ -96,6 +96,7 @@ Library
Language.Haskell.GhcMod.Browse Language.Haskell.GhcMod.Browse
Language.Haskell.GhcMod.CabalHelper Language.Haskell.GhcMod.CabalHelper
Language.Haskell.GhcMod.Caching Language.Haskell.GhcMod.Caching
Language.Haskell.GhcMod.Caching.Types
Language.Haskell.GhcMod.CaseSplit Language.Haskell.GhcMod.CaseSplit
Language.Haskell.GhcMod.Check Language.Haskell.GhcMod.Check
Language.Haskell.GhcMod.Convert Language.Haskell.GhcMod.Convert
@ -154,6 +155,7 @@ Library
, haskell-src-exts , haskell-src-exts
, text , text
, djinn-ghc >= 0.0.2.2 , djinn-ghc >= 0.0.2.2
, fclabels
if impl(ghc < 7.8) if impl(ghc < 7.8)
Build-Depends: convertible Build-Depends: convertible
if impl(ghc < 7.5) if impl(ghc < 7.5)
@ -213,7 +215,7 @@ Test-Suite spec
Default-Language: Haskell2010 Default-Language: Haskell2010
Default-Extensions: ScopedTypeVariables, RecordWildCards, NamedFieldPuns, Default-Extensions: ScopedTypeVariables, RecordWildCards, NamedFieldPuns,
ConstraintKinds, FlexibleContexts, ConstraintKinds, FlexibleContexts,
DataKinds, KindSignatures DataKinds, KindSignatures, TypeOperators
Main-Is: Main.hs Main-Is: Main.hs
Hs-Source-Dirs: test, . Hs-Source-Dirs: test, .
Ghc-Options: -Wall -fno-warn-deprecations Ghc-Options: -Wall -fno-warn-deprecations

View File

@ -9,7 +9,7 @@ main = doctest
, "-package", "transformers-" ++ VERSION_transformers , "-package", "transformers-" ++ VERSION_transformers
, "-package", "mtl-" ++ VERSION_mtl , "-package", "mtl-" ++ VERSION_mtl
, "-package", "directory-" ++ VERSION_directory , "-package", "directory-" ++ VERSION_directory
, "-XScopedTypeVariables", "-XRecordWildCards", "-XNamedFieldPuns", "-XConstraintKinds", "-XFlexibleContexts", "-XDataKinds", "-XKindSignatures" , "-XScopedTypeVariables", "-XRecordWildCards", "-XNamedFieldPuns", "-XConstraintKinds", "-XFlexibleContexts", "-XDataKinds", "-XKindSignatures", "-XTypeOperators"
, "-idist/build/autogen/" , "-idist/build/autogen/"
, "-optP-include" , "-optP-include"
, "-optPdist/build/autogen/cabal_macros.h" , "-optPdist/build/autogen/cabal_macros.h"