optsHEADmaster

1 files changed, 125 insertions, 2 deletions

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 =