module Git.Tree where

import           Conduit
import           Control.Monad
import           Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import           Data.Monoid
import           Data.Tagged
import           Data.Text (Text)
import           Git.Blob
import           Git.Tree.Builder
import           Git.Types

listTreeEntries :: MonadGit r m => Tree r -> m [(TreeFilePath, TreeEntry r)]
listTreeEntries :: Tree r -> m [(TreeFilePath, TreeEntry r)]
listTreeEntries Tree r
tree = ConduitT () Void m [(TreeFilePath, TreeEntry r)]
-> m [(TreeFilePath, TreeEntry r)]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m [(TreeFilePath, TreeEntry r)]
 -> m [(TreeFilePath, TreeEntry r)])
-> ConduitT () Void m [(TreeFilePath, TreeEntry r)]
-> m [(TreeFilePath, TreeEntry r)]
forall a b. (a -> b) -> a -> b
$ Tree r -> ConduitT () (TreeFilePath, TreeEntry r) m ()
forall r (m :: * -> *) i.
MonadGit r m =>
Tree r -> ConduitT i (TreeFilePath, TreeEntry r) m ()
sourceTreeEntries Tree r
tree ConduitT () (TreeFilePath, TreeEntry r) m ()
-> ConduitM
     (TreeFilePath, TreeEntry r) Void m [(TreeFilePath, TreeEntry r)]
-> ConduitT () Void m [(TreeFilePath, TreeEntry r)]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM
  (TreeFilePath, TreeEntry r) Void m [(TreeFilePath, TreeEntry r)]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList

copyTreeEntry :: (MonadGit r m, MonadGit s (t m), MonadTrans t)
              => TreeEntry r -> HashSet Text -> t m (TreeEntry s, HashSet Text)
