summaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs103
1 files changed, 77 insertions, 26 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 9e9214f..83b0ab3 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -7,9 +7,11 @@ import Control.Monad.Reader
import Data.ByteString.Lazy qualified as BL
import Data.List
import Data.List.NonEmpty qualified as NE
+import Data.Maybe
import Data.Proxy
import Data.Text qualified as T
+import System.Console.ANSI
import System.Console.GetOpt
import System.Directory
import System.Environment
@@ -19,11 +21,15 @@ import System.IO
import Command
import Command.Checkout
+import Command.Extract
import Command.JobId
+import Command.Log
import Command.Run
+import Command.Shell
+import Command.Subtree
import Config
+import Output
import Repo
-import Terminal
import Version
data CmdlineOptions = CmdlineOptions
@@ -31,6 +37,7 @@ data CmdlineOptions = CmdlineOptions
, optShowVersion :: Bool
, optCommon :: CommonOptions
, optStorage :: Maybe FilePath
+ , optOutput :: Maybe [ OutputType ]
}
defaultCmdlineOptions :: CmdlineOptions
@@ -39,6 +46,7 @@ defaultCmdlineOptions = CmdlineOptions
, optShowVersion = False
, optCommon = defaultCommonOptions
, optStorage = Nothing
+ , optOutput = Nothing
}
options :: [ OptDescr (CmdlineOptions -> Except String CmdlineOptions) ]
@@ -60,12 +68,21 @@ options =
{ optRepo = DeclaredRepo (RepoName $ T.pack repo) path : optRepo (optCommon opts)
}
}
- _ -> throwError $ "--repo: invalid value `" <> value <> "'"
+ _ -> throwError $ "--repo: invalid value ‘" <> value <> "’"
) "<repo>:<path>")
("override or declare repo path")
, Option [] [ "storage" ]
(ReqArg (\value opts -> return opts { optStorage = Just value }) "<path>")
"set storage path"
+ , Option [] [ "terminal-output" ]
+ (NoArg $ \opts -> return opts { optOutput = Just $ TerminalOutput : fromMaybe [] (optOutput opts) })
+ "use terminal-style output (default if standard output is terminal)"
+ , Option [] [ "log-output" ]
+ (OptArg (\value opts -> return opts { optOutput = Just $ LogOutput (fromMaybe "-" value) : fromMaybe [] (optOutput opts) }) "<path>")
+ "use log-style output to <path> or standard output"
+ , Option [] [ "test-output" ]
+ (OptArg (\value opts -> return opts { optOutput = Just $ TestOutput (fromMaybe "-" value) : fromMaybe [] (optOutput opts) }) "<path>")
+ "use test-style output to <path> or standard output"
]
data SomeCommandType = forall c. Command c => SC (Proxy c)
@@ -74,7 +91,11 @@ commands :: NE.NonEmpty SomeCommandType
commands =
( SC $ Proxy @RunCommand) NE.:|
[ SC $ Proxy @CheckoutCommand
+ , SC $ Proxy @ExtractCommand
, SC $ Proxy @JobIdCommand
+ , SC $ Proxy @LogCommand
+ , SC $ Proxy @ShellCommand
+ , SC $ Proxy @SubtreeCommand
]
lookupCommand :: String -> Maybe SomeCommandType
@@ -85,9 +106,10 @@ lookupCommand name = find p commands
main :: IO ()
main = do
args <- getArgs
- let ( mbConfigPath, args' ) = case args of
+ let isPathArgument path = maybe False (/= '-') (listToMaybe path) && any isPathSeparator path
+ let ( mbRootPath, args' ) = case args of
(path : rest)
- | any isPathSeparator path -> ( Just path, rest )
+ | isPathArgument path -> ( Just path, rest )
_ -> ( Nothing, args )
(opts, cmdargs) <- case getOpt RequireOrder options args' of
@@ -100,10 +122,10 @@ main = do
case foldl merge ( [], defaultCmdlineOptions ) os of
( [], opts ) -> return ( opts , cmdargs )
( errs, _ ) -> do
- hPutStrLn stderr $ unlines (reverse errs) <> "Try `minici --help' for more information."
+ hPutStrLn stderr $ unlines (reverse errs) <> "Try ‘minici --help’ for more information."
exitFailure
(_, _, errs) -> do
- hPutStrLn stderr $ concat errs <> "Try `minici --help' for more information."
+ hPutStrLn stderr $ concat errs <> "Try ‘minici --help’ for more information."
exitFailure
when (optShowHelp opts) $ do
@@ -126,13 +148,13 @@ main = do
putStrLn versionLine
exitSuccess
- ( configPath, cmdargs' ) <- case ( mbConfigPath, cmdargs ) of
+ ( rootPath, cmdargs' ) <- case ( mbRootPath, cmdargs ) of
( Just path, _ )
-> return ( Just path, cmdargs )
( _, path : rest )
- | any isPathSeparator path
+ | isPathArgument path
-> return ( Just path, rest )
- _ -> ( , cmdargs ) <$> findConfig
+ _ -> return ( Nothing , cmdargs )
( ncmd, cargs ) <- case cmdargs' of
[] -> return ( NE.head commands, [] )
@@ -141,12 +163,12 @@ main = do
| Just nc <- lookupCommand cname -> return (nc, cargs)
| otherwise -> do
hPutStr stderr $ unlines
- [ "Unknown command `" <> cname <> "'."
- , "Try `minici --help' for more information."
+ [ "Unknown command ‘" <> cname <> "’."
+ , "Try ‘minici --help’ for more information."
]
exitFailure
- runSomeCommand configPath opts ncmd cargs
+ runSomeCommand rootPath opts ncmd cargs
data FullCommandOptions c = FullCommandOptions
{ fcoSpecific :: CommandOptions c
@@ -169,11 +191,37 @@ fullCommandOptions proxy =
]
runSomeCommand :: Maybe FilePath -> CmdlineOptions -> SomeCommandType -> [ String ] -> IO ()
-runSomeCommand ciConfigPath gopts (SC tproxy) args = do
+runSomeCommand rootPath gopts (SC tproxy) args = do
+ let reportFailure err = hPutStrLn stderr err >> exitFailure
+ ( ciRootPath, ciJobRoot ) <- case rootPath of
+ Just path -> do
+ doesFileExist path >>= \case
+ True -> BL.readFile path >>= return . parseConfig >>= \case
+ Right config -> return ( path, JobRootConfig config )
+ Left err -> reportFailure $ "Failed to parse job file ‘" <> path <> "’:" <> err
+ False -> doesDirectoryExist path >>= \case
+ True -> openRepo path >>= \case
+ Just repo -> return ( path, JobRootRepo repo )
+ Nothing -> reportFailure $ "Failed to open repository ‘" <> path <> "’"
+ False -> reportFailure $ "File or directory ‘" <> path <> "’ not found"
+ Nothing -> do
+ openRepo "." >>= \case
+ Just repo -> return ( ".", JobRootRepo repo )
+ Nothing -> findConfig >>= \case
+ Just path -> BL.readFile path >>= return . parseConfig >>= \case
+ Right config -> return ( path, JobRootConfig config )
+ Left err -> reportFailure $ "Failed to parse job file ‘" <> path <> "’:" <> err
+ Nothing -> reportFailure $ "No job file or repository found"
+
+ let storageFileName = ".minici"
+ ciStorageDir = case ( optStorage gopts, ciRootPath, ciJobRoot ) of
+ ( Just path, _ , _ ) -> path
+ ( Nothing , path, JobRootConfig {} ) -> takeDirectory path </> storageFileName
+ ( Nothing , _ , JobRootRepo repo ) -> getRepoWorkDir repo </> storageFileName
+
let ciOptions = optCommon gopts
- ciStorageDir = optStorage gopts
let exitWithErrors errs = do
- hPutStrLn stderr $ concat errs <> "Try `minici " <> commandName tproxy <> " --help' for more information."
+ hPutStrLn stderr $ concat errs <> "Try ‘minici " <> commandName tproxy <> " --help’ for more information."
exitFailure
(opts, cmdargs) <- case getOpt Permute (fullCommandOptions tproxy) args of
@@ -188,14 +236,12 @@ runSomeCommand ciConfigPath gopts (SC tproxy) args = 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
- ciContainingRepo <- maybe (return Nothing) (openRepo . takeDirectory) ciConfigPath
+ ciContainingRepo <- case ciJobRoot of
+ JobRootRepo repo -> return (Just repo)
+ JobRootConfig _ -> openRepo $ takeDirectory ciRootPath
let openDeclaredRepo dir decl = do
let path = dir </> repoPath decl
@@ -203,19 +249,24 @@ runSomeCommand ciConfigPath gopts (SC tproxy) args = do
Just repo -> return ( repoName decl, repo )
Nothing -> do
absPath <- makeAbsolute path
- hPutStrLn stderr $ "Failed to open repo `" <> showRepoName (repoName decl) <> "' at " <> repoPath decl <> " (" <> absPath <> ")"
+ hPutStrLn stderr $ "Failed to open repo ‘" <> showRepoName (repoName decl) <> "’ at " <> repoPath decl <> " (" <> absPath <> ")"
exitFailure
cmdlineRepos <- forM (optRepo ciOptions) (openDeclaredRepo "")
- configRepos <- case ( ciConfigPath, ciConfig ) of
- ( Just path, Right config ) ->
+ configRepos <- case ciJobRoot of
+ JobRootConfig config ->
forM (configRepos config) $ \decl -> do
case lookup (repoName decl) cmdlineRepos of
Just repo -> return ( repoName decl, repo )
- Nothing -> openDeclaredRepo (takeDirectory path) decl
+ Nothing -> openDeclaredRepo (takeDirectory ciRootPath) decl
_ -> return []
let ciOtherRepos = configRepos ++ cmdlineRepos
- ciTerminalOutput <- initTerminalOutput
- flip runReaderT CommandInput {..} exec
+ outputTypes <- case optOutput gopts of
+ Just types -> return types
+ Nothing -> hSupportsANSI stdout >>= return . \case
+ True -> [ TerminalOutput ]
+ False -> [ LogOutput "-" ]
+ withOutput outputTypes $ \ciOutput -> do
+ flip runReaderT CommandInput {..} exec
generated by cgit v1.2.3 (git 2.25.1) at 2025-07-10 09:41:11 +0000