Rename GhcModLowLevel to GhcMod.Internal and document exposed items.

This commit is contained in:
Alan Zimmerman 2013-08-26 18:28:21 +02:00
parent a45bfb97b9
commit e487a535eb
6 changed files with 26 additions and 43 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,6 +57,9 @@ importDirs = [".","..","../..","../../..","../../../..","../../../../.."]
data Build = CabalPkg | SingleFile deriving Eq data Build = CabalPkg | SingleFile deriving Eq
-- | 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 :: GhcMonad m => Options -> Cradle -> [GHCOption] -> Bool -> m LogReader
initializeFlagsWithCradle opt cradle ghcOptions logging initializeFlagsWithCradle opt cradle ghcOptions logging
| cabal = withCabal |||> withoutCabal | cabal = withCabal |||> withoutCabal
@ -131,7 +134,7 @@ 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.
@ -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

@ -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

@ -1,41 +0,0 @@
-- | Low level access to the ghc-mod library.
module Language.Haskell.GhcModLowLevel (
-- * Cradle
Cradle(..)
, findCradle
-- * GHC version
, GHCVersion
, getGHCVersion
-- * Options
, Options(..)
, OutputStyle(..)
, defaultOptions
-- * Types
, ModuleString
, Expression
-- * Converting the 'Ghc' monad to the 'IO' monad
, withGHC
, withGHCDummyFile
-- * Low level access
, LogReader
, GHCOption
, initializeFlagsWithCradle
, setTargetFile
, checkSlowAndSet
, getDynamicFlags
) where
import Language.Haskell.GhcMod.Browse
import Language.Haskell.GhcMod.Check
import Language.Haskell.GhcMod.Cradle
import Language.Haskell.GhcMod.Debug
import Language.Haskell.GhcMod.ErrMsg
import Language.Haskell.GhcMod.Flag
import Language.Haskell.GhcMod.GHCApi
import Language.Haskell.GhcMod.Info
import Language.Haskell.GhcMod.Lang
import Language.Haskell.GhcMod.Lint
import Language.Haskell.GhcMod.List
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.CabalApi

View File

@ -40,7 +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.GhcModLowLevel 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