Merge pull request #141 from alanz/master

Exposing lower level API using GhcMonad
This commit is contained in:
Kazu Yamamoto 2013-09-02 19:25:46 -07:00
commit 0f3056e701
6 changed files with 37 additions and 9 deletions

View File

@ -21,6 +21,7 @@ import System.FilePath (normalise)
---------------------------------------------------------------- ----------------------------------------------------------------
-- | A means to read the log
type LogReader = IO [String] type LogReader = IO [String]
---------------------------------------------------------------- ----------------------------------------------------------------

View File

@ -57,9 +57,12 @@ importDirs = [".","..","../..","../../..","../../../..","../../../../.."]
data Build = CabalPkg | SingleFile deriving Eq data Build = CabalPkg | SingleFile deriving Eq
initializeFlagsWithCradle :: Options -> Cradle -> [GHCOption] -> Bool -> Ghc LogReader -- | Initialize the 'DynFlags' relating to the compilation of a single
-- file or GHC session according to the 'Cradle' and 'Options'
-- provided.
initializeFlagsWithCradle :: GhcMonad m => Options -> Cradle -> [GHCOption] -> Bool -> m LogReader
initializeFlagsWithCradle opt cradle ghcOptions logging initializeFlagsWithCradle opt cradle ghcOptions logging
| cabal = withCabal ||> withoutCabal | cabal = withCabal |||> withoutCabal
| otherwise = withoutCabal | otherwise = withoutCabal
where where
cabal = isJust $ cradleCabalFile cradle cabal = isJust $ cradleCabalFile cradle
@ -71,13 +74,13 @@ initializeFlagsWithCradle opt cradle ghcOptions logging
---------------------------------------------------------------- ----------------------------------------------------------------
initSession :: Build initSession :: GhcMonad m => Build
-> Options -> Options
-> [GHCOption] -> [GHCOption]
-> [IncludeDir] -> [IncludeDir]
-> Maybe [Package] -> Maybe [Package]
-> Bool -> Bool
-> Ghc LogReader -> m LogReader
initSession build opt cmdOpts idirs mDepPkgs logging = do initSession build opt cmdOpts idirs mDepPkgs logging = do
dflags0 <- getSessionDynFlags dflags0 <- getSessionDynFlags
(dflags1,readLog) <- setupDynamicFlags dflags0 (dflags1,readLog) <- setupDynamicFlags dflags0
@ -92,7 +95,7 @@ initSession build opt cmdOpts idirs mDepPkgs logging = do
---------------------------------------------------------------- ----------------------------------------------------------------
initializeFlags :: Options -> Ghc () initializeFlags :: GhcMonad m => Options -> m ()
initializeFlags opt = do initializeFlags opt = do
dflags0 <- getSessionDynFlags dflags0 <- getSessionDynFlags
dflags1 <- modifyFlagsWithOpts dflags0 $ ghcOpts opt dflags1 <- modifyFlagsWithOpts dflags0 $ ghcOpts opt
@ -127,22 +130,22 @@ setFastOrNot dflags Fast = dflags {
, hscTarget = HscNothing , hscTarget = HscNothing
} }
setSlowDynFlags :: Ghc () setSlowDynFlags :: GhcMonad m => m ()
setSlowDynFlags = (flip setFastOrNot Slow <$> getSessionDynFlags) setSlowDynFlags = (flip setFastOrNot Slow <$> getSessionDynFlags)
>>= void . setSessionDynFlags >>= void . setSessionDynFlags
-- To check TH, a session module graph is necessary. -- | To check TH, a session module graph is necessary.
-- "load" sets a session module graph using "depanal". -- "load" sets a session module graph using "depanal".
-- But we have to set "-fno-code" to DynFlags before "load". -- But we have to set "-fno-code" to DynFlags before "load".
-- So, this is necessary redundancy. -- So, this is necessary redundancy.
checkSlowAndSet :: Ghc () checkSlowAndSet :: GhcMonad m => m ()
checkSlowAndSet = do checkSlowAndSet = do
fast <- canCheckFast <$> depanal [] False fast <- canCheckFast <$> depanal [] False
unless fast setSlowDynFlags unless fast setSlowDynFlags
---------------------------------------------------------------- ----------------------------------------------------------------
modifyFlagsWithOpts :: DynFlags -> [String] -> Ghc DynFlags modifyFlagsWithOpts :: GhcMonad m => DynFlags -> [String] -> m DynFlags
modifyFlagsWithOpts dflags cmdOpts = modifyFlagsWithOpts dflags cmdOpts =
tfst <$> parseDynamicFlags dflags (map noLoc cmdOpts) tfst <$> parseDynamicFlags dflags (map noLoc cmdOpts)
where where
@ -150,6 +153,7 @@ modifyFlagsWithOpts dflags cmdOpts =
---------------------------------------------------------------- ----------------------------------------------------------------
-- | Set the file that GHC will load / compile
setTargetFile :: (GhcMonad m) => String -> m () setTargetFile :: (GhcMonad m) => String -> m ()
setTargetFile file = do setTargetFile file = do
target <- guessTarget file Nothing target <- guessTarget file Nothing
@ -157,6 +161,7 @@ setTargetFile file = do
---------------------------------------------------------------- ----------------------------------------------------------------
-- | Return the 'DynFlags' currently in use in the GHC session
getDynamicFlags :: IO DynFlags getDynamicFlags :: IO DynFlags
getDynamicFlags = runGhc (Just libdir) getSessionDynFlags getDynamicFlags = runGhc (Just libdir) getSessionDynFlags

View File

@ -12,6 +12,9 @@ import GHC
(||>) :: Ghc a -> Ghc a -> Ghc a (||>) :: Ghc a -> Ghc a -> Ghc a
x ||> y = x `gcatch` (\(_ :: IOException) -> y) x ||> y = x `gcatch` (\(_ :: IOException) -> y)
(|||>) :: GhcMonad m => m a -> m a -> m a
x |||> y = x `gcatch` (\(_ :: IOException) -> y)
---------------------------------------------------------------- ----------------------------------------------------------------
{-| Go to the next 'Ghc' monad by throwing 'AltGhcgoNext'. {-| Go to the next 'Ghc' monad by throwing 'AltGhcgoNext'.

View File

@ -0,0 +1,16 @@
-- | Low level access to the ghc-mod library.
module Language.Haskell.GhcMod.Internal (
-- * Low level access
LogReader
, GHCOption
, initializeFlagsWithCradle
, setTargetFile
, checkSlowAndSet
, getDynamicFlags
) where
import Language.Haskell.GhcMod.ErrMsg
import Language.Haskell.GhcMod.GHCApi
import Language.Haskell.GhcMod.Types

View File

@ -84,7 +84,9 @@ data Cradle = Cradle {
---------------------------------------------------------------- ----------------------------------------------------------------
-- | A single GHC option, as it would appear on the command line
type GHCOption = String type GHCOption = String
type IncludeDir = FilePath type IncludeDir = FilePath
type Package = String type Package = String

View File

@ -40,6 +40,7 @@ Library
Default-Language: Haskell2010 Default-Language: Haskell2010
GHC-Options: -Wall GHC-Options: -Wall
Exposed-Modules: Language.Haskell.GhcMod Exposed-Modules: Language.Haskell.GhcMod
Language.Haskell.GhcMod.Internal
Other-Modules: Language.Haskell.GhcMod.Browse Other-Modules: Language.Haskell.GhcMod.Browse
Language.Haskell.GhcMod.CabalApi Language.Haskell.GhcMod.CabalApi
Language.Haskell.GhcMod.Check Language.Haskell.GhcMod.Check