diff options
-rw-r--r-- | src/Command.hs | 8 | ||||
-rw-r--r-- | src/Command/Run.hs | 6 | ||||
-rw-r--r-- | src/Main.hs | 13 |
3 files changed, 20 insertions, 7 deletions
diff --git a/src/Command.hs b/src/Command.hs index aaaaca1..0d333e8 100644 --- a/src/Command.hs +++ b/src/Command.hs @@ -14,6 +14,7 @@ module Command ( getRepo, getDefaultRepo, tryGetDefaultRepo, getEvalInput, getTerminalOutput, + getStorageDir, ) where import Control.Monad.Catch @@ -27,6 +28,7 @@ import Data.Text.IO qualified as T import System.Console.GetOpt import System.Exit +import System.FilePath import System.IO import Config @@ -103,6 +105,7 @@ data CommandInput = CommandInput , ciContainingRepo :: Maybe Repo , ciOtherRepos :: [ ( RepoName, Repo ) ] , ciTerminalOutput :: TerminalOutput + , ciStorageDir :: Maybe FilePath } getCommonOptions :: CommandExec CommonOptions @@ -143,3 +146,8 @@ getEvalInput = CommandExec $ do getTerminalOutput :: CommandExec TerminalOutput getTerminalOutput = CommandExec (asks ciTerminalOutput) + +getStorageDir :: CommandExec FilePath +getStorageDir = CommandExec (asks ciStorageDir) >>= \case + Just dir -> return dir + Nothing -> ((</> ".minici") . takeDirectory) <$> getConfigPath diff --git a/src/Command/Run.hs b/src/Command/Run.hs index 7c6162a..905204e 100644 --- a/src/Command/Run.hs +++ b/src/Command/Run.hs @@ -15,7 +15,6 @@ import Data.Text qualified as T import Data.Text.IO qualified as T import System.Console.GetOpt -import System.FilePath import System.FilePath.Glob import System.IO @@ -194,8 +193,7 @@ cmdRun :: RunCommand -> CommandExec () cmdRun (RunCommand RunOptions {..} args) = do CommonOptions {..} <- getCommonOptions tout <- getTerminalOutput - configPath <- getConfigPath - let baseDir = takeDirectory configPath + storageDir <- getStorageDir ( rangeOptions, jobOptions ) <- partitionEithers . concat <$> sequence [ forM roRanges $ \range -> case T.splitOn ".." range of @@ -232,7 +230,7 @@ cmdRun (RunCommand RunOptions {..} args) = do tags <- mapM watchTagSource roNewTags liftIO $ do - mngr <- newJobManager (baseDir </> ".minici") optJobs + mngr <- newJobManager storageDir optJobs source <- mergeSources $ concat [ [ argumentJobs ], ranges, branches, tags ] headerLine <- newLine tout "" diff --git a/src/Main.hs b/src/Main.hs index 22ce236..f98b274 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -29,6 +29,7 @@ data CmdlineOptions = CmdlineOptions { optShowHelp :: Bool , optShowVersion :: Bool , optCommon :: CommonOptions + , optStorage :: Maybe FilePath } defaultCmdlineOptions :: CmdlineOptions @@ -36,6 +37,7 @@ defaultCmdlineOptions = CmdlineOptions { optShowHelp = False , optShowVersion = False , optCommon = defaultCommonOptions + , optStorage = Nothing } options :: [ OptDescr (CmdlineOptions -> Except String CmdlineOptions) ] @@ -60,6 +62,9 @@ options = _ -> 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" ] data SomeCommandType = forall c. Command c => SC (Proxy c) @@ -139,7 +144,7 @@ main = do ] exitFailure - runSomeCommand configPath (optCommon opts) ncmd cargs + runSomeCommand configPath opts ncmd cargs data FullCommandOptions c = FullCommandOptions { fcoSpecific :: CommandOptions c @@ -161,8 +166,10 @@ fullCommandOptions proxy = "show this help and exit" ] -runSomeCommand :: Maybe FilePath -> CommonOptions -> SomeCommandType -> [ String ] -> IO () -runSomeCommand ciConfigPath ciOptions (SC tproxy) args = do +runSomeCommand :: Maybe FilePath -> CmdlineOptions -> SomeCommandType -> [ String ] -> IO () +runSomeCommand ciConfigPath gopts (SC tproxy) args = do + let ciOptions = optCommon gopts + ciStorageDir = optStorage gopts let exitWithErrors errs = do hPutStrLn stderr $ concat errs <> "Try `minici " <> commandName tproxy <> " --help' for more information." exitFailure |