summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Command.hs8
-rw-r--r--src/Command/Run.hs6
-rw-r--r--src/Main.hs13
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