Safe Haskell | Safe |
---|---|
Language | Haskell98 |
- data CompileRunState err
- = CRSOk
- | CRSFail
- | CRSFailMsg String
- | CRSStopSeq
- | CRSStopAllSeq
- | CRSStop
- | CRSFailErrL String [err] (Maybe Int)
- | CRSErrInfoL String Bool [err]
- data CompileRun nm unit info err = CompileRun {
- crCUCache :: Map nm unit
- crCompileOrder :: [[nm]]
- crTopModNm :: nm
- crState :: CompileRunState err
- crStateInfo :: info
- type CompilePhase n u i e a = StateT (CompileRun n u i e) IO a
- data CompilePhaseT n u i e m a
- class CompileUnit u n l s | u -> n l s where
- class CompileUnitState s where
- class FPathError e => CompileRunError e p | e -> p where
- class CompileModName n where
- class CompileRunStateInfo i n p where
- data CompileParticipation = CompileParticipation_NoImport
- class FileLocatable x loc | loc -> x where
- mkEmptyCompileRun :: n -> i -> CompileRun n u i e
- crCU :: (Show n, Ord n) => n -> CompileRun n u i e -> u
- crMbCU :: Ord n => n -> CompileRun n u i e -> Maybe u
- ppCR :: (PP n, PP u) => CompileRun n u i e -> PP_Doc
- cpUpdStateInfo :: (i -> i) -> CompilePhase n u i e ()
- cpUpdSI :: (i -> i) -> CompilePhase n u i e ()
- cpUpdCU :: (Ord n, CompileUnit u n l s) => n -> (u -> u) -> CompilePhase n u i e ()
- cpUpdCUWithKey :: (Ord n, CompileUnit u n l s) => n -> (n -> u -> (n, u)) -> CompilePhase n u i e n
- cpSetFail :: CompilePhase n u i e ()
- cpSetStop :: CompilePhase n u i e ()
- cpSetStopSeq :: CompilePhase n u i e ()
- cpSetStopAllSeq :: CompilePhase n u i e ()
- cpSetOk :: CompilePhase n u i e ()
- cpSetErrs :: [e] -> CompilePhase n u i e ()
- cpSetLimitErrs :: Int -> String -> [e] -> CompilePhase n u i e ()
- cpSetLimitErrsWhen :: Int -> String -> [e] -> CompilePhase n u i e ()
- cpSetInfos :: String -> Bool -> [e] -> CompilePhase n u i e ()
- cpSetCompileOrder :: [[n]] -> CompilePhase n u i e ()
- cpSeq :: CompileRunError e p => [CompilePhase n u i e ()] -> CompilePhase n u i e ()
- cpSeqWhen :: CompileRunError e p => Bool -> [CompilePhase n u i e ()] -> CompilePhase n u i e ()
- cpEmpty :: CompilePhase n u i e ()
- cpFindFileForNameOrFPath :: FPATH n => String -> n -> FPath -> [(String, FPath)]
- cpFindFilesForFPathInLocations :: (Ord n, FPATH n, FileLocatable u loc, Show loc, CompileUnitState s, CompileRunError e p, CompileUnit u n loc s, CompileModName n, CompileRunStateInfo i n p) => (loc -> n -> FPath -> [(loc, FPath, [e])]) -> ((FPath, loc, [e]) -> res) -> Bool -> [(FileSuffix, s)] -> [loc] -> Maybe n -> Maybe FPath -> CompilePhase n u i e [res]
- cpFindFilesForFPath :: forall e n u p i s. (Ord n, FPATH n, FileLocatable u String, CompileUnitState s, CompileRunError e p, CompileUnit u n String s, CompileModName n, CompileRunStateInfo i n p) => Bool -> [(FileSuffix, s)] -> [String] -> Maybe n -> Maybe FPath -> CompilePhase n u i e [FPath]
- cpFindFileForFPath :: (Ord n, FPATH n, FileLocatable u String, CompileUnitState s, CompileRunError e p, CompileUnit u n String s, CompileModName n, CompileRunStateInfo i n p) => [(FileSuffix, s)] -> [String] -> Maybe n -> Maybe FPath -> CompilePhase n u i e (Maybe FPath)
- cpImportGather :: (Show n, Ord n, CompileUnit u n l s, CompileRunError e p, CompileUnitState s) => (n -> CompilePhase n u i e ()) -> n -> CompilePhase n u i e ()
- cpImportGatherFromMods :: (Show n, Ord n, CompileUnit u n l s, CompileRunError e p, CompileUnitState s) => (Maybe prev -> n -> CompilePhase n u i e (x, Maybe prev)) -> [n] -> CompilePhase n u i e ()
- cpImportGatherFromModsWithImp :: (Show n, Ord n, CompileUnit u n l s, CompileRunError e p, CompileUnitState s) => (u -> [n]) -> (Maybe prev -> n -> CompilePhase n u i e (x, Maybe prev)) -> [n] -> CompilePhase n u i e ()
- cpPP :: (PP n, PP u) => String -> CompilePhase n u i e ()
- cpPPMsg :: PP m => m -> CompilePhase n u i e ()
- forgetM :: Monad m => m a -> m ()
Documentation
data CompileRunState err Source #
CRSOk | |
CRSFail | |
CRSFailMsg String | |
CRSStopSeq | |
CRSStopAllSeq | |
CRSStop | |
CRSFailErrL String [err] (Maybe Int) | |
CRSErrInfoL String Bool [err] |
Show (CompileRunState err) Source # | |
Error (CompileRunState err) Source # | |
data CompileRun nm unit info err Source #
CompileRun | |
|
type CompilePhase n u i e a = StateT (CompileRun n u i e) IO a Source #
data CompilePhaseT n u i e m a Source #
CompileRun
as state in specific StateT variant with non standard >>=
newtype CompilePhaseT n u i e m a = CompilePhaseT {runCompilePhaseT :: CompileRun n u i e -> m (a, CompileRun n u i e)}
CompileRunner state n pos loc u i e m => Monad (CompilePhaseT n u i e m) Source # | |
CompileRunner state n pos loc u i e m => Functor (CompilePhaseT n u i e m) Source # | |
CompileRunner state n pos loc u i e m => Applicative (CompilePhaseT n u i e m) Source # | |
class CompileUnit u n l s | u -> n l s where Source #
Per compile unit
cuDefault, cuFPath, cuUpdFPath, cuLocation, cuUpdLocation, cuKey, cuUpdKey, cuState, cuUpdState, cuImports
cuFPath :: u -> FPath Source #
cuUpdFPath :: FPath -> u -> u Source #
cuLocation :: u -> l Source #
cuUpdLocation :: l -> u -> u Source #
cuUpdKey :: n -> u -> u Source #
cuUpdState :: s -> u -> u Source #
cuImports :: u -> [n] Source #
cuParticipation :: u -> [CompileParticipation] Source #
class CompileUnitState s where Source #
State of a compile unit
class FPathError e => CompileRunError e p | e -> p where Source #
Error reporting
crePPErrL :: [e] -> PP_Doc Source #
creMkNotFoundErrL :: p -> String -> [String] -> [FileSuffix] -> [e] Source #
creAreFatal :: [e] -> Bool Source #
class CompileModName n where Source #
Conversion from string to module name
class CompileRunStateInfo i n p where Source #
crsiImportPosOfCUKey :: n -> i -> p Source #
data CompileParticipation Source #
class FileLocatable x loc | loc -> x where Source #
fileLocation :: x -> loc Source #
noFileLocation :: loc Source #
mkEmptyCompileRun :: n -> i -> CompileRun n u i e Source #
cpUpdStateInfo :: (i -> i) -> CompilePhase n u i e () Source #
cpUpdSI :: (i -> i) -> CompilePhase n u i e () Source #
cpUpdCU :: (Ord n, CompileUnit u n l s) => n -> (u -> u) -> CompilePhase n u i e () Source #
cpUpdCUWithKey :: (Ord n, CompileUnit u n l s) => n -> (n -> u -> (n, u)) -> CompilePhase n u i e n Source #
cpSetFail :: CompilePhase n u i e () Source #
cpSetStop :: CompilePhase n u i e () Source #
cpSetStopSeq :: CompilePhase n u i e () Source #
cpSetStopAllSeq :: CompilePhase n u i e () Source #
cpSetOk :: CompilePhase n u i e () Source #
cpSetErrs :: [e] -> CompilePhase n u i e () Source #
cpSetLimitErrs :: Int -> String -> [e] -> CompilePhase n u i e () Source #
cpSetLimitErrsWhen :: Int -> String -> [e] -> CompilePhase n u i e () Source #
cpSetInfos :: String -> Bool -> [e] -> CompilePhase n u i e () Source #
cpSetCompileOrder :: [[n]] -> CompilePhase n u i e () Source #
cpSeq :: CompileRunError e p => [CompilePhase n u i e ()] -> CompilePhase n u i e () Source #
cpSeqWhen :: CompileRunError e p => Bool -> [CompilePhase n u i e ()] -> CompilePhase n u i e () Source #
cpEmpty :: CompilePhase n u i e () Source #
cpFindFilesForFPathInLocations Source #
:: (Ord n, FPATH n, FileLocatable u loc, Show loc, CompileUnitState s, CompileRunError e p, CompileUnit u n loc s, CompileModName n, CompileRunStateInfo i n p) | |
=> (loc -> n -> FPath -> [(loc, FPath, [e])]) | get the locations for a name, possibly with errors |
-> ((FPath, loc, [e]) -> res) | construct a result given a found location |
-> Bool | stop when first is found |
-> [(FileSuffix, s)] | suffix info |
-> [loc] | locations to search |
-> Maybe n | possibly a module name |
-> Maybe FPath | possibly a file path |
-> CompilePhase n u i e [res] |
cpFindFilesForFPath :: forall e n u p i s. (Ord n, FPATH n, FileLocatable u String, CompileUnitState s, CompileRunError e p, CompileUnit u n String s, CompileModName n, CompileRunStateInfo i n p) => Bool -> [(FileSuffix, s)] -> [String] -> Maybe n -> Maybe FPath -> CompilePhase n u i e [FPath] Source #
cpFindFileForFPath :: (Ord n, FPATH n, FileLocatable u String, CompileUnitState s, CompileRunError e p, CompileUnit u n String s, CompileModName n, CompileRunStateInfo i n p) => [(FileSuffix, s)] -> [String] -> Maybe n -> Maybe FPath -> CompilePhase n u i e (Maybe FPath) Source #
cpImportGather :: (Show n, Ord n, CompileUnit u n l s, CompileRunError e p, CompileUnitState s) => (n -> CompilePhase n u i e ()) -> n -> CompilePhase n u i e () Source #
Abbreviation for cpImportGatherFromMods for 1 module
cpImportGatherFromMods :: (Show n, Ord n, CompileUnit u n l s, CompileRunError e p, CompileUnitState s) => (Maybe prev -> n -> CompilePhase n u i e (x, Maybe prev)) -> [n] -> CompilePhase n u i e () Source #
recursively extract imported modules
cpImportGatherFromModsWithImp :: (Show n, Ord n, CompileUnit u n l s, CompileRunError e p, CompileUnitState s) => (u -> [n]) -> (Maybe prev -> n -> CompilePhase n u i e (x, Maybe prev)) -> [n] -> CompilePhase n u i e () Source #
recursively extract imported modules, providing a way to import + do the import
cpPPMsg :: PP m => m -> CompilePhase n u i e () Source #