{-# OPTIONS_GHC -Wno-orphans #-}
module Data.Git.Phoenix.Object where

import Data.Binary qualified as B
import Data.ByteString.Lazy qualified as L
import Data.ByteString.Lazy.Char8 qualified as L8
import Data.Git.Phoenix.Prelude
import Lazy.Scope qualified as S


data GitObjType = CommitType | TreeType | BlobType | CollidedHash deriving (Int -> GitObjType -> ShowS
[GitObjType] -> ShowS
GitObjType -> String
(Int -> GitObjType -> ShowS)
-> (GitObjType -> String)
-> ([GitObjType] -> ShowS)
-> Show GitObjType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GitObjType -> ShowS
showsPrec :: Int -> GitObjType -> ShowS
$cshow :: GitObjType -> String
show :: GitObjType -> String
$cshowList :: [GitObjType] -> ShowS
showList :: [GitObjType] -> ShowS
Show, GitObjType -> GitObjType -> Bool
(GitObjType -> GitObjType -> Bool)
-> (GitObjType -> GitObjType -> Bool) -> Eq GitObjType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GitObjType -> GitObjType -> Bool
== :: GitObjType -> GitObjType -> Bool
$c/= :: GitObjType -> GitObjType -> Bool
/= :: GitObjType -> GitObjType -> Bool
Eq)

data GitObjTypeG = Commit | Tree deriving (Int -> GitObjTypeG -> ShowS
[GitObjTypeG] -> ShowS
GitObjTypeG -> String
(Int -> GitObjTypeG -> ShowS)
-> (GitObjTypeG -> String)
-> ([GitObjTypeG] -> ShowS)
-> Show GitObjTypeG
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GitObjTypeG -> ShowS
showsPrec :: Int -> GitObjTypeG -> ShowS
$cshow :: GitObjTypeG -> String
show :: GitObjTypeG -> String
$cshowList :: [GitObjTypeG] -> ShowS
showList :: [GitObjTypeG] -> ShowS
Show, GitObjTypeG -> GitObjTypeG -> Bool
(GitObjTypeG -> GitObjTypeG -> Bool)
-> (GitObjTypeG -> GitObjTypeG -> Bool) -> Eq GitObjTypeG
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GitObjTypeG -> GitObjTypeG -> Bool
== :: GitObjTypeG -> GitObjTypeG -> Bool
$c/= :: GitObjTypeG -> GitObjTypeG -> Bool
/= :: GitObjTypeG -> GitObjTypeG -> Bool
Eq)

-- | Path relative to .git/objects or uber dir
newtype GitPath (t :: GitObjTypeG) = GitPath { forall (t :: GitObjTypeG). GitPath t -> String
toFp :: FilePath } deriving (Int -> GitPath t -> ShowS
[GitPath t] -> ShowS
GitPath t -> String
(Int -> GitPath t -> ShowS)
-> (GitPath t -> String)
-> ([GitPath t] -> ShowS)
-> Show (GitPath t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (t :: GitObjTypeG). Int -> GitPath t -> ShowS
forall (t :: GitObjTypeG). [GitPath t] -> ShowS
forall (t :: GitObjTypeG). GitPath t -> String
$cshowsPrec :: forall (t :: GitObjTypeG). Int -> GitPath t -> ShowS
showsPrec :: Int -> GitPath t -> ShowS
$cshow :: forall (t :: GitObjTypeG). GitPath t -> String
show :: GitPath t -> String
$cshowList :: forall (t :: GitObjTypeG). [GitPath t] -> ShowS
showList :: [GitPath t] -> ShowS
Show, GitPath t -> GitPath t -> Bool
(GitPath t -> GitPath t -> Bool)
-> (GitPath t -> GitPath t -> Bool) -> Eq (GitPath t)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (t :: GitObjTypeG). GitPath t -> GitPath t -> Bool
$c== :: forall (t :: GitObjTypeG). GitPath t -> GitPath t -> Bool
== :: GitPath t -> GitPath t -> Bool
$c/= :: forall (t :: GitObjTypeG). GitPath t -> GitPath t -> Bool
/= :: GitPath t -> GitPath t -> Bool
Eq, GitPath t -> ()
(GitPath t -> ()) -> NFData (GitPath t)
forall a. (a -> ()) -> NFData a
forall (t :: GitObjTypeG). GitPath t -> ()
$crnf :: forall (t :: GitObjTypeG). GitPath t -> ()
rnf :: GitPath t -> ()
NFData)

toCommitSha :: GitPath t -> LByteString
toCommitSha :: forall (t :: GitObjTypeG). GitPath t -> ByteString
toCommitSha (GitPath String
p) = String -> ByteString
L8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') String
p

classifyGitObject :: Monad m => Bs s -> LazyT s m (Maybe GitObjType)
classifyGitObject :: forall {k} (m :: * -> *) (s :: k).
Monad m =>
Bs s -> LazyT s m (Maybe GitObjType)
classifyGitObject Bs s
bs =
  [(Scoped s Bool, LazyT s m (Maybe GitObjType))]
-> LazyT s m (Maybe GitObjType) -> LazyT s m (Maybe GitObjType)
forall {k1} {k2} (s :: k1) (m :: k2 -> *) (a :: k2).
[(Scoped s Bool, m a)] -> m a -> m a
condM
    [ (Bs s
forall {k} (s :: k). Bs s
blob Bs s -> Bs s -> Scoped s Bool
forall {k} (s :: k). Bs s -> Bs s -> B s
`S.isPrefixOf` Bs s
bs, Maybe GitObjType -> LazyT s m (Maybe GitObjType)
forall a. a -> LazyT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe GitObjType -> LazyT s m (Maybe GitObjType))
-> Maybe GitObjType -> LazyT s m (Maybe GitObjType)
forall a b. (a -> b) -> a -> b
$ GitObjType -> Maybe GitObjType
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GitObjType
BlobType)
    , (Bs s
forall {k} (s :: k). Bs s
tree Bs s -> Bs s -> Scoped s Bool
forall {k} (s :: k). Bs s -> Bs s -> B s
`S.isPrefixOf` Bs s
bs, Maybe GitObjType -> LazyT s m (Maybe GitObjType)
forall a. a -> LazyT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe GitObjType -> LazyT s m (Maybe GitObjType))
-> Maybe GitObjType -> LazyT s m (Maybe GitObjType)
forall a b. (a -> b) -> a -> b
$ GitObjType -> Maybe GitObjType
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GitObjType
TreeType)
    , (Bs s
forall {k} (s :: k). Bs s
commit Bs s -> Bs s -> Scoped s Bool
forall {k} (s :: k). Bs s -> Bs s -> B s
`S.isPrefixOf` Bs s
bs, Maybe GitObjType -> LazyT s m (Maybe GitObjType)
forall a. a -> LazyT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe GitObjType -> LazyT s m (Maybe GitObjType))
-> Maybe GitObjType -> LazyT s m (Maybe GitObjType)
forall a b. (a -> b) -> a -> b
$ GitObjType -> Maybe GitObjType
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GitObjType
CommitType)
    , (ByteString -> Bs s
forall {k} (s :: k). ByteString -> Bs s
toBs ByteString
disambiguate Bs s -> Bs s -> Scoped s Bool
forall {k} (s :: k). Bs s -> Bs s -> B s
`S.isPrefixOf` Bs s
bs, Maybe GitObjType -> LazyT s m (Maybe GitObjType)
forall a. a -> LazyT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe GitObjType -> LazyT s m (Maybe GitObjType))
-> Maybe GitObjType -> LazyT s m (Maybe GitObjType)
forall a b. (a -> b) -> a -> b
$ GitObjType -> Maybe GitObjType
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GitObjType
CollidedHash)
    ]
    (Maybe GitObjType -> LazyT s m (Maybe GitObjType)
forall a. a -> LazyT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe GitObjType
forall a. Maybe a
Nothing)

