{-# LANGUAGE OverloadedStrings, TupleSections #-}
module HMGit.Internal.Parser.Object (
    ObjectType (..)
  , objectParser
  , treeParser
) where

import           HMGit.Internal.Parser.Core
import           HMGit.Internal.Utils       (foldChoice, hexStr)

import           Control.Monad.Extra        (ifM)
import           Control.Monad.Loops        (unfoldrM)
import qualified Data.ByteString.Lazy       as BL
import qualified Data.ByteString.Lazy.Char8 as BLC
import qualified Data.ByteString.Lazy.UTF8  as BLU
import           Data.List                  (isPrefixOf)
import           Data.Tuple.Extra           (secondM)
import qualified Path                       as P
import           Prelude                    hiding (null)
import           System.Posix.Types         (CMode (..))
import qualified Text.Megaparsec            as M
import qualified Text.Megaparsec.Char       as MC

-- | The Git object type.
-- Currently, it does not support tags.
data ObjectType = Blob -- ^ Blob object
    | Commit -- ^ Commit object
    | Tree -- ^ Tree object
    deriving (ObjectType -> ObjectType -> Bool
(ObjectType -> ObjectType -> Bool)
-> (ObjectType -> ObjectType -> Bool) -> Eq ObjectType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ObjectType -> ObjectType -> Bool
$c/= :: ObjectType -> ObjectType -> Bool
== :: ObjectType -> ObjectType -> Bool
$c== :: ObjectType -> ObjectType -> Bool
Eq, Int -> ObjectType
ObjectType -> Int
ObjectType -> [ObjectType]
ObjectType -> ObjectType
ObjectType -> ObjectType -> [ObjectType]
ObjectType -> ObjectType -> ObjectType -> [ObjectType]
(ObjectType -> ObjectType)
-> (ObjectType -> ObjectType)
-> (Int -> ObjectType)
-> (ObjectType -> Int)
-> (ObjectType -> [ObjectType])
-> (ObjectType -> ObjectType -> [ObjectType])
-> (ObjectType -> ObjectType -> [ObjectType])
-> (ObjectType -> ObjectType -> ObjectType -> [ObjectType])
-> Enum ObjectType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ObjectType -> ObjectType -> ObjectType -> [ObjectType]
$cenumFromThenTo :: ObjectType -> ObjectType -> ObjectType -> [ObjectType]
enumFromTo :: ObjectType -> ObjectType -> [ObjectType]
$cenumFromTo :: ObjectType -> ObjectType -> [ObjectType]
enumFromThen :: ObjectType -> ObjectType -> [ObjectType]
$cenumFromThen :: ObjectType -> ObjectType -> [ObjectType]
enumFrom :: ObjectType -> [ObjectType]
$cenumFrom :: ObjectType -> [ObjectType]
fromEnum :: ObjectType -> Int
$cfromEnum :: ObjectType -> Int
toEnum :: Int -> ObjectType
$ctoEnum :: Int -> ObjectType
pred :: ObjectType -> ObjectType
$cpred :: ObjectType -> ObjectType
succ :: ObjectType -> ObjectType
$csucc :: ObjectType -> ObjectType
Enum)

instance Show ObjectType where
    show :: ObjectType -> String
show ObjectType
Blob   = String
"blob"
    show ObjectType
Commit = String
"commit"
    show ObjectType
Tree   = String
"tree"

instance Read ObjectType where
    readsPrec :: Int -> ReadS ObjectType
readsPrec Int
_ String
s
        | String
"blob" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s = [(ObjectType
Blob, Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
4 String
s)]
        | String
"commit" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s = [(ObjectType
Commit, Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
6 String
s)]
        | String
"tree" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s = [(ObjectType
Tree, Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
4 String
s)]
        | Bool
otherwise = []

objectTypes :: ByteStringParser ObjectType
objectTypes :: ByteStringParser ObjectType
objectTypes = String -> ObjectType
forall a. Read a => String -> a
read (String -> ObjectType)
-> (ByteString -> String) -> ByteString -> ObjectType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BLC.unpack
    (ByteString -> ObjectType)
-> ParsecT ParseException ByteString Identity ByteString
-> ByteStringParser ObjectType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ObjectType
 -> ParsecT ParseException ByteString Identity ByteString)
