module Data.Git.Phoenix.Commit where

import Data.ByteString.Lazy qualified as L
import Data.ByteString.Lazy.Char8 qualified as L8
import Data.Time
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
-- import Data.Time.Format.Internal
import Data.Word8 qualified as W
import Relude

type LbsPair = (LByteString, LByteString)

extractField ::
  Word8 -> LByteString -> (LByteString -> LbsPair) -> LByteString -> LbsPair
extractField :: Word8
-> ByteString -> (ByteString -> LbsPair) -> ByteString -> LbsPair
extractField Word8
b ByteString
field ByteString -> LbsPair
parseValue ByteString
bs =
  case (Word8 -> Bool) -> ByteString -> ByteString
L.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
b) ByteString
bs of
    ByteString
"" -> (ByteString
"", ByteString
"")
    ByteString
bs' ->
      if ByteString
field ByteString -> ByteString -> Bool
`L.isPrefixOf` ByteString
bs'
      then ByteString -> LbsPair
parseValue (ByteString -> LbsPair) -> ByteString -> LbsPair
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
L.drop (ByteString -> Int64
L.length ByteString
field) ByteString
bs'
      else Word8
-> ByteString -> (ByteString -> LbsPair) -> ByteString -> LbsPair
extractField Word8
b ByteString
field ByteString -> LbsPair
parseValue (ByteString -> LbsPair) -> ByteString -> LbsPair
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
L.drop Int64
1 ByteString
bs'

extractParent :: L.ByteString -> LbsPair
extractParent :: ByteString -> LbsPair
extractParent =
  Word8
-> ByteString -> (ByteString -> LbsPair) -> ByteString -> LbsPair
extractField Word8
W._lf ByteString
"\nparent " ((Word8 -> Bool) -> ByteString -> LbsPair
L.span Word8 -> Bool
W.isHexDigit)

extractAuthor :: LByteString -> LbsPair
extractAuthor :: ByteString -> LbsPair
extractAuthor =
  Word8
-> ByteString -> (ByteString -> LbsPair) -> ByteString -> LbsPair
extractField Word8
W._lf ByteString
"\nauthor " ((Word8 -> Bool) -> ByteString -> LbsPair
L.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
W._less))

extractCommitTs :: LByteString -> Maybe (Int64, LByteString)
extractCommitTs :: ByteString -> Maybe (Int64, ByteString)
extractCommitTs ByteString
bs =
  case Word8
-> ByteString -> (ByteString -> LbsPair) -> ByteString -> LbsPair
extractField Word8
W._greater ByteString
"> " ((Word8 -> Bool) -> ByteString -> LbsPair
L.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
W._lf)) ByteString
bs of
    (ByteString
tsBs, ByteString
bs') ->
      case ByteString -> Maybe (Int64, ByteString)
L8.readInt64 ByteString
tsBs of
        Maybe (Int64, ByteString)
Nothing -> Maybe (Int64, ByteString)
forall a. Maybe a
Nothing
        Just (Int64
epoch', ByteString
spcTzBs) ->
          case ByteString -> Maybe (Int64, ByteString)
L8.readInt64 (ByteString -> Maybe (Int64, ByteString))
-> ByteString -> Maybe (Int64, ByteString)
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> ByteString
L.dropWhile Word8 -> Bool
W.isSpace ByteString
spcTzBs of
            Maybe (Int64, ByteString)
Nothing -> Maybe (Int64, ByteString)
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
                (Int64, ByteString) -> Maybe (Int64, ByteString)
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, ByteString
bs')

extractMessage :: LByteString -> LByteString
extractMessage :: ByteString -> ByteString
extractMessage ByteString
bs =
  case Word8
-> ByteString -> (ByteString -> LbsPair) -> ByteString -> LbsPair
extractField Word8
W._lf ByteString
"\n\n" ((Word8 -> Bool) -> ByteString -> LbsPair
L.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
W._lf)) ByteString
bs of
    (ByteString
msgFirstLine, ByteString
_) -> ByteString
msgFirstLine

extractTreeHash :: LByteString -> LbsPair
extractTreeHash :: ByteString -> LbsPair
extractTreeHash =
  Word8
-> ByteString -> (ByteString -> LbsPair) -> ByteString -> LbsPair
extractField Word8
0 ByteString
"\0tree " ((Word8 -> Bool) -> ByteString -> LbsPair
L.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