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
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)
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 :: LByteString -> Maybe GitObjType
classifyGitObject :: ByteString -> Maybe GitObjType
classifyGitObject ByteString
bs
| ByteString
blob ByteString -> ByteString -> Bool
`L.isPrefixOf` ByteString
bs = GitObjType -> Maybe GitObjType
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GitObjType
BlobType
| ByteString
tree ByteString -> ByteString -> Bool
`L.isPrefixOf` ByteString
bs = GitObjType -> Maybe GitObjType
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GitObjType
TreeType
| ByteString
commit ByteString -> ByteString -> Bool
`L.isPrefixOf` ByteString
bs = GitObjType -> Maybe GitObjType
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GitObjType
CommitType
| ByteString
disambiguate ByteString -> ByteString -> Bool
`L.isPrefixOf` ByteString
bs = GitObjType -> Maybe GitObjType
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GitObjType
CollidedHash
| Bool
otherwise = Maybe GitObjType
forall a. Maybe a
Nothing
commit, tree, blob, disambiguate :: L.ByteString
disambiguate :: ByteString
disambiguate = ByteString
"disambigate "
commit :: ByteString
commit = ByteString
"commit "
blob :: ByteString
blob = ByteString
"blob "
tree :: ByteString
tree = ByteString
"tree "
gitObjectP :: LByteString -> Bool
gitObjectP :: ByteString -> Bool
gitObjectP ByteString
bs =
case ByteString -> Maybe GitObjType
classifyGitObject ByteString
bs of
Maybe GitObjType
Nothing -> Bool
False
Just GitObjType
CollidedHash -> Bool
False
Just GitObjType
_ -> Bool
True
compressedDisambiguate :: L.ByteString
compressedDisambiguate :: ByteString
compressedDisambiguate =
CompressParams -> ByteString -> ByteString
compressWith
(CompressParams
defaultCompressParams { compressLevel = CompressionLevel 0 })
ByteString
disambiguate
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
""