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 Start :: *World -> *World
37 # ([argv0:args], w) = getCommandLine w
38 # (mode, positionals, errs) = getOpt Permute opts args
39 # mode = foldl (o) id mode MInterpret
40 // | not (errs =: []) = Left [e +++ "\n"\\e<-errs]
41 // | not (positionals =: []) = die ["Positional arguments not allowed"] w
45 MHelp = Left [usageInfo ("Usage: " +++ argv0 +++ " [opts]\n") opts]
46 MLex = map (\x->toString x +++ "\n") <$> lex cs
47 MParse = map (\x->toString x +++ "\n") <$> (lex cs >>= parse)
48 MType = (\(e, x)->["type: ",toString x, "\n", toString e]) <$> (lex cs >>= parse >>= check)
49 MInterpret = (\x->[toString x]) <$> (lex cs >>= parse >>= check >>= int o fst)
50 MGen = lex cs >>= parse >>= check >>= gen o fst
51 = setReturnCode (either (const 1) (const 0) mstr)
52 (snd (fclose (foldr fwrites io (either id id mstr)) w))