module Git.Commit where

import           Conduit
import           Control.Monad
import           Data.Function
import           Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import           Data.List
import           Data.Maybe
import           Data.Monoid
import           Data.Tagged
import           Data.Text (Text)
import           Git.Tree
import           Git.Types
import           Prelude hiding (FilePath)

commitTreeEntry :: MonadGit r m
                => Commit r -> TreeFilePath -> m (Maybe (TreeEntry r))
commitTreeEntry :: Commit r -> TreeFilePath -> m (Maybe (TreeEntry r))
commitTreeEntry Commit r
c TreeFilePath
path = (Tree r -> TreeFilePath -> m (Maybe (TreeEntry r)))
-> TreeFilePath -> Tree r -> m (Maybe (TreeEntry r))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tree r -> TreeFilePath -> m (Maybe (TreeEntry r))
forall r (m :: * -> *).
MonadGit r m =>
Tree r -> TreeFilePath -> m (Maybe (TreeEntry r))
treeEntry TreeFilePath
path (Tree r -> m (Maybe (TreeEntry r)))
-> m (Tree r) -> m (Maybe (TreeEntry r))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TreeOid r -> m (Tree r)
forall r (m :: * -> *). MonadGit r m => TreeOid r -> m (Tree r)
lookupTree (Commit r -> TreeOid r
forall r. Commit r -> TreeOid r
commitTree Commit r
c)

copyCommitOid :: (IsOid (Oid r), MonadGit s n)
              => CommitOid r -> n (CommitOid s)
copyCommitOid :: CommitOid r -> n (CommitOid s)
copyCommitOid = Text -> n (CommitOid s)
forall r (m :: * -> *) o.
MonadGit r m =>
Text -> m (Tagged o (Oid r))
parseObjOid (Text -> n (CommitOid s))
-> (CommitOid r -> Text) -> CommitOid r -> n (CommitOid s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommitOid r -> Text
forall o a. IsOid o => Tagged a o -> Text
renderObjOid

copyCommit :: (MonadGit r m, MonadGit s (t m), MonadTrans t)
           => CommitOid r
           -> Maybe RefName
           -> HashSet Text
           -> t m (CommitOid s, HashSet Text)
copyCommit :: CommitOid r
-> Maybe Text -> HashSet Text -> t m (CommitOid s, HashSet Text)
copyCommit CommitOid r
cr Maybe Text
mref HashSet Text
needed = do
    let oid :: Oid r
oid = CommitOid r -> Oid r
forall k (s :: k) b. Tagged s b -> b
untag CommitOid r
cr
        sha :: Text
sha = Oid r -> Text
forall o. IsOid o => o -> Text
renderOid Oid r
oid
    Commit r
commit <- m (Commit r) -> t m (Commit r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Commit r) -> t m (Commit r)) -> m (Commit r) -> t m (Commit r)
forall a b. (a -> b) -> a -> b
$ CommitOid r -> m (Commit r)
forall r (m :: * -> *). MonadGit r m => CommitOid r -> m (Commit r)
lookupCommit CommitOid r
cr
    Oid s
oid2   <- Text -> t m (Oid s)
forall r (m :: * -> *). MonadGit r m => Text -> m (Oid r)
parseOid Text
sha
    if Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member Text
sha HashSet Text
needed
        then do
        let parents :: [CommitOid r]
parents = Commit r -> [CommitOid r]
forall r. Commit r -> [CommitOid r]
commitParents Commit r
commit
        ([CommitOid s]
parentRefs,HashSet Text
needed') <- (([CommitOid s], HashSet Text)
 -> CommitOid r -> t m ([CommitOid s], HashSet Text))
-> ([CommitOid s], HashSet Text)
-> [CommitOid r]
-> t m ([CommitOid s], HashSet Text)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([CommitOid s], HashSet Text)
-> CommitOid r -> t m ([CommitOid s], HashSet Text)
forall r (m :: * -> *) s (t :: (* -> *) -> * -> *).
(MonadGit r m, MonadGit s (t m), MonadTrans t) =>
([Tagged (Commit s) (Oid s)], HashSet Text)
-> Tagged (Commit r) (Oid r)
-> t m ([Tagged (Commit s) (Oid s)], HashSet Text)
copyParent ([],HashSet Text
needed) [CommitOid r]
parents
        (Tagged (Tree s) (Oid s)
tr,HashSet Text
needed'') <- TreeOid r
-> HashSet Text -> t m (Tagged (Tree s) (Oid s), HashSet Text)
forall r (m :: * -> *) s (t :: (* -> *) -> * -> *).
(MonadGit r m, MonadGit s (t m), MonadTrans t) =>
TreeOid r -> HashSet Text -> t m (TreeOid s, HashSet Text)
copyTree (Commit r -> TreeOid r
forall r. Commit r -> TreeOid r
commitTree Commit r
commit) HashSet Text
needed'
        Bool -> t m () -> t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TreeOid r -> Text
