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 |