-> [ObjectType]
-> ParsecT ParseException ByteString Identity ByteString
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Alternative f) =>
(a -> f b) -> t a -> f b
foldChoice (ByteString -> ParsecT ParseException ByteString Identity ByteString
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MC.string (ByteString
 -> ParsecT ParseException ByteString Identity ByteString)
-> (ObjectType -> ByteString)
-> ObjectType
-> ParsecT ParseException ByteString Identity ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BLU.fromString (String -> ByteString)
-> (ObjectType -> String) -> ObjectType -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectType -> String
forall a. Show a => a -> String
show) [ ObjectType
Blob .. ObjectType
Tree ]

header :: Num i => ByteStringParser (ObjectType, i)
header :: ByteStringParser (ObjectType, i)
header = (,)
    (ObjectType -> i -> (ObjectType, i))
-> ByteStringParser ObjectType
-> ParsecT
     ParseException ByteString Identity (i -> (ObjectType, i))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteStringParser ObjectType
objectTypes
    ParsecT ParseException ByteString Identity (i -> (ObjectType, i))
-> ParsecT ParseException ByteString Identity i
-> ByteStringParser (ObjectType, i)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ByteStringParser ()
space ByteStringParser ()
-> ParsecT ParseException ByteString Identity i
-> ParsecT ParseException ByteString Identity i
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT ParseException ByteString Identity i
forall i. Num i => ByteStringParser i
decimal ParsecT ParseException ByteString Identity i
-> ParsecT ParseException ByteString Identity Word8
-> ParsecT ParseException ByteString Identity i
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT ParseException ByteString Identity Word8
null)

-- | Object binary parser
objectParser :: ByteStringParser (ObjectType, BL.ByteString)
objectParser :: ByteStringParser (ObjectType, ByteString)
objectParser = (ByteStringParser (ObjectType, Int)
forall i. Num i => ByteStringParser (ObjectType, i)
header ByteStringParser (ObjectType, Int)
-> ((ObjectType, Int) -> ByteStringParser (ObjectType, ByteString))
-> ByteStringParser (ObjectType, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> ParsecT ParseException ByteString Identity ByteString)
-> (ObjectType, Int) -> ByteStringParser (ObjectType, ByteString)
forall (m :: * -> *) b b' a.
Functor m =>
(b -> m b') -> (a, b) -> m (a, b')
secondM (([Word8] -> ByteString)
-> ParsecT ParseException ByteString Identity [Word8]
-> ParsecT ParseException ByteString Identity ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Word8] -> ByteString
BL.pack (ParsecT ParseException ByteString Identity [Word8]
 -> ParsecT ParseException ByteString Identity ByteString)
-> (Int -> ParsecT ParseException ByteString Identity [Word8])
-> Int
-> ParsecT ParseException ByteString Identity ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
 -> ParsecT ParseException ByteString Identity Word8
 -> ParsecT ParseException ByteString Identity [Word8])
-> ParsecT ParseException ByteString Identity Word8
-> Int
-> ParsecT ParseException ByteString Identity [Word8]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int
-> ParsecT ParseException ByteString Identity Word8
-> ParsecT ParseException ByteString Identity [Word8]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
M.count ParsecT ParseException ByteString Identity Word8
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
M.anySingle))
    ByteStringParser (ObjectType, ByteString)
-> ByteStringParser () -> ByteStringParser (ObjectType, ByteString)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ByteStringParser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
M.eof

-- | Tree binary parser
treeParser :: Int -> ByteStringParser [(CMode, P.Path P.Rel P.File, String)]
treeParser :: Int -> ByteStringParser [(CMode, Path Rel File, String)]
treeParser Int
limit = ((Int
  -> ParsecT
       ParseException
       ByteString
       Identity
       (Maybe ((CMode, Path Rel File, String), Int)))
 -> Int -> ByteStringParser [(CMode, Path Rel File, String)])
-> Int
-> (Int
    -> ParsecT
         ParseException
         ByteString
         Identity
         (Maybe ((CMode, Path Rel File, String), Int)))
