{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Data.PackStream.Parser
(
  null, bool, integer, float,
  bytes, string, list, dict, structure,
  value
) where

import Data.PackStream.Internal.Type ( PackStream, PackStreamError(..), Structure(..), Value(..) )
import Data.PackStream.Internal.Code
import Data.PackStream.Internal.Binary ( Interpret(..) )

import Prelude hiding (null)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS (head, tail, drop, take, singleton)
import Data.Text (Text)
import Data.Map.Strict (Map, fromList)
import Data.Binary (Word8)
import Control.Monad.State ( gets, modify )
import Control.Monad.Except (throwError)
import Control.Monad (replicateM)


-- |Parse '()'
null :: PackStream ()
null :: PackStream ()
null = PackStream Word8
bite1 PackStream Word8 -> (Word8 -> PackStream ()) -> PackStream ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PackStreamError
-> [(Word8 -> Bool, PackStream ())] -> Word8 -> PackStream ()
forall a.
PackStreamError
-> [(Word8 -> Bool, PackStream a)] -> Word8 -> PackStream a
select PackStreamError
NotNull [ (Word8 -> Bool
isNull, () -> PackStream ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ]

-- |Parse 'Bool'
bool :: PackStream Bool
bool :: PackStream Bool
bool = PackStream Word8
bite1 PackStream Word8 -> (Word8 -> PackStream Bool) -> PackStream Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PackStreamError
-> [(Word8 -> Bool, PackStream Bool)] -> Word8 -> PackStream Bool
forall a.
PackStreamError
-> [(Word8 -> Bool, PackStream a)] -> Word8 -> PackStream a
select PackStreamError
NotBool [ (Word8 -> Bool
isTrue, Bool -> PackStream Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
                                , (Word8 -> Bool
isFalse, Bool -> PackStream Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)
                                ]

-- |Parse 'Int'
integer :: PackStream Int
integer :: PackStream Int
integer = PackStream Word8
bite1 PackStream Word8 -> (Word8 -> PackStream Int) -> PackStream Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
x -> PackStreamError
-> [(Word8 -> Bool, PackStream Int)] -> Word8 -> PackStream Int
forall a.
PackStreamError
-> [(Word8 -> Bool, PackStream a)] -> Word8 -> PackStream a
select PackStreamError
NotInt [ (Word8 -> Bool
isTinyInt, ByteString -> PackStream Int
forall a (m :: * -> *).
(Interpret a, MonadError PackStreamError m) =>
ByteString -> m a
interpret (ByteString -> PackStream Int) -> ByteString -> PackStream Int
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString
BS.singleton Word8
x)
                                        , (Word8 -> Bool
isInt8,  Int -> PackStream ByteString
bite Int
1 PackStream ByteString
-> (ByteString -> PackStream Int) -> PackStream Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> PackStream Int
forall a (m :: * -> *).
(Interpret a, MonadError PackStreamError m) =>
ByteString -> m a
interpret)
                                        , (Word8 -> Bool
isInt16, Int -> PackStream ByteString
bite Int
2 PackStream ByteString
-> (ByteString -> PackStream Int) -> PackStream Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> PackStream Int
forall a (m :: * -> *).
(Interpret a, MonadError PackStreamError m) =>
ByteString -> m a
interpret)
                                        , (Word8 -> Bool
isInt32, Int -> PackStream ByteString
bite Int
4 PackStream ByteString
-> (ByteString -> PackStream Int) -> PackStream Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> PackStream Int
forall a (m :: * -> *).
(Interpret a, MonadError PackStreamError m) =>
ByteString -> m a
interpret)
                                        , (Word8 -> Bool
isInt64, Int -> PackStream ByteString
bite Int
8 PackStream ByteString
-> (ByteString -> PackStream Int) -> PackStream Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> PackStream Int
forall a (m :: * -> *).
(Interpret a, MonadError PackStreamError m) =>
ByteString -> m a
interpret)
                                        ] Word8
x

-- |Parse 'Double'
float :: PackStream Double
float :: PackStream Double
float = PackStream Word8
bite1 PackStream Word8
-> (Word8 -> PackStream Double) -> PackStream Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PackStreamError
-> [(Word8 -> Bool, PackStream Double)]
-> Word8
-> PackStream Double
forall a.
PackStreamError
-> [(Word8 -> Bool, PackStream a)] -> Word8 -> PackStream a
select PackStreamError
NotFloat [ (Word8 -> Bool
isFloat, Int -> PackStream ByteString
bite Int
8 PackStream ByteString
-> (ByteString -> PackStream Double) -> PackStream Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> PackStream Double
forall a (m :: * -> *).
(Interpret a, MonadError PackStreamError m) =>
ByteString -> m a
interpret) ]

-- |Parse 'ByteString'
bytes :: PackStream ByteString
bytes :: PackStream ByteString
bytes = PackStream Word8
bite1 PackStream Word8
-> (Word8 -> PackStream ByteString) -> PackStream ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PackStreamError
-> [(Word8 -> Bool, PackStream ByteString)]
-> Word8
-> PackStream ByteString
forall a.
PackStreamError
-> [(Word8 -> Bool, PackStream a)] -> Word8 -> PackStream a
select PackStreamError
NotBytes [ (Word8 -> Bool
isBytes8,  Int -> PackStream ByteString
bite'by'bytes Int
1)
                                  , (Word8 -> Bool
isBytes16, Int -> PackStream ByteString
bite'by'bytes Int
2)
                                  , (Word8 -> Bool
isBytes32, Int -> PackStream ByteString
bite'by'bytes Int
4)
                                  ]

-- |Parse 'Text'
string :: PackStream Text
string :: PackStream Text
string = PackStream Word8
bite1 PackStream Word8 -> (Word8 -> PackStream Text) -> PackStream Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
x -> PackStreamError
-> [(Word8 -> Bool, PackStream Text)] -> Word8 -> PackStream Text
forall a.
PackStreamError
-> [(Word8 -> Bool, PackStream a)] -> Word8 -> PackStream a
select PackStreamError
NotBytes [ (Word8 -> Bool
isTinyString, Int -> PackStream ByteString
bite (Word8 -> Int
tinySize Word8
x) PackStream ByteString
-> (ByteString -> PackStream Text) -> PackStream Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> PackStream Text
forall a (m :: * -> *).
(Interpret a, MonadError PackStreamError m) =>
ByteString -> m a
interpret)
                                         , (Word8 -> Bool
isString8,    Int -> PackStream ByteString
bite'by'bytes Int
1 PackStream ByteString
-> (ByteString -> PackStream Text) -> PackStream Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> PackStream Text
forall a (m :: * -> *).
(Interpret a, MonadError PackStreamError m) =>
ByteString -> m a
interpret)
                                         , (Word8 -> Bool
isString16,   Int -> PackStream ByteString
bite'by'bytes Int
2 PackStream ByteString
-> (ByteString -> PackStream Text) -> PackStream Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> PackStream Text
forall a (m :: * -> *).
(Interpret a, MonadError PackStreamError m) =>
ByteString -> m a
interpret)
                                         , (Word8 -> Bool
isString32,   Int -> PackStream ByteString
bite'by'bytes Int
4 PackStream ByteString
-> (ByteString -> PackStream Text) -> PackStream Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> PackStream Text
forall a (m :: * -> *).
(Interpret a, MonadError PackStreamError m) =>
ByteString -> m a
interpret)
                                         ] Word8
x

-- |Parse a list of specified 'Value's (e.g. `list integer` will parse some '[Int]')
list :: PackStream a -> PackStream [a]
list :: PackStream a -> PackStream [a]
list PackStream a
action = PackStream Word8
bite1 PackStream Word8 -> (Word8 -> PackStream [a]) -> PackStream [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
x -> PackStreamError
-> [(Word8 -> Bool, PackStream [a])] -> Word8 -> PackStream [a]
forall a.
PackStreamError
-> [(Word8 -> Bool, PackStream a)] -> Word8 -> PackStream a
select PackStreamError
NotList [ (Word8 -> Bool
isTinyList, PackStream a -> Int -> PackStream [a]
forall a. PackStream a -> Int -> PackStream [a]
multiple PackStream a
action (Word8 -> Int
tinySize Word8
x))
                                             , (Word8 -> Bool
isList8,    Int -> PackStream Int
collectionSize Int
1 PackStream Int -> (Int -> PackStream [a]) -> PackStream [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PackStream a -> Int -> PackStream [a]
forall a. PackStream a -> Int -> PackStream [a]
multiple PackStream a
action)
                                             , (Word8 -> Bool
isList16,   Int -> PackStream Int
collectionSize Int
2 PackStream Int -> (Int -> PackStream [a]) -> PackStream [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PackStream a -> Int -> PackStream [a]
forall a. PackStream a -> Int -> PackStream [a]
multiple PackStream a
action)
                                             , (Word8 -> Bool
isList32,   Int -> PackStream Int
collectionSize Int
4 PackStream Int -> (Int -> PackStream [a]) -> PackStream [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PackStream a -> Int -> PackStream [a]
forall a. PackStream a -> Int -> PackStream [a]
multiple PackStream a
action)
                                             ] Word8
x

-- |Parse a dictionary of specified 'Value's (e.g. `dict integer` will parse some 'Map Text Int')
dict :: forall a.PackStream a -> PackStream (Map Text a)
dict :: PackStream a -> PackStream (Map Text a)
dict PackStream a
action = PackStream Word8
bite1 PackStream Word8
-> (Word8 -> PackStream (Map Text a)) -> PackStream (Map Text a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
x -> PackStreamError
-> [(Word8 -> Bool, PackStream (Map Text a))]
-> Word8
-> PackStream (Map Text a)
forall a.
PackStreamError
-> [(Word8 -> Bool, PackStream a)] -> Word8 -> PackStream a
select PackStreamError
NotDict [ (Word8 -> Bool
isTinyDict, Int -> PackStream (Map Text a)
makeDict (Word8 -> Int
tinySize Word8
x))
                                             , (Word8 -> Bool
isDict8,    Int -> PackStream Int
collectionSize Int
1 PackStream Int
-> (Int -> PackStream (Map Text a)) -> PackStream (Map Text a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> PackStream (Map Text a)
makeDict)
                                             , (Word8 -> Bool
isDict16,   Int -> PackStream Int
collectionSize Int
2 PackStream Int
-> (Int -> PackStream (Map Text a)) -> PackStream (Map Text a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> PackStream (Map Text a)
makeDict)
                                             , (Word8 -> Bool
isDict32,   Int -> PackStream Int
collectionSize Int
4 PackStream Int
-> (Int -> PackStream (Map Text a)) -> PackStream (Map Text a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> PackStream (Map Text a)
makeDict)
                                             ] Word8
x
  where
    makeDict :: Int -> PackStream (Map Text a)
    makeDict :: Int -> PackStream (Map Text a)
makeDict = ([(Text, a)] -> Map Text a
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(Text, a)] -> Map Text a)
-> PackStream [(Text, a)] -> PackStream (Map Text a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (PackStream [(Text, a)] -> PackStream (Map Text a))
-> (Int -> PackStream [(Text, a)])
-> Int
-> PackStream (Map Text a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackStream (Text, a) -> Int -> PackStream [(Text, a)]
forall a. PackStream a -> Int -> PackStream [a]
multiple ((,) (Text -> a -> (Text, a))
-> PackStream Text -> PackStream (a -> (Text, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackStream Text
string PackStream (a -> (Text, a)) -> PackStream a -> PackStream (Text, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PackStream a
action)

-- |Parse 'Structure'
structure :: PackStream Structure
structure :: PackStream Structure
structure = PackStream Word8
bite1 PackStream Word8
-> (Word8 -> PackStream Structure) -> PackStream Structure
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
x -> PackStreamError
-> [(Word8 -> Bool, PackStream Structure)]
-> Word8
-> PackStream Structure
forall a.
PackStreamError
-> [(Word8 -> Bool, PackStream a)] -> Word8 -> PackStream a
select PackStreamError
NotStructure [ (Word8 -> Bool
isStructure, Int -> PackStream Structure
makeStructure (Word8 -> Int
tinySize Word8
x)) ] Word8
x
  where
    makeStructure :: Int -> PackStream Structure
    makeStructure :: Int -> PackStream Structure
makeStructure Int
n = Word8 -> [Value] -> Structure
Structure (Word8 -> [Value] -> Structure)
-> PackStream Word8 -> PackStream ([Value] -> Structure)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackStream Word8
bite1 PackStream ([Value] -> Structure)
-> PackStream [Value] -> PackStream Structure
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PackStream Value -> Int -> PackStream [Value]
forall a. PackStream a -> Int -> PackStream [a]
multiple PackStream Value
value Int
n

-- |Parse any valid 'Value'
value :: PackStream Value
value :: PackStream Value
value = PackStream Word8
look1 PackStream Word8 -> (Word8 -> PackStream Value) -> PackStream Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> PackStream Value
byMarker
  where
    byMarker :: Word8 -> PackStream Value
    byMarker :: Word8 -> PackStream Value
byMarker Word8
n | Word8 -> Bool
isNull Word8
n      = Value
N Value -> PackStream () -> PackStream Value
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ PackStream ()
null
               | Word8 -> Bool
isBool Word8
n      = Bool -> Value
B (Bool -> Value) -> PackStream Bool -> PackStream Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackStream Bool
bool
               | Word8 -> Bool
isInt Word8
n       = Int -> Value
I (Int -> Value) -> PackStream Int -> PackStream Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackStream Int
integer
               | Word8 -> Bool
isFloat Word8
n     = Double -> Value
F (Double -> Value) -> PackStream Double -> PackStream Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackStream Double
float
               | Word8 -> Bool
isBytes Word8
n     = ByteString -> Value
U (ByteString -> Value) -> PackStream ByteString -> PackStream Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackStream ByteString
bytes
               | Word8 -> Bool
isString Word8
n    = Text -> Value
T (Text -> Value) -> PackStream Text -> PackStream Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackStream Text
string
               | Word8 -> Bool
isList Word8
n      = [Value] -> Value
L ([Value] -> Value) -> PackStream [Value] -> PackStream Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackStream Value -> PackStream [Value]
forall a. PackStream a -> PackStream [a]
list PackStream Value
value
               | Word8 -> Bool
isDict Word8
n      = Map Text Value -> Value
D (Map Text Value -> Value)
-> PackStream (Map Text Value) -> PackStream Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackStream Value -> PackStream (Map Text Value)
forall a. PackStream a -> PackStream (Map Text a)
dict PackStream Value
value
               | Word8 -> Bool
isStructure Word8
n = Structure -> Value
S (Structure -> Value) -> PackStream Structure -> PackStream Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackStream Structure
structure
               | Bool
otherwise     = PackStreamError -> PackStream Value
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PackStreamError
NotValue

-- |Selects a parser to use by the marker byte predicate. Raises the 'PackStreamError' if nothing is suitable
select :: PackStreamError -> [(Word8 -> Bool, PackStream a)] -> Word8 -> PackStream a
select :: PackStreamError
-> [(Word8 -> Bool, PackStream a)] -> Word8 -> PackStream a
select PackStreamError
e []               Word8
_ = PackStreamError -> PackStream a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError PackStreamError
e
select PackStreamError
e ((Word8 -> Bool
p, PackStream a
action):[(Word8 -> Bool, PackStream a)]
xs) Word8
w | Word8 -> Bool
p Word8
w       = PackStream a
action
                            | Bool
otherwise = PackStreamError
-> [(Word8 -> Bool, PackStream a)] -> Word8 -> PackStream a
forall a.
PackStreamError
-> [(Word8 -> Bool, PackStream a)] -> Word8 -> PackStream a
select PackStreamError
e [(Word8 -> Bool, PackStream a)]
xs Word8
w

-- |Gets one byte from the 'ByteString'
bite1 :: PackStream Word8
bite1 :: PackStream Word8
bite1 = do Word8
b <- (ByteString -> Word8) -> PackStream Word8
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ByteString -> Word8
BS.head
           (ByteString -> ByteString) -> PackStream ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ByteString -> ByteString
BS.tail
           Word8 -> PackStream Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
b

-- |Gets the specified number of bytes from the 'ByteString'
bite :: Int -> PackStream ByteString
bite :: Int -> PackStream ByteString
bite Int
n = do ByteString
bs <- (ByteString -> ByteString) -> PackStream ByteString
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((ByteString -> ByteString) -> PackStream ByteString)
-> (ByteString -> ByteString) -> PackStream ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
n
            (ByteString -> ByteString) -> PackStream ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ByteString -> ByteString) -> PackStream ())
-> (ByteString -> ByteString) -> PackStream ()
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
n
            ByteString -> PackStream ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs

-- |Looks at the first byte of the 'ByteString' without modifying it
look1 :: PackStream Word8
look1 :: PackStream Word8
look1 = (ByteString -> Word8) -> PackStream Word8
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ByteString -> Word8
BS.head

-- |Gets the specified number of bytes from the 'ByteString', 
-- interprets them as some unsigned int ('Word') and then get the specified number of
-- further bytes from the 'ByteString'
bite'by'bytes :: Int -> PackStream ByteString
bite'by'bytes :: Int -> PackStream ByteString
bite'by'bytes Int
n = Int -> PackStream Int
collectionSize Int
n PackStream Int
-> (Int -> PackStream ByteString) -> PackStream ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> PackStream ByteString
bite

-- |Performs some 'PackStream' parser combinator the specified number of times
multiple :: PackStream a -> Int -> PackStream [a]
multiple :: PackStream a -> Int -> PackStream [a]
multiple PackStream a
action Int
n = Int -> PackStream a -> PackStream [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n PackStream a
action

-- |Gets the specified number of bytes from the 'ByteString' and
-- interprets them as some unsigned int ('Word')
collectionSize :: Int -> PackStream Int
collectionSize :: Int -> PackStream Int
collectionSize Int
n = Int -> PackStream ByteString
bite Int
n PackStream ByteString
-> (ByteString -> PackStream Int) -> PackStream Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Word -> Int) -> PackStream Word -> PackStream Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PackStream Word -> PackStream Int)
-> (ByteString -> PackStream Word) -> ByteString -> PackStream Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(Interpret Word, MonadError PackStreamError m) =>
ByteString -> m Word
forall a (m :: * -> *).
(Interpret a, MonadError PackStreamError m) =>
ByteString -> m a
interpret @Word