{-# LANGUAGE ExplicitNamespaces, FlexibleContexts, Rank2Types, TypeOperators #-}
module HMGit.Internal.Parser.Core.ByteString (
    ParseException (..)
  , runByteStringParser
  , ByteStringParser
  , null
  , space
  , decimal
  , octal
  , fromBinaryGetter
  , relFile
) where

import           HMGit.Internal.Exceptions (MonadThrowable (..))
import           HMGit.Internal.Utils      (first3M)

import qualified Codec.Binary.UTF8.String  as S
import           Control.Exception.Safe    (Exception, MonadThrow)
import           Control.Monad             (void, (>=>))
import           Control.Natural           (type (~>))
import qualified Data.Binary.Get           as BG
import qualified Data.ByteString.Lazy      as BL
import           Data.Char                 (chr, ord)
import           Data.Char                 (digitToInt)
import           Data.List                 (foldl')
import           Data.Tuple.Extra          (thd3)
import           Data.Typeable             (Typeable)
import           Data.Void                 (Void)
import           Data.Word                 (Word8)
import qualified Path                      as P
import           Prelude                   hiding (null)
import qualified Text.Megaparsec           as M
import qualified Text.Megaparsec.Byte      as M

data ParseException = TreeParser String
    | IndexParser String
    | MasterHashParser String
    deriving (ParseException -> ParseException -> Bool
(ParseException -> ParseException -> Bool)
-> (ParseException -> ParseException -> Bool) -> Eq ParseException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseException -> ParseException -> Bool
$c/= :: ParseException -> ParseException -> Bool
== :: ParseException -> ParseException -> Bool
$c== :: ParseException -> ParseException -> Bool
Eq, Eq ParseException
Eq ParseException
-> (ParseException -> ParseException -> Ordering)
-> (ParseException -> ParseException -> Bool)
-> (ParseException -> ParseException -> Bool)
-> (ParseException -> ParseException -> Bool)
-> (ParseException -> ParseException -> Bool)
-> (ParseException -> ParseException -> ParseException)
-> (ParseException -> ParseException -> ParseException)
-> Ord ParseException
ParseException -> ParseException -> Bool
ParseException -> ParseException -> Ordering
ParseException -> ParseException -> ParseException
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ParseException -> ParseException -> ParseException
$cmin :: ParseException -> ParseException -> ParseException
max :: ParseException -> ParseException -> ParseException
$cmax :: ParseException -> ParseException -> ParseException
>= :: ParseException -> ParseException -> Bool
$c>= :: ParseException -> ParseException -> Bool
> :: ParseException -> ParseException -> Bool
$c> :: ParseException -> ParseException -> Bool
<= :: ParseException -> ParseException -> Bool
$c<= :: ParseException -> ParseException -> Bool
< :: ParseException -> ParseException -> Bool
$c< :: ParseException -> ParseException -> Bool
compare :: ParseException -> ParseException -> Ordering
$ccompare :: ParseException -> ParseException -> Ordering
$cp1Ord :: Eq ParseException
Ord, Int -> ParseException -> ShowS
[ParseException] -> ShowS
ParseException -> String
(Int -> ParseException -> ShowS)
-> (ParseException -> String)
-> ([ParseException] -> ShowS)
-> Show ParseException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseException] -> ShowS
$cshowList :: [ParseException] -> ShowS
show :: ParseException -> String
$cshow :: ParseException -> String
showsPrec :: Int -> ParseException -> ShowS
$cshowsPrec :: Int -> ParseException -> ShowS
Show)

instance M.ShowErrorComponent ParseException where
    showErrorComponent :: ParseException -> String
showErrorComponent (TreeParser String
s)       = String
"tree object parse error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s
    showErrorComponent (IndexParser String
s)      = String
"index parse error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s
    showErrorComponent (MasterHashParser String
s) = String
"master hash parse error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s

instance Exception ParseException

type ByteStringParser = M.Parsec ParseException BL.ByteString

runByteStringParser :: (
    MonadThrow m
  , Show e
  , M.ShowErrorComponent e
  , Typeable e
  , M.VisualStream s
  , M.TraversableStream s
  , Typeable s
  , Show s
  , Show (M.Token s)
  )
    => M.Parsec e s a
    -> P.Path b t
    -> s
    -> m a
runByteStringParser :: Parsec e s a -> Path b t -> s -> m a
runByteStringParser Parsec e s a
p Path b t
fp = Maybe Void -> Either (ParseErrorBundle s e) ~> m
forall (m :: * -> *) (n :: * -> *) e.
(MonadThrowable m, MonadThrow n, Exception e) =>
Maybe e -> m ~> n
fromMonad (Maybe Void
forall a. Maybe a
Nothing :: Maybe Void)
    (Either (ParseErrorBundle s e) a -> m a)
-> (s -> Either (ParseErrorBundle s e) a) -> s -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
M.runParser Parsec e s a
p (Path b t -> String
forall b t. Path b t -> String
P.toFilePath Path b t
fp)

-- | null
null :: ByteStringParser Word8
null :: ByteStringParser Word8
null = Token ByteString
-> ParsecT ParseException ByteString Identity (Token ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
M.single Token ByteString
0

-- | M.space is fine but we just want to match 0x20
space :: ByteStringParser ()
space :: ByteStringParser ()
space = ByteStringParser Word8 -> ByteStringParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ByteStringParser Word8 -> ByteStringParser ())
-> ByteStringParser Word8 -> ByteStringParser ()
forall a b. (a -> b) -> a -> b
$ Token ByteString
-> ParsecT ParseException ByteString Identity (Token ByteString)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
M.single (Token ByteString
 -> ParsecT ParseException ByteString Identity (Token ByteString))
-> Token ByteString
-> ParsecT ParseException ByteString Identity (Token ByteString)
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
' '

-- | decimal
decimal :: Num i => ByteStringParser i
decimal :: ByteStringParser i
decimal = (i -> Word8 -> i) -> i -> [Word8] -> i
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\i
acc Word8
c -> i
acc i -> i -> i
forall a. Num a => a -> a -> a
* i
10 i -> i -> i
forall a. Num a => a -> a -> a
+ Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
digitToInt (Int -> Char
chr (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c)))) i
0
    ([Word8] -> i)
