module GF.CompileOne(
OneOutput,CompiledModule,
compileOne,reuseGFO,useTheSource
) where
import GF.Compile.GetGrammar(getSourceModule)
import GF.Compile.Rename(renameModule)
import GF.Compile.CheckGrammar(checkModule)
import GF.Compile.Optimize(optimizeModule)
import GF.Compile.SubExOpt(subexpModule,unsubexpModule)
import GF.Compile.GeneratePMCFG(generatePMCFG)
import GF.Compile.Update(extendModule,rebuildModule)
import GF.Compile.Tags(writeTags,gf2gftags)
import GF.Grammar.Grammar
import GF.Grammar.Printer(ppModule,TermPrintQual(..))
import GF.Grammar.Binary(decodeModule,encodeModule)
import GF.Infra.Option
import GF.Infra.UseIO(FullPath,IOE,isGFO,gf2gfo,MonadIO(..),Output(..),putPointE)
import GF.Infra.CheckM(runCheck')
import GF.Data.Operations(ErrorMonad,liftErr,(+++))
import GF.System.Directory(doesFileExist,getCurrentDirectory,renameFile)
import System.FilePath(makeRelative)
import System.Random(randomIO)
import qualified Data.Map as Map
import GF.Text.Pretty(render,(<+>),($$))
import GF.System.Console(TermColors(..),getTermColors)
import Control.Monad((<=<))
import qualified Control.Monad.Fail as Fail
type OneOutput = (Maybe FullPath,CompiledModule)
type CompiledModule = Module
compileOne, reuseGFO, useTheSource ::
(Output m,ErrorMonad m,MonadIO m, Fail.MonadFail m) =>
Options -> Grammar -> FullPath -> m OneOutput
compileOne :: Options -> Grammar -> FullPath -> m OneOutput
compileOne Options
opts Grammar
srcgr FullPath
file =
if FullPath -> Bool
isGFO FullPath
file
then Options -> Grammar -> FullPath -> m OneOutput
forall (m :: * -> *).
(Output m, ErrorMonad m, MonadIO m, MonadFail m) =>
Options -> Grammar -> FullPath -> m OneOutput
reuseGFO Options
opts Grammar
srcgr FullPath
file
else do Bool
b1 <- FullPath -> m Bool
forall (m :: * -> *). MonadIO m => FullPath -> m Bool
doesFileExist FullPath
file
if Bool
b1 then Options -> Grammar -> FullPath -> m OneOutput
forall (m :: * -> *).
(Output m, ErrorMonad m, MonadIO m, MonadFail m) =>
Options -> Grammar -> FullPath -> m OneOutput
useTheSource Options
opts Grammar
srcgr FullPath
file
else Options -> Grammar -> FullPath -> m OneOutput
forall (m :: * -> *).
(Output m, ErrorMonad m, MonadIO m, MonadFail m) =>
Options -> Grammar -> FullPath -> m OneOutput
reuseGFO Options
opts Grammar
srcgr (Options -> FullPath -> FullPath
gf2gfo Options
opts FullPath
file)
reuseGFO :: Options -> Grammar -> FullPath -> m OneOutput
reuseGFO Options
opts Grammar
srcgr FullPath
file =
do FullPath
cwd <- m FullPath
forall (io :: * -> *). MonadIO io => io FullPath
getCurrentDirectory
let rfile :: FullPath
rfile = FullPath -> FullPath -> FullPath
makeRelative FullPath
cwd FullPath
file
SourceModule
sm00 <- Verbosity
-> Options -> FullPath -> m SourceModule -> m SourceModule
forall (m :: * -> *) b.
(Output m, MonadIO m) =>
Verbosity -> Options -> FullPath -> m b -> m b
putPointE Verbosity
Verbose Options
opts (FullPath
"+ reading" FullPath -> FullPath -> FullPath
+++ FullPath
rfile) (m SourceModule -> m SourceModule)
-> m SourceModule -> m SourceModule
forall a b. (a -> b) -> a -> b
$
FullPath -> m SourceModule
forall (io :: * -> *). MonadIO io => FullPath -> io SourceModule
decodeModule FullPath
file
let sm0 :: SourceModule
sm0 = (SourceModule -> ModuleName
forall a b. (a, b) -> a
fst SourceModule
sm00,(SourceModule -> ModuleInfo
forall a b. (a, b) -> b
snd SourceModule
sm00){mflags :: Options
mflags=ModuleInfo -> Options
mflags (SourceModule -> ModuleInfo
forall a b. (a, b) -> b
snd SourceModule
sm00) Options -> Options -> Options
`addOptions` Options
opts})
Options -> Pass -> SourceModule -> m ()
forall (m :: * -> *).
Output m =>
Options -> Pass -> SourceModule -> m ()
idump Options
opts Pass
Source SourceModule
sm0
let sm1 :: SourceModule
sm1 = SourceModule -> SourceModule
unsubexpModule SourceModule
sm0
(SourceModule
sm,FullPath
warnings) <-
Options -> Check SourceModule -> m (SourceModule, FullPath)
forall (m :: * -> *) a.
ErrorMonad m =>
Options -> Check a -> m (a, FullPath)
runCheck' Options
opts (Check SourceModule -> m (SourceModule, FullPath))
-> Check SourceModule -> m (SourceModule, FullPath)
forall a b. (a -> b) -> a -> b
$ FullPath -> Grammar -> SourceModule -> Check SourceModule
extendModule FullPath
cwd Grammar
srcgr SourceModule
sm1
Options -> FullPath -> m ()
forall (m :: * -> *).
(MonadIO m, Output m) =>
Options -> FullPath -> m ()
warnOut Options
opts FullPath
warnings
if (Flags -> Bool) -> Options -> Bool
forall a. (Flags -> a) -> Options -> a
flag Flags -> Bool
optTagsOnly Options
opts
then Options -> Grammar -> FullPath -> SourceModule -> m ()
forall (m :: * -> *) a.
(Output m, MonadIO m) =>
Options -> Grammar -> FullPath -> (a, ModuleInfo) -> m ()
writeTags Options
opts Grammar
srcgr (Options -> FullPath -> FullPath
gf2gftags Options
opts FullPath
file) SourceModule
sm1
else () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
OneOutput -> m OneOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (FullPath -> Maybe FullPath
forall a. a -> Maybe a
Just FullPath
file,SourceModule
sm)
useTheSource :: Options -> Grammar -> FullPath -> m OneOutput
useTheSource Options
opts Grammar
srcgr FullPath
file =
do FullPath
cwd <- m FullPath
forall (io :: * -> *). MonadIO io => io FullPath
getCurrentDirectory
let rfile :: FullPath
rfile = FullPath -> FullPath -> FullPath
makeRelative FullPath
cwd FullPath
file
SourceModule
sm <- FullPath -> FullPath -> m SourceModule -> m SourceModule
forall (m :: * -> *) b.
(Output m, MonadIO m) =>
FullPath -> FullPath -> m b -> m b
putpOpt (FullPath
"- parsing" FullPath -> FullPath -> FullPath
+++ FullPath
rfile)
(FullPath
"- compiling" FullPath -> FullPath -> FullPath
+++ FullPath
rfile FullPath -> FullPath -> FullPath
forall a. [a] -> [a] -> [a]
++ FullPath
"... ")
(Options -> FullPath -> m SourceModule
forall (m :: * -> *).
(MonadIO m, ErrorMonad m) =>
Options -> FullPath -> m SourceModule
getSourceModule Options
opts FullPath
file)
Options -> Pass -> SourceModule -> m ()
forall (m :: * -> *).
Output m =>
Options -> Pass -> SourceModule -> m ()
idump Options
opts Pass
Source SourceModule
sm
Options
-> FullPath
-> Maybe FullPath
-> Grammar
-> SourceModule
-> m OneOutput
forall (m :: * -> *).
(ErrorMonad m, MonadIO m, MonadFail m, Output m) =>
Options
-> FullPath
-> Maybe FullPath
-> Grammar
-> SourceModule
-> m OneOutput
compileSourceModule Options
opts FullPath
cwd (FullPath -> Maybe FullPath
forall a. a -> Maybe a
Just FullPath
file) Grammar
srcgr SourceModule
sm
where
putpOpt :: FullPath -> FullPath -> m b -> m b
putpOpt FullPath
v FullPath
m m b
act
| Options -> Verbosity -> Bool
verbAtLeast Options
opts Verbosity
Verbose = Verbosity -> Options -> FullPath -> m b -> m b
forall (m :: * -> *) b.
(Output m, MonadIO m) =>
Verbosity -> Options -> FullPath -> m b -> m b
putPointE Verbosity
Normal Options
opts FullPath
v m b
act
| Options -> Verbosity -> Bool
verbAtLeast Options
opts Verbosity
Normal = FullPath -> m ()
forall (m :: * -> *). Output m => FullPath -> m ()
putStrE FullPath
m m () -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m b
act
| Bool
otherwise = Verbosity -> Options -> FullPath -> m b -> m b
forall (m :: * -> *) b.
(Output m, MonadIO m) =>
Verbosity -> Options -> FullPath -> m b -> m b
putPointE Verbosity
Verbose Options
opts FullPath
v m b
act
type CompileSource = Grammar -> Module -> IOE OneOutput
compileSourceModule :: Options
-> FullPath
-> Maybe FullPath
-> Grammar
-> SourceModule
-> m OneOutput
compileSourceModule Options
opts FullPath
cwd Maybe FullPath
mb_gfFile Grammar
gr =
if (Flags -> Bool) -> Options -> Bool
forall a. (Flags -> a) -> Options -> a
flag Flags -> Bool
optTagsOnly Options
opts
then SourceModule -> m OneOutput
forall (m :: * -> *) a a.
(Output m, MonadIO m) =>
(a, ModuleInfo) -> m (Maybe a, (a, ModuleInfo))
generateTags (SourceModule -> m OneOutput)
-> (SourceModule -> m SourceModule) -> SourceModule -> m OneOutput
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (SourceModule -> m SourceModule) -> SourceModule -> m SourceModule
forall (m :: * -> *) a.
Monad m =>
((a, ModuleInfo) -> m (a, ModuleInfo))
-> (a, ModuleInfo) -> m (a, ModuleInfo)
ifComplete SourceModule -> m SourceModule
middle (SourceModule -> m SourceModule)
-> (SourceModule -> m SourceModule)
-> SourceModule
-> m SourceModule
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< SourceModule -> m SourceModule
frontend
else SourceModule -> m OneOutput
forall (m :: * -> *).
(Output m, MonadIO m) =>
SourceModule -> m OneOutput
generateGFO (SourceModule -> m OneOutput)
-> (SourceModule -> m SourceModule) -> SourceModule -> m OneOutput
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (SourceModule -> m SourceModule) -> SourceModule -> m SourceModule
forall (m :: * -> *) a.
Monad m =>
((a, ModuleInfo) -> m (a, ModuleInfo))
-> (a, ModuleInfo) -> m (a, ModuleInfo)
ifComplete (SourceModule -> m SourceModule
backend (SourceModule -> m SourceModule)
-> (SourceModule -> m SourceModule)
-> SourceModule
-> m SourceModule
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< SourceModule -> m SourceModule
middle) (SourceModule -> m SourceModule)
-> (SourceModule -> m SourceModule)
-> SourceModule
-> m SourceModule
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< SourceModule -> m SourceModule
frontend
where
frontend :: SourceModule -> m SourceModule
frontend = Pass -> FullPath -> Check SourceModule -> m SourceModule
runPass Pass
Extend FullPath
"" (Check SourceModule -> m SourceModule)
-> (SourceModule -> Check SourceModule)
-> SourceModule
-> m SourceModule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FullPath -> Grammar -> SourceModule -> Check SourceModule
extendModule FullPath
cwd Grammar
gr
(SourceModule -> m SourceModule)
-> (SourceModule -> m SourceModule)
-> SourceModule
-> m SourceModule
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Pass -> FullPath -> Check SourceModule -> m SourceModule
runPass Pass
Rebuild FullPath
"" (Check SourceModule -> m SourceModule)
-> (SourceModule -> Check SourceModule)
-> SourceModule
-> m SourceModule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FullPath -> Grammar -> SourceModule -> Check SourceModule
rebuildModule FullPath
cwd Grammar
gr
middle :: SourceModule -> m SourceModule
middle = Pass -> FullPath -> Check SourceModule -> m SourceModule
runPass Pass
TypeCheck FullPath
"type checking" (Check SourceModule -> m SourceModule)
-> (SourceModule -> Check SourceModule)
-> SourceModule
-> m SourceModule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options
-> FullPath -> Grammar -> SourceModule -> Check SourceModule
checkModule Options
opts FullPath
cwd Grammar
gr
(SourceModule -> m SourceModule)
-> (SourceModule -> m SourceModule)
-> SourceModule
-> m SourceModule
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Pass -> FullPath -> Check SourceModule -> m SourceModule
runPass Pass
Rename FullPath
"renaming" (Check SourceModule -> m SourceModule)
-> (SourceModule -> Check SourceModule)
-> SourceModule
-> m SourceModule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FullPath -> Grammar -> SourceModule -> Check SourceModule
renameModule FullPath
cwd Grammar
gr
backend :: SourceModule -> m SourceModule
backend SourceModule
mo3 =
do SourceModule
mo4 <- Pass -> FullPath -> Err SourceModule -> m SourceModule
runPassE Pass
Optimize FullPath
"optimizing" (Err SourceModule -> m SourceModule)
-> Err SourceModule -> m SourceModule
forall a b. (a -> b) -> a -> b
$ Options -> Grammar -> SourceModule -> Err SourceModule
optimizeModule Options
opts Grammar
gr SourceModule
mo3
if ModuleInfo -> Bool
isModCnc (SourceModule -> ModuleInfo
forall a b. (a, b) -> b
snd SourceModule
mo4) Bool -> Bool -> Bool
&& (Flags -> Bool) -> Options -> Bool
forall a. (Flags -> a) -> Options -> a
flag Flags -> Bool
optPMCFG Options
opts
then FullPath -> m SourceModule -> m SourceModule
runPassI FullPath
"generating PMCFG" (m SourceModule -> m SourceModule)
-> m SourceModule -> m SourceModule
forall a b. (a -> b) -> a -> b
$ Options
-> Grammar -> Maybe FullPath -> SourceModule -> m SourceModule
forall (m :: * -> *).
(MonadFail m, Output m) =>
Options
-> Grammar -> Maybe FullPath -> SourceModule -> m SourceModule
generatePMCFG Options
opts Grammar
gr Maybe FullPath
mb_gfFile SourceModule
mo4
else FullPath -> m SourceModule -> m SourceModule
runPassI FullPath
"" (m SourceModule -> m SourceModule)
-> m SourceModule -> m SourceModule
forall a b. (a -> b) -> a -> b
$ SourceModule -> m SourceModule
forall (m :: * -> *) a. Monad m => a -> m a
return SourceModule
mo4
ifComplete :: ((a, ModuleInfo) -> m (a, ModuleInfo))
-> (a, ModuleInfo) -> m (a, ModuleInfo)
ifComplete (a, ModuleInfo) -> m (a, ModuleInfo)
yes mo :: (a, ModuleInfo)
mo@(a
_,ModuleInfo
mi) =
if ModuleInfo -> Bool
isCompleteModule ModuleInfo
mi then (a, ModuleInfo) -> m (a, ModuleInfo)
yes (a, ModuleInfo)
mo else (a, ModuleInfo) -> m (a, ModuleInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (a, ModuleInfo)
mo
generateGFO :: SourceModule -> m OneOutput
generateGFO SourceModule
mo =
do let mb_gfo :: Maybe FullPath
mb_gfo = (FullPath -> FullPath) -> Maybe FullPath -> Maybe FullPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Options -> FullPath -> FullPath
gf2gfo Options
opts) Maybe FullPath
mb_gfFile
(FullPath -> m ()) -> Maybe FullPath -> m ()
forall (m :: * -> *) a. Monad m => (a -> m ()) -> Maybe a -> m ()
maybeM ((FullPath -> SourceModule -> m ())
-> SourceModule -> FullPath -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Options -> FullPath -> FullPath -> SourceModule -> m ()
forall (m :: * -> *).
(Output m, MonadIO m) =>
Options -> FullPath -> FullPath -> SourceModule -> m ()
writeGFO Options
opts FullPath
cwd) SourceModule
mo) Maybe FullPath
mb_gfo
OneOutput -> m OneOutput
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FullPath
mb_gfo,SourceModule
mo)
generateTags :: (a, ModuleInfo) -> m (Maybe a, (a, ModuleInfo))
generateTags (a, ModuleInfo)
mo =
do (FullPath -> m ()) -> Maybe FullPath -> m ()
forall (m :: * -> *) a. Monad m => (a -> m ()) -> Maybe a -> m ()
maybeM ((FullPath -> (a, ModuleInfo) -> m ())
-> (a, ModuleInfo) -> FullPath -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Options -> Grammar -> FullPath -> (a, ModuleInfo) -> m ()
forall (m :: * -> *) a.
(Output m, MonadIO m) =>
Options -> Grammar -> FullPath -> (a, ModuleInfo) -> m ()
writeTags Options
opts Grammar
gr) (a, ModuleInfo)
mo (FullPath -> m ()) -> (FullPath -> FullPath) -> FullPath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> FullPath -> FullPath
gf2gftags Options
opts) Maybe FullPath
mb_gfFile
(Maybe a, (a, ModuleInfo)) -> m (Maybe a, (a, ModuleInfo))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a
forall a. Maybe a
Nothing,(a, ModuleInfo)
mo)
putpp :: FullPath -> m b -> m b
putpp FullPath
s = if FullPath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FullPath
s then m b -> m b
forall a. a -> a
id else Verbosity -> Options -> FullPath -> m b -> m b
forall (m :: * -> *) b.
(Output m, MonadIO m) =>
Verbosity -> Options -> FullPath -> m b -> m b
putPointE Verbosity
Verbose Options
opts (FullPath
" "FullPath -> FullPath -> FullPath
forall a. [a] -> [a] -> [a]
++FullPath
sFullPath -> FullPath -> FullPath
forall a. [a] -> [a] -> [a]
++FullPath
" ")
runPass :: Pass -> FullPath -> Check SourceModule -> m SourceModule
runPass = ((SourceModule, FullPath) -> SourceModule)
-> ((SourceModule, FullPath) -> SourceModule)
-> ((SourceModule, FullPath) -> FullPath)
-> (Check SourceModule -> m (SourceModule, FullPath))
-> Pass
-> FullPath
-> Check SourceModule
-> m SourceModule
forall (m :: * -> *) t b t.
(Output m, MonadIO m) =>
(t -> b)
-> (t -> SourceModule)
-> (t -> FullPath)
-> (t -> m t)
-> Pass
-> FullPath
-> t
-> m b
runPass' (SourceModule, FullPath) -> SourceModule
forall a b. (a, b) -> a
fst (SourceModule, FullPath) -> SourceModule
forall a b. (a, b) -> a
fst (SourceModule, FullPath) -> FullPath
forall a b. (a, b) -> b
snd (Err (SourceModule, FullPath) -> m (SourceModule, FullPath)
forall (m :: * -> *) a. ErrorMonad m => Err a -> m a
liftErr (Err (SourceModule, FullPath) -> m (SourceModule, FullPath))
-> (Check SourceModule -> Err (SourceModule, FullPath))
-> Check SourceModule
-> m (SourceModule, FullPath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Check SourceModule -> Err (SourceModule, FullPath)
forall (m :: * -> *) a.
ErrorMonad m =>
Options -> Check a -> m (a, FullPath)
runCheck' Options
opts)
runPassE :: Pass -> FullPath -> Err SourceModule -> m SourceModule
runPassE = (Err SourceModule -> m SourceModule)
-> (SourceModule -> SourceModule)
-> Pass
-> FullPath
-> Err SourceModule
-> m SourceModule
forall (m :: * -> *) t b.
(Output m, MonadIO m) =>
(t -> m b) -> (b -> SourceModule) -> Pass -> FullPath -> t -> m b
runPass2e Err SourceModule -> m SourceModule
forall (m :: * -> *) a. ErrorMonad m => Err a -> m a
liftErr SourceModule -> SourceModule
forall a. a -> a
id
runPassI :: FullPath -> m SourceModule -> m SourceModule
runPassI = (m SourceModule -> m SourceModule)
-> (SourceModule -> SourceModule)
-> Pass
-> FullPath
-> m SourceModule
-> m SourceModule
forall (m :: * -> *) t b.
(Output m, MonadIO m) =>
(t -> m b) -> (b -> SourceModule) -> Pass -> FullPath -> t -> m b
runPass2e m SourceModule -> m SourceModule
forall a. a -> a
id SourceModule -> SourceModule
forall a. a -> a
id Pass
Canon
runPass2e :: (t -> m b) -> (b -> SourceModule) -> Pass -> FullPath -> t -> m b
runPass2e t -> m b
lift b -> SourceModule
dump = (b -> b)
-> (b -> SourceModule)
-> (b -> FullPath)
-> (t -> m b)
-> Pass
-> FullPath
-> t
-> m b
forall (m :: * -> *) t b t.
(Output m, MonadIO m) =>
(t -> b)
-> (t -> SourceModule)
-> (t -> FullPath)
-> (t -> m t)
-> Pass
-> FullPath
-> t
-> m b
runPass' b -> b
forall a. a -> a
id b -> SourceModule
dump (FullPath -> b -> FullPath
forall a b. a -> b -> a
const FullPath
"") t -> m b
lift
runPass' :: (t -> b)
-> (t -> SourceModule)
-> (t -> FullPath)
-> (t -> m t)
-> Pass
-> FullPath
-> t
-> m b
runPass' t -> b
ret t -> SourceModule
dump t -> FullPath
warn t -> m t
lift Pass
pass FullPath
pp t
m =
do t
out <- FullPath -> m t -> m t
forall (m :: * -> *) b.
(Output m, MonadIO m) =>
FullPath -> m b -> m b
putpp FullPath
pp (m t -> m t) -> m t -> m t
forall a b. (a -> b) -> a -> b
$ t -> m t
lift t
m
Options -> FullPath -> m ()
forall (m :: * -> *).
(MonadIO m, Output m) =>
Options -> FullPath -> m ()
warnOut Options
opts (t -> FullPath
warn t
out)
Options -> Pass -> SourceModule -> m ()
forall (m :: * -> *).
Output m =>
Options -> Pass -> SourceModule -> m ()
idump Options
opts Pass
pass (t -> SourceModule
dump t
out)
b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> b
ret t
out)
maybeM :: (a -> m ()) -> Maybe a -> m ()
maybeM a -> m ()
f = m () -> (a -> m ()) -> Maybe a -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) a -> m ()
f
writeGFO :: Options -> FullPath -> FullPath -> SourceModule -> m ()
writeGFO Options
opts FullPath
cwd FullPath
file SourceModule
mo =
Verbosity -> Options -> FullPath -> m () -> m ()
forall (m :: * -> *) b.
(Output m, MonadIO m) =>
Verbosity -> Options -> FullPath -> m b -> m b
putPointE Verbosity
Normal Options
opts (FullPath
" write file" FullPath -> FullPath -> FullPath
+++ FullPath
rfile) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
do Int
n <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
let tmp :: FullPath
tmp = FullPath
fileFullPath -> FullPath -> FullPath
forall a. [a] -> [a] -> [a]
++FullPath
".tmp" FullPath -> FullPath -> FullPath
forall a. [a] -> [a] -> [a]
++Int -> FullPath
forall a. Show a => a -> FullPath
show (Int
n::Int)
FullPath -> SourceModule -> m ()
forall (io :: * -> *).
MonadIO io =>
FullPath -> SourceModule -> io ()
encodeModule FullPath
tmp SourceModule
mo2
FullPath -> FullPath -> m ()
forall (m :: * -> *). MonadIO m => FullPath -> FullPath -> m ()
renameFile FullPath
tmp FullPath
file
where
rfile :: FullPath
rfile = FullPath -> FullPath -> FullPath
makeRelative FullPath
cwd FullPath
file
mo2 :: SourceModule
mo2 = (ModuleName
m,ModuleInfo
mi{jments :: Map Ident Info
jments=(Info -> Bool) -> Map Ident Info -> Map Ident Info
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Info -> Bool
notAnyInd (ModuleInfo -> Map Ident Info
jments ModuleInfo
mi)})
(ModuleName
m,ModuleInfo
mi) = SourceModule -> SourceModule
subexpModule SourceModule
mo
notAnyInd :: Info -> Bool
notAnyInd Info
x = case Info
x of AnyInd{} -> Bool
False; Info
_ -> Bool
True
intermOut :: Options -> Dump -> a2 -> m ()
intermOut Options
opts Dump
d a2
doc
| Options -> Dump -> Bool
dump Options
opts Dump
d = FullPath -> m ()
forall (m :: * -> *). Output m => FullPath -> m ()
ePutStrLn (Doc -> FullPath
forall a. Pretty a => a -> FullPath
render (FullPath
"\n\n--#" FullPath -> FullPath -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
<+> Dump -> FullPath
forall a. Show a => a -> FullPath
show Dump
d Doc -> a2 -> Doc
forall a1 a2. (Pretty a1, Pretty a2) => a1 -> a2 -> Doc
$$ a2
doc))
| Bool
otherwise = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
idump :: Options -> Pass -> SourceModule -> m ()
idump Options
opts Pass
pass = Options -> Dump -> Doc -> m ()
forall (m :: * -> *) a2.
(Output m, Pretty a2) =>
Options -> Dump -> a2 -> m ()
intermOut Options
opts (Pass -> Dump
Dump Pass
pass) (Doc -> m ()) -> (SourceModule -> Doc) -> SourceModule -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TermPrintQual -> SourceModule -> Doc
ppModule TermPrintQual
Internal
warnOut :: Options -> FullPath -> m ()
warnOut Options
opts FullPath
warnings
| FullPath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FullPath
warnings = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do TermColors
t <- m TermColors
forall (m :: * -> *). MonadIO m => m TermColors
getTermColors
FullPath -> m ()
forall (m :: * -> *). Output m => FullPath -> m ()
ePutStr (TermColors -> FullPath
blueFg TermColors
t);FullPath -> m ()
forall (m :: * -> *). Output m => FullPath -> m ()
ePutStr FullPath
ws;FullPath -> m ()
forall (m :: * -> *). Output m => FullPath -> m ()
ePutStrLn (TermColors -> FullPath
restore TermColors
t)
where
ws :: FullPath
ws = if (Flags -> Verbosity) -> Options -> Verbosity
forall a. (Flags -> a) -> Options -> a
flag Flags -> Verbosity
optVerbosity Options
opts Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
Normal
then Char
'\n'Char -> FullPath -> FullPath
forall a. a -> [a] -> [a]
:FullPath
warnings
else FullPath
warnings