6 import Control.Monad => qualified join
8 import System.CommandLine
16 chars :: *File -> ([Char], *File)
23 :: Mode = MHelp | MLex | MParse | MType | MInterpret | MGen
25 opts :: [OptDescr (Mode -> Mode)]
27 [ Option ['?'] ["help"] (NoArg (const MHelp)) "Display this message"
28 , Option ['l'] ["lex"] (NoArg (const MLex)) "Up to and including lexing"
29 , Option ['p'] ["parse"] (NoArg (const MParse)) "Up to and including parse"
30 , Option ['t'] ["type"] (NoArg (const MType)) "Up to and including typing"
31 , Option ['i'] ["interpret"] (NoArg (const MInterpret)) "Up to and including interpretation"
32 , Option ['g'] ["gen"] (NoArg (const MGen)) "Up to and including generation"
35 exit :: Int [String] *File *World -> *World
36 exit i e f w = snd (fclose (foldr fwrites f e) (setReturnCode i w))
38 Start :: *World -> *World
41 # ([argv0:args], w) = getCommandLine w
42 # (mode, positionals, errs) = getOpt Permute opts args
43 # mode = foldl (o) id mode MInterpret
44 | not (errs =: []) = exit 1 [e +++ "\n"\\e<-errs] io w
45 | not (positionals =: []) = exit 1 ["Positional arguments not allowed"] io w
48 MHelp = Left [usageInfo ("Usage: " +++ argv0 +++ " [opts]\n") opts]
49 MLex = map (\x->toString x +++ "\n") <$> lex cs
50 MParse = map (\x->toString x +++ "\n") <$> (lex cs >>= parse)
51 MType = (\(e, x)->["type: ",toString x, "\n", toString e]) <$> (lex cs >>= parse >>= check)
52 MInterpret = (\x->[toString x]) <$> (lex cs >>= parse >>= check >>= int o fst)
53 MGen = lex cs >>= parse >>= check >>= gen o fst
54 = exit (either (\_->1) (\_->0) mstr) (either id id mstr) io w