module Data.Git.Phoenix.Commit where

import Data.ByteString.Lazy.Char8 qualified as L8
import Data.Time
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.Word8 qualified as W
import Lazy.Scope as S
import Relude

extractField ::
  Monad m =>
  Word8 -> Bs s -> (Bs s -> LazyT s m  (Bs s, Bs s)) -> Bs s -> LazyT s m (Bs s, Bs s)
extractField :: forall {k} (m :: * -> *) (s :: k).
Monad m =>
Word8
-> Bs s
-> (Bs s -> LazyT s m (Bs s, Bs s))
-> Bs s
-> LazyT s m (Bs s, Bs s)
extractField Word8
b Bs s
field Bs s -> LazyT s m (Bs s, Bs s)
parseValue Bs s
bs =
  case (Word8 -> Bool) -> Bs s -> Bs s
forall {k} (s :: k). (Word8 -> Bool) -> Bs s -> Bs s
S.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
b) Bs s
bs of
    Bs s
"" -> (Bs s, Bs s) -> LazyT s m (Bs s, Bs s)
forall a. a -> LazyT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bs s
"", Bs s
"")
    Bs s
bs' -> [(Scoped s Bool, LazyT s m (Bs s, Bs s))]
-> LazyT s m (Bs s, Bs s) -> LazyT s m (Bs s, Bs s)
forall {k1} {k2} (s :: k1) (m :: k2 -> *) (a :: k2).
[(Scoped s Bool, m a)] -> m a -> m a
condM
      [ ( Bs s
field Bs s -> Bs s -> Scoped s Bool
forall {k} (s :: k). Bs s -> Bs s -> B s
`S.isPrefixOf` Bs s
bs'
        , Bs s -> LazyT s m (Bs s, Bs s)
parseValue (Bs s -> I64 s
forall {k} (s :: k). Bs s -> I64 s
S.length Bs s
field I64 s -> Bs s -> Bs s
forall {k} (s :: k). I64 s -> Bs s -> Bs s
`S.drop` Bs s
bs') )
      ]
      (Word8
-> Bs s
-> (Bs s -> LazyT s m (Bs s, Bs s))
-> Bs s
-> LazyT s m (Bs s, Bs s)
forall {k} (m :: * -> *) (s :: k).
Monad m =>
Word8
-> Bs s
-> (Bs s -> LazyT s m (Bs s, Bs s))
-> Bs s
-> LazyT s m (Bs s, Bs s)
extractField Word8
b Bs s
field Bs s -> LazyT s m (Bs s, Bs s)
parseValue (Bs s -> LazyT s m (Bs s, Bs s)) -> Bs s -> LazyT s m (Bs s, Bs s)
forall a b. (a -> b) -> a -> b
$ I64 s -> Bs s -> Bs s
forall {k} (s :: k). I64 s -> Bs s -> Bs s
S.drop I64 s
1 Bs s
bs')

extractParent :: Monad m => Bs s -> LazyT s m (Bs s, Bs s)
extractParent :: forall {k} (m :: * -> *) (s :: k).
Monad m =>
Bs s -> LazyT s m (Bs s, Bs s)
extractParent =
  Word8
-> Bs s
-> (Bs s -> LazyT s m (Bs s, Bs s))
-> Bs s
-> LazyT s m (Bs s, Bs s)
forall {k} (m :: * -> *) (s :: k).
Monad m =>
Word8
-> Bs s
-> (Bs s -> LazyT s m (Bs s, Bs s))
-> Bs s
-> LazyT s m (Bs s, Bs s)
extractField Word8
W._lf Bs s
"\nparent " ((Bs s, Bs s) -> LazyT s m (Bs s, Bs s)
forall a. a -> LazyT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Bs s, Bs s) -> LazyT s m (Bs s, Bs s))
-> (Bs s -> (Bs s, Bs s)) -> Bs s -> LazyT s m (Bs s, Bs s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> Bs s -> (Bs s, Bs s)
forall {k} (s :: k). (Word8 -> Bool) -> Bs s -> (Bs s, Bs s)
S.span Word8 -> Bool
W.isHexDigit)

extractAuthor :: Monad m => Bs s -> LazyT s m (Bs s, Bs s)
extractAuthor :: forall {k} (m :: * -> *) (s :: k).
Monad m =>
Bs s -> LazyT s m (Bs s, Bs s)
extractAuthor =
  Word8
-> Bs s
-> (Bs s -> LazyT s m (Bs s, Bs s))
-> Bs s
-> LazyT s m (Bs s, Bs s)
forall {k} (m :: * -> *) (s :: k).
Monad m =>
Word8
-> Bs s
-> (Bs s -> LazyT s m (Bs s, Bs s))
-> Bs s
-> LazyT s m (Bs s, Bs s)
extractField Word8
W._lf Bs s
"\nauthor " ((Bs s, Bs s) -> LazyT s m (Bs s, Bs s)
forall a. a -> LazyT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Bs s, Bs s) -> LazyT s m (Bs s, Bs s))
-> (Bs s -> (Bs s, Bs s)) -> Bs s -> LazyT s m (Bs s, Bs s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> Bs s -> (Bs s, Bs s)
forall {k} (s :: k). (Word8 -> Bool) -> Bs s -> (Bs s, Bs s)
S.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
W._less))

