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)