module Git.Blob where

import           Conduit
import           Control.Applicative
import           Control.Monad
import           Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import           Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import           Data.Tagged
import           Data.Text as T
import           Data.Text.Encoding as T
import           Git.Types

createBlobUtf8 :: MonadGit r m => Text -> m (BlobOid r)
createBlobUtf8 :: Text -> m (BlobOid r)
createBlobUtf8 = BlobContents m -> m (BlobOid r)
forall r (m :: * -> *).
MonadGit r m =>
BlobContents m -> m (BlobOid r)
createBlob (BlobContents m -> m (BlobOid r))
-> (Text -> BlobContents m) -> Text -> m (BlobOid r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BlobContents m
forall (m :: * -> *). ByteString -> BlobContents m
BlobString (ByteString -> BlobContents m)
-> (Text -> ByteString) -> Text -> BlobContents m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8

catBlob :: MonadGit r m => BlobOid r -> m ByteString
catBlob :: BlobOid r -> m ByteString
catBlob = BlobOid r -> m (Blob r m)
forall r (m :: * -> *). MonadGit r m => BlobOid r -> m (Blob r m)
lookupBlob (BlobOid r -> m (Blob r m))
-> (Blob r m -> m ByteString) -> BlobOid r -> m ByteString
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Blob r m -> m ByteString
forall r (m :: * -> *). MonadGit r m => Blob r m -> m ByteString
blobToByteString

catBlobLazy :: MonadGit r m => BlobOid r -> m BL.ByteString
catBlobLazy :: BlobOid r -> m ByteString
catBlobLazy = BlobOid r -> m (Blob r m)
forall r (m :: * -> *). MonadGit r m => BlobOid r -> m (Blob r m)
lookupBlob (BlobOid r -> m (Blob r m))
-> (Blob r m -> m ByteString) -> BlobOid r -> m ByteString
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Blob r m -> m ByteString
forall r (m :: * -> *). MonadGit r m => Blob r m -> m ByteString
blobToLazyByteString

catBlobUtf8 :: MonadGit r m => BlobOid r -> m Text
catBlobUtf8 :: BlobOid r -> m Text
catBlobUtf8 = BlobOid r -> m ByteString
forall r (m :: * -> *). MonadGit r m => BlobOid r -> m ByteString
catBlob (BlobOid r -> m ByteString)
-> (ByteString -> m Text) -> BlobOid r -> m Text
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> (ByteString -> Text) -> ByteString -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8

blobContentsToByteString :: MonadGit r m => BlobContents m -> m ByteString
blobContentsToByteString :: BlobContents m -> m ByteString
blobContentsToByteString (BlobString ByteString
bs) = ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
blobContentsToByteString (BlobStringLazy ByteString
bs) =
    ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat (ByteString -> [ByteString]
BL.toChunks ByteString
bs)
blobContentsToByteString (BlobStream ByteSource m
bs) =
    [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks (ByteString -> ByteString) -> m ByteString -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ConduitT () Void m ByteString -> m ByteString
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m ByteString -> m ByteString)
-> ConduitT () Void m ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ ByteSource m
bs ByteSource m
-> ConduitM ByteString Void m ByteString
-> ConduitT () Void m ByteString
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString Void m ByteString
forall (m :: * -> *) lazy strict o.
(Monad m, LazySequence lazy strict) =>
ConduitT strict o m lazy
sinkLazy)
blobContentsToByteString (BlobSizedStream ByteSource m
bs Int
_) =
    ConduitT () Void m ByteString -> m ByteString
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m ByteString -> m ByteString)
-> ConduitT () Void m ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BL.toChunks (ByteString -> ByteString)
-> ConduitT () Void m ByteString -> ConduitT () Void m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteSource m
bs ByteSource m
-> ConduitM ByteString Void m ByteString
-> ConduitT () Void m ByteString
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString Void m ByteString
forall (m :: * -> *) lazy strict o.
(Monad m, LazySequence lazy strict) =>
ConduitT strict o m lazy
sinkLazy)

blobToByteString :: MonadGit r m => Blob r m -> m ByteString
blobToByteString :: Blob r m -> m ByteString
blobToByteString (Blob BlobOid r
_ BlobContents m
contents) = BlobContents m -> m ByteString
forall r (m :: * -> *).
MonadGit r m =>
BlobContents m -> m ByteString
blobContentsToByteString BlobContents m
contents

blobContentsToLazyByteString :: MonadGit r m
                             => BlobContents m -> m BL.ByteString