extractCommitTs :: Monad m => Bs s -> LazyT s m (Maybe (Int64, Bs s))
extractCommitTs :: forall {k} (m :: * -> *) (s :: k).
Monad m =>
Bs s -> LazyT s m (Maybe (Int64, Bs s))
extractCommitTs Bs s
bs =
  Word8
-> Bs s
-> (Bs s -> LazyT s m (Bs s, Bs s))
-> Bs s
-> LazyT s m (Bs s, Bs s)
forall {k} (m :: * -> *) (s :: k).
Monad m =>
Word8
-> Bs s
-> (Bs s -> LazyT s m (Bs s, Bs s))
-> Bs s
-> LazyT s m (Bs s, Bs s)
extractField Word8
W._greater Bs s
"> " ((Bs s, Bs s) -> LazyT s m (Bs s, Bs s)
forall a. a -> LazyT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Bs s, Bs s) -> LazyT s m (Bs s, Bs s))
-> (Bs s -> (Bs s, Bs s)) -> Bs s -> LazyT s m (Bs s, Bs s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> Bs s -> (Bs s, Bs s)
forall {k} (s :: k). (Word8 -> Bool) -> Bs s -> (Bs s, Bs s)
S.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
W._lf)) Bs s
bs LazyT s m (Bs s, Bs s)
-> ((Bs s, Bs s) -> LazyT s m (Maybe (Int64, Bs s)))
-> LazyT s m (Maybe (Int64, Bs s))
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
>>= \case
    (Bs s
tsBs, Bs s
bs') ->
      Scoped s (Maybe (Int64, ByteString))
-> LazyT s m (Maybe (Int64, ByteString))
forall {k} a (m :: * -> *) (s :: k).
(NFData a, Monad m) =>
Scoped s a -> LazyT s m a
unScope ((ByteString -> Maybe (Int64, ByteString))
-> Bs s -> Scoped s (Maybe (Int64, ByteString))
forall {k} a (s :: k). (ByteString -> a) -> Bs s -> Scoped s a
bs2Scoped ByteString -> Maybe (Int64, ByteString)
L8.readInt64 Bs s
tsBs) LazyT s m (Maybe (Int64, ByteString))
-> (Maybe (Int64, ByteString) -> LazyT s m (Maybe (Int64, Bs s)))
-> LazyT s m (Maybe (Int64, Bs s))
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
>>= \case
        Maybe (Int64, ByteString)
Nothing -> Maybe (Int64, Bs s) -> LazyT s m (Maybe (Int64, Bs s))
forall a. a -> LazyT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Int64, Bs s) -> LazyT s m (Maybe (Int64, Bs s)))
-> Maybe (Int64, Bs s) -> LazyT s m (Maybe (Int64, Bs s))
forall a b. (a -> b) -> a -> b
$ Maybe (Int64, Bs s)
forall a. Maybe a
Nothing
        Just (Int64
epoch', ByteString
spcTzBs) ->
          Scoped s (Maybe (Int64, ByteString))
-> LazyT s m (Maybe (Int64, ByteString))
forall {k} a (m :: * -> *) (s :: k).
(NFData a, Monad m) =>
Scoped s a -> LazyT s m a
unScope ((ByteString -> Maybe (Int64, ByteString))
-> Bs s -> Scoped s (Maybe (Int64, ByteString))
forall {k} a (s :: k). (ByteString -> a) -> Bs s -> Scoped s a
bs2Scoped ByteString -> Maybe (Int64, ByteString)
L8.readInt64 (Bs s -> Scoped s (Maybe (Int64, ByteString)))
-> Bs s -> Scoped s (Maybe (Int64, ByteString))
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> Bs s -> Bs s
forall {k} (s :: k). (Word8 -> Bool) -> Bs s -> Bs s
S.dropWhile Word8 -> Bool
W.isSpace (Bs s -> Bs s) -> Bs s -> Bs s
forall a b. (a -> b) -> a -> b
$ ByteString -> Bs s
forall {k} (s :: k). ByteString -> Bs s
toBs ByteString
spcTzBs) LazyT s m (Maybe (Int64, ByteString))
-> (Maybe (Int64, ByteString) -> LazyT s m (Maybe (Int64, Bs s)))
-> LazyT s m (Maybe (Int64, Bs s))
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
>>= \case
            Maybe (Int64, ByteString)
