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
97
98
99
100
|
module Main (main) where
import Control.Monad
import Control.Monad.Except
import Control.Monad.Reader
import Data.List
import Data.Proxy
import System.Console.GetOpt
import System.Environment
import System.Exit
import System.IO
import Command
import Command.Run
import Config
import Version
data CmdlineOptions = CmdlineOptions
{ optShowHelp :: Bool
, optShowVersion :: Bool
}
defaultCmdlineOptions :: CmdlineOptions
defaultCmdlineOptions = CmdlineOptions
{ optShowHelp = False
, optShowVersion = False
}
options :: [OptDescr (CmdlineOptions -> CmdlineOptions)]
options =
[ Option ['h'] ["help"]
(NoArg $ \opts -> opts { optShowHelp = True })
"show this help and exit"
, Option ['V'] ["version"]
(NoArg $ \opts -> opts { optShowVersion = True })
"show version and exit"
]
data SomeCommandType = forall c. Command c => SC (Proxy c)
commands :: [ SomeCommandType ]
commands =
[ SC $ Proxy @RunCommand
]
lookupCommand :: String -> Maybe SomeCommandType
lookupCommand name = find p commands
where
p (SC cmd) = commandName cmd == name
main :: IO ()
main = do
args <- getArgs
(opts, cmdargs) <- case getOpt RequireOrder options args of
(o, cmdargs, []) -> return (foldl (flip id) defaultCmdlineOptions o, cmdargs)
(_, _, errs) -> do
hPutStrLn stderr $ concat errs <> "Try `minici --help' for more information."
exitFailure
when (optShowHelp opts) $ do
let header = "Usage: minici [<option>...] <command> [<args>]"
putStr $ usageInfo header options
exitSuccess
when (optShowVersion opts) $ do
putStrLn versionLine
exitSuccess
(ncmd, cargs) <- case cmdargs of
[] -> return (head commands, [])
(cname : cargs)
| Just nc <- lookupCommand cname -> return (nc, cargs)
| otherwise -> do
hPutStr stderr $ unlines
[ "Unknown command `" <> cname <> "'."
, "Try `minici --help' for more information."
]
exitFailure
runSomeCommand ncmd cargs
runSomeCommand :: SomeCommandType -> [ String ] -> IO ()
runSomeCommand (SC tproxy) args = do
let exitWithErrors errs = do
hPutStr stderr $ concat errs
exitFailure
(opts, cmdargs) <- case getOpt Permute (commandOptions tproxy) args of
(o, strargs, []) -> case runExcept $ argsFromStrings strargs of
Left err -> exitWithErrors [ err <> "\n" ]
Right cmdargs -> return (foldl (flip id) (defaultCommandOptions tproxy) o, cmdargs)
(_, _, errs) -> exitWithErrors errs
Just configPath <- findConfig
config <- parseConfig configPath
let cmd = commandInit tproxy opts cmdargs
let CommandExec exec = commandExec cmd
flip runReaderT config exec
|