From 11243e53041a8cf0258b11990b892f50fffdab94 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Tue, 11 Aug 2015 06:35:14 +0200 Subject: [PATCH] Add in-memory caching otherwise everything is slow --- Language/Haskell/GhcMod/CabalHelper.hs | 30 ++++---- Language/Haskell/GhcMod/Caching.hs | 97 ++++++++++-------------- Language/Haskell/GhcMod/Caching/Types.hs | 52 +++++++++++++ Language/Haskell/GhcMod/Modules.hs | 2 +- Language/Haskell/GhcMod/Monad/Types.hs | 46 ++--------- Language/Haskell/GhcMod/Target.hs | 11 ++- Language/Haskell/GhcMod/Types.hs | 56 +++++++++++++- ghc-mod.cabal | 6 +- test/doctests.hs | 2 +- 9 files changed, 182 insertions(+), 120 deletions(-) create mode 100644 Language/Haskell/GhcMod/Caching/Types.hs diff --git a/Language/Haskell/GhcMod/CabalHelper.hs b/Language/Haskell/GhcMod/CabalHelper.hs index 57f133d..ac5bf39 100644 --- a/Language/Haskell/GhcMod/CabalHelper.hs +++ b/Language/Haskell/GhcMod/CabalHelper.hs @@ -26,9 +26,9 @@ module Language.Haskell.GhcMod.CabalHelper import Control.Applicative import Control.Monad +import Control.Category ((.)) import Data.Maybe import Data.Monoid -import Data.Version import Data.Serialize (Serialize) import Data.Traversable import Distribution.Helper @@ -40,15 +40,16 @@ import Language.Haskell.GhcMod.Utils import Language.Haskell.GhcMod.PathsAndFiles import Language.Haskell.GhcMod.Logging import System.FilePath -import Prelude +import Prelude hiding ((.)) import Paths_ghc_mod as GhcMod -- | Only package related GHC options, sufficient for things that don't need to -- access home modules -getGhcMergedPkgOptions :: (Applicative m, IOish m, GmEnv m, GmLog m) - => m [GHCOption] +getGhcMergedPkgOptions :: (Applicative m, IOish m, GmEnv m, GmState m, GmLog m) + => m [GHCOption] getGhcMergedPkgOptions = chCached Cached { + cacheLens = Just (lGmcMergedPkgOptions . lGmCaches), cacheFile = mergedPkgOptsCacheFile, cachedAction = \ _tcf (progs, rootdir, distdir, _) _ma -> do opts <- withCabal $ runQuery' progs rootdir distdir $ ghcMergedPkgOptions @@ -67,13 +68,14 @@ getCustomPkgDbStack = do mCusPkgDbFile <- liftIO . (traverse readFile <=< findCustomPackageDbFile) . cradleRootDir =<< cradle 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 mCusPkgStack <- getCustomPkgDbStack 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 { + cacheLens = Just (lGmcPackageDbStack . lGmCaches), cacheFile = pkgDbStackCacheFile, cachedAction = \ _tcf (progs, rootdir, distdir, _) _ma -> do 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 -- '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] -getComponents = chCached cabalHelperCache - -cabalHelperCache - :: (Functor m, Applicative m, MonadIO m) - => Cached m (Programs, FilePath, FilePath, (Version, String)) [GmComponent 'GMCRaw ChEntrypoint] -cabalHelperCache = Cached { +getComponents = chCached Cached { + cacheLens = Just (lGmcComponents . lGmCaches), cacheFile = cabalHelperCacheFile, cachedAction = \ _tcf (progs, rootdir, distdir, _vers) _ma -> runQuery' progs rootdir distdir $ do @@ -144,6 +142,8 @@ withCabal action = do cusPkgStack <- maybe [] ((PackageDb "clear"):) <$> getCustomPkgDbStack + --TODO: also invalidate when sandboxConfig file changed + when (isSetupConfigOutOfDate mCabalFile mCabalConfig) $ gmLog GmDebug "" $ strDoc $ "setup configuration is out of date, reconfiguring Cabal project." when pkgDbStackOutOfSync $ @@ -194,8 +194,8 @@ helperProgs opts = Programs { ghcPkgProgram = T.ghcPkgProgram opts } -chCached :: (Applicative m, IOish m, GmEnv m, GmLog m, Serialize a) - => Cached m (Programs, FilePath, FilePath, (Version, [Char])) a -> m a +chCached :: (Applicative m, IOish m, GmEnv m, GmState m, GmLog m, Serialize a) + => Cached m GhcModState ChCacheData a -> m a chCached c = do root <- cradleRootDir <$> cradle d <- cacheInputData root diff --git a/Language/Haskell/GhcMod/Caching.hs b/Language/Haskell/GhcMod/Caching.hs index 195c580..2c0219f 100644 --- a/Language/Haskell/GhcMod/Caching.hs +++ b/Language/Haskell/GhcMod/Caching.hs @@ -1,11 +1,16 @@ {-# 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.Monad import Control.Monad.Trans.Maybe import Data.Maybe -import Data.Serialize +import Data.Serialize (Serialize, encode, decode) import Data.Version +import Data.Label import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS8 import System.FilePath @@ -13,54 +18,13 @@ import Utils (TimedFile(..), timeMaybe, mightExist) import Paths_ghc_mod (version) import Language.Haskell.GhcMod.Monad.Types +import Language.Haskell.GhcMod.Caching.Types 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. -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' - -> Cached m d a -- ^ Cache descriptor + -> Cached m GhcModState d a -- ^ Cache descriptor -> d -> m a cached dir cd d = do @@ -86,23 +50,42 @@ cached dir cd d = do (ifs', a) <- (cachedAction cd) tcf d ma gmLog GmDebug "" $ (text "regenerating cache") <+>: text (cacheFile cd) <+> 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) $ BS.append cacheHeader $ encode (ifs', d, a) return a + setLabel l x = do + s <- gmsGet + gmsPut $ set l x s + readCache :: m (Maybe ([FilePath], d, a)) readCache = runMaybeT $ do - f <- MaybeT $ liftIO $ mightExist $ cacheFile cd - MaybeT $ readCache' f - where - readCache' f = 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 + case cacheLens cd of + Just label -> do + c <- MaybeT (get label `liftM` gmsGet) `mplus` readCacheFromFile + setLabel label $ Just c + return c + Nothing -> + readCacheFromFile + + readCacheFromFile = do + f <- MaybeT $ liftIO $ mightExist $ cacheFile cd + 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 dir cfile ifs = liftIO $ do diff --git a/Language/Haskell/GhcMod/Caching/Types.hs b/Language/Haskell/GhcMod/Caching/Types.hs new file mode 100644 index 0000000..ae32a7c --- /dev/null +++ b/Language/Haskell/GhcMod/Caching/Types.hs @@ -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])) diff --git a/Language/Haskell/GhcMod/Modules.hs b/Language/Haskell/GhcMod/Modules.hs index 03c69a8..a5766c6 100644 --- a/Language/Haskell/GhcMod/Modules.hs +++ b/Language/Haskell/GhcMod/Modules.hs @@ -14,7 +14,7 @@ import qualified GHC as G ---------------------------------------------------------------- -- | 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 Options { detailed } <- options df <- runGmPkgGhc G.getSessionDynFlags diff --git a/Language/Haskell/GhcMod/Monad/Types.hs b/Language/Haskell/GhcMod/Monad/Types.hs index e9343e7..0074ec3 100644 --- a/Language/Haskell/GhcMod/Monad/Types.hs +++ b/Language/Haskell/GhcMod/Monad/Types.hs @@ -30,6 +30,7 @@ module Language.Haskell.GhcMod.Monad.Types ( -- * Environment, state and logging , GhcModEnv(..) , GhcModState(..) + , GhcModCaches(..) , defaultGhcModState , GmGhcSession(..) , GmComponent(..) @@ -78,7 +79,7 @@ import Control.Monad.Reader (ReaderT(..)) import Control.Monad.Error (ErrorT(..), MonadError(..)) import Control.Monad.State.Strict (StateT(..)) 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.Trans.Control @@ -95,51 +96,13 @@ import qualified Control.Monad.IO.Class as MTL import Data.Monoid (Monoid) #endif -import Data.Set (Set) -import Data.Map as Map (Map, empty) import Data.Maybe import Data.Monoid import Data.IORef -import Distribution.Helper -import Text.PrettyPrint (Doc) import Prelude 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' -- 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' @@ -270,6 +233,11 @@ instance Monad m => GmState (GhcModT m) where gmsPut = GhcModT . put 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 gmlJournal :: GhcModLog -> m () gmlHistory :: m GhcModLog diff --git a/Language/Haskell/GhcMod/Target.hs b/Language/Haskell/GhcMod/Target.hs index 36ed391..a51e906 100644 --- a/Language/Haskell/GhcMod/Target.hs +++ b/Language/Haskell/GhcMod/Target.hs @@ -19,6 +19,7 @@ module Language.Haskell.GhcMod.Target where import Control.Arrow import Control.Applicative +import Control.Category ((.)) import Control.Monad.Reader (runReaderT) import GHC import GHC.Paths (libdir) @@ -53,7 +54,7 @@ import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set import Distribution.Helper -import Prelude +import Prelude hiding ((.)) import System.Directory import System.FilePath @@ -86,7 +87,7 @@ runLightGhc env action = do renv <- newIORef env 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 pkgOpts <- packageGhcOptions withLightHscEnv pkgOpts $ \env -> liftIO $ runLightGhc env action @@ -203,10 +204,11 @@ targetGhcOptions crdl sefnmn = do let cn = pickComponent candidates 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)] (Map.Map ChComponentName (GmComponent 'GMCResolved (Set.Set ModulePath))) resolvedComponentsCache = Cached { + cacheLens = Just (lGmcResolvedComponents . lGmCaches), cacheFile = resolvedComponentsCacheFile, cachedAction = \tcfs comps ma -> do Cradle {..} <- cradle @@ -282,7 +284,8 @@ findCandidates scns = foldl1 Set.intersection scns pickComponent :: Set ChComponentName -> ChComponentName 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 crdl <- cradle case cradleCabalFile crdl of diff --git a/Language/Haskell/GhcMod/Types.hs b/Language/Haskell/GhcMod/Types.hs index f7e0799..02532a2 100644 --- a/Language/Haskell/GhcMod/Types.hs +++ b/Language/Haskell/GhcMod/Types.hs @@ -1,5 +1,5 @@ {-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, DeriveGeneric, - StandaloneDeriving, DefaultSignatures, FlexibleInstances #-} + StandaloneDeriving, DefaultSignatures, FlexibleInstances, TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-deprecations #-} 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 Control.Exception (Exception) import Control.Applicative +import Control.Monad import Data.Serialize import Data.Version import Data.List (intercalate) @@ -23,16 +24,22 @@ import qualified Data.Set as Set import Data.Monoid import Data.Maybe import Data.Typeable (Typeable) +import Data.IORef +import Data.Label.Derive import Distribution.Helper import Exception (ExceptionMonad) #if __GLASGOW_HASKELL__ < 708 import qualified MonadUtils as GHC (MonadIO(..)) #endif import GHC (ModuleName, moduleNameString, mkModuleName) +import HscTypes (HscEnv) import PackageConfig (PackageConfig) import GHC.Generics +import Text.PrettyPrint (Doc) import Prelude +import Language.Haskell.GhcMod.Caching.Types + -- | A constraint alias (-XConstraintKinds) to make functions dealing with -- 'GhcModT' somewhat cleaner. -- @@ -114,6 +121,50 @@ data Cradle = Cradle { , cradleCabalFile :: Maybe FilePath } 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. @@ -303,3 +354,6 @@ instance Serialize Programs instance Serialize ChModuleName instance Serialize ChComponentName instance Serialize ChEntrypoint + +mkLabel ''GhcModCaches +mkLabel ''GhcModState diff --git a/ghc-mod.cabal b/ghc-mod.cabal index e8be16a..76d700e 100644 --- a/ghc-mod.cabal +++ b/ghc-mod.cabal @@ -87,7 +87,7 @@ Library GHC-Options: -Wall -fno-warn-deprecations Default-Extensions: ScopedTypeVariables, RecordWildCards, NamedFieldPuns, ConstraintKinds, FlexibleContexts, - DataKinds, KindSignatures + DataKinds, KindSignatures, TypeOperators Exposed-Modules: Language.Haskell.GhcMod Language.Haskell.GhcMod.Internal Other-Modules: Paths_ghc_mod @@ -96,6 +96,7 @@ Library Language.Haskell.GhcMod.Browse Language.Haskell.GhcMod.CabalHelper Language.Haskell.GhcMod.Caching + Language.Haskell.GhcMod.Caching.Types Language.Haskell.GhcMod.CaseSplit Language.Haskell.GhcMod.Check Language.Haskell.GhcMod.Convert @@ -154,6 +155,7 @@ Library , haskell-src-exts , text , djinn-ghc >= 0.0.2.2 + , fclabels if impl(ghc < 7.8) Build-Depends: convertible if impl(ghc < 7.5) @@ -213,7 +215,7 @@ Test-Suite spec Default-Language: Haskell2010 Default-Extensions: ScopedTypeVariables, RecordWildCards, NamedFieldPuns, ConstraintKinds, FlexibleContexts, - DataKinds, KindSignatures + DataKinds, KindSignatures, TypeOperators Main-Is: Main.hs Hs-Source-Dirs: test, . Ghc-Options: -Wall -fno-warn-deprecations diff --git a/test/doctests.hs b/test/doctests.hs index 08da97b..03d710f 100644 --- a/test/doctests.hs +++ b/test/doctests.hs @@ -9,7 +9,7 @@ main = doctest , "-package", "transformers-" ++ VERSION_transformers , "-package", "mtl-" ++ VERSION_mtl , "-package", "directory-" ++ VERSION_directory - , "-XScopedTypeVariables", "-XRecordWildCards", "-XNamedFieldPuns", "-XConstraintKinds", "-XFlexibleContexts", "-XDataKinds", "-XKindSignatures" + , "-XScopedTypeVariables", "-XRecordWildCards", "-XNamedFieldPuns", "-XConstraintKinds", "-XFlexibleContexts", "-XDataKinds", "-XKindSignatures", "-XTypeOperators" , "-idist/build/autogen/" , "-optP-include" , "-optPdist/build/autogen/cabal_macros.h"