-> ParsecT ParseException ByteString Identity [Word8]
-> ByteStringParser i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteStringParser Word8
-> ParsecT ParseException ByteString Identity [Word8]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.some ByteStringParser Word8
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
M.digitChar

-- | octal
octal :: Num i => ByteStringParser i
octal :: ByteStringParser i
octal = (i -> Word8 -> i) -> i -> [Word8] -> i
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\i
acc Word8
c -> i
acc i -> i -> i
forall a. Num a => a -> a -> a
* i
8 i -> i -> i
forall a. Num a => a -> a -> a
+ Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
digitToInt (Int -> Char
chr (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c)))) i
0
    ([Word8] -> i)
-> ParsecT ParseException ByteString Identity [Word8]
-> ByteStringParser i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteStringParser Word8
-> ParsecT ParseException ByteString Identity [Word8]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
M.some ByteStringParser Word8
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m (Token s)
M.octDigitChar

-- | Natural transformation from Get to parsec
fromBinaryGetter :: (String -> ParseException) -> BG.Get ~> ByteStringParser
fromBinaryGetter :: (String -> ParseException) -> Get ~> ByteStringParser
fromBinaryGetter String -> ParseException
pException Get x
binGetter = ParsecT ParseException ByteString Identity ByteString
forall e s (m :: * -> *). MonadParsec e s m => m s
M.getInput
    ParsecT ParseException ByteString Identity ByteString
