module Data.Git.Phoenix.Tree where

import Data.ByteString.Lazy qualified as L
import Data.Git.Phoenix.App
import Data.Git.Phoenix.Object
import Data.Git.Phoenix.Prelude
import Data.Git.Phoenix.Sha
import Data.Git.Phoenix.ShaCollision
import Data.Git.Phoenix.Io

dropTreeHeader :: LByteString -> LByteString
dropTreeHeader :: LByteString -> LByteString
dropTreeHeader = Int64 -> LByteString -> LByteString
L.drop Int64
1 (LByteString -> LByteString)
-> (LByteString -> LByteString) -> LByteString -> LByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> LByteString -> LByteString
L.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0)

data DOF = Dir | File deriving (DOF -> DOF -> Bool
(DOF -> DOF -> Bool) -> (DOF -> DOF -> Bool) -> Eq DOF
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DOF -> DOF -> Bool
== :: DOF -> DOF -> Bool
$c/= :: DOF -> DOF -> Bool
/= :: DOF -> DOF -> Bool
Eq, Int -> DOF -> ShowS
[DOF] -> ShowS
DOF -> String
(Int -> DOF -> ShowS)
-> (DOF -> String) -> ([DOF] -> ShowS) -> Show DOF
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DOF -> ShowS
showsPrec :: Int -> DOF -> ShowS
$cshow :: DOF -> String
show :: DOF -> String
$cshowList :: [DOF] -> ShowS
showList :: [DOF] -> ShowS
Show, (forall x. DOF -> Rep DOF x)
-> (forall x. Rep DOF x -> DOF) -> Generic DOF
forall x. Rep DOF x -> DOF
forall x. DOF -> Rep DOF x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DOF -> Rep DOF x
from :: forall x. DOF -> Rep DOF x
$cto :: forall x. Rep DOF x -> DOF
to :: forall x. Rep DOF x -> DOF
Generic)

instance NFData DOF

dofToGitObjType :: DOF -> GitObjType
dofToGitObjType :: DOF -> GitObjType
dofToGitObjType =
  \case
    DOF
Dir -> GitObjType
TreeType
    DOF
File -> GitObjType
BlobType

readTreeShas :: LByteString -> [(DOF, LByteString)]
readTreeShas :: LByteString -> [(DOF, LByteString)]
readTreeShas LByteString
modePrefixedBs =
  case LByteString -> Maybe (Word8, LByteString)
L.uncons LByteString
modePrefixedBs of
    Just (Word8
0x31, LByteString
bs) -> DOF -> LByteString -> [(DOF, LByteString)]
go DOF
File LByteString
bs {- '1' blob  -}
    Just (Word8
0x34, LByteString
bs) -> DOF -> LByteString -> [(DOF, LByteString)]
go DOF
Dir LByteString
bs  {- '4' tree  -}
    Maybe (Word8, LByteString)
Nothing -> []
    Just (Word8
ue, LByteString
_) ->
      Text -> [(DOF, LByteString)]
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> [(DOF, LByteString)]) -> Text -> [(DOF, LByteString)]
forall a b. (a -> b) -> a -> b
$ Text
"tree entry mode does not start with 1 nor 4: "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word8 -> Text
forall b a. (Show a, IsString b) => a -> b
show Word8
ue Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LByteString -> Text
forall b a. (Show a, IsString b) => a -> b
show LByteString
modePrefixedBs
  where
    shaBinLen :: Int64
shaBinLen = Int64
20
    go :: DOF -> LByteString -> [(DOF, LByteString)]
go DOF
dof LByteString
bs =
      case LByteString -> Maybe (Word8, LByteString)
