mirror of
https://github.com/anoma/juvix.git
synced 2024-09-11 08:15:41 +03:00
Apply common options in dev compile
subcommands (#2732)
This commit is contained in:
parent
ad76c7a583
commit
2ec8a4343a
40
app/App.hs
40
app/App.hs
@ -151,13 +151,21 @@ getEntryPoint' RunAppIOArgs {..} inputFile = do
|
||||
mainFile <- getMainAppFile inputFile
|
||||
set entryPointStdin estdin <$> entryPointFromGlobalOptionsPre root (mainFile ^. pathPath) opts
|
||||
|
||||
runPipelineEither :: (Members '[EmbedIO, TaggedLock, App] r) => Maybe (AppPath File) -> Sem (PipelineEff r) a -> Sem r (Either JuvixError (ResolverState, PipelineResult a))
|
||||
runPipelineEither input_ p = do
|
||||
runPipelineEither ::
|
||||
(Members '[EmbedIO, TaggedLock, App] r, EntryPointOptions opts) =>
|
||||
opts ->
|
||||
Maybe (AppPath File) ->
|
||||
Sem (PipelineEff r) a ->
|
||||
Sem r (Either JuvixError (ResolverState, PipelineResult a))
|
||||
runPipelineEither opts input_ p = do
|
||||
args <- askArgs
|
||||
entry <- getEntryPoint' args input_
|
||||
entry <- applyOptions opts <$> getEntryPoint' args input_
|
||||
runIOEither entry p
|
||||
|
||||
runPipelineSetupEither :: (Members '[EmbedIO, TaggedLock, App] r) => Sem (PipelineEff' r) a -> Sem r (Either JuvixError (ResolverState, a))
|
||||
runPipelineSetupEither ::
|
||||
(Members '[EmbedIO, TaggedLock, App] r) =>
|
||||
Sem (PipelineEff' r) a ->
|
||||
Sem r (Either JuvixError (ResolverState, a))
|
||||
runPipelineSetupEither p = do
|
||||
args <- askArgs
|
||||
entry <- getEntryPointStdin' args
|
||||
@ -204,18 +212,30 @@ getEntryPointStdin = do
|
||||
_runAppIOArgsRoot <- askRoot
|
||||
getEntryPointStdin' RunAppIOArgs {..}
|
||||
|
||||
runPipelineTermination :: (Members '[EmbedIO, App, TaggedLock] r) => Maybe (AppPath File) -> Sem (Termination ': PipelineEff r) a -> Sem r (PipelineResult a)
|
||||
runPipelineTermination ::
|
||||
(Members '[EmbedIO, App, TaggedLock] r) =>
|
||||
Maybe (AppPath File) ->
|
||||
Sem (Termination ': PipelineEff r) a ->
|
||||
Sem r (PipelineResult a)
|
||||
runPipelineTermination input_ p = do
|
||||
r <- runPipelineEither input_ (evalTermination iniTerminationState p) >>= fromRightJuvixError
|
||||
r <- runPipelineEither () input_ (evalTermination iniTerminationState p) >>= fromRightJuvixError
|
||||
return (snd r)
|
||||
|
||||
runPipeline ::
|
||||
runPipelineNoOptions ::
|
||||
(Members '[App, EmbedIO, TaggedLock] r) =>
|
||||
Maybe (AppPath File) ->
|
||||
Sem (PipelineEff r) a ->
|
||||
Sem r a
|
||||
runPipeline input_ p = do
|
||||
r <- runPipelineEither input_ p >>= fromRightJuvixError
|
||||
runPipelineNoOptions = runPipeline ()
|
||||
|
||||
runPipeline ::
|
||||
(Members '[App, EmbedIO, TaggedLock] r, EntryPointOptions opts) =>
|
||||
opts ->
|
||||
Maybe (AppPath File) ->
|
||||
Sem (PipelineEff r) a ->
|
||||
Sem r a
|
||||
runPipeline opts input_ p = do
|
||||
r <- runPipelineEither opts input_ p >>= fromRightJuvixError
|
||||
return (snd r ^. pipelineResult)
|
||||
|
||||
runPipelineHtml ::
|
||||
@ -225,7 +245,7 @@ runPipelineHtml ::
|
||||
Sem r (InternalTypedResult, [InternalTypedResult])
|
||||
runPipelineHtml bNonRecursive input_
|
||||
| bNonRecursive = do
|
||||
r <- runPipeline input_ upToInternalTyped
|
||||
r <- runPipelineNoOptions input_ upToInternalTyped
|
||||
return (r, [])
|
||||
| otherwise = do
|
||||
args <- askArgs
|
||||
|
@ -14,7 +14,7 @@ import Juvix.Compiler.Core.Translation
|
||||
runCommand :: forall r. (Members '[EmbedIO, TaggedLock, App] r) => CoreFromConcreteOptions -> Sem r ()
|
||||
runCommand coreOpts = do
|
||||
gopts <- askGlobalOptions
|
||||
md <- (^. coreResultModule) <$> runPipeline (Just (coreOpts ^. coreFromConcreteInputFile)) upToCore
|
||||
md <- (^. coreResultModule) <$> runPipelineNoOptions (Just (coreOpts ^. coreFromConcreteInputFile)) upToCore
|
||||
path :: Path Abs File <- fromAppPathFile (coreOpts ^. coreFromConcreteInputFile)
|
||||
let r =
|
||||
run
|
||||
|
@ -11,6 +11,6 @@ runCommand opts = do
|
||||
let inputFile = opts ^. asmCompileCommonOptions . compileInputFile
|
||||
moutputFile = opts ^. asmCompileCommonOptions . compileOutputFile
|
||||
outFile :: Path Abs File <- getOutputFile FileExtJuvixAsm inputFile moutputFile
|
||||
res :: InfoTable <- runPipeline inputFile upToAsm
|
||||
res :: InfoTable <- runPipeline opts inputFile upToAsm
|
||||
let txt = ppPrint res res
|
||||
writeFileEnsureLn outFile txt
|
||||
|
@ -11,6 +11,6 @@ runCommand opts = do
|
||||
let inputFile = opts ^. casmCompileCommonOptions . compileInputFile
|
||||
moutputFile = opts ^. casmCompileCommonOptions . compileOutputFile
|
||||
outFile :: Path Abs File <- getOutputFile FileExtCasm inputFile moutputFile
|
||||
res :: Result <- runPipeline inputFile upToCasm
|
||||
res :: Result <- runPipeline opts inputFile upToCasm
|
||||
let txt = ppPrint res
|
||||
writeFileEnsureLn outFile txt
|
||||
|
@ -20,7 +20,7 @@ runCommand opts = do
|
||||
moutputFile = opts ^. coreCompileCommonOptions . compileOutputFile
|
||||
gopts <- askGlobalOptions
|
||||
outFile :: Path Abs File <- getOutputFile FileExtJuvixCore inputFile moutputFile
|
||||
coremodule :: Core.Module <- (^. coreResultModule) <$> runPipeline inputFile upToStoredCore
|
||||
coremodule :: Core.Module <- (^. coreResultModule) <$> runPipeline opts inputFile upToStoredCore
|
||||
res :: Core.Module <-
|
||||
( runError @JuvixError
|
||||
. runReader (project' @Core.CoreOptions gopts)
|
||||
|
@ -14,6 +14,6 @@ runCommand opts = do
|
||||
let inputFile = opts ^. regCompileCommonOptions . compileInputFile
|
||||
moutputFile = opts ^. regCompileCommonOptions . compileOutputFile
|
||||
outFile :: Path Abs File <- getOutputFile FileExtJuvixReg inputFile moutputFile
|
||||
res :: InfoTable <- runPipeline inputFile upToReg
|
||||
res :: InfoTable <- runPipeline opts inputFile upToReg
|
||||
let txt = ppPrint res res
|
||||
writeFileEnsureLn outFile txt
|
||||
|
@ -14,6 +14,6 @@ runCommand opts = do
|
||||
let inputFile = opts ^. treeCompileCommonOptions . compileInputFile
|
||||
moutputFile = opts ^. treeCompileCommonOptions . compileOutputFile
|
||||
outFile :: Path Abs File <- getOutputFile FileExtJuvixTree inputFile moutputFile
|
||||
res :: InfoTable <- runPipeline inputFile upToTree
|
||||
res :: InfoTable <- runPipeline opts inputFile upToTree
|
||||
let txt = ppPrint res res
|
||||
writeFileEnsureLn outFile txt
|
||||
|
@ -8,7 +8,7 @@ import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking qu
|
||||
runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => InternalTypeOptions -> Sem r ()
|
||||
runCommand localOpts = do
|
||||
globalOpts <- askGlobalOptions
|
||||
res <- runPipeline (localOpts ^. internalTypeInputFile) upToInternalTyped
|
||||
res <- runPipelineNoOptions (localOpts ^. internalTypeInputFile) upToInternalTyped
|
||||
say "Well done! It type checks"
|
||||
when (localOpts ^. internalTypePrint) $ do
|
||||
let checkedModule = res ^. InternalTyped.resultModule
|
||||
|
@ -9,5 +9,5 @@ runCommand :: (Members '[EmbedIO, App, TaggedLock] r) => ParseOptions -> Sem r (
|
||||
runCommand opts = do
|
||||
m <-
|
||||
(^. Parser.resultModule)
|
||||
<$> runPipeline (opts ^. parseOptionsInputFile) upToParsing
|
||||
<$> runPipelineNoOptions (opts ^. parseOptionsInputFile) upToParsing
|
||||
if opts ^. parseOptionsNoPrettyShow then say (show m) else say (pack (ppShow m))
|
||||
|
@ -10,7 +10,7 @@ import Juvix.Prelude.Pretty
|
||||
runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => ScopeOptions -> Sem r ()
|
||||
runCommand opts = do
|
||||
globalOpts <- askGlobalOptions
|
||||
res :: Scoper.ScoperResult <- runPipeline (opts ^. scopeInputFile) upToScoping
|
||||
res :: Scoper.ScoperResult <- runPipelineNoOptions (opts ^. scopeInputFile) upToScoping
|
||||
let m :: Module 'Scoped 'ModuleTop = res ^. Scoper.resultModule
|
||||
if
|
||||
| opts ^. scopeWithComments ->
|
||||
|
@ -9,7 +9,7 @@ import Juvix.Extra.Strings qualified as Str
|
||||
runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => EvalOptions -> Sem r ()
|
||||
runCommand opts@EvalOptions {..} = do
|
||||
gopts <- askGlobalOptions
|
||||
Core.CoreResult {..} <- runPipeline _evalInputFile upToCore
|
||||
Core.CoreResult {..} <- runPipelineNoOptions _evalInputFile upToCore
|
||||
let r =
|
||||
run
|
||||
. runReader (project gopts)
|
||||
|
@ -31,7 +31,7 @@ compileToCore ::
|
||||
(Members '[App, EmbedIO, TaggedLock] r) =>
|
||||
CompileCommonOptions ('InputExtension 'FileExtJuvix) ->
|
||||
Sem r CoreResult
|
||||
compileToCore opts = runPipeline (Just (opts ^. compileInputFile)) upToCore
|
||||
compileToCore opts = runPipeline opts (Just (opts ^. compileInputFile)) upToCore
|
||||
|
||||
commandTargetHelper :: CompileTarget -> Parser a -> Mod CommandFields a
|
||||
commandTargetHelper t parseCommand =
|
||||
|
@ -103,5 +103,5 @@ runScopeFileApp = interpret $ \case
|
||||
{ _pathPath = mkPrepath (toFilePath p),
|
||||
_pathIsInput = False
|
||||
}
|
||||
runPipeline (Just appFile) upToScoping
|
||||
runPipelineNoOptions (Just appFile) upToScoping
|
||||
ScopeStdin e -> runPipelineEntry e upToScoping
|
||||
|
@ -16,7 +16,7 @@ import System.Process qualified as Process
|
||||
|
||||
runGenOnlySourceHtml :: (Members '[EmbedIO, TaggedLock, App] r) => HtmlOptions -> Sem r ()
|
||||
runGenOnlySourceHtml HtmlOptions {..} = do
|
||||
res <- runPipeline _htmlInputFile upToScoping
|
||||
res <- runPipelineNoOptions _htmlInputFile upToScoping
|
||||
let m = res ^. Scoper.resultModule
|
||||
outputDir <- fromAppPathDir _htmlOutputDir
|
||||
liftIO $
|
||||
|
@ -17,7 +17,7 @@ runCommand ::
|
||||
Sem r ()
|
||||
runCommand opts = do
|
||||
let inputFile = opts ^. markdownInputFile
|
||||
scopedM <- runPipeline inputFile upToScoping
|
||||
scopedM <- runPipelineNoOptions inputFile upToScoping
|
||||
let m = scopedM ^. Scoper.resultModule
|
||||
outputDir <- fromAppPathDir (opts ^. markdownOutputDir)
|
||||
let res =
|
||||
|
@ -5,5 +5,5 @@ import Commands.Typecheck.Options
|
||||
|
||||
runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => TypecheckOptions -> Sem r ()
|
||||
runCommand localOpts = do
|
||||
void (runPipeline (localOpts ^. typecheckInputFile) upToCoreTypecheck)
|
||||
void (runPipelineNoOptions (localOpts ^. typecheckInputFile) upToCoreTypecheck)
|
||||
say "Well done! It type checks"
|
||||
|
@ -288,3 +288,6 @@ optRegTransformationIds = optTransformationIds Reg.parseTransformations Reg.comp
|
||||
|
||||
class EntryPointOptions a where
|
||||
applyOptions :: a -> EntryPoint -> EntryPoint
|
||||
|
||||
instance EntryPointOptions () where
|
||||
applyOptions () = id
|
||||
|
Loading…
Reference in New Issue
Block a user