Merge pull request #141 from alanz/master
Exposing lower level API using GhcMonad
This commit is contained in:
commit
0f3056e701
@ -21,6 +21,7 @@ import System.FilePath (normalise)
|
|||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
|
||||||
|
-- | A means to read the log
|
||||||
type LogReader = IO [String]
|
type LogReader = IO [String]
|
||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
@ -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
|
||||||
|
|
||||||
|
@ -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'.
|
||||||
|
16
Language/Haskell/GhcMod/Internal.hs
Normal file
16
Language/Haskell/GhcMod/Internal.hs
Normal 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
|
||||||
|
|
@ -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
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user