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
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
|
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.Checkout
import Command.Run
import Config
import Repo
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 -> Except String CmdlineOptions) ]
options =
[ Option [ 'h' ] [ "help" ]
(NoArg $ \opts -> return opts { optShowHelp = True })
"show this help and exit"
, Option [ 'V' ] [ "version" ]
(NoArg $ \opts -> return opts { optShowVersion = True })
"show version and exit"
, Option [ 'j' ] [ "jobs" ]
(ReqArg (\num opts -> return opts { optCommon = (optCommon opts) { optJobs = read num }}) "<num>")
("number of jobs to run simultaneously (default " <> show (optJobs defaultCommonOptions) <> ")")
, Option [] [ "repo" ]
(ReqArg (\value opts ->
case span (/= ':') value of
( repo, ':' : path ) -> return opts
{ optCommon = (optCommon opts)
{ optRepo = DeclaredRepo (RepoName $ T.pack repo) path : optRepo (optCommon opts)
}
}
_ -> throwError $ "--repo: invalid value `" <> value <> "'"
) "<repo>:<path>")
("override or declare repo path")
]
data SomeCommandType = forall c. Command c => SC (Proxy c)
commands :: [ SomeCommandType ]
commands =
[ SC $ Proxy @RunCommand
, SC $ Proxy @CheckoutCommand
]
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
(os, cmdargs, []) -> do
let merge :: ([String], CmdlineOptions) -> (CmdlineOptions -> Except String CmdlineOptions) -> ([String], CmdlineOptions)
merge ( errs, o ) f = case runExcept $ f o of
Left err -> ( err : errs, o )
Right o' -> ( errs, o' )
case foldl merge ( [], defaultCmdlineOptions ) os of
( [], opts ) -> return ( opts , cmdargs )
( errs, _ ) -> do
hPutStrLn stderr $ unlines (reverse errs) <> "Try `minici --help' for more information."
exitFailure
(_, _, 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
namedRepos <- forM (optRepo ciOptions) $ \decl -> do
openRepo (repoPath decl) >>= \case
Just repo -> return ( Just (repoName decl), repo )
Nothing -> do
hPutStrLn stderr $ "Failed to open repo `" <> showRepoName (repoName decl) <> "' at " <> repoPath decl
exitFailure
defaultRepo <- maybe (return Nothing) (openRepo . takeDirectory) ciConfigPath
let ciRepos = concat
[ maybe [] (\r -> [ ( Nothing, r ) ]) defaultRepo
, namedRepos
]
ciTerminalOutput <- initTerminalOutput
flip runReaderT CommandInput {..} exec
|