module GF.CompileOne(-- ** Compiling a single module
                     OneOutput,CompiledModule,
                     compileOne,reuseGFO,useTheSource
                     --, CompileSource, compileSourceModule
                     ) where

-- The main compiler passes
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,(<+>),($$)) --Doc,
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

-- | Compile a given source file (or just load a .gfo file),
-- given a 'Grammar' containing everything it depends on.
-- Calls 'reuseGFO' or 'useTheSource'.
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)

-- | Read a compiled GF module.
-- Also undo common subexp optimization, to enable normal computations.
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) <- -- putPointE Normal opts "creating indirections" $ 
                      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 -> IOE OneOutput
-- | Compile GF module from source. It both returns the result and
-- stores it in a @.gfo@ file
-- (or a tags file, if running with the @-tags@ option)
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 -> InitPath -> Maybe FilePath -> CompileSource
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
    -- Apply to all modules
    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

    -- Apply to complete modules
    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

    -- Apply to complete modules when not generating tags
    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
" ")

    -- * Running a compiler pass, with impedance matching
    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 -> InitPath -> FilePath -> SourceModule -> IOE ()
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 --avoid name clashes when compiling with 'make -j'
         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

-- to output an intermediate stage
--intermOut :: Options -> Dump -> Doc -> IOE ()
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