blobContentsToLazyByteString :: BlobContents m -> m ByteString
blobContentsToLazyByteString (BlobString ByteString
bs) = ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BL.fromChunks [ByteString
bs]
blobContentsToLazyByteString (BlobStringLazy ByteString
bs) = ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
blobContentsToLazyByteString (BlobStream ByteSource m
bs) = ConduitT () Void m ByteString -> m ByteString
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m ByteString -> m ByteString)
-> ConduitT () Void m ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ ByteSource m
bs ByteSource m
-> ConduitM ByteString Void m ByteString
-> ConduitT () Void m ByteString
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString Void m ByteString
forall (m :: * -> *) lazy strict o.
(Monad m, LazySequence lazy strict) =>
ConduitT strict o m lazy
sinkLazy
blobContentsToLazyByteString (BlobSizedStream ByteSource m
bs Int
_) = ConduitT () Void m ByteString -> m ByteString
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m ByteString -> m ByteString)
-> ConduitT () Void m ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ ByteSource m
bs ByteSource m
-> ConduitM ByteString Void m ByteString
-> ConduitT () Void m ByteString
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString Void m ByteString
forall (m :: * -> *) lazy strict o.
(Monad m, LazySequence lazy strict) =>
ConduitT strict o m lazy
sinkLazy

blobToLazyByteString :: MonadGit r m => Blob r m -> m BL.ByteString
blobToLazyByteString :: Blob r m -> m ByteString
blobToLazyByteString (Blob BlobOid r
_ BlobContents m
contents) = BlobContents m -> m ByteString
forall r (m :: * -> *).
MonadGit r m =>
BlobContents m -> m ByteString
blobContentsToLazyByteString BlobContents m
contents

writeBlob :: (MonadGit r m, MonadIO m, MonadResource m)
          => FilePath -> BlobContents m -> m ()
writeBlob :: FilePath -> BlobContents m -> m ()
writeBlob FilePath
path (BlobString ByteString
bs)         = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
B.writeFile FilePath
path ByteString
bs
writeBlob FilePath
path (BlobStringLazy ByteString
bs)     = ConduitT () Void m () -> m ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m () -> m ()) -> ConduitT () Void m () -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ConduitT () ByteString m ()
forall (m :: * -> *) lazy strict i.
(Monad m, LazySequence lazy strict) =>
lazy -> ConduitT i strict m ()
sourceLazy ByteString
bs ConduitT () ByteString m ()
-> ConduitM ByteString Void m () -> ConduitT () Void m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| FilePath -> ConduitM ByteString Void m ()
forall (m :: * -> *) o.
MonadResource m =>
FilePath -> ConduitT ByteString o m ()
sinkFile FilePath
path
writeBlob FilePath
path (BlobStream ConduitT () ByteString m ()
str)        = ConduitT () Void m () -> m ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m () -> m ()) -> ConduitT () Void m () -> m ()
forall a b. (a -> b) -> a -> b
$ ConduitT () ByteString m ()
str ConduitT () ByteString m ()
-> ConduitM ByteString Void m () -> ConduitT () Void m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| FilePath -> ConduitM ByteString Void m ()
forall (m :: * -> *) o.
MonadResource m =>
FilePath -> ConduitT ByteString o m ()
sinkFile FilePath
path
writeBlob FilePath
path (BlobSizedStream ConduitT () ByteString m ()
str Int
_) = ConduitT () Void m () -> m ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m () -> m ()) -> ConduitT () Void m () -> m ()
forall a b. (a -> b) -> a -> b
$ ConduitT () ByteString m ()
str ConduitT () ByteString m ()
-> ConduitM ByteString Void m () -> ConduitT () Void m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| FilePath -> ConduitM ByteString Void m ()
forall (m :: * -> *) o.
MonadResource m =>
FilePath -> ConduitT ByteString o m ()
sinkFile FilePath
path

treeBlobEntries :: MonadGit r m
                => Tree r -> m [(TreeFilePath, BlobOid r, BlobKind)]
treeBlobEntries :: Tree r -> m [(ByteString, BlobOid r, BlobKind)]
treeBlobEntries Tree r
tree = ConduitT () Void m [(ByteString, BlobOid r, BlobKind)]
-> m [(ByteString, BlobOid r, BlobKind)]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m [(ByteString, BlobOid r, BlobKind)]
 -> m [(ByteString, BlobOid r, BlobKind)])