copyTreeEntry :: TreeEntry r -> HashSet Text -> t m (TreeEntry s, HashSet Text)
copyTreeEntry (BlobEntry BlobOid r
oid BlobKind
kind) HashSet Text
needed = do
    (Tagged s (Oid s)
b,HashSet Text
needed') <- BlobOid r -> HashSet Text -> t m (Tagged s (Oid s), HashSet Text)
forall r (m :: * -> *) s (t :: (* -> *) -> * -> *).
(MonadGit r m, MonadGit s (t m), MonadTrans t) =>
BlobOid r -> HashSet Text -> t m (BlobOid s, HashSet Text)
copyBlob BlobOid r
oid HashSet Text
needed
    Bool -> t m () -> t m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (BlobOid r -> Text
forall o a. IsOid o => Tagged a o -> Text
renderObjOid BlobOid r
oid Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Tagged s (Oid s) -> Text
forall o a. IsOid o => Tagged a o -> Text
renderObjOid Tagged s (Oid s)
b) (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 blob: "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BlobOid r -> Text
forall o a. IsOid o => Tagged a o -> Text
renderObjOid BlobOid r
oid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" /= " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Tagged s (Oid s) -> Text
forall o a. IsOid o => Tagged a o -> Text
renderObjOid Tagged s (Oid s)
b
    (TreeEntry s, HashSet Text) -> t m (TreeEntry s, HashSet Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tagged s (Oid s) -> BlobKind -> TreeEntry s
forall r. BlobOid r -> BlobKind -> TreeEntry r
BlobEntry Tagged s (Oid s)
b BlobKind
kind, HashSet Text
needed')
copyTreeEntry (CommitEntry CommitOid r
oid) HashSet Text
needed = do
    Oid s
coid <- Text -> t m (Oid s)
forall r (m :: * -> *). MonadGit r m => Text -> m (Oid r)
parseOid (CommitOid r -> Text
forall o a. IsOid o => Tagged a o -> Text
renderObjOid CommitOid r
oid)
    (TreeEntry s, HashSet Text) -> t m (TreeEntry s, HashSet Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (CommitOid s -> TreeEntry s
forall r. CommitOid r -> TreeEntry r
CommitEntry (Oid s -> CommitOid s
forall k (s :: k) b. b -> Tagged s b
Tagged Oid s
coid), HashSet Text
needed)
copyTreeEntry (TreeEntry TreeOid r
_) HashSet Text
_ = [Char] -> t m (TreeEntry s, HashSet Text)
forall a. HasCallStack => [Char] -> a
error [Char]
"This should never be called"

copyTree :: (MonadGit r m, MonadGit s (t m), MonadTrans t)
         => TreeOid r -> HashSet Text -> t m (TreeOid s, HashSet Text)
copyTree :: TreeOid r -> HashSet Text -> t m (TreeOid s, HashSet Text)
copyTree TreeOid r
tr HashSet Text
needed = do
    let oid :: Oid r
oid = TreeOid r -> Oid r
forall k (s :: k) b. Tagged s b -> b
untag TreeOid r
tr
        sha :: Text
sha = Oid r -> Text
forall o. IsOid o => o -> Text
renderOid Oid r
oid
    Oid s
oid2 <- Text -> t m (Oid s)
forall r (m :: * -> *). MonadGit r m => Text -> m (Oid r)
parseOid (Oid r -> Text
forall o. IsOid o => o -> Text
renderOid Oid r
oid)
    if Text -> HashSet Text -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member Text
sha HashSet Text
needed
        then do
        Tree r
tree    <- m (Tree r) -> t m (Tree r)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Tree r) -> t m (Tree r)) -> m (Tree r) -> t m (Tree r)
forall a b. (a -> b) -> a -> b
$ TreeOid r -> m (Tree r)
forall r (m :: * -> *). MonadGit r m => TreeOid r -> m (Tree r)
lookupTree TreeOid r
tr
        [(TreeFilePath, TreeEntry r)]
entries <- m [(TreeFilePath, TreeEntry r)]
-> t m [(TreeFilePath, TreeEntry r)]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [(TreeFilePath, TreeEntry r)]
 -> t m [(TreeFilePath, TreeEntry r)])
-> m [(TreeFilePath, TreeEntry r)]
-> t m [(TreeFilePath, TreeEntry r)]
forall a b. (a -> b) -> a -> b
$ Tree r -> m [(TreeFilePath, TreeEntry r)]
forall r (m :: * -> *).
MonadGit r m =>
Tree r -> m [(TreeFilePath, TreeEntry r)]
listTreeEntries Tree r
tree
        (HashSet Text
needed', TreeOid s
tref) <-
            TreeT s (t m) (HashSet Text) -> t m (HashSet Text, TreeOid s)
forall r (m :: * -> *) a.
MonadGit r m =>
TreeT r m a -> m (a, TreeOid r)
withNewTree (TreeT s (t m) (HashSet Text) -> t m (HashSet Text, TreeOid s))
-> TreeT s (t m) (HashSet Text) -> t m (HashSet Text, TreeOid s)
forall a b. (a -> b) -> a -> b
$ (HashSet Text
 -> (TreeFilePath, TreeEntry r) -> TreeT s (t m) (HashSet Text))
-> HashSet Text
-> [(TreeFilePath, TreeEntry r)]
-> TreeT s (t m) (HashSet Text)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM HashSet Text
-> (TreeFilePath, TreeEntry r) -> TreeT s (t m) (HashSet Text)
forall r (m :: * -> *) s (t :: (* -> *) -> * -> *).
(MonadGit r m, MonadGit s (t m), MonadTrans t) =>
HashSet Text
-> (TreeFilePath, TreeEntry r) -> TreeT s (t m) (HashSet Text)
doCopyTreeEntry HashSet Text
needed [(TreeFilePath, TreeEntry r)]
entries

        let 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'
        (TreeOid s, HashSet Text) -> t m (TreeOid s, HashSet Text)
forall (m :: * -> *) a. Monad m => a -> m a
return ((TreeOid s, HashSet Text) -> t m (TreeOid s, HashSet Text))
-> (TreeOid s, HashSet Text) -> t m (TreeOid s, HashSet Text)
forall a b. (a -> b) -> a -> b
$ TreeOid s
tref TreeOid s -> (TreeOid s, HashSet Text) -> (TreeOid s, HashSet Text)
`seq` HashSet Text
x HashSet Text
-> (TreeOid s, HashSet Text) -> (TreeOid s, HashSet Text)
`seq` (TreeOid s
tref, HashSet Text
x)

        else (TreeOid s, HashSet Text) -> t m (TreeOid s, HashSet Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Oid s -> TreeOid s
forall k (s :: k) b. b -> Tagged s b
Tagged Oid s
oid2, HashSet Text
needed)
  where
    doCopyTreeEntry :: (MonadGit r m, MonadGit s (t m), MonadTrans t)
                    => HashSet Text
                    -> (TreeFilePath, TreeEntry r)
                    -> TreeT s (t m) (HashSet Text)
    doCopyTreeEntry :: HashSet Text
-> (TreeFilePath, TreeEntry r) -> TreeT s (t m) (HashSet Text)
doCopyTreeEntry HashSet Text
set (TreeFilePath
_, TreeEntry {}) = HashSet Text -> TreeT s (t m) (HashSet Text)
forall (m :: * -> *) a. Monad m => a -> m a
return HashSet Text
set
    doCopyTreeEntry HashSet Text
set (TreeFilePath
fp, TreeEntry r
ent) = do
        (TreeEntry s
ent2,HashSet Text
set') <- t m (TreeEntry s, HashSet Text)
-> TreeT s (t m) (TreeEntry s, HashSet Text)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (t m (TreeEntry s, HashSet Text)
 -> TreeT s (t m) (TreeEntry s, HashSet Text))
-> t m (TreeEntry s, HashSet Text)
-> TreeT s (t m) (TreeEntry s, HashSet Text)
forall a b. (a -> b) -> a -> b
$ TreeEntry r -> HashSet Text -> t m (TreeEntry s, HashSet Text)
forall r (m :: * -> *) s (t :: (* -> *) -> * -> *).
(MonadGit r m, MonadGit s (t m), MonadTrans t) =>
TreeEntry r -> HashSet Text -> t m (TreeEntry s, HashSet Text)
copyTreeEntry TreeEntry r
ent HashSet Text
set
        TreeFilePath -> TreeEntry s -> TreeT s (t m) ()
forall r (m :: * -> *).
MonadGit r m =>
TreeFilePath -> TreeEntry r -> TreeT r m ()
putEntry TreeFilePath
fp TreeEntry s
ent2
        HashSet Text -> TreeT s (t m) (HashSet Text)
forall (m :: * -> *) a. Monad m => a -> m a
return HashSet Text
set'