{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}
module Data.PackStream
(
  PackStreamError (..), PackStream (..), PackStreamValue (..)
, unpackStream, unpackFail, unpackThrow
, Value (..), ToValue (..), FromValue (..), (=:), at
, Structure (..)
) where

import Data.PackStream.Internal.Type
import qualified Data.PackStream.Parser as P
import qualified Data.PackStream.Serializer as S

import Prelude hiding (lookup)
import Data.ByteString (ByteString)
import Data.Text (Text)
import Data.Map.Strict (Map, lookup)
import Control.Monad.Except (MonadError(..), liftEither)

#if !MIN_VERSION_base(4, 13, 0)
import Control.Monad.Fail (MonadFail)
#endif

-- |The data types that can be interpreted or parsed to/from 'PackStream' 'ByteString'
class PackStreamValue a where
    -- |Pack a value into a 'PackStream' 'ByteString'
    pack :: a -> ByteString
    -- |Parse a value from a 'PackStream' 'ByteString'
    unpack :: PackStream a

instance PackStreamValue () where
    pack :: () -> ByteString
pack ()
_ = ByteString
S.null
    unpack :: PackStream ()
unpack = PackStream ()
P.null

instance PackStreamValue Bool where
    pack :: Bool -> ByteString
pack = Bool -> ByteString
S.bool
    unpack :: PackStream Bool
unpack = PackStream Bool
P.bool

instance PackStreamValue Int where
    pack :: Int -> ByteString
pack = Int -> ByteString
S.integer
    unpack :: PackStream Int
unpack = PackStream Int
P.integer

instance PackStreamValue Integer where
    pack :: Integer -> ByteString
pack = Int -> ByteString
S.integer (Int -> ByteString) -> (Integer -> Int) -> Integer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    unpack :: PackStream Integer
unpack = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> PackStream Int -> PackStream Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackStream Int
P.integer

instance PackStreamValue Double where
    pack :: Double -> ByteString
pack = Double -> ByteString
S.float
    unpack :: PackStream Double
unpack = PackStream Double
P.float

instance PackStreamValue ByteString where
    pack :: ByteString -> ByteString
pack = ByteString -> ByteString
S.bytes
    unpack :: PackStream ByteString
unpack = PackStream ByteString
P.bytes

instance PackStreamValue Text where
    pack :: Text -> ByteString
pack = Text -> ByteString
S.string
    unpack :: PackStream Text
unpack = PackStream Text
P.string

instance (ToValue a, PackStreamValue a) => PackStreamValue [a] where
    pack :: [a] -> ByteString
pack = [Value] -> ByteString
S.list ([Value] -> ByteString) -> ([a] -> [Value]) -> [a] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> [a] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Value
forall a. ToValue a => a -> Value
toValue
    unpack :: PackStream [a]
unpack = PackStream a -> PackStream [a]
forall a. PackStream a -> PackStream [a]
P.list PackStream a
forall a. PackStreamValue a => PackStream a
unpack

instance (ToValue a, PackStreamValue a) => PackStreamValue (Map Text a) where
    pack :: Map Text a -> ByteString
pack = Map Text Value -> ByteString
S.dict (Map Text Value -> ByteString)
-> (Map Text a -> Map Text Value) -> Map Text a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Value) -> Map Text a -> Map Text Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Value
forall a. ToValue a => a -> Value
toValue
    unpack :: PackStream (Map Text a)
unpack = PackStream a -> PackStream (Map Text a)
forall a. PackStream a -> PackStream (Map Text a)
P.dict PackStream a
forall a. PackStreamValue a => PackStream a
unpack

instance PackStreamValue Structure where
    pack :: Structure -> ByteString
pack = Structure -> ByteString
S.structure
    unpack :: PackStream Structure
unpack = PackStream Structure
P.structure

instance PackStreamValue Value where
    pack :: Value -> ByteString
pack = Value -> ByteString
S.value
    unpack :: PackStream Value
unpack = PackStream Value
P.value

-- |Unpack some value of the specific type from 'ByteString' or raise 'PackStreamError'
unpackThrow :: (MonadError PackStreamError m, PackStreamValue a) => ByteString -> m a
unpackThrow :: ByteString -> m a
unpackThrow = Either PackStreamError a -> m a
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either PackStreamError a -> m a)
-> (ByteString -> Either PackStreamError a) -> ByteString -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackStream a -> ByteString -> Either PackStreamError a
forall a. PackStream a -> ByteString -> Either PackStreamError a
unpackStream PackStream a
forall a. PackStreamValue a => PackStream a
unpack

-- |Unpack some value of the specific type from 'ByteString' or 'fail'
unpackFail :: (MonadFail m, PackStreamValue a) => ByteString -> m a
unpackFail :: ByteString -> m a
unpackFail ByteString
bs = case PackStream a -> ByteString -> Either PackStreamError a
forall a. PackStream a -> ByteString -> Either PackStreamError a
unpackStream PackStream a
forall a. PackStreamValue a => PackStream a
unpack ByteString
bs of
                  Right a
x -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
                  Left  PackStreamError
e -> String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ PackStreamError -> String
forall a. Show a => a -> String
show PackStreamError
e

-- |Extract a value of a specific type from 'Value' dictionary
at :: (MonadError PackStreamError m, FromValue a) => Map Text Value -> Text -> m a
at :: Map Text Value -> Text -> m a
at Map Text Value
dict Text
key = case Text
key Text -> Map Text Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
`lookup` Map Text Value
dict of
                Just Value
val -> Either PackStreamError a -> m a
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either PackStreamError a -> m a)
-> Either PackStreamError a -> m a
forall a b. (a -> b) -> a -> b
$ Value -> Either PackStreamError a
forall a. FromValue a => Value -> Either PackStreamError a
fromValue Value
val
                Maybe Value
Nothing  -> PackStreamError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PackStreamError -> m a) -> PackStreamError -> m a
forall a b. (a -> b) -> a -> b
$ Text -> PackStreamError
DictHasNoKey Text
key