-> ConduitT () Void m [(ByteString, BlobOid r, BlobKind)]
-> m [(ByteString, BlobOid r, BlobKind)]
forall a b. (a -> b) -> a -> b
$ Tree r -> ConduitT () (ByteString, BlobOid r, BlobKind) m ()
forall r (m :: * -> *) i.
MonadGit r m =>
Tree r -> ConduitT i (ByteString, BlobOid r, BlobKind) m ()
sourceTreeBlobEntries Tree r
tree ConduitT () (ByteString, BlobOid r, BlobKind) m ()
-> ConduitM
     (ByteString, BlobOid r, BlobKind)
     Void
     m
     [(ByteString, BlobOid r, BlobKind)]
-> ConduitT () Void m [(ByteString, BlobOid r, BlobKind)]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM
  (ByteString, BlobOid r, BlobKind)
  Void
  m
  [(ByteString, BlobOid r, BlobKind)]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList

sourceTreeBlobEntries
    :: MonadGit r m
    => Tree r -> ConduitT i (TreeFilePath, BlobOid r, BlobKind) m ()
sourceTreeBlobEntries :: Tree r -> ConduitT i (ByteString, BlobOid r, BlobKind) m ()
sourceTreeBlobEntries Tree r
tree =
    Tree r -> ConduitT i (ByteString, TreeEntry r) m ()
forall r (m :: * -> *) i.
MonadGit r m =>
Tree r -> ConduitT i (ByteString, TreeEntry r) m ()
sourceTreeEntries Tree r
tree ConduitT i (ByteString, TreeEntry r) m ()
-> ConduitM
     (ByteString, TreeEntry r) (ByteString, BlobOid r, BlobKind) m ()
-> ConduitT i (ByteString, BlobOid r, BlobKind) m ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ((ByteString, TreeEntry r)
 -> ConduitM
      (ByteString, TreeEntry r) (ByteString, BlobOid r, BlobKind) m ())
-> ConduitM
     (ByteString, TreeEntry r) (ByteString, BlobOid r, BlobKind) m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever (ByteString, TreeEntry r)
-> ConduitM
     (ByteString, TreeEntry r) (ByteString, BlobOid r, BlobKind) m ()
forall (m :: * -> *) a r i.
Monad m =>
(a, TreeEntry r) -> ConduitT i (a, Tagged r (Oid r), BlobKind) m ()
go
  where
    go :: (a, TreeEntry r) -> ConduitT i (a, Tagged r (Oid r), BlobKind) m ()
go (a
fp ,BlobEntry Tagged r (Oid r)
oid BlobKind
k) = (a, Tagged r (Oid r), BlobKind)
-> ConduitT i (a, Tagged r (Oid r), BlobKind) m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (a
fp, Tagged r (Oid r)
oid, BlobKind
k)
    go (a, TreeEntry r)
_ = () -> ConduitT i (a, Tagged r (Oid r), BlobKind) m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

copyBlob :: (MonadGit r m, MonadGit s (t m), MonadTrans t)
         => BlobOid r -> HashSet Text -> t m (BlobOid s, HashSet Text)
copyBlob :: BlobOid r -> HashSet Text -> t m (BlobOid s, HashSet Text)
copyBlob BlobOid r
blobr HashSet Text
needed = do
    let oid :: Oid r
oid = BlobOid r -> Oid r
forall k (s :: k) b. Tagged s b -> b
untag BlobOid r
blobr
        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
        ByteString
bs <- m ByteString -> t m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> t m ByteString) -> m ByteString -> t m ByteString
forall a b. (a -> b) -> a -> b
$ Blob r m -> m ByteString
forall r (m :: * -> *). MonadGit r m => Blob r m -> m ByteString
blobToByteString (Blob r m -> m ByteString) -> m (Blob r m) -> m ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< BlobOid r -> m (Blob r m)
forall r (m :: * -> *). MonadGit r m => BlobOid r -> m (Blob r m)
lookupBlob (Oid r -> BlobOid r
forall k (s :: k) b. b -> Tagged s b
Tagged Oid r
oid)
        BlobOid s
boid <- BlobContents (t m) -> t m (BlobOid s)
forall r (m :: * -> *).
MonadGit r m =>
BlobContents m -> m (BlobOid r)
createBlob (ByteString -> BlobContents (t m)
forall (m :: * -> *). ByteString -> BlobContents m
BlobString ByteString
bs)

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

        else (BlobOid s, HashSet Text) -> t m (BlobOid s, HashSet Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Oid s -> BlobOid s
forall k (s :: k) b. b -> Tagged s b
Tagged Oid s
oid2, HashSet Text
needed)