L.uncons (LByteString -> Maybe (Word8, LByteString))
-> LByteString -> Maybe (Word8, LByteString)
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> LByteString -> LByteString
L.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) LByteString
bs  of
        Just (Word8
0, LByteString
shaPrefixedBs) ->
          let (LByteString
sha, LByteString
bs') = Int64 -> LByteString -> (LByteString, LByteString)
L.splitAt Int64
shaBinLen LByteString
shaPrefixedBs in
            (DOF
dof, LByteString
sha) (DOF, LByteString) -> [(DOF, LByteString)] -> [(DOF, LByteString)]
forall a. a -> [a] -> [a]
: LByteString -> [(DOF, LByteString)]
readTreeShas LByteString
bs'
        Just (Word8
nz, LByteString
_) ->
          Text -> [(DOF, LByteString)]
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> [(DOF, LByteString)]) -> Text -> [(DOF, LByteString)]
forall a b. (a -> b) -> a -> b
$ Text
"expected zero byte but got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word8 -> Text
forall b a. (Show a, IsString b) => a -> b
show Word8
nz Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LByteString -> Text
forall b a. (Show a, IsString b) => a -> b
show LByteString
modePrefixedBs
        Maybe (Word8, LByteString)
Nothing ->
          Text -> [(DOF, LByteString)]
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> [(DOF, LByteString)]) -> Text -> [(DOF, LByteString)]
forall a b. (a -> b) -> a -> b
$ Text
"unexpected end of tree entry: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LByteString -> Text
forall b a. (Show a, IsString b) => a -> b
show LByteString
modePrefixedBs

-- Type is defined to decouple reading files and handling there content.
-- Such trick minimize QSem
data NonRecursive
  = JustBlob !()
  | TreeShas ![(DOF, LByteString)]
  -- collision strict BS is not big just list of file names
  -- so it is safe to return out of lazy scope
  | Collision !(Tagged Compressed LByteString)
  deriving (Int -> NonRecursive -> ShowS
[NonRecursive] -> ShowS
NonRecursive -> String
(Int -> NonRecursive -> ShowS)
-> (NonRecursive -> String)
-> ([NonRecursive] -> ShowS)
-> Show NonRecursive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NonRecursive -> ShowS
showsPrec :: Int -> NonRecursive -> ShowS
$cshow :: NonRecursive -> String
show :: NonRecursive -> String
$cshowList :: [NonRecursive] -> ShowS
showList :: [NonRecursive] -> ShowS
Show, NonRecursive -> NonRecursive -> Bool
(NonRecursive -> NonRecursive -> Bool)
-> (NonRecursive -> NonRecursive -> Bool) -> Eq NonRecursive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NonRecursive -> NonRecursive -> Bool
== :: NonRecursive -> NonRecursive -> Bool
$c/= :: NonRecursive -> NonRecursive -> Bool
/= :: NonRecursive -> NonRecursive -> Bool
Eq, (forall x. NonRecursive -> Rep NonRecursive x)
-> (forall x. Rep NonRecursive x -> NonRecursive)
-> Generic NonRecursive
forall x. Rep NonRecursive x -> NonRecursive
forall x. NonRecursive -> Rep NonRecursive x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NonRecursive -> Rep NonRecursive x
from :: forall x. NonRecursive -> Rep NonRecursive x
$cto :: forall x. Rep NonRecursive x -> NonRecursive
to :: forall x. Rep NonRecursive x -> NonRecursive
Generic)

instance NFData NonRecursive

parseTreeObject :: PhoenixExtractM m =>
  FilePath ->
  Tagged Compressed LByteString ->
  LByteString ->
  m (Either (Tagged Compressed LByteString) [(DOF, LByteString)])
parseTreeObject :: forall (m :: * -> *).
PhoenixExtractM m =>
String
-> Tagged Compressed LByteString
-> LByteString
-> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)])
parseTreeObject String
gop Tagged Compressed LByteString
cbs LByteString
bs =
  case LByteString -> Maybe GitObjType
classifyGitObject LByteString
bs of
    Just GitObjType
BlobType -> String
-> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)])
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)]))
-> String
-> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)])
forall a b. (a -> b) -> a -> b
$ String
gop String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is Git blob but expected Git tree"
    Just GitObjType
CommitType -> String
-> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)])
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)]))
-> String
-> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)])
forall a b. (a -> b) -> a -> b
$ String
gop String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is Git commit but expected Git tree"
    Just GitObjType
TreeType -> do
      Either (Tagged Compressed LByteString) [(DOF, LByteString)]
-> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Tagged Compressed LByteString) [(DOF, LByteString)]
 -> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)]))
