content: -- |
  -- Module      : Data.Git.Monad
  -- License     : BSD-style
  -- Maintainer  : Nicolas DI PRIMA <nicolas@di-prima.fr>
  -- Stability   : experimental
  -- Portability : unix
  --
  -- Simplifies the Git operation presents in this package.
  --
  -- You can easily access to the usual Git general informations:
  --
  -- * access to Head, Branches or Tags
  -- * direct access to a Commit
  --
  -- This module also defines a convenient Monad to access the whole information
  -- from a Commit: see 'CommitAccessMonad' and 'withCommit'.
  --
  -- You can also easily create a new commit: see 'CommitM' and 'withNewCommit'
  --
  
  {-# LANGUAGE CPP #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE Rank2Types #-}
  {-# LANGUAGE TypeSynonymInstances #-}
  
  module Data.Git.Monad
      ( -- * GitMonad
        GitMonad(..)
      , GitM
      , withRepo
      , withCurrentRepo
        -- ** Operations
      , Resolvable(..)
      , branchList
      , branchWrite
      , tagList
      , tagWrite
      , headGet
      , headResolv
      , headSet
      , getCommit
  
        -- * Read a commit
      , CommitAccessM
      , withCommit
        -- ** Operations
      , getAuthor
      , getCommitter
      , getParents
      , getExtras
      , getEncoding
      , getMessage
      , getFile
      , getDir
        -- * Create a new Commit
      , CommitM
      , withNewCommit
      , withBranch
        -- ** Operations
      , setAuthor
      , setCommitter
      , setParents
      , setExtras
      , setEncoding
      , setMessage
      , setFile
      , deleteFile
  
        -- * convenients re-exports
      , Git.Git
      , Git.Ref
      , Git.RefName(..)
      , Git.Commit(..)
      , Git.Person(..)
      ) where
  
  
  -- import qualified Control.Monad.Fail as Fail
  import Data.ByteString (ByteString)
  import qualified Data.ByteString as B
  import qualified Data.ByteString.Lazy as BL
  import qualified Data.Git as Git
  import qualified Data.Git.Revision as Git
  import qualified Data.Git.Repository as Git
  import qualified Data.Git.Storage.Object as Git
  import           Data.Git.Imports
  import           Data.Git.OS
  
  import           Data.Git.Ref (SHA1)
  
  --import qualified Filesystem.Path as FP
  
  import Data.Set (Set)
  
  -------------------------------------------------------------------------------
  --                              Revision helper                              --
  -------------------------------------------------------------------------------
  
  revisionFromString :: String -> Git.Revision
  revisionFromString = Git.fromString
  
  -- | this is a convenient class to allow a common interface for what user may
  -- need to optain a Ref from a given Resolvable object.
  --
  -- each of this instances is a convenient implementation of what a user would
  -- have to do in order to resolve a branch, a tag or a String.
  --
  -- > resolve (Ref "2ad98b90...2ca") === Ref "2ad98b90...2ca"
  -- > resolve "master"
  -- > resolve "HEAD^^^"
  --
  class Resolvable rev where
      resolve :: GitMonad m => rev -> m (Maybe (Git.Ref SHA1))
  instance Resolvable (Git.Ref SHA1) where
      resolve = return . Just
  instance Resolvable Git.Revision where
      resolve rev = do
          git <- getGit
          liftGit $ Git.resolveRevision git rev
  instance Resolvable String where
      resolve = resolve . revisionFromString
  instance Resolvable Git.RefName where
      resolve = resolve . Git.refNameRaw
  
  -------------------------------------------------------------------------------
  --                              GitMonad                                     --
  -------------------------------------------------------------------------------
  
  -- | Basic operations common between the different Monads defined in this
  -- package.
  class (Functor m, Applicative m, Monad m) => GitMonad m where
      -- | the current Monad must allow access to the current Git
      getGit :: m (Git.Git SHA1)
      liftGit :: IO a -> m a
  
  branchList :: GitMonad git => git (Set Git.RefName)
  branchList = getGit >>= liftGit . Git.branchList
  
  branchWrite :: GitMonad git => Git.RefName -> Git.Ref SHA1 -> git ()
  branchWrite rn ref = do
      git <- getGit
      liftGit $ Git.branchWrite git rn ref
  
  tagList :: GitMonad git => git (Set Git.RefName)
  tagList = getGit >>= liftGit . Git.tagList
  
  tagWrite :: GitMonad git => Git.RefName -> Git.Ref SHA1 -> git ()
  tagWrite rn ref = do
      git <- getGit
      liftGit $ Git.tagWrite git rn ref
  
  headGet :: GitMonad git => git (Either (Git.Ref SHA1) Git.RefName)
  headGet = getGit >>= liftGit . Git.headGet
  
  headResolv :: GitMonad git => git (Maybe (Git.Ref SHA1))
  headResolv = do
      e <- headGet
      case e of
          Left ref -> resolve ref
          Right v  -> resolve v
  
  headSet :: GitMonad git => Either (Git.Ref SHA1) Git.RefName -> git ()
  headSet e = do
      git <- getGit
      liftGit $ Git.headSet git e
  
  getCommit :: (GitMonad git, Resolvable ref) => ref -> git (Maybe (Git.Commit SHA1))
  getCommit r = do
      mRef <- resolve r
      case mRef of
          Nothing  -> return Nothing
          Just ref -> do
              git <- getGit
              liftGit $ Git.getCommitMaybe git ref
  
  setObject :: (GitMonad git, Git.Objectable obj) => obj SHA1 -> git (Git.Ref SHA1)
  setObject obj = do
      git <- getGit
      liftGit $ Git.setObject git $ Git.toObject obj
  
  getObject :: (GitMonad git, Resolvable ref)
            => ref
            -> Bool
            -> git (Maybe (Git.Object SHA1))
  getObject rev resolvDelta = do
      git <- getGit
      mRef <- resolve rev
      case mRef of
          Nothing  -> return Nothing
          Just ref -> liftGit $ Git.getObject git ref resolvDelta
  
  workTreeNew :: GitMonad git => git (Git.WorkTree hash)
  workTreeNew = liftGit Git.workTreeNew
  
  workTreeFrom :: GitMonad git => Git.Ref hash -> git (Git.WorkTree hash)
  workTreeFrom ref = liftGit $ Git.workTreeFrom ref
  
  workTreeFlush :: GitMonad git => Git.WorkTree SHA1 -> git (Git.Ref SHA1)
  workTreeFlush tree = do
      git <- getGit
      liftGit $ Git.workTreeFlush git tree
  
  resolvPath :: (GitMonad git, Resolvable ref)
             => ref -- ^ the commit Ref, Revision ("master", "HEAD^^" or a ref...)
             -> Git.EntPath
             -> git (Maybe (Git.Ref SHA1))
  resolvPath commitRev entPath = do
      git <- getGit
      mRef <- resolve commitRev
      case mRef of
          Nothing  -> return Nothing
          Just ref -> liftGit $ Git.resolvePath git ref entPath
  
  -------------------------------------------------------------------------------
  --                                                                           --
  -------------------------------------------------------------------------------
  
  data Result ctx a
      = ResultSuccess !ctx !a
      | ResultFailure !String
  
  -------------------------------------------------------------------------------
  --                                 GitM                                      --
  -------------------------------------------------------------------------------
  
  data GitContext = GitContext
      { gitContextGit  :: !(Git.Git SHA1)
      }
  
  newtype GitM a = GitM
      { runGitM :: GitContext -> IO (Result GitContext a)
      }
  
  instance Functor GitM where
      fmap = fmapGitM
  
  instance Applicative GitM where
      pure  = returnGitM
      (<*>) = appendGitM
  
  instance Monad GitM where
      return = returnGitM
      (>>=)  = bindGitM
  #if MIN_VERSION_base(4,13,0)
  instance MonadFail GitM where
  #endif
      fail   = failGitM
  
  instance GitMonad GitM where
      getGit  = getGitM
      liftGit = liftGitM
  
  fmapGitM :: (a -> b) -> GitM a -> GitM b
  fmapGitM f m = GitM $ \ctx -> do
      r <- runGitM m ctx
      return $ case r of
          ResultSuccess ctx' v -> ResultSuccess ctx' (f v)
          ResultFailure err    -> ResultFailure err
  
  returnGitM :: a -> GitM a
  returnGitM v = GitM $ \ctx -> return (ResultSuccess ctx v)
  
  appendGitM :: GitM (a -> b) -> GitM a -> GitM b
  appendGitM m1f m2 = m1f >>= \f -> m2 >>= \v -> return (f v)
  
  bindGitM :: GitM a -> (a -> GitM b) -> GitM b
  bindGitM m fm = GitM $ \ctx -> do
      r <- runGitM m ctx
      case r of
          ResultSuccess ctx' v -> runGitM (fm v) ctx'
          ResultFailure err    -> return (ResultFailure err)
  
  failGitM :: String -> GitM a
  failGitM msg = GitM $ \_ -> return (ResultFailure msg)
  
  getGitM :: GitM (Git.Git SHA1)
  getGitM = GitM $ \ctx -> return (ResultSuccess ctx (gitContextGit ctx))
  
  liftGitM :: IO a -> GitM a
  liftGitM f = GitM $ \ctx -> ResultSuccess ctx <$> f
  
  executeGitM :: Git.Git SHA1 -> GitM a -> IO (Either String a)
  executeGitM git m = do
      r <- runGitM m $ GitContext git
      return $ case r of
          ResultSuccess _   v -> Right v
          ResultFailure err   -> Left err
  
  withRepo :: LocalPath -> GitM a -> IO (Either String a)
  withRepo repoPath m = Git.withRepo repoPath (\git -> executeGitM git m)
  
  withCurrentRepo :: GitM a -> IO (Either String a)
  withCurrentRepo m = Git.withCurrentRepo (\git -> executeGitM git m)
  
  
  -------------------------------------------------------------------------------
  --                             CommitAccessM                                 --
  -------------------------------------------------------------------------------
  
  data CommitAccessContext = CommitAccessContext
      { commitAccessContextCommit :: !(Git.Commit SHA1)
      , commitAccessContextRef    :: !(Git.Ref SHA1)
      }
  
  -- | ReadOnly operations on a given commit
  newtype CommitAccessM  a = CommitAccessM
      { runCommitAccessM :: forall git . GitMonad git => CommitAccessContext -> git (Result CommitAccessContext a)
      }
  
  instance Functor CommitAccessM where
      fmap = fmapCommitAccessM
  
  instance Applicative CommitAccessM where
      pure  = returnCommitAccessM
      (<*>) = appendCommitAccessM
  
  instance Monad CommitAccessM where
      return = returnCommitAccessM
      (>>=)  = bindCommitAccessM
  #if MIN_VERSION_base(4,13,0)
  instance MonadFail CommitAccessM where
  #endif
      fail   = failCommitAccessM
  
  instance GitMonad CommitAccessM where
      getGit  = getCommitAccessM
      liftGit = liftCommitAccessM
  
  fmapCommitAccessM :: (a -> b) -> CommitAccessM a -> CommitAccessM b
  fmapCommitAccessM f m = CommitAccessM $ \ctx -> do
      r <- runCommitAccessM m ctx
      return $ case r of
          ResultSuccess ctx' v -> ResultSuccess ctx' (f v)
          ResultFailure err    -> ResultFailure err
  
  returnCommitAccessM :: a -> CommitAccessM a
  returnCommitAccessM v = CommitAccessM $ \ctx -> return (ResultSuccess ctx v)
  
  appendCommitAccessM :: CommitAccessM (a -> b) -> CommitAccessM a -> CommitAccessM b
  appendCommitAccessM m1f m2 = m1f >>= \f -> m2 >>= \v -> return (f v)
  
  bindCommitAccessM :: CommitAccessM a -> (a -> CommitAccessM b) -> CommitAccessM b
  bindCommitAccessM m fm = CommitAccessM $ \ctx -> do
      r <- runCommitAccessM m ctx
      case r of
          ResultSuccess ctx' v -> runCommitAccessM (fm v) ctx'
          ResultFailure err    -> return (ResultFailure err)
  
  failCommitAccessM :: String -> CommitAccessM a
  failCommitAccessM msg = CommitAccessM $ \_ -> return (ResultFailure msg)
  
  getCommitAccessM :: CommitAccessM (Git.Git SHA1)
  getCommitAccessM = CommitAccessM $ \ctx -> ResultSuccess ctx <$> getGit
  
  liftCommitAccessM :: IO a -> CommitAccessM a
  liftCommitAccessM f = CommitAccessM $ \ctx -> ResultSuccess ctx <$> (liftGit f)
  
  -- Operations -----------------------------------------------------------------
  
  withCommitAccessContext :: (CommitAccessContext -> a) -> CommitAccessM a
  withCommitAccessContext operation = CommitAccessM $ \ctx ->
      return $ ResultSuccess ctx $ operation ctx
  
  getAuthor :: CommitAccessM Git.Person
  getAuthor = withCommitAccessContext (Git.commitAuthor . commitAccessContextCommit)
  
  getCommitter :: CommitAccessM Git.Person
  getCommitter = withCommitAccessContext (Git.commitCommitter . commitAccessContextCommit)
  
  getParents :: CommitAccessM [Git.Ref SHA1]
  getParents = withCommitAccessContext (Git.commitParents . commitAccessContextCommit)
  
  getExtras :: CommitAccessM [Git.CommitExtra]
  getExtras = withCommitAccessContext (Git.commitExtras . commitAccessContextCommit)
  
  getEncoding :: CommitAccessM (Maybe ByteString)
  getEncoding = withCommitAccessContext (Git.commitEncoding . commitAccessContextCommit)
  
  getMessage :: CommitAccessM ByteString
  getMessage = withCommitAccessContext (Git.commitMessage . commitAccessContextCommit)
  
  getContextRef_ :: CommitAccessM (Git.Ref SHA1)
  getContextRef_ = withCommitAccessContext commitAccessContextRef
  
  getContextObject_ :: Git.EntPath -> CommitAccessM (Maybe (Git.Object SHA1))
  getContextObject_ fp = do
      commitRef <- getContextRef_
      mRef <- resolvPath commitRef fp
      case mRef of
          Nothing  -> return Nothing
          Just ref -> getObject ref True
  
  -- | get the content of the file at the given Path
  --
  -- if the given Path is not a file or does not exist,
  -- the function returns Nothing.
  getFile :: Git.EntPath -> CommitAccessM (Maybe BL.ByteString)
  getFile fp = do
      mObj <- getContextObject_ fp
      return $ case mObj of
          Nothing  -> Nothing
          Just obj -> case Git.objectToBlob obj of
              Nothing -> Nothing
              Just b  -> Just $ Git.blobGetContent b
  
  -- | list the element present in the Given Directory Path
  --
  -- if the given Path is not a directory or does not exist,
  -- the function returns Nothing.
  getDir :: Git.EntPath -> CommitAccessM (Maybe [Git.EntName])
  getDir fp = do
      mObj <- getContextObject_ fp
      return $ case mObj of
          Nothing  -> Nothing
          Just obj -> case Git.objectToTree obj of
              Nothing   -> Nothing
              Just tree -> Just $ map (\(_, n, _) -> n) $ Git.treeGetEnts tree
  
  -- | open a commit in the current GitMonad
  --
  -- Read commit's info (Author, Committer, message...) or Commit's Tree.
  --
  -- > withCurrentRepo $
  -- >    withCommit "master" $ do
  -- >        -- print the commit's author information
  -- >        author <- getAuthor
  -- >        liftGit $ print author
  -- >
  -- >        -- print the list of files|dirs in the root directory
  -- >        l <- getDir []
  -- >        liftGit $ print l
  --
  withCommit :: (Resolvable ref, GitMonad git
  #if MIN_VERSION_base(4,13,0)
                , MonadFail git
  #endif
                )
             => ref
                  -- ^ the commit revision or reference to open
             -> CommitAccessM a
             -> git a
  withCommit rev m = do
      mRef <- resolve rev
      case mRef of
          Nothing -> fail "revision does not exist"
          Just ref -> do
              mCommit <- getCommit ref
              case mCommit of
                  Nothing -> fail $ "the given ref does not exist or is not a commit"
                  Just commit -> do
                      let ctx = CommitAccessContext
                                  { commitAccessContextCommit = commit
                                  , commitAccessContextRef    = ref
                                  }
                      r <- runCommitAccessM m ctx
                      case r of
                          ResultFailure err   -> fail err
                          ResultSuccess _   a -> return a
  
  -------------------------------------------------------------------------------
  --                                 CommitM                                      --
  -------------------------------------------------------------------------------
  
  data CommitContext = CommitContext
      { commitContextAuthor    :: !Git.Person
      , commitContextCommitter :: !Git.Person
      , commitContextParents   :: ![Git.Ref SHA1]
      , commitContextExtras    :: ![Git.CommitExtra]
      , commitContextEncoding  :: !(Maybe ByteString)
      , commitContextMessage   :: !ByteString
      , commitContextTree      :: !(Git.WorkTree SHA1)
      }
  
  newtype CommitM  a = CommitM
      { runCommitM :: forall git . GitMonad git => CommitContext -> git (Result CommitContext a)
      }
  
  instance Functor CommitM where
      fmap = fmapCommitM
  
  instance Applicative CommitM where
      pure  = returnCommitM
      (<*>) = appendCommitM
  
  instance Monad CommitM where
      return = returnCommitM
      (>>=)  = bindCommitM
  #if MIN_VERSION_base(4,13,0)
  instance MonadFail CommitM where
  #endif
      fail   = failCommitM
  
  instance GitMonad CommitM where
      getGit  = getCommitM
      liftGit = liftCommitM
  
  fmapCommitM :: (a -> b) -> CommitM a -> CommitM b
  fmapCommitM f m = CommitM $ \ctx -> do
      r <- runCommitM m ctx
      return $ case r of
          ResultSuccess ctx' v -> ResultSuccess ctx' (f v)
          ResultFailure err    -> ResultFailure err
  
  returnCommitM :: a -> CommitM a
  returnCommitM v = CommitM $ \ctx -> return (ResultSuccess ctx v)
  
  appendCommitM :: CommitM (a -> b) -> CommitM a -> CommitM b
  appendCommitM m1f m2 = m1f >>= \f -> m2 >>= \v -> return (f v)
  
  bindCommitM :: CommitM a -> (a -> CommitM b) -> CommitM b
  bindCommitM m fm = CommitM $ \ctx -> do
      r <- runCommitM m ctx
      case r of
          ResultSuccess ctx' v -> runCommitM (fm v) ctx'
          ResultFailure err    -> return (ResultFailure err)
  
  failCommitM :: String -> CommitM a
  failCommitM msg = CommitM $ \_ -> return (ResultFailure msg)
  
  getCommitM :: CommitM (Git.Git SHA1)
  getCommitM = CommitM $ \ctx -> ResultSuccess ctx <$> getGit
  
  liftCommitM :: IO a -> CommitM a
  liftCommitM f = CommitM $ \ctx -> ResultSuccess ctx <$> (liftGit f)
  
  -- Operations -----------------------------------------------------------------
  
  commitUpdateContext :: (CommitContext -> IO (CommitContext, a)) -> CommitM a
  commitUpdateContext operation = CommitM $ \ctx -> do
      (ctx', r) <- liftGit $ operation ctx
      return (ResultSuccess ctx' r)
  
  -- | replace the Commit's Author
  setAuthor :: Git.Person -> CommitM ()
  setAuthor p = commitUpdateContext $ \ctx -> return (ctx { commitContextCommitter = p }, ())
  
  -- | replace the Commit's Committer
  setCommitter :: Git.Person -> CommitM ()
  setCommitter p = commitUpdateContext $ \ctx -> return (ctx { commitContextCommitter = p }, ())
  
  -- | replace the Commit's Parents
  setParents :: [Git.Ref SHA1] -> CommitM ()
  setParents l = commitUpdateContext $ \ctx -> return (ctx { commitContextParents = l }, ())
  
  -- | replace the Commit's Extras
  setExtras :: [Git.CommitExtra] -> CommitM ()
  setExtras l = commitUpdateContext $ \ctx -> return (ctx { commitContextExtras = l }, ())
  
  -- | replace the Commit's encoding
  setEncoding :: Maybe ByteString -> CommitM ()
  setEncoding e = commitUpdateContext $ \ctx -> return (ctx { commitContextEncoding = e }, ())
  
  -- | replace the Commit's message with the new given message.
  setMessage :: ByteString -> CommitM ()
  setMessage msg = commitUpdateContext $ \ctx -> return (ctx { commitContextMessage = msg }, ())
  
  setContextObject_ :: Git.Objectable object
                    => Git.EntPath
                    -> (Git.EntType, object SHA1)
                    -> CommitM ()
  setContextObject_ path (t, obj) = do
      ref <- setObject obj
      git <- getGit
      commitUpdateContext $ \ctx -> do
          Git.workTreeSet git (commitContextTree ctx) path (t, ref)
          return (ctx, ())
  
  -- | add a new file in in the Commit's Working Tree
  setFile :: Git.EntPath
          -> BL.ByteString
          -> CommitM ()
  setFile path bl = setContextObject_ path (Git.EntFile , Git.Blob bl)
  
  -- | delete a file from the Commit's Working Tree.
  deleteFile :: Git.EntPath -> CommitM ()
  deleteFile path = do
      git <- getGit
      commitUpdateContext $ \ctx -> do
          Git.workTreeDelete git (commitContextTree ctx) path
          return (ctx, ())
  
  -- | create a new commit in the current GitMonad
  --
  -- The commit is pre-filled with the following default values:
  --
  -- * author and committer are the same
  -- * the commit's parents is an empty list
  -- * there is no commit encoding
  -- * the commit's extras is an empty list
  -- * the commit message is an empty ByteString
  -- * the working tree is a new empty Tree or the Tree associated to the
  --   given Revision or Ref.
  --
  -- You can update these values with the commit setters (setFile, setAuthor...)
  --
  -- Example:
  --
  -- > withCurrentRepo $ do
  -- >    (r, ()) <- withNewCommit person (Nothing :: Maybe (Ref SHA1)) $ do
  -- >        setMessage "inital commit"
  -- >        setFile ["README.md"] "# My awesome project\n\nthis is a new project\n"
  -- >    branchWrite "master" r
  -- >
  --
  -- you can also continue the work on a same branch. In this case the commit's
  -- parent is already set to the Reference associated to the revision.
  -- You can, change the parents if you wish to erase, or replace, this value.
  --
  -- > withCurrentRepo $ do
  -- >    readmeContent <- withCommit (Just "master") $ getFile ["README.md"]
  -- >    (r, ()) <- withNewCommit person (Just "master") $ do
  -- >        setMessage "update the README"
  -- >        setFile ["README.md"] $ readmeContent <> "just add some more description\n"
  -- >    branchWrite "master" r
  --
  withNewCommit :: (GitMonad git, Resolvable rev
  #if MIN_VERSION_base(4,13,0)
                   , MonadFail git
  #endif
                   )
                => Git.Person
                  -- ^ by default a commit must have an Author and a Committer.
                  --
                  -- The given value will be given to both Author and Committer.
                -> Maybe rev
                  -- ^ it is possible to prepopulate the Working Tree with a
                  -- given Ref's Tree.
                -> CommitM a
                  -- ^ the action to perform in the new commit (set files,
                  -- Person, encoding or extras)
                -> git (Git.Ref SHA1, a)
  withNewCommit p mPrec m = do
      workTree <- case mPrec of
                      Nothing -> workTreeNew
                      Just r -> do
                          mc <- getCommit r
                          case mc of
                              Nothing -> fail "the given revision does not exist or is not a commit"
                              Just c  -> workTreeFrom (Git.commitTreeish c)
      parents <- case mPrec of
                      Nothing -> return []
                      Just r  -> do
                          mr <- resolve r
                          return $ case mr of
                              Nothing -> []
                              Just ref -> [ref]
      let ctx = CommitContext
                  { commitContextAuthor    = p
                  , commitContextCommitter = p
                  , commitContextParents   = parents
                  , commitContextExtras    = []
                  , commitContextEncoding  = Nothing
                  , commitContextMessage   = B.empty
                  , commitContextTree      = workTree
                  }
      r <- runCommitM m ctx
      case r of
          ResultFailure err    -> fail err
          ResultSuccess ctx' a -> do
              treeRef <- workTreeFlush (commitContextTree ctx')
              let commit = Git.Commit
                              { Git.commitTreeish   = treeRef
                              , Git.commitParents   = commitContextParents ctx'
                              , Git.commitAuthor    = commitContextAuthor ctx'
                              , Git.commitCommitter = commitContextCommitter ctx'
                              , Git.commitEncoding  = commitContextEncoding ctx'
                              , Git.commitExtras    = commitContextExtras ctx'
                              , Git.commitMessage   = commitContextMessage ctx'
                              }
              ref <- setObject commit
              return (ref, a)
  
  -- | create or continue to work on a branch
  --
  -- This is a convenient function to create or to linearily work  on a branch.
  -- This function applies a first Collect of information on the parent commit
  -- (the actual branch's commit). Then it creates a new commit and update
  -- the branch to point to this commit.
  --
  -- for example:
  --
  -- @
  -- withCurrentRepo $
  --     withBranch person "master" True
  --         (getAuthor)
  --         (maybe (setMessage "initial commit on this branch")
  --                (\author -> setMessage $ "continue the great work of " ++ show (personName author))
  --         )
  -- @
  --
  withBranch :: (GitMonad git
  #if MIN_VERSION_base(4,13,0)
                , MonadFail git
  #endif
                )
             => Git.Person
                  -- ^ the default Author and Committer (see 'withNewCommit')
             -> Git.RefName
                  -- ^ the branch to work on
             -> Bool
                  -- ^ propopulate the parent's tree (if it exists) in the
                  -- new created commit.
                  --
                  -- In any cases, if the branch already exists, the new commit
                  -- parent will be filled with the result of ('resolv' "branchName")
             -> (CommitAccessM a)
                  -- ^ the action to performs in the parent's new commit if it exists.
             -> (Maybe a -> CommitM b)
                  -- ^ the action to performs in the new commit
                  --
                  -- the argument is the result of the action on the parent commit.
                  --
                  -- Nothing if the parent does not exist.
             -> git (Git.Ref SHA1, b)
  withBranch p branchName keepTree actionParent actionNew = do
      -- attempt to resolve the branch
      mRefParent <- resolve branchName
  
      -- configure the precedency of the tree and the action in the new commit
      (mRefTree, actionInCommit) <- case mRefParent of
          -- in the case the branch does not exist already: there is not precedency
          Nothing -> return (Nothing, actionNew Nothing)
          -- if the branch exists
          Just refParent -> do
              -- performs the action in the parent commit
              a <- withCommit refParent actionParent
              return $ if keepTree
                  -- if user has choosen to prepopulate the Tree with the
                  -- parent's tree we prepopulate the tree.
                  then (Just refParent, actionNew $ Just a)
                  -- else, we make sure the parent is at least setted
                  else (Nothing, setParents [refParent] >> actionNew (Just a))
      -- create the new commit
      (ref, b) <- withNewCommit p (mRefTree) actionInCommit
      -- write the branch
      branchWrite branchName ref
      return (ref, b)
  