Nothing -> Maybe (Int64, Bs s) -> LazyT s m (Maybe (Int64, Bs s))
forall a. a -> LazyT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Int64, Bs s) -> LazyT s m (Maybe (Int64, Bs s)))
-> Maybe (Int64, Bs s) -> LazyT s m (Maybe (Int64, Bs s))
forall a b. (a -> b) -> a -> b
$ Maybe (Int64, Bs s)
forall a. Maybe a
Nothing
            Just (Int64
tz, ByteString
_) ->
              let
                tzAbs :: Int64
tzAbs = Int64 -> Int64
forall a. Num a => a -> a
abs Int64
tz
                (Int64
tzH, Int64
tzM) = Int64
tzAbs Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int64
100
              in
                Maybe (Int64, Bs s) -> LazyT s m (Maybe (Int64, Bs s))
forall a. a -> LazyT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Int64, Bs s) -> LazyT s m (Maybe (Int64, Bs s)))
-> Maybe (Int64, Bs s) -> LazyT s m (Maybe (Int64, Bs s))
forall a b. (a -> b) -> a -> b
$ (Int64, Bs s) -> Maybe (Int64, Bs s)
forall a. a -> Maybe a
Just (Int64
epoch' Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ (Int64
tzH Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
3600 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
tzM Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
60) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64 -> Int64
forall a. Num a => a -> a
signum Int64
tz, Bs s
bs')

extractMessage :: Monad m => Bs s -> LazyT s m (Bs s)
extractMessage :: forall {k} (m :: * -> *) (s :: k).
Monad m =>
Bs s -> LazyT s m (Bs s)
extractMessage Bs s
bs =
  Word8
-> Bs s
-> (Bs s -> LazyT s m (Bs s, Bs s))
-> Bs s
-> LazyT s m (Bs s, Bs s)
forall {k} (m :: * -> *) (s :: k).
Monad m =>
Word8
-> Bs s
-> (Bs s -> LazyT s m (Bs s, Bs s))
-> Bs s
-> LazyT s m (Bs s, Bs s)
extractField Word8
W._lf Bs s
"\n\n" ((Bs s, Bs s) -> LazyT s m (Bs s, Bs s)
forall a. a -> LazyT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Bs s, Bs s) -> LazyT s m (Bs s, Bs s))
-> (Bs s -> (Bs s, Bs s)) -> Bs s -> LazyT s m (Bs s, Bs s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> Bs s -> (Bs s, Bs s)
forall {k} (s :: k). (Word8 -> Bool) -> Bs s -> (Bs s, Bs s)
S.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
W._lf)) Bs s
bs LazyT s m (Bs s, Bs s)
-> ((Bs s, Bs s) -> LazyT s m (Bs s)) -> LazyT s m (Bs s)
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
>>= \case
    (Bs s
msgFirstLine, Bs s
_) -> Bs s -> LazyT s m (Bs s)
forall a. a -> LazyT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bs s
msgFirstLine

extractTreeHash :: Monad m => Bs s -> LazyT s m (Bs s, Bs s)
extractTreeHash :: forall {k} (m :: * -> *) (s :: k).
Monad m =>
Bs s -> LazyT s m (Bs s, Bs s)
extractTreeHash =
  Word8
-> Bs s
-> (Bs s -> LazyT s m (Bs s, Bs s))
-> Bs s
-> LazyT s m (Bs s, Bs s)
forall {k} (m :: * -> *) (s :: k).
Monad m =>
Word8
-> Bs s
-> (Bs s -> LazyT s m (Bs s, Bs s))
-> Bs s
-> LazyT s m (Bs s, Bs s)
extractField Word8
0 Bs s
"\0tree " ((Bs s, Bs s) -> LazyT s m (Bs s, Bs s)
forall a. a -> LazyT s m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Bs s, Bs s) -> LazyT s m (Bs s, Bs s))
-> (Bs s -> (Bs s, Bs s)) -> Bs s -> LazyT s m (Bs s, Bs s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> Bs s -> (Bs s, Bs s)
forall {k} (s :: k). (Word8 -> Bool) -> Bs s -> (Bs s, Bs s)
S.span Word8 -> Bool
W.isHexDigit)

epoch :: UTCTime
epoch :: UTCTime
epoch = POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
0
{-# INLINE epoch #-}

secondsToUtcTime :: Integer -> UTCTime
secondsToUtcTime :: Integer -> UTCTime
secondsToUtcTime Integer
x = POSIXTime -> UTCTime -> UTCTime
addUTCTime (DiffTime -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (DiffTime -> POSIXTime) -> DiffTime -> POSIXTime
forall a b. (a -> b) -> a -> b
$ Integer -> DiffTime
picosecondsToDiffTime (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000000000000)) UTCTime
epoch