-> (LByteString
    -> Either (Tagged Compressed LByteString) [(DOF, LByteString)])
-> LByteString
-> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(DOF, LByteString)]
-> Either (Tagged Compressed LByteString) [(DOF, LByteString)]
forall a b. b -> Either a b
Right ([(DOF, LByteString)]
 -> Either (Tagged Compressed LByteString) [(DOF, LByteString)])
-> (LByteString -> [(DOF, LByteString)])
-> LByteString
-> Either (Tagged Compressed LByteString) [(DOF, LByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LByteString -> [(DOF, LByteString)]
readTreeShas (LByteString
 -> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)]))
-> LByteString
-> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)])
forall a b. (a -> b) -> a -> b
$ LByteString -> LByteString
dropTreeHeader LByteString
bs
    Just GitObjType
CollidedHash -> Either (Tagged Compressed LByteString) [(DOF, LByteString)]
-> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Tagged Compressed LByteString) [(DOF, LByteString)]
 -> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)]))
-> Either (Tagged Compressed LByteString) [(DOF, LByteString)]
-> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)])
forall a b. (a -> b) -> a -> b
$ Tagged Compressed LByteString
-> Either (Tagged Compressed LByteString) [(DOF, LByteString)]
forall a b. a -> Either a b
Left Tagged Compressed LByteString
cbs
    Maybe GitObjType
Nothing -> String
-> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)])
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
 -> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)]))
-> String
-> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)])
forall a b. (a -> b) -> a -> b
$ String
gop String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not a Git tree object"

onRight_ :: Monad m => (b -> m ()) -> Either a b -> m (Either a b)
onRight_ :: forall (m :: * -> *) b a.
Monad m =>
(b -> m ()) -> Either a b -> m (Either a b)
onRight_ b -> m ()
f = \case
  v :: Either a b
v@(Left a
_) -> Either a b -> m (Either a b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either a b
v
  r :: Either a b
r@(Right b
v) -> b -> m ()
f b
v m () -> m (Either a b) -> m (Either a b)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either a b -> m (Either a b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either a b
r

extractTree :: PhoenixExtractM m => GitPath Tree -> m ()
extractTree :: forall (m :: * -> *). PhoenixExtractM m => GitPath 'Tree -> m ()
extractTree GitPath 'Tree
treeHash = do
  Tagged udr <- (PhoenixExtractConf -> Tagged InDir String)
-> m (Tagged InDir String)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PhoenixExtractConf -> Tagged InDir String
uberDir
  dd <- getDestDir
  copyTree (udr </> toFp treeHash) treeHash >>=
    mapM_ (copyTreeLinks dd) . $(tw "len/")
  where
    copyTree :: String -> GitPath 'Tree -> m [(DOF, LByteString)]
copyTree String
treePath GitPath 'Tree
trH = do
      let save :: LByteString -> m ()
save LByteString
bs = do
            destDir <- m String
getDestDir
            saveCompressedBs (destDir </> toFp trH) bs
      rl <- String
-> (Tagged Compressed LByteString
    -> LByteString
    -> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)]))
-> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)])
forall a (m :: * -> *).
(NFData a, MonadUnliftIO m, HasInHandlesSem m) =>
String
-> (Tagged Compressed LByteString -> LByteString -> m a) -> m a
withCompressedH String
treePath ((Tagged Compressed LByteString
  -> LByteString
  -> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)]))
 -> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)]))
-> (Tagged Compressed LByteString
    -> LByteString
    -> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)]))
-> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)])
forall a b. (a -> b) -> a -> b
$ \Tagged Compressed LByteString
cTreeBs LByteString
treeBs ->
        String
-> Tagged Compressed LByteString
-> LByteString
-> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)])
forall (m :: * -> *).
PhoenixExtractM m =>
String
-> Tagged Compressed LByteString
-> LByteString
-> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)])
parseTreeObject String
treePath Tagged Compressed LByteString
cTreeBs LByteString
treeBs m (Either (Tagged Compressed LByteString) [(DOF, LByteString)])
-> (Either (Tagged Compressed LByteString) [(DOF, LByteString)]
    -> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)]))
-> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)])
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([(DOF, LByteString)] -> m ())
-> Either (Tagged Compressed LByteString) [(DOF, LByteString)]
-> m (Either (Tagged Compressed LByteString) [(DOF, LByteString)])
forall (m :: * -> *) b a.
Monad m =>
(b -> m ()) -> Either a b -> m (Either a b)
onRight_ (\[(DOF, LByteString)]
_ -> LByteString -> m ()
save LByteString
treeBs)
      shas <- case rl of
        Right [(DOF, LByteString)]
shas' -> [(DOF, LByteString)] -> m [(DOF, LByteString)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(DOF, LByteString)]
shas'
        Left Tagged Compressed LByteString
cbs -> do
          uniPath <- GitPath 'Tree
-> Tagged Compressed LByteString -> GitObjType -> m String
forall (m :: * -> *) (x :: GitObjTypeG).
PhoenixExtractM m =>
GitPath x
-> Tagged Compressed LByteString -> GitObjType -> m String
uniqBs (forall (t :: GitObjTypeG). String -> GitPath t
GitPath @Tree String
treePath) Tagged Compressed LByteString
cbs GitObjType
TreeType
          withCompressed uniPath
            (\LByteString
ubs -> do
                LByteString -> m ()
save LByteString
ubs
                [(DOF, LByteString)] -> m [(DOF, LByteString)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(DOF, LByteString)] -> m [(DOF, LByteString)])
-> (LByteString -> [(DOF, LByteString)])
-> LByteString
-> m [(DOF, LByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LByteString -> [(DOF, LByteString)]
readTreeShas (LByteString -> m [(DOF, LByteString)])
-> LByteString -> m [(DOF, LByteString)]
forall a b. (a -> b) -> a -> b
$ LByteString -> LByteString
dropTreeHeader LByteString
ubs
            )
      pure shas
    getDestDir :: m String
getDestDir = (\(Tagged String
r) -> String
r String -> ShowS
</> String
".git" String -> ShowS
</> String
"objects") (Tagged OutDir String -> String)
-> m (Tagged OutDir String) -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PhoenixExtractConf -> Tagged OutDir String)
-> m (Tagged OutDir String)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PhoenixExtractConf -> Tagged OutDir String
destGitDir
    copyTreeLinks :: String -> (DOF, LByteString) -> m ()
copyTreeLinks String
destDir (DOF
dof, LByteString
binSha) = do
      (Tagged udr) <- (PhoenixExtractConf -> Tagged InDir String)
-> m (Tagged InDir String)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks PhoenixExtractConf -> Tagged InDir String
uberDir
      liftIO $(trIo "/destDir binSha")
      let shaP = LByteString -> GitPath (ZonkAny 0)
forall (a :: GitObjTypeG). LByteString -> GitPath a
binSha2Path LByteString
binSha
          absSha = String
udr String -> ShowS
</> GitPath (ZonkAny 0) -> String
forall (t :: GitObjTypeG). GitPath t -> String
toFp GitPath (ZonkAny 0)
shaP
          saveBlob = String -> LByteString -> m ()
forall (m :: * -> *).
MonadUnliftIO m =>
String -> LByteString -> m ()
saveCompressedBs (String
destDir String -> ShowS
</> GitPath (ZonkAny 0) -> String
forall (t :: GitObjTypeG). GitPath t -> String
toFp GitPath (ZonkAny 0)
shaP)
          saveTree LByteString
bs = do
            LByteString -> m ()
saveBlob LByteString
bs
            [(DOF, LByteString)] -> m [(DOF, LByteString)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(DOF, LByteString)] -> m [(DOF, LByteString)])
