summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--minici.cabal1
-rw-r--r--src/Command.hs30
-rw-r--r--src/Command/Checkout.hs34
-rw-r--r--src/Main.hs54
-rw-r--r--src/Repo.hs27
5 files changed, 131 insertions, 15 deletions
diff --git a/minici.cabal b/minici.cabal
index fc3c3da..7c05311 100644
--- a/minici.cabal
+++ b/minici.cabal
@@ -48,6 +48,7 @@ executable minici
other-modules:
Command
+ Command.Checkout
Command.Run
Config
Job
diff --git a/src/Command.hs b/src/Command.hs
index 2114d90..8ca0655 100644
--- a/src/Command.hs
+++ b/src/Command.hs
@@ -10,6 +10,7 @@ module Command (
getCommonOptions,
getConfigPath,
getConfig,
+ getRepo, getDefaultRepo,
getTerminalOutput,
) where
@@ -25,15 +26,18 @@ import System.Exit
import System.IO
import Config
+import Repo
import Terminal
data CommonOptions = CommonOptions
{ optJobs :: Int
+ , optRepo :: [ DeclaredRepo ]
}
defaultCommonOptions :: CommonOptions
defaultCommonOptions = CommonOptions
{ optJobs = 2
+ , optRepo = []
}
class CommandArgumentsType (CommandArguments c) => Command c where
@@ -79,10 +83,16 @@ instance CommandArgumentsType [ Text ] where
newtype CommandExec a = CommandExec (ReaderT CommandInput IO a)
deriving (Functor, Applicative, Monad, MonadIO)
+instance MonadFail CommandExec where
+ fail err = liftIO $ do
+ hPutStrLn stderr err
+ exitFailure
+
data CommandInput = CommandInput
{ ciOptions :: CommonOptions
, ciConfigPath :: Maybe FilePath
, ciConfig :: Either String Config
+ , ciRepos :: [ ( Maybe RepoName, Repo ) ]
, ciTerminalOutput :: TerminalOutput
}
@@ -92,18 +102,26 @@ getCommonOptions = CommandExec (asks ciOptions)
getConfigPath :: CommandExec FilePath
getConfigPath = CommandExec $ do
asks ciConfigPath >>= \case
- Nothing -> liftIO $ do
- hPutStrLn stderr "no job file found"
- exitFailure
+ Nothing -> fail $ "no job file found"
Just path -> return path
getConfig :: CommandExec Config
getConfig = CommandExec $ do
asks ciConfig >>= \case
- Left err -> liftIO $ do
- hPutStrLn stderr err
- exitFailure
+ Left err -> fail err
Right config -> return config
+getRepo :: RepoName -> CommandExec Repo
+getRepo name = CommandExec $ do
+ asks (lookup (Just name) . ciRepos) >>= \case
+ Just repo -> return repo
+ Nothing -> fail $ "repo `" <> showRepoName name <> "' not declared"
+
+getDefaultRepo :: CommandExec Repo
+getDefaultRepo = CommandExec $ do
+ asks (lookup Nothing . ciRepos) >>= \case
+ Just repo -> return repo
+ Nothing -> fail $ "no defalut repo"
+
getTerminalOutput :: CommandExec TerminalOutput
getTerminalOutput = CommandExec (asks ciTerminalOutput)
diff --git a/src/Command/Checkout.hs b/src/Command/Checkout.hs
new file mode 100644
index 0000000..c180a34
--- /dev/null
+++ b/src/Command/Checkout.hs
@@ -0,0 +1,34 @@
+module Command.Checkout (
+ CheckoutCommand,
+) where
+
+import Data.Text (Text)
+import Data.Text qualified as T
+
+import Command
+import Repo
+
+
+data CheckoutCommand = CheckoutCommand (Maybe RepoName) Text
+
+instance Command CheckoutCommand where
+ commandName _ = "checkout"
+ commandDescription _ = "Checkout (part of) a given repository"
+
+ type CommandArguments CheckoutCommand = [ Text ]
+
+ commandUsage _ = T.pack $ unlines $
+ [ "Usage: minici checkout [<repo> [<revision>]] [<option>...]"
+ ]
+
+ commandInit _ _ = \case
+ (name : revision : _) -> CheckoutCommand (Just (RepoName name)) revision
+ [ name ] -> CheckoutCommand (Just (RepoName name)) "HEAD"
+ [] -> CheckoutCommand Nothing "HEAD"
+ commandExec = cmdCheckout
+
+cmdCheckout :: CheckoutCommand -> CommandExec ()
+cmdCheckout (CheckoutCommand name revision) = do
+ repo <- maybe getDefaultRepo getRepo name
+ commit <- maybe (fail $ T.unpack $ "revision `" <> revision <> "' not found") return =<< readCommit repo revision
+ checkoutAt commit "."
diff --git a/src/Main.hs b/src/Main.hs
index 6a7cf8d..f86bd77 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -16,8 +16,10 @@ import System.FilePath
import System.IO
import Command
+import Command.Checkout
import Command.Run
import Config
+import Repo
import Terminal
import Version
@@ -34,17 +36,28 @@ defaultCmdlineOptions = CmdlineOptions
, optCommon = defaultCommonOptions
}
-options :: [OptDescr (CmdlineOptions -> CmdlineOptions)]
+options :: [ OptDescr (CmdlineOptions -> Except String CmdlineOptions) ]
options =
- [ Option ['h'] ["help"]
- (NoArg $ \opts -> opts { optShowHelp = True })
+ [ Option [ 'h' ] [ "help" ]
+ (NoArg $ \opts -> return opts { optShowHelp = True })
"show this help and exit"
- , Option ['V'] ["version"]
- (NoArg $ \opts -> opts { optShowVersion = True })
+ , Option [ 'V' ] [ "version" ]
+ (NoArg $ \opts -> return opts { optShowVersion = True })
"show version and exit"
- , Option ['j'] ["jobs"]
- (ReqArg (\num opts -> opts { optCommon = (optCommon opts) { optJobs = read num }}) "<num>")
+ , 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)
@@ -52,6 +65,7 @@ data SomeCommandType = forall c. Command c => SC (Proxy c)
commands :: [ SomeCommandType ]
commands =
[ SC $ Proxy @RunCommand
+ , SC $ Proxy @CheckoutCommand
]
lookupCommand :: String -> Maybe SomeCommandType
@@ -68,7 +82,17 @@ main = do
_ -> ( Nothing, args )
(opts, cmdargs) <- case getOpt RequireOrder options args' of
- (o, cmdargs, []) -> return (foldl (flip id) defaultCmdlineOptions o, cmdargs)
+ (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
@@ -159,5 +183,19 @@ runSomeCommand ciConfigPath ciOptions (SC tproxy) args = do
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
diff --git a/src/Repo.hs b/src/Repo.hs
index c8e818c..1053248 100644
--- a/src/Repo.hs
+++ b/src/Repo.hs
@@ -1,10 +1,14 @@
module Repo (
- Repo, Commit, commitId,
+ Repo,
+ DeclaredRepo(..),
+ RepoName(..), textRepoName, showRepoName,
+ Commit, commitId,
CommitId, textCommitId, showCommitId,
TreeId, textTreeId, showTreeId,
Tag(..),
openRepo,
+ readCommit,
readBranch,
readTag,
listCommits,
@@ -53,6 +57,21 @@ data Repo
, gitWatchedBranches :: MVar (Map Text [ TVar (Maybe Commit) ])
}
+data DeclaredRepo = DeclaredRepo
+ { repoName :: RepoName
+ , repoPath :: FilePath
+ }
+
+newtype RepoName = RepoName Text
+ deriving (Eq, Ord)
+
+textRepoName :: RepoName -> Text
+textRepoName (RepoName text) = text
+
+showRepoName :: RepoName -> String
+showRepoName = T.unpack . textRepoName
+
+
data Commit = Commit
{ commitRepo :: Repo
, commitId_ :: CommitId
@@ -133,6 +152,12 @@ mkCommit commitRepo commitId_ = do
commitDetails <- newMVar Nothing
return $ Commit {..}
+readCommit :: MonadIO m => Repo -> Text -> m (Maybe Commit)
+readCommit repo@GitRepo {..} ref = liftIO $ do
+ readProcessWithExitCode "git" [ "--git-dir=" <> gitDir, "rev-parse", "--verify", "--quiet", T.unpack ref <> "^{commit}" ] "" >>= \case
+ ( ExitSuccess, out, _ ) | cid : _ <- lines out -> Just <$> mkCommit repo (CommitId $ BC.pack cid)
+ _ -> return Nothing
+
readCommitFromFile :: MonadIO m => Repo -> FilePath -> m (Maybe Commit)
readCommitFromFile repo@GitRepo {..} path = liftIO $ do
try @IOException (BC.readFile $ gitDir </> path) >>= \case
generated by cgit v1.2.3 (git 2.25.1) at 2025-10-31 19:57:41 +0000