-> ByteStringParser [(CMode, Path Rel File, String)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int
 -> ParsecT
      ParseException
      ByteString
      Identity
      (Maybe ((CMode, Path Rel File, String), Int)))
-> Int -> ByteStringParser [(CMode, Path Rel File, String)]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe (b, a))) -> a -> m [b]
unfoldrM Int
0 ((Int
  -> ParsecT
       ParseException
       ByteString
       Identity
       (Maybe ((CMode, Path Rel File, String), Int)))
 -> ByteStringParser [(CMode, Path Rel File, String)])
-> (Int
    -> ParsecT
         ParseException
         ByteString
         Identity
         (Maybe ((CMode, Path Rel File, String), Int)))
-> ByteStringParser [(CMode, Path Rel File, String)]
forall a b. (a -> b) -> a -> b
$ \Int
lim ->
    ParsecT ParseException ByteString Identity Bool
-> ParsecT
     ParseException
     ByteString
     Identity
     (Maybe ((CMode, Path Rel File, String), Int))
-> ParsecT
     ParseException
     ByteString
     Identity
     (Maybe ((CMode, Path Rel File, String), Int))
-> ParsecT
     ParseException
     ByteString
     Identity
     (Maybe ((CMode, Path Rel File, String), Int))
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM ((Int
lim Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
limit Bool -> Bool -> Bool
||) (Bool -> Bool)
-> ParsecT ParseException ByteString Identity Bool
-> ParsecT ParseException ByteString Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ParseException ByteString Identity Bool
forall e s (m :: * -> *). MonadParsec e s m => m Bool
M.atEnd) (Maybe ((CMode, Path Rel File, String), Int)
-> ParsecT
     ParseException
     ByteString
     Identity
     (Maybe ((CMode, Path Rel File, String), Int))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ((CMode, Path Rel File, String), Int)
forall a. Maybe a
Nothing) (ParsecT
   ParseException
   ByteString
   Identity
   (Maybe ((CMode, Path Rel File, String), Int))
 -> ParsecT
      ParseException
      ByteString
      Identity
      (Maybe ((CMode, Path Rel File, String), Int)))
-> ParsecT
     ParseException
     ByteString
     Identity
     (Maybe ((CMode, Path Rel File, String), Int))
-> ParsecT
     ParseException
     ByteString
     Identity
     (Maybe ((CMode, Path Rel File, String), Int))
forall a b. (a -> b) -> a -> b
$ do
        CMode
cmode <- ByteStringParser CMode
forall i. Num i => ByteStringParser i
octal ByteStringParser CMode
-> ByteStringParser () -> ByteStringParser CMode
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ByteStringParser ()
space
        Path Rel File
prel <- ByteStringParser (Path Rel File)
relFile
        ((CMode, Path Rel File, String), Int)
-> Maybe ((CMode, Path Rel File, String), Int)
forall a. a -> Maybe a
Just (((CMode, Path Rel File, String), Int)
 -> Maybe ((CMode, Path Rel File, String), Int))
-> ([Word8] -> ((CMode, Path Rel File, String), Int))
-> [Word8]
-> Maybe ((CMode, Path Rel File, String), Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, Int -> Int
forall a. Enum a => a -> a
succ Int
lim) ((CMode, Path Rel File, String)
 -> ((CMode, Path Rel File, String), Int))
-> ([Word8] -> (CMode, Path Rel File, String))
-> [Word8]
-> ((CMode, Path Rel File, String), Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CMode
cmode, Path Rel File
prel,) (String -> (CMode, Path Rel File, String))
-> ([Word8] -> String) -> [Word8] -> (CMode, Path Rel File, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> String
forall mono.
(MonoFoldable mono, PrintfArg (Element mono)) =>
mono -> String
hexStr ([Word8] -> Maybe ((CMode, Path Rel File, String), Int))
-> ParsecT ParseException ByteString Identity [Word8]
-> ParsecT
     ParseException
     ByteString
     Identity
     (Maybe ((CMode, Path Rel File, String), Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> ParsecT ParseException ByteString Identity Word8
-> ParsecT ParseException ByteString Identity [Word8]
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
M.count Int
20 ParsecT ParseException ByteString Identity Word8
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
M.anySingle