-> (LByteString -> [(DOF, LByteString)])
-> LByteString
-> m [(DOF, LByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LByteString -> [(DOF, LByteString)]
readTreeShas (LByteString -> m [(DOF, LByteString)])
-> LByteString -> m [(DOF, LByteString)]
forall a b. (a -> b) -> a -> b
$ LByteString -> LByteString
dropTreeHeader LByteString
bs
      nonRec <- withCompressedH absSha $ \Tagged Compressed LByteString
cbs LByteString
bs ->
        case LByteString -> Maybe GitObjType
classifyGitObject LByteString
bs of
          Just GitObjType
BlobType
            | DOF
dof DOF -> DOF -> Bool
forall a. Eq a => a -> a -> Bool
== DOF
File -> () -> NonRecursive
JustBlob (() -> NonRecursive) -> m () -> m NonRecursive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LByteString -> m ()
saveBlob LByteString
bs
            | Bool
otherwise -> String -> m NonRecursive
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m NonRecursive) -> String -> m NonRecursive
forall a b. (a -> b) -> a -> b
$ String
absSha String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not a GIT blob"
          Just GitObjType
TreeType
            | DOF
dof DOF -> DOF -> Bool
forall a. Eq a => a -> a -> Bool
== DOF
Dir -> [(DOF, LByteString)] -> NonRecursive
TreeShas ([(DOF, LByteString)] -> NonRecursive)
-> m [(DOF, LByteString)] -> m NonRecursive
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LByteString -> m [(DOF, LByteString)]
saveTree LByteString
bs
            | Bool
otherwise -> String -> m NonRecursive
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m NonRecursive) -> String -> m NonRecursive
forall a b. (a -> b) -> a -> b
$ String
absSha String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not a GIT tree"
          Just GitObjType
CollidedHash ->
            NonRecursive -> m NonRecursive
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonRecursive -> m NonRecursive) -> NonRecursive -> m NonRecursive
forall a b. (a -> b) -> a -> b
$ Tagged Compressed LByteString -> NonRecursive
Collision Tagged Compressed LByteString
cbs
          Maybe GitObjType
_ -> String -> m NonRecursive
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m NonRecursive) -> String -> m NonRecursive
forall a b. (a -> b) -> a -> b
$ String
absSha String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not a GIT tree nor GIT blob nor disambiguate file"
      case nonRec of
        JustBlob () -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        TreeShas [(DOF, LByteString)]
rows ->
          ((DOF, LByteString) -> m ()) -> [(DOF, LByteString)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> (DOF, LByteString) -> m ()
copyTreeLinks String
destDir) [(DOF, LByteString)]
rows
        Collision Tagged Compressed LByteString
cbs' -> do
          uniPath <- GitPath (ZonkAny 0)
-> Tagged Compressed LByteString -> GitObjType -> m String
forall (m :: * -> *) (x :: GitObjTypeG).
PhoenixExtractM m =>
GitPath x
-> Tagged Compressed LByteString -> GitObjType -> m String
uniqBs GitPath (ZonkAny 0)
shaP Tagged Compressed LByteString
cbs' (DOF -> GitObjType
dofToGitObjType DOF
dof)
          !lr <- withCompressed uniPath $ \LByteString
ubs ->
            case LByteString -> Maybe GitObjType
classifyGitObject LByteString
ubs of
              Just GitObjType
BlobType -> () -> Either () [(DOF, LByteString)]
forall a b. a -> Either a b
Left (() -> Either () [(DOF, LByteString)])
-> m () -> m (Either () [(DOF, LByteString)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LByteString -> m ()
saveBlob LByteString
ubs
              Just GitObjType
TreeType -> [(DOF, LByteString)] -> Either () [(DOF, LByteString)]
forall a b. b -> Either a b
Right ([(DOF, LByteString)] -> Either () [(DOF, LByteString)])
-> m [(DOF, LByteString)] -> m (Either () [(DOF, LByteString)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LByteString -> m [(DOF, LByteString)]
saveTree LByteString
ubs
              Maybe GitObjType
_ -> String -> m (Either () [(DOF, LByteString)])
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (Either () [(DOF, LByteString)]))
-> String -> m (Either () [(DOF, LByteString)])
forall a b. (a -> b) -> a -> b
$ String
absSha String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not GIT tree nor GIT blob"
          case lr of
            Left () -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            Right [(DOF, LByteString)]
rows -> ((DOF, LByteString) -> m ()) -> [(DOF, LByteString)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> (DOF, LByteString) -> m ()
copyTreeLinks String
destDir) [(DOF, LByteString)]
rows