mirror of
https://github.com/anoma/juvix.git
synced 2024-12-13 19:49:20 +03:00
82 lines
2.8 KiB
Haskell
82 lines
2.8 KiB
Haskell
module CLI
|
|
( module CLI,
|
|
module GlobalOptions,
|
|
module Command,
|
|
)
|
|
where
|
|
|
|
import Command
|
|
import GlobalOptions
|
|
import MiniJuvix.Prelude hiding (Doc)
|
|
import Options.Applicative
|
|
import Options.Applicative.Help.Pretty
|
|
|
|
data CLI = CLI
|
|
{ _cliGlobalOptions :: GlobalOptions,
|
|
_cliCommand :: Command
|
|
}
|
|
|
|
makeLenses ''CLI
|
|
|
|
parseCLI :: Parser CLI
|
|
parseCLI = do
|
|
_cliGlobalOptions <- parseGlobalOptions
|
|
_cliCommand <- parseCommand
|
|
pure CLI {..}
|
|
|
|
cliMainFile :: CLI -> Maybe FilePath
|
|
cliMainFile = aux . (^. cliCommand)
|
|
where
|
|
aux :: Command -> Maybe FilePath
|
|
aux = \case
|
|
Scope s -> Just (head (s ^. scopeInputFiles))
|
|
Parse s -> Just (s ^. parseInputFile)
|
|
Termination (Calls s) -> Just (s ^. callsInputFile)
|
|
Termination (CallGraph s) -> Just (s ^. graphInputFile)
|
|
Html s -> Just (s ^. htmlInputFile)
|
|
MiniHaskell s -> Just (s ^. miniHaskellInputFile)
|
|
Highlight s -> Just (s ^. highlightInputFile)
|
|
MiniC s -> Just (s ^. miniCInputFile)
|
|
Compile s -> Just (s ^. compileInputFile)
|
|
MicroJuvix (TypeCheck s) -> Just (s ^. microJuvixTypeInputFile)
|
|
MicroJuvix (Pretty s) -> Just (s ^. microJuvixPrettyInputFile)
|
|
MonoJuvix s -> Just (s ^. monoJuvixInputFile)
|
|
DisplayVersion -> Nothing
|
|
DisplayRoot -> Nothing
|
|
|
|
makeAbsPaths :: CLI -> IO CLI
|
|
makeAbsPaths = traverseOf cliCommand aux
|
|
where
|
|
aux :: Command -> IO Command
|
|
aux = \case
|
|
Scope s -> Scope <$> traverseOf scopeInputFiles (mapM makeAbsolute) s
|
|
Parse s -> Parse <$> traverseOf parseInputFile makeAbsolute s
|
|
Termination (Calls s) -> Termination . Calls <$> traverseOf callsInputFile makeAbsolute s
|
|
Termination (CallGraph s) -> Termination . CallGraph <$> traverseOf graphInputFile makeAbsolute s
|
|
Html s -> Html <$> traverseOf htmlInputFile makeAbsolute s
|
|
MiniHaskell s -> MiniHaskell <$> traverseOf miniHaskellInputFile makeAbsolute s
|
|
Highlight s -> Highlight <$> traverseOf highlightInputFile makeAbsolute s
|
|
MiniC s -> MiniC <$> traverseOf miniCInputFile makeAbsolute s
|
|
Compile s -> Compile <$> traverseOf compileInputFile makeAbsolute s
|
|
MicroJuvix (TypeCheck s) -> MicroJuvix . TypeCheck <$> traverseOf microJuvixTypeInputFile makeAbsolute s
|
|
MicroJuvix (Pretty s) -> MicroJuvix . Pretty <$> traverseOf microJuvixPrettyInputFile makeAbsolute s
|
|
MonoJuvix s -> MonoJuvix <$> traverseOf monoJuvixInputFile makeAbsolute s
|
|
DisplayVersion -> return DisplayVersion
|
|
DisplayRoot -> return DisplayRoot
|
|
|
|
descr :: ParserInfo CLI
|
|
descr =
|
|
info
|
|
(parseCLI <**> helper)
|
|
( fullDesc
|
|
<> progDesc "The MiniJuvix compiler."
|
|
<> headerDoc (Just headDoc)
|
|
<> footerDoc (Just foot)
|
|
)
|
|
where
|
|
headDoc :: Doc
|
|
headDoc = dullblue $ bold $ underline "MiniJuvix help"
|
|
|
|
foot :: Doc
|
|
foot = bold "maintainers: " <> "The MiniJuvix Team"
|