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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
|
module Main (main) where
import Control.Monad
import Control.Monad.Except
import Control.Monad.Reader
import Data.ByteString.Lazy qualified as BL
import Data.List
import Data.Proxy
import Data.Text qualified as T
import System.Console.GetOpt
import System.Environment
import System.Exit
import System.FilePath
import System.IO
import Command
import Command.Run
import Config
import Terminal
import Version
data CmdlineOptions = CmdlineOptions
{ optShowHelp :: Bool
, optShowVersion :: Bool
, optCommon :: CommonOptions
}
defaultCmdlineOptions :: CmdlineOptions
defaultCmdlineOptions = CmdlineOptions
{ optShowHelp = False
, optShowVersion = False
, optCommon = defaultCommonOptions
}
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"
, Option ['j'] ["jobs"]
(ReqArg (\num opts -> opts { optCommon = (optCommon opts) { optJobs = read num }}) "<num>")
("number of jobs to run simultaneously (default " <> show (optJobs defaultCommonOptions) <> ")")
]
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
let ( mbConfigPath, args' ) = case args of
(path : rest)
| any isPathSeparator path -> ( Just path, rest )
_ -> ( Nothing, args )
(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 [<job-file>] [<option>...] <command> [<args>]\n\nCommon options are:"
commandDesc (SC proxy) = " " <> padCommand (commandName proxy) <> commandDescription proxy
padTo n str = str <> replicate (n - length str) ' '
padCommand = padTo (maxCommandNameLength + 3)
commandNameLength (SC proxy) = length $ commandName proxy
maxCommandNameLength = maximum $ map commandNameLength commands
putStr $ usageInfo header options <> unlines (
[ ""
, "Available commands:"
] ++ map commandDesc commands
)
exitSuccess
when (optShowVersion opts) $ do
putStrLn versionLine
exitSuccess
( configPath, cmdargs' ) <- case ( mbConfigPath, cmdargs ) of
( Just path, _ )
-> return ( Just path, cmdargs )
( _, path : rest )
| any isPathSeparator path
-> return ( Just path, rest )
_ -> ( , cmdargs ) <$> findConfig
( 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 configPath (optCommon opts) ncmd cargs
data FullCommandOptions c = FullCommandOptions
{ fcoSpecific :: CommandOptions c
, fcoShowHelp :: Bool
}
defaultFullOptions :: Command c => proxy c -> FullCommandOptions c
defaultFullOptions proxy = FullCommandOptions
{ fcoSpecific = defaultCommandOptions proxy
, fcoShowHelp = False
}
fullCommandOptions :: Command c => proxy c -> [ OptDescr (FullCommandOptions c -> FullCommandOptions c) ]
fullCommandOptions proxy =
map (fmap $ \f fco -> fco { fcoSpecific = f (fcoSpecific fco) } ) (commandOptions proxy)
++
[ Option [ 'h' ] [ "help" ]
(NoArg $ \opts -> opts { fcoShowHelp = True })
"show this help and exit"
]
runSomeCommand :: Maybe FilePath -> CommonOptions -> SomeCommandType -> [ String ] -> IO ()
runSomeCommand ciConfigPath ciOptions (SC tproxy) args = do
let exitWithErrors errs = do
hPutStrLn stderr $ concat errs <> "Try `minici " <> commandName tproxy <> " --help' for more information."
exitFailure
(opts, cmdargs) <- case getOpt Permute (fullCommandOptions tproxy) args of
(o, strargs, []) -> case runExcept $ argsFromStrings strargs of
Left err -> exitWithErrors [ err <> "\n" ]
Right cmdargs -> do
let fullOptions = foldl (flip id) (defaultFullOptions tproxy) o
return (fullOptions, cmdargs)
(_, _, errs) -> exitWithErrors errs
when (fcoShowHelp opts) $ do
putStr $ usageInfo (T.unpack $ commandUsage tproxy) (fullCommandOptions tproxy)
exitSuccess
ciConfig <- case ciConfigPath of
Just path -> parseConfig <$> BL.readFile path
Nothing -> return $ Left "no job file found"
let cmd = commandInit tproxy (fcoSpecific opts) cmdargs
let CommandExec exec = commandExec cmd
ciTerminalOutput <- initTerminalOutput
flip runReaderT CommandInput {..} exec
|