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
|
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.Lexer (scan)
import Micro.Parser (parse, parseFromFile)
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,
optHelp :: Bool,
optVersion :: Bool
}
defOptions =
Options
{ optParse = False,
optHelp = False,
optVersion = False
}
options :: [OptDescr (Options -> Options)]
options =
[ Option
['p']
["parse"]
(NoArg (\opts -> opts {optParse = True}))
"only parse, reporting any errors",
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 -> IO ()
compileFile filename onlyParse = do
res <- parseFromFile (scan parse) filename
case res of
Left err -> hPutStrLn stderr (showParserError err) >> exitFailure
Right ast -> do
res <- return $ compile ast
case crExit 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
_ -> usage progName []
where
opts = foldl (flip id) defOptions o
(_, _, errs) -> usage progName errs
|
