1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
module Main where
import Control.Monad (when)
import Control.Monad.State (evalState)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Micro.Compiler
import Micro.Error (showErrorList, showParserError)
import Micro.Parser
import System.Console.GetOpt
import System.Environment (getProgName)
import System.Environment.Blank (getArgs)
import System.Exit (exitFailure, exitSuccess)
import System.IO (hPutStr, hPutStrLn, stderr, stdout)
data Options = Options
{ optParse :: Bool,
optAst :: Bool,
optHelp :: Bool,
optVersion :: Bool
}
defOptions =
Options
{ optParse = False,
optAst = False,
optHelp = False,
optVersion = False
}
options :: [OptDescr (Options -> Options)]
options =
[ Option
['p']
["parse"]
(NoArg (\opts -> opts {optParse = True}))
"only parse, reporting any errors",
Option
['a']
["ast"]
(NoArg (\opts -> opts {optAst = True}))
"parse and output the AST",
Option
['h']
["help"]
(NoArg (\opts -> opts {optHelp = True}))
"show help",
Option
['v']
["version"]
(NoArg (\opts -> opts {optVersion = True}))
"output version and exit"
]
usage :: String -> [String] -> IO ()
usage progName errs
| null errs = do
putStrLn helpText
exitSuccess
| otherwise = do
hPutStrLn stderr ("error: " ++ concat errs ++ "Try " ++ progName ++ " -h for more information.")
exitFailure
where
header =
"Usage: "
++ progName
++ " [OPTION...] file"
helpText =
usageInfo header options
compileFile :: String -> Bool -> Bool -> IO ()
compileFile filename onlyParse showAst = do
res <- parseFromFile filename
case res of
Left err -> hPutStrLn stderr (showParserError err) >> exitFailure
Right ast -> do
res <- return $ if showAst then fmap (\ast -> show ast) (compileToAst ast) else compile ast
case res of
Right out -> if onlyParse then exitSuccess else hPutStrLn stdout out
Left errs -> hPutStr stderr (showErrorList errs) >> exitFailure
main :: IO ()
main = do
progName <- getProgName
argv <- getArgs
case getOpt Permute options argv of
(o, n, []) ->
do
when (optHelp opts) $ usage progName []
when (optVersion opts) $ putStrLn (progName ++ " " ++ version) >> exitSuccess
case n of
[filename] -> compileFile filename (optParse opts) (optAst opts)
_ -> usage progName []
where
opts = foldl (flip id) defOptions o
(_, _, errs) -> usage progName errs
|