forall o a. IsOid o => Tagged a o -> Text
renderObjOid (Commit r -> TreeOid r
forall r. Commit r -> TreeOid r
commitTree Commit r
commit) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Tagged (Tree s) (Oid s) -> Text
forall o a. IsOid o => Tagged a o -> Text
renderObjOid Tagged (Tree s) (Oid s)
tr) (t m () -> t m ()) -> t m () -> t m ()
forall a b. (a -> b) -> a -> b
$
            GitException -> t m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (GitException -> t m ()) -> GitException -> t m ()
forall a b. (a -> b) -> a -> b
$ Text -> GitException
BackendError (Text -> GitException) -> Text -> GitException
forall a b. (a -> b) -> a -> b
$ Text
"Error copying tree: "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TreeOid r -> Text
forall o a. IsOid o => Tagged a o -> Text
renderObjOid (Commit r -> TreeOid r
forall r. Commit r -> TreeOid r
commitTree Commit r
commit)
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" /= " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Tagged (Tree s) (Oid s) -> Text
forall o a. IsOid o => Tagged a o -> Text
renderObjOid Tagged (Tree s) (Oid s)
tr

        Commit s
commit' <- [CommitOid s]
-> Tagged (Tree s) (Oid s)
-> Signature
-> Signature
-> Text
-> Maybe Text
-> t m (Commit s)
forall r (m :: * -> *).
MonadGit r m =>
[CommitOid r]
-> TreeOid r
-> Signature
-> Signature
-> Text
-> Maybe Text
-> m (Commit r)
createCommit ([CommitOid s] -> [CommitOid s]
forall a. [a] -> [a]
reverse [CommitOid s]
parentRefs) Tagged (Tree s) (Oid s)
tr
            (Commit r -> Signature
forall r. Commit r -> Signature
commitAuthor Commit r
commit)
            (Commit r -> Signature
forall r. Commit r -> Signature
commitCommitter Commit r
commit)
            (Commit r -> Text
forall r. Commit r -> Text
commitLog Commit r
commit)
            Maybe Text
mref

        let coid :: CommitOid s
coid = Commit s -> CommitOid s
forall r. Commit r -> CommitOid r
commitOid Commit s
commit'
            x :: HashSet Text
