/
Main.hs
77 lines (66 loc) · 2.45 KB
/
Main.hs
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
module Main where
import CmdDB
import Control.Applicative
import Control.Exception
import Control.Monad
import Data.List
import Data.Maybe
import System.Cmd
import System.Environment (getArgs)
import System.Exit
import Types
import Utils
----------------------------------------------------------------
main :: IO ()
main = flip catches handlers $ do
(args,opts) <- argsOpts <$> getArgs
when (args == []) helpAndExit
checkHelp args opts helpCommandAndExit
let act = head args
mcmdspec = commandSpecByName act commandDB
when (isNothing mcmdspec) (illegalCommandAndExit act)
let Just cmdspec = mcmdspec
params = tail args
eoptspecs = parseOptions cmdspec opts
checkOptions eoptspecs illegalOptionsAndExit
let Right flags = eoptspecs
run cmdspec params flags
where
handlers = [Handler handleExit]
handleExit :: ExitCode -> IO ()
handleExit _ = return ()
----------------------------------------------------------------
argsOpts :: [String] -> ([String],[String])
argsOpts args = (args', opts)
where
args' = filter (not . isPrefixOf "-") args
opts = filter (isPrefixOf "-") args
parseOptions :: CommandSpec -> [String] -> Either [String] Flags
parseOptions cmdspc opts = check opts [] defaultFlags
where
optMvals = options cmdspc
check [] [] fg = Right fg
check [] es _ = Left es
check (o:os) es fg = case optionSpecByName o optionDB of
Nothing -> check os (o:es) fg
Just x -> case lookup (option x) optMvals of
Nothing -> check os (o:es) fg
Just mval -> check os es (updateFlags (option x) mval fg)
checkHelp :: [String] -> [String] -> FunctionCommand -> IO ()
checkHelp args opts func
| "-h" `elem` opts
|| "--help" `elem` opts = func undefined args undefined
| otherwise = return ()
checkOptions :: Either [String] Flags -> ([String] -> IO ()) -> IO ()
checkOptions (Left xs) func = func xs
checkOptions _ _ = return ()
----------------------------------------------------------------
run :: CommandSpec -> [String] -> Flags -> IO ()
run cmdspec params flags = case routing cmdspec of
RouteFunc func -> func cmdspec params flags
RouteProc subcmd subargs -> callProcess subcmd subargs params flags
callProcess :: String ->[String] -> [String] -> Flags -> IO ()
callProcess pro args0 args1 flags = system script >> return ()
where
opts = flagsToOptions flags
script = joinBy " " $ pro : opts ++ args0 ++ args1