commit, tree, blob :: Bs s
commit :: forall {k} (s :: k). Bs s
commit = Bs s
"commit "
blob :: forall {k} (s :: k). Bs s
blob = Bs s
"blob "
tree :: forall {k} (s :: k). Bs s
tree = Bs s
"tree "

disambiguate :: LByteString
disambiguate :: ByteString
disambiguate = ByteString
"disambigate "

gitObjectP :: Monad m => Bs s -> LazyT s m Bool
gitObjectP :: forall {k} (m :: * -> *) (s :: k).
Monad m =>
Bs s -> LazyT s m Bool
gitObjectP Bs s
bs =
  Bs s -> LazyT s m (Maybe GitObjType)
forall {k} (m :: * -> *) (s :: k).
Monad m =>
Bs s -> LazyT s m (Maybe GitObjType)
classifyGitObject Bs s
bs LazyT s m (Maybe GitObjType)
-> (Maybe GitObjType -> LazyT s m Bool) -> LazyT s m Bool
forall a b. LazyT s m a -> (a -> LazyT s m b) -> LazyT s m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> LazyT s m Bool
forall a. a -> LazyT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> LazyT s m Bool)
-> (Maybe GitObjType -> Bool) -> Maybe GitObjType -> LazyT s m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    Maybe GitObjType
Nothing -> Bool
False
    Just GitObjType
CollidedHash -> Bool
False
    Just GitObjType
_ -> Bool
True

compressedDisambiguate :: LByteString
compressedDisambiguate :: ByteString
compressedDisambiguate = CompressParams -> ByteString -> ByteString
compressWith CompressParams
params ByteString
disambiguate
  where
    params :: CompressParams
params = CompressParams
defaultCompressParams { compressLevel = CompressionLevel 0 }

compressedDisambiguateBs :: Bs s
compressedDisambiguateBs :: forall {k} (s :: k). Bs s
compressedDisambiguateBs = ByteString -> Bs s
forall {k} (s :: k). ByteString -> Bs s
toBs ByteString
compressedDisambiguate

compressedDisambiguateLen :: Int64
compressedDisambiguateLen :: Int64
compressedDisambiguateLen = ByteString -> Int64
L.length ByteString
compressedDisambiguate

encodedIntLen :: Int64
encodedIntLen :: Int64
encodedIntLen = ByteString -> Int64
L.length (ByteString -> Int64) -> (Int64 -> ByteString) -> Int64 -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> ByteString
forall a. Binary a => a -> ByteString
B.encode (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
L.length ByteString
""