x    = Text -> HashSet Text -> HashSet Text
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.delete Text
sha HashSet Text
needed''
        (CommitOid s, HashSet Text) -> t m (CommitOid s, HashSet Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ((CommitOid s, HashSet Text) -> t m (CommitOid s, HashSet Text))
-> (CommitOid s, HashSet Text) -> t m (CommitOid s, HashSet Text)
forall a b. (a -> b) -> a -> b
$ CommitOid s
coid CommitOid s
-> (CommitOid s, HashSet Text) -> (CommitOid s, HashSet Text)
`seq` HashSet Text
x HashSet Text
-> (CommitOid s, HashSet Text) -> (CommitOid s, HashSet Text)
`seq` (CommitOid s
coid, HashSet Text
x)

        else (CommitOid s, HashSet Text) -> t m (CommitOid s, HashSet Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Oid s -> CommitOid s
forall k (s :: k) b. b -> Tagged s b
Tagged Oid s
oid2, HashSet Text
needed)
  where
    copyParent :: ([Tagged (Commit s) (Oid s)], HashSet Text)
-> Tagged (Commit r) (Oid r)
-> t m ([Tagged (Commit s) (Oid s)], HashSet Text)
copyParent ([Tagged (Commit s) (Oid s)]
prefs,HashSet Text
needed') Tagged (Commit r) (Oid r)
cref = do
        (Tagged (Commit s) (Oid s)
cref2,HashSet Text
needed'') <- Tagged (Commit r) (Oid r)
-> Maybe Text
-> HashSet Text
-> t m (Tagged (Commit s) (Oid s), HashSet Text)
forall r (m :: * -> *) s (t :: (* -> *) -> * -> *).
(MonadGit r m, MonadGit s (t m), MonadTrans t) =>
CommitOid r
-> Maybe Text -> HashSet Text -> t m (CommitOid s, HashSet Text)
copyCommit Tagged (Commit r) (Oid r)
cref Maybe Text
forall a. Maybe a
Nothing HashSet Text
needed'
        Bool -> t m () -> t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Tagged (Commit r) (Oid r) -> Text
forall o a. IsOid o => Tagged a o -> Text
renderObjOid Tagged (Commit r) (Oid r)
cref Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Tagged (Commit s) (Oid s) -> Text
forall o a. IsOid o => Tagged a o -> Text
renderObjOid Tagged (Commit s) (Oid s)
cref2) (t m () -> t m ()) -> t m () -> t m ()
forall a b. (a -> b) -> a -> b
$
            GitException -> t m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (GitException -> t m ()) -> GitException -> t m ()
forall a b. (a -> b) -> a -> b
$ Text -> GitException
BackendError (Text -> GitException) -> Text -> GitException
forall a b. (a -> b) -> a -> b
$ Text
"Error copying commit: "
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Tagged (Commit r) (Oid r) -> Text
forall o a. IsOid o => Tagged a o -> Text
renderObjOid Tagged (Commit r) (Oid r)
cref Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" /= " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Tagged (Commit s) (Oid s) -> Text
forall o a. IsOid o => Tagged a o -> Text
renderObjOid Tagged (Commit s) (Oid s)
cref2
        let x :: [Tagged (Commit s) (Oid s)]
x = Tagged (Commit s) (Oid s)
cref2 Tagged (Commit s) (Oid s)
-> [Tagged (Commit s) (Oid s)] -> [Tagged (Commit s) (Oid s)]
`seq` (Tagged (Commit s) (Oid s)
cref2Tagged (Commit s) (Oid s)
-> [Tagged (Commit s) (Oid s)] -> [Tagged (Commit s) (Oid s)]
forall a. a -> [a] -> [a]
:[Tagged (Commit s) (Oid s)]
prefs)
        ([Tagged (Commit s) (Oid s)], HashSet Text)
-> t m ([Tagged (Commit s) (Oid s)], HashSet Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (([Tagged (Commit s) (Oid s)], HashSet Text)
 -> t m ([Tagged (Commit s) (Oid s)], HashSet Text))
-> ([Tagged (Commit s) (Oid s)], HashSet Text)
-> t m ([Tagged (Commit s) (Oid s)], HashSet Text)
forall a b. (a -> b) -> a -> b
$ [Tagged (Commit s) (Oid s)]
x [Tagged (Commit s) (Oid s)]
-> ([Tagged (Commit s) (Oid s)], HashSet Text)
-> ([Tagged (Commit s) (Oid s)], HashSet Text)
`seq` HashSet Text
needed'' HashSet Text
-> ([Tagged (Commit s) (Oid s)], HashSet Text)
-> ([Tagged (Commit s) (Oid s)], HashSet Text)
`seq` ([Tagged (Commit s) (Oid s)]
x,HashSet Text
needed'')

listCommits :: MonadGit r m
            => Maybe (CommitOid r) -- ^ A commit we may already have
            -> CommitOid r         -- ^ The commit we need
            -> m [CommitOid r]     -- ^ All the objects in between
listCommits :: Maybe (CommitOid r) -> CommitOid r -> m [CommitOid r]
listCommits Maybe (CommitOid r)
mhave CommitOid r
need =
    ConduitT () Void m [CommitOid r] -> m [CommitOid r]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m [CommitOid r] -> m [CommitOid r])
-> ConduitT () Void m [CommitOid r] -> m [CommitOid r]
forall a b. (a -> b) -> a -> b
$ Maybe (CommitOid r)
-> CommitOid r -> Bool -> ConduitT () (ObjectOid r) m ()
forall r (m :: * -> *) i.
MonadGit r m =>
Maybe (CommitOid r)
-> CommitOid r -> Bool -> ConduitT i (ObjectOid r) m ()
sourceObjects Maybe (CommitOid r)
mhave CommitOid r
need Bool
False
        ConduitT () (ObjectOid r) m ()
-> ConduitM (ObjectOid r) Void m [CommitOid r]
-> ConduitT () Void m [CommitOid r]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (ObjectOid r -> m (CommitOid r))
-> ConduitT (ObjectOid r) (CommitOid r) m ()
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
mapMC (\(CommitObjOid CommitOid r
c) -> CommitOid r -> m (CommitOid r)
forall (m :: * -> *) a. Monad m => a -> m a
return CommitOid r
c)
        ConduitT (ObjectOid r) (CommitOid r) m ()
-> ConduitM (CommitOid r) Void m [CommitOid r]
-> ConduitM (ObjectOid r) Void m [CommitOid r]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM (CommitOid r) Void m [CommitOid r]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList

traverseCommits :: MonadGit r m => (CommitOid r -> m a) -> CommitOid r -> m [a]
traverseCommits :: (CommitOid r -> m a) -> CommitOid r -> m [a]
traverseCommits CommitOid r -> m a
f CommitOid r
need = (CommitOid r -> m a) -> [CommitOid r] -> m [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM CommitOid r -> m a
f ([CommitOid r] -> m [a]) -> m [CommitOid r] -> m [a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (CommitOid r) -> CommitOid r -> m [CommitOid r]
forall r (m :: * -> *).
MonadGit r m =>
Maybe (CommitOid r) -> CommitOid r -> m [CommitOid r]
listCommits Maybe (CommitOid r)
forall a. Maybe a
Nothing CommitOid r
need

traverseCommits_ :: MonadGit r m => (CommitOid r -> m ()) -> CommitOid r -> m ()
traverseCommits_ :: (CommitOid r -> m ()) -> CommitOid r -> m ()
traverseCommits_ = (m [()] -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m [()] -> m ()) -> (CommitOid r -> m [()]) -> CommitOid r -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((CommitOid r -> m [()]) -> CommitOid r -> m ())
-> ((CommitOid r -> m ()) -> CommitOid r -> m [()])
-> (CommitOid r -> m ())
-> CommitOid r
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CommitOid r -> m ()) -> CommitOid r -> m [()]
forall r (m :: * -> *) a.
MonadGit r m =>
(CommitOid r -> m a) -> CommitOid r -> m [a]
traverseCommits