-> (ByteString -> ParsecT ParseException ByteString Identity x)
-> ParsecT ParseException ByteString Identity x
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((ByteString, ByteOffset, String)
 -> ParsecT ParseException ByteString Identity x)
-> ((ByteString, ByteOffset, x)
    -> ParsecT ParseException ByteString Identity x)
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, x)
-> ParsecT ParseException ByteString Identity x
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ParseException -> ParsecT ParseException ByteString Identity x
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
M.customFailure (ParseException -> ParsecT ParseException ByteString Identity x)
-> ((ByteString, ByteOffset, String) -> ParseException)
-> (ByteString, ByteOffset, String)
-> ParsecT ParseException ByteString Identity x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParseException
pException (String -> ParseException)
-> ((ByteString, ByteOffset, String) -> String)
-> (ByteString, ByteOffset, String)
-> ParseException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteOffset, String) -> String
forall a b c. (a, b, c) -> c
thd3) ((ByteString -> ByteStringParser ())
-> (ByteString, ByteOffset, x)
-> ParsecT ParseException ByteString Identity ((), ByteOffset, x)
forall (m :: * -> *) a a' b c.
Functor m =>
(a -> m a') -> (a, b, c) -> m (a', b, c)
first3M ByteString -> ByteStringParser ()
forall e s (m :: * -> *). MonadParsec e s m => s -> m ()
M.setInput ((ByteString, ByteOffset, x)
 -> ParsecT ParseException ByteString Identity ((), ByteOffset, x))
-> (((), ByteOffset, x)
    -> ParsecT ParseException ByteString Identity x)
-> (ByteString, ByteOffset, x)
-> ParsecT ParseException ByteString Identity x
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> x -> ParsecT ParseException ByteString Identity x
forall (f :: * -> *) a. Applicative f => a -> f a
pure (x -> ParsecT ParseException ByteString Identity x)
-> (((), ByteOffset, x) -> x)
-> ((), ByteOffset, x)
-> ParsecT ParseException ByteString Identity x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((), ByteOffset, x) -> x
forall a b c. (a, b, c) -> c
thd3)
    (Either
   (ByteString, ByteOffset, String) (ByteString, ByteOffset, x)
 -> ParsecT ParseException ByteString Identity x)
-> (ByteString
    -> Either
         (ByteString, ByteOffset, String) (ByteString, ByteOffset, x))
-> ByteString
-> ParsecT ParseException ByteString Identity x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get x
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, x)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
BG.runGetOrFail Get x
binGetter

-- | parse relative file path until null
relFile :: ByteStringParser (P.Path P.Rel P.File)
relFile :: ByteStringParser (Path Rel File)
relFile = ByteStringParser Word8
-> ByteStringParser Word8
-> ParsecT ParseException ByteString Identity [Word8]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
M.manyTill ByteStringParser Word8
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
M.anySingle ByteStringParser Word8
null
    ParsecT ParseException ByteString Identity [Word8]
-> ([Word8] -> ByteStringParser (Path Rel File))
-> ByteStringParser (Path Rel File)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteStringParser (Path Rel File)
-> (Path Rel File -> ByteStringParser (Path Rel File))
-> Maybe (Path Rel File)
-> ByteStringParser (Path Rel File)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ParseException -> ByteStringParser (Path Rel File)
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
M.customFailure (ParseException -> ByteStringParser (Path Rel File))
-> ParseException -> ByteStringParser (Path Rel File)
forall a b. (a -> b) -> a -> b
$ String -> ParseException
TreeParser String
"failed to parse relative file path") Path Rel File -> ByteStringParser (Path Rel File)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
     (Maybe (Path Rel File) -> ByteStringParser (Path Rel File))
-> ([Word8] -> Maybe (Path Rel File))
-> [Word8]
-> ByteStringParser (Path Rel File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
P.parseRelFile (String -> Maybe (Path Rel File))
-> ([Word8] -> String) -> [Word8] -> Maybe (Path Rel File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> String
S.decode