From 9474585e6cfa4e2780f806a6cec3f7f8c848158a Mon Sep 17 00:00:00 2001 From: Mirek Kratochvil Date: Wed, 29 Apr 2026 10:34:36 +0200 Subject: opts --- Opts.hs | 127 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 125 insertions(+), 2 deletions(-) (limited to 'Opts.hs') diff --git a/Opts.hs b/Opts.hs index 70dff3f..6eef652 100644 --- a/Opts.hs +++ b/Opts.hs @@ -1,14 +1,137 @@ {-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE RecordWildCards #-} module Opts where -import Paths_clusterpainter (version) +import Paths_git_deli (version) import Data.Version (showVersion) import Options.Applicative -data Opts = Opts deriving Show +data DeliOpts = DeliOpts + { doParents :: [String] + , doBranches :: [String] + } deriving (Show) + +deliOpts :: Parser DeliOpts +deliOpts = do + doParents <- + many . strOption + $ short 'p' + <> long "parent" + <> help + "force the new delinearized commit to be a descendant of this commit" + doBranches <- + many . strOption + $ short 'b' + <> long "branch" + <> help + "delinearize the commit into a given named branch, updating the branch to the new commit (implies commit descendancy from the original branch)" + pure DeliOpts {..} + +data Cmd + = CmdHead + { chMsg :: Maybe String + , chSetBase :: [String] + } + | CmdEat + { ceBase :: Maybe String + , ceTarget :: Maybe String + , ceOntoHead :: Maybe String + , ceDOpts :: DeliOpts + } + | CmdCommit + { ccGitCommitArgs :: [String] + , ccDOpts :: DeliOpts + } + deriving (Show) + +cmdHead = do + chMsg <- + optional + $ strOption + (short 'm' + <> long "msg" + <> metavar "message" + <> value "DELI-HEAD" + <> showDefault + <> help "commit message on the head") + chSetBase <- + asum + [ some + (strOption + $ short 'b' + <> long "base" + <> metavar "ref" + <> help + "set the base commit manually (can be specified multiple times; default: HEAD)") + , flag' [] $ long "no-base" <> help "do not set any base commit" + , pure ["HEAD"] + ] + pure CmdHead {..} + +-- TODO this deserves ApplicativeDo (probably name the combnations of possibilities) +cmdEat = + let ceBT = + asum + [ (Nothing, ) . Just + <$> strArgument + (metavar "TARGET" + <> help + "eat commits towards TARGET from a merge-base with DELI-HEAD (if unspecified, assumes current HEAD)") + , (,) + <$> fmap + Just + (strArgument + $ metavar "RANGE-BASE" + <> help "parent of the first commit to eat") + <*> fmap + Just + (strArgument + $ metavar "RANGE-END" <> help "last commit to eat") + , pure (Nothing, Nothing) + ] + ceOntoHead = + optional . strOption + $ long "onto" + <> metavar "DELI-HEAD" + <> help + "transplant commits onto a given deli-head (if unspecified, git-deli tries to use the first one that appears in linear history)" + in uncurry CmdEat <$> ceBT <*> ceOntoHead <*> deliOpts + +cmdCommit = do + ccDOpts <- deliOpts + ccGitCommitArgs <- + many + $ strArgument + (metavar "git-commit-option" + <> help "arguments passed to git-commit(1)") + pure CmdCommit {..} + +-- TODO invent a front-end for merging of 2 different deli-heads +-- TODO: base commit management +cmd :: Parser Cmd +cmd = + hsubparser + $ mconcat + [ command "head" + $ info cmdHead + $ progDesc "Create and manage multi-branch heads" + , command "eat" + $ info cmdEat + $ progDesc "Delinearize commit histories" + , command "commit" + $ info cmdCommit + $ progDesc "Record changes to the repository" + ] + +data Opts = Opts + { oCmd :: Cmd + } deriving (Show) + +opts :: Parser Opts +opts = Opts <$> cmd parseOpts :: IO Opts parseOpts = -- cgit v1.2.3