{-# LANGUAGE IncoherentInstances  #-}
{-# LANGUAGE OverloadedLists      #-}

-- | Core PackStream AST: the 'Ps' type and the 'PackStream' type class for
-- converting between Haskell types and PackStream values.
--
-- Specification: <https://neo4j.com/docs/bolt/current/packstream/>
module Data.PackStream.Ps
    ( -- * Core types
      Tag
    , Ps(..)
    , structFromDict
    , structureSingleton
      -- * PackStream class
    , PackStream(..)
      -- * Operators
    , (.:), (.=)
      -- * Accessors
    , getPs, putPs
      -- * Type matching
    , typeMismatch
    , withNull, withBoolean, withInteger, withFloat
    , withBytes, withString, withList, withDictionary
    ) where

import           Compat.Prelude
import           Prelude                       hiding (putStr)

import qualified Data.ByteString               as S
import qualified Data.ByteString.Lazy          as L
import qualified Data.ByteString.Short         as SBS
import qualified Data.HashMap.Strict           as HashMap
import           Data.Kind                     (Constraint, Type)
import           Data.List.NonEmpty            (NonEmpty)
import qualified Data.List.NonEmpty            as NEL
import qualified Data.Text                     as T
import qualified Data.Text.Lazy                as LT
import           Data.Typeable
import qualified Data.Vector                   as V
import qualified Data.HashMap.Lazy             as H

import           Data.PackStream.Get.Internal
import           Data.PackStream.Integer
import           Data.PackStream.Put
import           Data.PackStream.Result
import           Data.PackStream.Tags ()

import           Compat.Binary
import           TextShow (showt)


-- | Structure tag byte identifying a PackStream structure type.
type Tag :: Type
type Tag = Word8

-- | A PackStream value. This is the intermediate AST used for serialization.
type Ps :: Type
data Ps
  = PsNull
    -- ^ missing or empty value
  | PsBoolean !Bool
    -- ^ true or false
  | PsInteger !PSInteger
    -- ^ signed 64-bit integer
  | PsFloat !Double
    -- ^ 64-bit floating point number
  | PsBytes !S.ByteString
    -- ^ byte array
  | PsString !T.Text
    -- ^ unicode text, UTF-8
  | PsList !(V.Vector Ps)
    -- ^ ordered collection of values
  | PsDictionary !(H.HashMap T.Text Ps)
    -- ^ collection of key-value entries (no order guaranteed)
  | PsStructure !Tag !(V.Vector Ps)
    -- ^ composite value with a type signature
    --
    -- fields being a Vector is a bit wasteful, but the spec demands it
    -- in practice there is always just 1 field, which is a dictionary
    -- Control messages all use dictionaries: https://neo4j.com/docs/bolt/current/bolt/message/#messages
    -- Datatypes all use dictionaries: https://neo4j.com/docs/bolt/current/bolt/structure-semantics/
  deriving stock (Int -> Ps -> ShowS
[Ps] -> ShowS
Ps -> [Char]
(Int -> Ps -> ShowS)
-> (Ps -> [Char]) -> ([Ps] -> ShowS) -> Show Ps
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ps -> ShowS
showsPrec :: Int -> Ps -> ShowS
$cshow :: Ps -> [Char]
show :: Ps -> [Char]
$cshowList :: [Ps] -> ShowS
showList :: [Ps] -> ShowS
Show, Ps -> Ps -> Bool
(Ps -> Ps -> Bool) -> (Ps -> Ps -> Bool) -> Eq Ps
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ps -> Ps -> Bool
== :: Ps -> Ps -> Bool
$c/= :: Ps -> Ps -> Bool
/= :: Ps -> Ps -> Bool
Eq)

-- | Build a structure with a single dictionary field.
structFromDict :: Tag -> H.HashMap T.Text Ps -> Ps
structFromDict :: Word8 -> HashMap Text Ps -> Ps
structFromDict Word8
tag HashMap Text Ps
map = Word8 -> Vector Ps -> Ps
PsStructure Word8
tag (Vector Ps -> Ps) -> Vector Ps -> Ps
forall a b. (a -> b) -> a -> b
$ Ps -> Vector Ps
forall a. a -> Vector a
V.singleton (Ps -> Vector Ps) -> Ps -> Vector Ps
forall a b. (a -> b) -> a -> b
$ HashMap Text Ps -> Ps
PsDictionary HashMap Text Ps
map

-- | Build a structure with exactly one field.
structureSingleton :: Tag -> Ps -> Ps
structureSingleton :: Word8 -> Ps -> Ps
structureSingleton Word8
tag Ps
ps = Word8 -> Vector Ps -> Ps
PsStructure Word8
tag (Vector Ps -> Ps) -> Vector Ps -> Ps
forall a b. (a -> b) -> a -> b
$ Ps -> Vector Ps
forall a. a -> Vector a
V.singleton Ps
ps


-- | Look up a key in a 'PsDictionary' and decode the value.
(.:) :: PackStream a => Ps -> T.Text -> Result a
(PsDictionary HashMap Text Ps
m) .: :: forall a. PackStream a => Ps -> Text -> Result a
.: Text
key = case Text -> HashMap Text Ps -> Maybe Ps
forall k v. Hashable k => k -> HashMap k v -> Maybe v
H.lookup Text
key HashMap Text Ps
m of
  Maybe Ps
Nothing -> Text -> Result a
forall a. Text -> Result a
Error (Text -> Result a) -> Text -> Result a
forall a b. (a -> b) -> a -> b
$ Text
"missing key \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
  Just Ps
v -> Ps -> Result a
forall a. PackStream a => Ps -> Result a
fromPs Ps
v
Ps
m .: Text
_ = Text -> Result a
forall a. Text -> Result a
Error (Text -> Result a) -> Text -> Result a
forall a b. (a -> b) -> a -> b
$ (Text
"expected PsDictionary got " :: T.Text) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (TypeRep -> Text
forall a. TextShow a => a -> Text
showt (TypeRep -> Text) -> (Ps -> TypeRep) -> Ps -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ps -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (Ps -> Text) -> Ps -> Text
forall a b. (a -> b) -> a -> b
$ Ps
m)

-- | Build a key-value pair for constructing a 'PsDictionary'.
(.=) :: PackStream a => T.Text -> a -> (Ps, Ps)
Text
k .= :: forall a. PackStream a => Text -> a -> (Ps, Ps)
.= a
a = (Text -> Ps
PsString Text
k, a -> Ps
forall a. PackStream a => a -> Ps
toPs a
a)

instance NFData Ps where
  rnf :: Ps -> ()
rnf Ps
obj = case Ps
obj of
    PsList Vector Ps
a -> Vector Ps -> ()
forall a. NFData a => a -> ()
rnf Vector Ps
a
    PsDictionary   HashMap Text Ps
m -> HashMap Text Ps -> ()
forall a. NFData a => a -> ()
rnf HashMap Text Ps
m
    Ps
_             -> ()

-- | Decode any PackStream value from the binary stream.
getPs :: Get Ps
getPs :: Get Ps
getPs = do
  Word8
tag <- Get Word8
getWord8

  Word8 -> (() -> Ps) -> Get Ps -> Get Ps
forall a. Word8 -> (() -> a) -> Get a -> Get a
tryNull Word8
tag (Ps -> () -> Ps
forall a b. a -> b -> a
const Ps
PsNull) (Get Ps -> Get Ps) -> Get Ps -> Get Ps
forall a b. (a -> b) -> a -> b
$
    Word8 -> (Bool -> Ps) -> Get Ps -> Get Ps
forall a. Word8 -> (Bool -> a) -> Get a -> Get a
tryBoolean    Word8
tag Bool -> Ps
PsBoolean (Get Ps -> Get Ps) -> Get Ps -> Get Ps
forall a b. (a -> b) -> a -> b
$
    Word8 -> (PSInteger -> Ps) -> Get Ps -> Get Ps
forall a. Word8 -> (PSInteger -> a) -> Get a -> Get a
tryPSInteger  Word8
tag PSInteger -> Ps
PsInteger (Get Ps -> Get Ps) -> Get Ps -> Get Ps
forall a b. (a -> b) -> a -> b
$
    Word8 -> (Double -> Ps) -> Get Ps -> Get Ps
forall a. Word8 -> (Double -> a) -> Get a -> Get a
tryFloat      Word8
tag Double -> Ps
PsFloat (Get Ps -> Get Ps) -> Get Ps -> Get Ps
forall a b. (a -> b) -> a -> b
$
    Word8 -> (Text -> Ps) -> Get Ps -> Get Ps
forall a. Word8 -> (Text -> a) -> Get a -> Get a
tryString     Word8
tag Text -> Ps
PsString (Get Ps -> Get Ps) -> Get Ps -> Get Ps
forall a b. (a -> b) -> a -> b
$
    Word8 -> (ByteString -> Ps) -> Get Ps -> Get Ps
forall a. Word8 -> (ByteString -> a) -> Get a -> Get a
tryBytes      Word8
tag ByteString -> Ps
PsBytes (Get Ps -> Get Ps) -> Get Ps -> Get Ps
forall a b. (a -> b) -> a -> b
$
    Get Ps -> Word8 -> (Vector Ps -> Ps) -> Get Ps -> Get Ps
forall b a. Get b -> Word8 -> (Vector b -> a) -> Get a -> Get a
tryList Get Ps
getPs Word8
tag Vector Ps -> Ps
PsList (Get Ps -> Get Ps) -> Get Ps -> Get Ps
forall a b. (a -> b) -> a -> b
$
    Get Text
-> Get Ps -> Word8 -> (HashMap Text Ps -> Ps) -> Get Ps -> Get Ps
forall k v a.
Hashable k =>
Get k -> Get v -> Word8 -> (HashMap k v -> a) -> Get a -> Get a
tryDictionary Get Text
getString Get Ps
getPs Word8
tag HashMap Text Ps -> Ps
PsDictionary (Get Ps -> Get Ps) -> Get Ps -> Get Ps
forall a b. (a -> b) -> a -> b
$
    Get Ps -> Word8 -> ((Word8, Vector Ps) -> Ps) -> Get Ps -> Get Ps
forall b a.
Get b -> Word8 -> ((Word8, Vector b) -> a) -> Get a -> Get a
tryStructure Get Ps
getPs Word8
tag ((Word8 -> Vector Ps -> Ps) -> (Word8, Vector Ps) -> Ps
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Word8 -> Vector Ps -> Ps
PsStructure) (Get Ps -> Get Ps) -> Get Ps -> Get Ps
forall a b. (a -> b) -> a -> b
$
    [Char] -> Get Ps
forall a. [Char] -> Get a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"getPs: internal error " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
tag) -- should never happen

-- | Encode any PackStream value to the binary stream.
putPs :: Ps -> Put
putPs :: Ps -> Put
putPs = \case
  Ps
PsNull         -> Put
putNull
  PsBoolean    Bool
b -> Bool -> Put
putBoolean Bool
b
  PsInteger    PSInteger
n -> PSInteger -> Put
forall t. Persist t => t -> Put
put PSInteger
n
  PsFloat      Double
d -> Double -> Put
putFloat Double
d
  PsString     Text
t -> Text -> Put
putString Text
t
  PsBytes      ByteString
b -> ByteString -> Put
putBytes ByteString
b
  PsList       Vector Ps
a -> (Ps -> Put) -> Vector Ps -> Put
forall a. (a -> Put) -> Vector a -> Put
putList Ps -> Put
putPs Vector Ps
a
  PsDictionary HashMap Text Ps
m -> (Text -> Put) -> (Ps -> Put) -> HashMap Text Ps -> Put
forall a b. (a -> Put) -> (b -> Put) -> HashMap a b -> Put
putDictionary Text -> Put
putString Ps -> Put
putPs HashMap Text Ps
m
  PsStructure Word8
t Vector Ps
fs -> do
    let nfields :: Int
nfields = Vector Ps -> Int
forall a. Vector a -> Int
V.length Vector Ps
fs
    Word8 -> Put
putWord8 (Word8
0xB0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nfields)
    Word8 -> Put
putWord8 Word8
t
    (Ps -> Put) -> Vector Ps -> Put
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ Ps -> Put
putPs Vector Ps
fs

-- | This 'Persist' instance encodes\/decodes to\/from PackStream format
instance Persist Ps where
  get :: Get Ps
get = Get Ps
getPs
  put :: Ps -> Put
put = Ps -> Put
putPs

-- | Class for converting between PackStream 'Ps's and native Haskell types.
type PackStream :: Type -> Constraint
class PackStream a where
  toPs   :: a -> Ps

  -- | Encodes directly to 'Put' monad bypassing the intermediate 'Ps' AST
  --
  -- @since 1.1.0.0
  toBinary :: a -> Put
  toBinary = Ps -> Put
putPs (Ps -> Put) -> (a -> Ps) -> a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Ps
forall a. PackStream a => a -> Ps
toPs

  fromPs :: Ps -> Result a

-- core instances

-- | The trivial identity 'PackStream' instance
instance PackStream Ps where
  toPs :: Ps -> Ps
toPs = Ps -> Ps
forall a. a -> a
id
  toBinary :: Ps -> Put
toBinary = Ps -> Put
putPs
  fromPs :: Ps -> Result Ps
fromPs = Ps -> Result Ps
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Encodes as 'PsNull'
instance PackStream () where
  toPs :: () -> Ps
toPs ()
_ = Ps
PsNull
  toBinary :: () -> Put
toBinary ()
_ = Put
putNull
  fromPs :: Ps -> Result ()
fromPs = Text -> Result () -> Ps -> Result ()
forall a. Text -> Result a -> Ps -> Result a
withNull Text
"()" (() -> Result ()
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance PackStream Bool where
  toPs :: Bool -> Ps
toPs = Bool -> Ps
PsBoolean
  toBinary :: Bool -> Put
toBinary = Bool -> Put
putBoolean
  fromPs :: Ps -> Result Bool
fromPs = Text -> (Bool -> Result Bool) -> Ps -> Result Bool
forall a. Text -> (Bool -> Result a) -> Ps -> Result a
withBoolean Text
"Boolean" Bool -> Result Bool
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

----------------------------------------------------------------------------

instance PackStream PSInteger where
  toPs :: PSInteger -> Ps
toPs = PSInteger -> Ps
PsInteger
  toBinary :: PSInteger -> Put
toBinary = PSInteger -> Put
forall t. Persist t => t -> Put
put
  fromPs :: Ps -> Result PSInteger
fromPs = Text -> (PSInteger -> Result PSInteger) -> Ps -> Result PSInteger
forall a. Text -> (PSInteger -> Result a) -> Ps -> Result a
withInteger Text
"PSInteger" PSInteger -> Result PSInteger
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

fromPsInteger :: FromPSInteger i => T.Text -> Ps -> Result i
fromPsInteger :: forall i. FromPSInteger i => Text -> Ps -> Result i
fromPsInteger Text
expected = Text -> (PSInteger -> Result i) -> Ps -> Result i
forall a. Text -> (PSInteger -> Result a) -> Ps -> Result a
withInteger Text
expected PSInteger -> Result i
go
  where
    go :: PSInteger -> Result i
go PSInteger
j = case PSInteger -> Maybe i
forall a. FromPSInteger a => PSInteger -> Maybe a
fromPSInteger PSInteger
j of
      Just i
j' -> i -> Result i
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure i
j'
      Maybe i
Nothing -> [Char] -> Result i
forall a. [Char] -> Result a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Result i) -> [Char] -> Result i
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ Text
"PackStream integer " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PSInteger -> Text
forall a. TextShow a => a -> Text
showt PSInteger
j Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" cannot be decoded into " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
expected

instance PackStream Word32 where
  toPs :: Word32 -> Ps
toPs = PSInteger -> Ps
PsInteger (PSInteger -> Ps) -> (Word32 -> PSInteger) -> Word32 -> Ps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> PSInteger
forall a. ToPSInteger a => a -> PSInteger
toPSInteger
  toBinary :: Word32 -> Put
toBinary = PSInteger -> Put
forall t. Persist t => t -> Put
put (PSInteger -> Put) -> (Word32 -> PSInteger) -> Word32 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> PSInteger
forall a. ToPSInteger a => a -> PSInteger
toPSInteger
  fromPs :: Ps -> Result Word32
fromPs = Text -> Ps -> Result Word32
forall i. FromPSInteger i => Text -> Ps -> Result i
fromPsInteger Text
"Word32"

instance PackStream Word16 where
  toPs :: Word16 -> Ps
toPs = PSInteger -> Ps
PsInteger (PSInteger -> Ps) -> (Word16 -> PSInteger) -> Word16 -> Ps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> PSInteger
forall a. ToPSInteger a => a -> PSInteger
toPSInteger
  toBinary :: Word16 -> Put
toBinary = PSInteger -> Put
forall t. Persist t => t -> Put
put (PSInteger -> Put) -> (Word16 -> PSInteger) -> Word16 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> PSInteger
forall a. ToPSInteger a => a -> PSInteger
toPSInteger
  fromPs :: Ps -> Result Word16
fromPs = Text -> Ps -> Result Word16
forall i. FromPSInteger i => Text -> Ps -> Result i
fromPsInteger Text
"Word16"

instance PackStream Word8 where
  toPs :: Word8 -> Ps
toPs = PSInteger -> Ps
PsInteger (PSInteger -> Ps) -> (Word8 -> PSInteger) -> Word8 -> Ps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> PSInteger
forall a. ToPSInteger a => a -> PSInteger
toPSInteger
  toBinary :: Word8 -> Put
toBinary = PSInteger -> Put
forall t. Persist t => t -> Put
put (PSInteger -> Put) -> (Word8 -> PSInteger) -> Word8 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> PSInteger
forall a. ToPSInteger a => a -> PSInteger
toPSInteger
  fromPs :: Ps -> Result Word8
fromPs = Text -> Ps -> Result Word8
forall i. FromPSInteger i => Text -> Ps -> Result i
fromPsInteger Text
"Word8"

instance PackStream Int64 where
  toPs :: Int64 -> Ps
toPs = PSInteger -> Ps
PsInteger (PSInteger -> Ps) -> (Int64 -> PSInteger) -> Int64 -> Ps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> PSInteger
forall a. ToPSInteger a => a -> PSInteger
toPSInteger
  toBinary :: Int64 -> Put
toBinary = PSInteger -> Put
forall t. Persist t => t -> Put
put (PSInteger -> Put) -> (Int64 -> PSInteger) -> Int64 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> PSInteger
forall a. ToPSInteger a => a -> PSInteger
toPSInteger
  fromPs :: Ps -> Result Int64
fromPs = Text -> Ps -> Result Int64
forall i. FromPSInteger i => Text -> Ps -> Result i
fromPsInteger Text
"Int64"

instance PackStream Int32 where
  toPs :: Int32 -> Ps
toPs = PSInteger -> Ps
PsInteger (PSInteger -> Ps) -> (Int32 -> PSInteger) -> Int32 -> Ps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> PSInteger
forall a. ToPSInteger a => a -> PSInteger
toPSInteger
  toBinary :: Int32 -> Put
toBinary = PSInteger -> Put
forall t. Persist t => t -> Put
put (PSInteger -> Put) -> (Int32 -> PSInteger) -> Int32 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> PSInteger
forall a. ToPSInteger a => a -> PSInteger
toPSInteger
  fromPs :: Ps -> Result Int32
fromPs = Text -> Ps -> Result Int32
forall i. FromPSInteger i => Text -> Ps -> Result i
fromPsInteger Text
"Int32"

instance PackStream Int16 where
  toPs :: Int16 -> Ps
toPs = PSInteger -> Ps
PsInteger (PSInteger -> Ps) -> (Int16 -> PSInteger) -> Int16 -> Ps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> PSInteger
forall a. ToPSInteger a => a -> PSInteger
toPSInteger
  toBinary :: Int16 -> Put
toBinary = PSInteger -> Put
forall t. Persist t => t -> Put
put (PSInteger -> Put) -> (Int16 -> PSInteger) -> Int16 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> PSInteger
forall a. ToPSInteger a => a -> PSInteger
toPSInteger
  fromPs :: Ps -> Result Int16
fromPs = Text -> Ps -> Result Int16
forall i. FromPSInteger i => Text -> Ps -> Result i
fromPsInteger Text
"Int16"

instance PackStream Int8 where
  toPs :: Int8 -> Ps
toPs = PSInteger -> Ps
PsInteger (PSInteger -> Ps) -> (Int8 -> PSInteger) -> Int8 -> Ps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> PSInteger
forall a. ToPSInteger a => a -> PSInteger
toPSInteger
  toBinary :: Int8 -> Put
toBinary = PSInteger -> Put
forall t. Persist t => t -> Put
put (PSInteger -> Put) -> (Int8 -> PSInteger) -> Int8 -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> PSInteger
forall a. ToPSInteger a => a -> PSInteger
toPSInteger
  fromPs :: Ps -> Result Int8
fromPs = Text -> Ps -> Result Int8
forall i. FromPSInteger i => Text -> Ps -> Result i
fromPsInteger Text
"Int8"

instance PackStream Int where
  toPs :: Int -> Ps
toPs = PSInteger -> Ps
PsInteger (PSInteger -> Ps) -> (Int -> PSInteger) -> Int -> Ps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PSInteger
forall a. ToPSInteger a => a -> PSInteger
toPSInteger
  toBinary :: Int -> Put
toBinary = PSInteger -> Put
forall t. Persist t => t -> Put
put (PSInteger -> Put) -> (Int -> PSInteger) -> Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PSInteger
forall a. ToPSInteger a => a -> PSInteger
toPSInteger
  fromPs :: Ps -> Result Int
fromPs = Text -> Ps -> Result Int
forall i. FromPSInteger i => Text -> Ps -> Result i
fromPsInteger Text
"Int"

----------------------------------------------------------------------------

-- | This instance decodes 64bit and 32bit floats from PackStream streams into a 'Double'
instance PackStream Double where
  toPs :: Double -> Ps
toPs = Double -> Ps
PsFloat
  toBinary :: Double -> Put
toBinary = Double -> Put
putFloat
  fromPs :: Ps -> Result Double
fromPs = Text -> (Double -> Result Double) -> Ps -> Result Double
forall a. Text -> (Double -> Result a) -> Ps -> Result a
withFloat Text
"Double" Double -> Result Double
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance PackStream S.ByteString where
  toPs :: ByteString -> Ps
toPs = ByteString -> Ps
PsBytes
  toBinary :: ByteString -> Put
toBinary = ByteString -> Put
putBytes
  fromPs :: Ps -> Result ByteString
fromPs = Text
-> (ByteString -> Result ByteString) -> Ps -> Result ByteString
forall a. Text -> (ByteString -> Result a) -> Ps -> Result a
withBytes Text
"ByteString" ByteString -> Result ByteString
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- Because of overlapping instance, this must be above [a]
instance PackStream String where
  toPs :: [Char] -> Ps
toPs = Text -> Ps
forall a. PackStream a => a -> Ps
toPs (Text -> Ps) -> ([Char] -> Text) -> [Char] -> Ps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
  toBinary :: [Char] -> Put
toBinary = Text -> Put
putString (Text -> Put) -> ([Char] -> Text) -> [Char] -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack
  fromPs :: Ps -> Result [Char]
fromPs Ps
obj = Text -> [Char]
T.unpack (Text -> [Char]) -> Result Text -> Result [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ps -> Result Text
forall a. PackStream a => Ps -> Result a
fromPs Ps
obj

instance PackStream a => PackStream (V.Vector a) where
  toPs :: Vector a -> Ps
toPs = Vector Ps -> Ps
PsList (Vector Ps -> Ps) -> (Vector a -> Vector Ps) -> Vector a -> Ps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Ps) -> Vector a -> Vector Ps
forall a b. (a -> b) -> Vector a -> Vector b
V.map a -> Ps
forall a. PackStream a => a -> Ps
toPs
  toBinary :: Vector a -> Put
toBinary = (a -> Put) -> Vector a -> Put
forall a. (a -> Put) -> Vector a -> Put
putList a -> Put
forall a. PackStream a => a -> Put
toBinary
  fromPs :: Ps -> Result (Vector a)
fromPs = Text -> (Vector Ps -> Result (Vector a)) -> Ps -> Result (Vector a)
forall a. Text -> (Vector Ps -> Result a) -> Ps -> Result a
withList Text
"Vector" ((Ps -> Result a) -> Vector Ps -> Result (Vector a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Vector a -> f (Vector b)
traverse Ps -> Result a
forall a. PackStream a => Ps -> Result a
fromPs)



-- | 'Maybe's are encoded as nullable types, i.e. 'Nothing' is encoded as @nil@.
--
-- __NOTE__: Encoding nested 'Maybe's or 'Maybe's enclosing types which encode to @nil@ (such as '()') will break round-tripping
instance PackStream a => PackStream (Maybe a) where
  toPs :: Maybe a -> Ps
toPs = \case
    Just a
a  -> a -> Ps
forall a. PackStream a => a -> Ps
toPs a
a
    Maybe a
Nothing -> Ps
PsNull
  toBinary :: Maybe a -> Put
toBinary = \case
    Just a
a  -> a -> Put
forall a. PackStream a => a -> Put
toBinary a
a
    Maybe a
Nothing -> Put
putNull

  fromPs :: Ps -> Result (Maybe a)
fromPs = \case
    Ps
PsNull -> Maybe a -> Result (Maybe a)
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    Ps
obj       -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Result a -> Result (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ps -> Result a
forall a. PackStream a => Ps -> Result a
fromPs Ps
obj

-- UTF8 string like

instance PackStream L.ByteString where
  toPs :: ByteString -> Ps
toPs = ByteString -> Ps
PsBytes (ByteString -> Ps)
-> (ByteString -> ByteString) -> ByteString -> Ps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.toStrict
  toBinary :: ByteString -> Put
toBinary = ByteString -> Put
putBytes (ByteString -> Put)
-> (ByteString -> ByteString) -> ByteString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.toStrict
  fromPs :: Ps -> Result ByteString
fromPs Ps
obj = ByteString -> ByteString
L.fromStrict (ByteString -> ByteString)
-> Result ByteString -> Result ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ps -> Result ByteString
forall a. PackStream a => Ps -> Result a
fromPs Ps
obj

instance PackStream SBS.ShortByteString where
  toPs :: ShortByteString -> Ps
toPs = ByteString -> Ps
PsBytes (ByteString -> Ps)
-> (ShortByteString -> ByteString) -> ShortByteString -> Ps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort
  toBinary :: ShortByteString -> Put
toBinary = ByteString -> Put
putBytes (ByteString -> Put)
-> (ShortByteString -> ByteString) -> ShortByteString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort
  fromPs :: Ps -> Result ShortByteString
fromPs Ps
obj = ByteString -> ShortByteString
SBS.toShort (ByteString -> ShortByteString)
-> Result ByteString -> Result ShortByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ps -> Result ByteString
forall a. PackStream a => Ps -> Result a
fromPs Ps
obj

instance PackStream T.Text where
  toPs :: Text -> Ps
toPs = Text -> Ps
PsString
  toBinary :: Text -> Put
toBinary = Text -> Put
putString
  fromPs :: Ps -> Result Text
fromPs = Text -> (Text -> Result Text) -> Ps -> Result Text
forall a. Text -> (Text -> Result a) -> Ps -> Result a
withString Text
"Text" Text -> Result Text
forall a. a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance PackStream LT.Text where
  toPs :: Text -> Ps
toPs = Text -> Ps
forall a. PackStream a => a -> Ps
toPs (Text -> Ps) -> (Text -> Text) -> Text -> Ps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.toStrict
  toBinary :: Text -> Put
toBinary = Text -> Put
putString (Text -> Put) -> (Text -> Text) -> Text -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.toStrict
  fromPs :: Ps -> Result Text
fromPs Ps
obj = Text -> Text
LT.fromStrict (Text -> Text) -> Result Text -> Result Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ps -> Result Text
forall a. PackStream a => Ps -> Result a
fromPs Ps
obj

-- array like

instance PackStream a => PackStream [a] where
  toPs :: [a] -> Ps
toPs = Vector a -> Ps
forall a. PackStream a => a -> Ps
toPs (Vector a -> Ps) -> ([a] -> Vector a) -> [a] -> Ps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Vector a
forall a. [a] -> Vector a
V.fromList
  toBinary :: [a] -> Put
toBinary = (a -> Put) -> Vector a -> Put
forall a. (a -> Put) -> Vector a -> Put
putList a -> Put
forall a. PackStream a => a -> Put
toBinary (Vector a -> Put) -> ([a] -> Vector a) -> [a] -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Vector a
forall a. [a] -> Vector a
V.fromList
  fromPs :: Ps -> Result [a]
fromPs Ps
obj = Vector a -> [a]
forall a. Vector a -> [a]
V.toList (Vector a -> [a]) -> Result (Vector a) -> Result [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ps -> Result (Vector a)
forall a. PackStream a => Ps -> Result a
fromPs Ps
obj

instance PackStream a => PackStream (NonEmpty a) where
  toPs :: NonEmpty a -> Ps
toPs = [a] -> Ps
forall a. PackStream a => a -> Ps
toPs ([a] -> Ps) -> (NonEmpty a -> [a]) -> NonEmpty a -> Ps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NEL.toList
  toBinary :: NonEmpty a -> Put
toBinary = [a] -> Put
forall a. PackStream a => a -> Put
toBinary ([a] -> Put) -> (NonEmpty a -> [a]) -> NonEmpty a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NEL.toList
  fromPs :: Ps -> Result (NonEmpty a)
fromPs Ps
o = do
    [a]
lst <- Ps -> Result [a]
forall a. PackStream a => Ps -> Result a
fromPs Ps
o
    case [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty [a]
lst of
      Just NonEmpty a
as -> NonEmpty a -> Result (NonEmpty a)
forall a. a -> Result a
Success NonEmpty a
as
      Maybe (NonEmpty a)
Nothing -> Text -> Result (NonEmpty a)
forall a. Text -> Result a
Error Text
"empty list"

-- dictionary like

instance (PackStream v) => PackStream (HashMap.HashMap T.Text v) where
  toPs :: HashMap Text v -> Ps
toPs = HashMap Text Ps -> Ps
PsDictionary (HashMap Text Ps -> Ps)
-> (HashMap Text v -> HashMap Text Ps) -> HashMap Text v -> Ps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> Ps) -> HashMap Text v -> HashMap Text Ps
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
H.map v -> Ps
forall a. PackStream a => a -> Ps
toPs
  toBinary :: HashMap Text v -> Put
toBinary = (Text -> Put) -> (v -> Put) -> HashMap Text v -> Put
forall a b. (a -> Put) -> (b -> Put) -> HashMap a b -> Put
putDictionary Text -> Put
putString v -> Put
forall a. PackStream a => a -> Put
toBinary (HashMap Text v -> Put)
-> (HashMap Text v -> HashMap Text v) -> HashMap Text v -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, v)] -> HashMap Text v
forall k v. Hashable k => [(k, v)] -> HashMap k v
H.fromList ([(Text, v)] -> HashMap Text v)
-> (HashMap Text v -> [(Text, v)])
-> HashMap Text v
-> HashMap Text v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text v -> [(Text, v)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList
  fromPs :: Ps -> Result (HashMap Text v)
fromPs = Text
-> (HashMap Text Ps -> Result (HashMap Text v))
-> Ps
-> Result (HashMap Text v)
forall a. Text -> (HashMap Text Ps -> Result a) -> Ps -> Result a
withDictionary Text
"HashMap" ((Ps -> Result v) -> HashMap Text Ps -> Result (HashMap Text v)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HashMap Text a -> f (HashMap Text b)
traverse Ps -> Result v
forall a. PackStream a => Ps -> Result a
fromPs)



-- tuples

instance (PackStream a1, PackStream a2) => PackStream (a1, a2) where
  toPs :: (a1, a2) -> Ps
toPs (a1
a1, a2
a2) = Vector Ps -> Ps
PsList [a1 -> Ps
forall a. PackStream a => a -> Ps
toPs a1
a1, a2 -> Ps
forall a. PackStream a => a -> Ps
toPs a2
a2]
  toBinary :: (a1, a2) -> Put
toBinary (a1
a1, a2
a2) = Word32 -> Put -> Put
putList' Word32
2 (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ do { a1 -> Put
forall a. PackStream a => a -> Put
toBinary a1
a1; a2 -> Put
forall a. PackStream a => a -> Put
toBinary a2
a2 }
  fromPs :: Ps -> Result (a1, a2)
fromPs (PsList [Item (Vector Ps)
a1, Item (Vector Ps)
a2]) = (,) (a1 -> a2 -> (a1, a2)) -> Result a1 -> Result (a2 -> (a1, a2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ps -> Result a1
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a1 Result (a2 -> (a1, a2)) -> Result a2 -> Result (a1, a2)
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a2
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a2
  fromPs Ps
obj                    = Text -> Ps -> Result (a1, a2)
forall a. Text -> Ps -> Result a
typeMismatch Text
"2-tuple" Ps
obj

instance (PackStream a1, PackStream a2, PackStream a3) => PackStream (a1, a2, a3) where
  toPs :: (a1, a2, a3) -> Ps
toPs (a1
a1, a2
a2, a3
a3) = Vector Ps -> Ps
PsList [a1 -> Ps
forall a. PackStream a => a -> Ps
toPs a1
a1, a2 -> Ps
forall a. PackStream a => a -> Ps
toPs a2
a2, a3 -> Ps
forall a. PackStream a => a -> Ps
toPs a3
a3]
  toBinary :: (a1, a2, a3) -> Put
toBinary (a1
a1, a2
a2, a3
a3) = Word32 -> Put -> Put
putList' Word32
3 (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ do { a1 -> Put
forall a. PackStream a => a -> Put
toBinary a1
a1; a2 -> Put
forall a. PackStream a => a -> Put
toBinary a2
a2; a3 -> Put
forall a. PackStream a => a -> Put
toBinary a3
a3 }
  fromPs :: Ps -> Result (a1, a2, a3)
fromPs (PsList [Item (Vector Ps)
a1, Item (Vector Ps)
a2, Item (Vector Ps)
a3]) = (,,) (a1 -> a2 -> a3 -> (a1, a2, a3))
-> Result a1 -> Result (a2 -> a3 -> (a1, a2, a3))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ps -> Result a1
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a1 Result (a2 -> a3 -> (a1, a2, a3))
-> Result a2 -> Result (a3 -> (a1, a2, a3))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a2
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a2 Result (a3 -> (a1, a2, a3)) -> Result a3 -> Result (a1, a2, a3)
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a3
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a3
  fromPs Ps
obj = Text -> Ps -> Result (a1, a2, a3)
forall a. Text -> Ps -> Result a
typeMismatch Text
"3-tuple" Ps
obj

instance (PackStream a1, PackStream a2, PackStream a3, PackStream a4) => PackStream (a1, a2, a3, a4) where
  toPs :: (a1, a2, a3, a4) -> Ps
toPs (a1
a1, a2
a2, a3
a3, a4
a4) = Vector Ps -> Ps
PsList [a1 -> Ps
forall a. PackStream a => a -> Ps
toPs a1
a1, a2 -> Ps
forall a. PackStream a => a -> Ps
toPs a2
a2, a3 -> Ps
forall a. PackStream a => a -> Ps
toPs a3
a3, a4 -> Ps
forall a. PackStream a => a -> Ps
toPs a4
a4]
  toBinary :: (a1, a2, a3, a4) -> Put
toBinary (a1
a1, a2
a2, a3
a3, a4
a4) = Word32 -> Put -> Put
putList' Word32
4 (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ do { a1 -> Put
forall a. PackStream a => a -> Put
toBinary a1
a1; a2 -> Put
forall a. PackStream a => a -> Put
toBinary a2
a2; a3 -> Put
forall a. PackStream a => a -> Put
toBinary a3
a3; a4 -> Put
forall a. PackStream a => a -> Put
toBinary a4
a4 }
  fromPs :: Ps -> Result (a1, a2, a3, a4)
fromPs (PsList [Item (Vector Ps)
a1, Item (Vector Ps)
a2, Item (Vector Ps)
a3, Item (Vector Ps)
a4]) = (,,,) (a1 -> a2 -> a3 -> a4 -> (a1, a2, a3, a4))
-> Result a1 -> Result (a2 -> a3 -> a4 -> (a1, a2, a3, a4))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ps -> Result a1
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a1 Result (a2 -> a3 -> a4 -> (a1, a2, a3, a4))
-> Result a2 -> Result (a3 -> a4 -> (a1, a2, a3, a4))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a2
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a2 Result (a3 -> a4 -> (a1, a2, a3, a4))
-> Result a3 -> Result (a4 -> (a1, a2, a3, a4))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a3
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a3 Result (a4 -> (a1, a2, a3, a4))
-> Result a4 -> Result (a1, a2, a3, a4)
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a4
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a4
  fromPs Ps
obj = Text -> Ps -> Result (a1, a2, a3, a4)
forall a. Text -> Ps -> Result a
typeMismatch Text
"4-tuple" Ps
obj

instance (PackStream a1, PackStream a2, PackStream a3, PackStream a4, PackStream a5) => PackStream (a1, a2, a3, a4, a5) where
  toPs :: (a1, a2, a3, a4, a5) -> Ps
toPs (a1
a1, a2
a2, a3
a3, a4
a4, a5
a5) = Vector Ps -> Ps
PsList [a1 -> Ps
forall a. PackStream a => a -> Ps
toPs a1
a1, a2 -> Ps
forall a. PackStream a => a -> Ps
toPs a2
a2, a3 -> Ps
forall a. PackStream a => a -> Ps
toPs a3
a3, a4 -> Ps
forall a. PackStream a => a -> Ps
toPs a4
a4, a5 -> Ps
forall a. PackStream a => a -> Ps
toPs a5
a5]
  toBinary :: (a1, a2, a3, a4, a5) -> Put
toBinary (a1
a1, a2
a2, a3
a3, a4
a4, a5
a5) = Word32 -> Put -> Put
putList' Word32
5 (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ do { a1 -> Put
forall a. PackStream a => a -> Put
toBinary a1
a1; a2 -> Put
forall a. PackStream a => a -> Put
toBinary a2
a2; a3 -> Put
forall a. PackStream a => a -> Put
toBinary a3
a3; a4 -> Put
forall a. PackStream a => a -> Put
toBinary a4
a4; a5 -> Put
forall a. PackStream a => a -> Put
toBinary a5
a5 }
  fromPs :: Ps -> Result (a1, a2, a3, a4, a5)
fromPs (PsList [Item (Vector Ps)
a1, Item (Vector Ps)
a2, Item (Vector Ps)
a3, Item (Vector Ps)
a4, Item (Vector Ps)
a5]) = (,,,,) (a1 -> a2 -> a3 -> a4 -> a5 -> (a1, a2, a3, a4, a5))
-> Result a1
-> Result (a2 -> a3 -> a4 -> a5 -> (a1, a2, a3, a4, a5))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ps -> Result a1
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a1 Result (a2 -> a3 -> a4 -> a5 -> (a1, a2, a3, a4, a5))
-> Result a2 -> Result (a3 -> a4 -> a5 -> (a1, a2, a3, a4, a5))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a2
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a2 Result (a3 -> a4 -> a5 -> (a1, a2, a3, a4, a5))
-> Result a3 -> Result (a4 -> a5 -> (a1, a2, a3, a4, a5))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a3
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a3 Result (a4 -> a5 -> (a1, a2, a3, a4, a5))
-> Result a4 -> Result (a5 -> (a1, a2, a3, a4, a5))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a4
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a4 Result (a5 -> (a1, a2, a3, a4, a5))
-> Result a5 -> Result (a1, a2, a3, a4, a5)
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a5
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a5
  fromPs Ps
obj = Text -> Ps -> Result (a1, a2, a3, a4, a5)
forall a. Text -> Ps -> Result a
typeMismatch Text
"5-tuple" Ps
obj

instance (PackStream a1, PackStream a2, PackStream a3, PackStream a4, PackStream a5, PackStream a6) => PackStream (a1, a2, a3, a4, a5, a6) where
  toPs :: (a1, a2, a3, a4, a5, a6) -> Ps
toPs (a1
a1, a2
a2, a3
a3, a4
a4, a5
a5, a6
a6) = Vector Ps -> Ps
PsList [a1 -> Ps
forall a. PackStream a => a -> Ps
toPs a1
a1, a2 -> Ps
forall a. PackStream a => a -> Ps
toPs a2
a2, a3 -> Ps
forall a. PackStream a => a -> Ps
toPs a3
a3, a4 -> Ps
forall a. PackStream a => a -> Ps
toPs a4
a4, a5 -> Ps
forall a. PackStream a => a -> Ps
toPs a5
a5, a6 -> Ps
forall a. PackStream a => a -> Ps
toPs a6
a6]
  toBinary :: (a1, a2, a3, a4, a5, a6) -> Put
toBinary (a1
a1, a2
a2, a3
a3, a4
a4, a5
a5, a6
a6) = Word32 -> Put -> Put
putList' Word32
6 (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ do { a1 -> Put
forall a. PackStream a => a -> Put
toBinary a1
a1; a2 -> Put
forall a. PackStream a => a -> Put
toBinary a2
a2; a3 -> Put
forall a. PackStream a => a -> Put
toBinary a3
a3; a4 -> Put
forall a. PackStream a => a -> Put
toBinary a4
a4; a5 -> Put
forall a. PackStream a => a -> Put
toBinary a5
a5; a6 -> Put
forall a. PackStream a => a -> Put
toBinary a6
a6 }
  fromPs :: Ps -> Result (a1, a2, a3, a4, a5, a6)
fromPs (PsList [Item (Vector Ps)
a1, Item (Vector Ps)
a2, Item (Vector Ps)
a3, Item (Vector Ps)
a4, Item (Vector Ps)
a5, Item (Vector Ps)
a6]) = (,,,,,) (a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> (a1, a2, a3, a4, a5, a6))
-> Result a1
-> Result (a2 -> a3 -> a4 -> a5 -> a6 -> (a1, a2, a3, a4, a5, a6))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ps -> Result a1
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a1 Result (a2 -> a3 -> a4 -> a5 -> a6 -> (a1, a2, a3, a4, a5, a6))
-> Result a2
-> Result (a3 -> a4 -> a5 -> a6 -> (a1, a2, a3, a4, a5, a6))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a2
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a2 Result (a3 -> a4 -> a5 -> a6 -> (a1, a2, a3, a4, a5, a6))
-> Result a3 -> Result (a4 -> a5 -> a6 -> (a1, a2, a3, a4, a5, a6))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a3
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a3 Result (a4 -> a5 -> a6 -> (a1, a2, a3, a4, a5, a6))
-> Result a4 -> Result (a5 -> a6 -> (a1, a2, a3, a4, a5, a6))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a4
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a4 Result (a5 -> a6 -> (a1, a2, a3, a4, a5, a6))
-> Result a5 -> Result (a6 -> (a1, a2, a3, a4, a5, a6))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a5
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a5 Result (a6 -> (a1, a2, a3, a4, a5, a6))
-> Result a6 -> Result (a1, a2, a3, a4, a5, a6)
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a6
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a6
  fromPs Ps
obj = Text -> Ps -> Result (a1, a2, a3, a4, a5, a6)
forall a. Text -> Ps -> Result a
typeMismatch Text
"6-tuple" Ps
obj

instance (PackStream a1, PackStream a2, PackStream a3, PackStream a4, PackStream a5, PackStream a6, PackStream a7) => PackStream (a1, a2, a3, a4, a5, a6, a7) where
  toPs :: (a1, a2, a3, a4, a5, a6, a7) -> Ps
toPs (a1
a1, a2
a2, a3
a3, a4
a4, a5
a5, a6
a6, a7
a7) = Vector Ps -> Ps
PsList [a1 -> Ps
forall a. PackStream a => a -> Ps
toPs a1
a1, a2 -> Ps
forall a. PackStream a => a -> Ps
toPs a2
a2, a3 -> Ps
forall a. PackStream a => a -> Ps
toPs a3
a3, a4 -> Ps
forall a. PackStream a => a -> Ps
toPs a4
a4, a5 -> Ps
forall a. PackStream a => a -> Ps
toPs a5
a5, a6 -> Ps
forall a. PackStream a => a -> Ps
toPs a6
a6, a7 -> Ps
forall a. PackStream a => a -> Ps
toPs a7
a7]
  toBinary :: (a1, a2, a3, a4, a5, a6, a7) -> Put
toBinary (a1
a1, a2
a2, a3
a3, a4
a4, a5
a5, a6
a6, a7
a7) = Word32 -> Put -> Put
putList' Word32
7 (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ do { a1 -> Put
forall a. PackStream a => a -> Put
toBinary a1
a1; a2 -> Put
forall a. PackStream a => a -> Put
toBinary a2
a2; a3 -> Put
forall a. PackStream a => a -> Put
toBinary a3
a3; a4 -> Put
forall a. PackStream a => a -> Put
toBinary a4
a4; a5 -> Put
forall a. PackStream a => a -> Put
toBinary a5
a5; a6 -> Put
forall a. PackStream a => a -> Put
toBinary a6
a6; a7 -> Put
forall a. PackStream a => a -> Put
toBinary a7
a7 }
  fromPs :: Ps -> Result (a1, a2, a3, a4, a5, a6, a7)
fromPs (PsList [Item (Vector Ps)
a1, Item (Vector Ps)
a2, Item (Vector Ps)
a3, Item (Vector Ps)
a4, Item (Vector Ps)
a5, Item (Vector Ps)
a6, Item (Vector Ps)
a7]) = (,,,,,,) (a1
 -> a2
 -> a3
 -> a4
 -> a5
 -> a6
 -> a7
 -> (a1, a2, a3, a4, a5, a6, a7))
-> Result a1
-> Result
     (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> (a1, a2, a3, a4, a5, a6, a7))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ps -> Result a1
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a1 Result
  (a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> (a1, a2, a3, a4, a5, a6, a7))
-> Result a2
-> Result
     (a3 -> a4 -> a5 -> a6 -> a7 -> (a1, a2, a3, a4, a5, a6, a7))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a2
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a2 Result (a3 -> a4 -> a5 -> a6 -> a7 -> (a1, a2, a3, a4, a5, a6, a7))
-> Result a3
-> Result (a4 -> a5 -> a6 -> a7 -> (a1, a2, a3, a4, a5, a6, a7))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a3
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a3 Result (a4 -> a5 -> a6 -> a7 -> (a1, a2, a3, a4, a5, a6, a7))
-> Result a4
-> Result (a5 -> a6 -> a7 -> (a1, a2, a3, a4, a5, a6, a7))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a4
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a4 Result (a5 -> a6 -> a7 -> (a1, a2, a3, a4, a5, a6, a7))
-> Result a5 -> Result (a6 -> a7 -> (a1, a2, a3, a4, a5, a6, a7))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a5
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a5 Result (a6 -> a7 -> (a1, a2, a3, a4, a5, a6, a7))
-> Result a6 -> Result (a7 -> (a1, a2, a3, a4, a5, a6, a7))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a6
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a6 Result (a7 -> (a1, a2, a3, a4, a5, a6, a7))
-> Result a7 -> Result (a1, a2, a3, a4, a5, a6, a7)
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a7
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a7
  fromPs Ps
obj = Text -> Ps -> Result (a1, a2, a3, a4, a5, a6, a7)
forall a. Text -> Ps -> Result a
typeMismatch Text
"7-tuple" Ps
obj

instance (PackStream a1, PackStream a2, PackStream a3, PackStream a4, PackStream a5, PackStream a6, PackStream a7, PackStream a8) => PackStream (a1, a2, a3, a4, a5, a6, a7, a8) where
  toPs :: (a1, a2, a3, a4, a5, a6, a7, a8) -> Ps
toPs (a1
a1, a2
a2, a3
a3, a4
a4, a5
a5, a6
a6, a7
a7, a8
a8) = Vector Ps -> Ps
PsList [a1 -> Ps
forall a. PackStream a => a -> Ps
toPs a1
a1, a2 -> Ps
forall a. PackStream a => a -> Ps
toPs a2
a2, a3 -> Ps
forall a. PackStream a => a -> Ps
toPs a3
a3, a4 -> Ps
forall a. PackStream a => a -> Ps
toPs a4
a4, a5 -> Ps
forall a. PackStream a => a -> Ps
toPs a5
a5, a6 -> Ps
forall a. PackStream a => a -> Ps
toPs a6
a6, a7 -> Ps
forall a. PackStream a => a -> Ps
toPs a7
a7, a8 -> Ps
forall a. PackStream a => a -> Ps
toPs a8
a8]
  toBinary :: (a1, a2, a3, a4, a5, a6, a7, a8) -> Put
toBinary (a1
a1, a2
a2, a3
a3, a4
a4, a5
a5, a6
a6, a7
a7, a8
a8) = Word32 -> Put -> Put
putList' Word32
8 (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ do { a1 -> Put
forall a. PackStream a => a -> Put
toBinary a1
a1; a2 -> Put
forall a. PackStream a => a -> Put
toBinary a2
a2; a3 -> Put
forall a. PackStream a => a -> Put
toBinary a3
a3; a4 -> Put
forall a. PackStream a => a -> Put
toBinary a4
a4; a5 -> Put
forall a. PackStream a => a -> Put
toBinary a5
a5; a6 -> Put
forall a. PackStream a => a -> Put
toBinary a6
a6; a7 -> Put
forall a. PackStream a => a -> Put
toBinary a7
a7; a8 -> Put
forall a. PackStream a => a -> Put
toBinary a8
a8 }
  fromPs :: Ps -> Result (a1, a2, a3, a4, a5, a6, a7, a8)
fromPs (PsList [Item (Vector Ps)
a1, Item (Vector Ps)
a2, Item (Vector Ps)
a3, Item (Vector Ps)
a4, Item (Vector Ps)
a5, Item (Vector Ps)
a6, Item (Vector Ps)
a7, Item (Vector Ps)
a8]) = (,,,,,,,) (a1
 -> a2
 -> a3
 -> a4
 -> a5
 -> a6
 -> a7
 -> a8
 -> (a1, a2, a3, a4, a5, a6, a7, a8))
-> Result a1
-> Result
     (a2
      -> a3
      -> a4
      -> a5
      -> a6
      -> a7
      -> a8
      -> (a1, a2, a3, a4, a5, a6, a7, a8))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ps -> Result a1
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a1 Result
  (a2
   -> a3
   -> a4
   -> a5
   -> a6
   -> a7
   -> a8
   -> (a1, a2, a3, a4, a5, a6, a7, a8))
-> Result a2
-> Result
     (a3
      -> a4 -> a5 -> a6 -> a7 -> a8 -> (a1, a2, a3, a4, a5, a6, a7, a8))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a2
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a2 Result
  (a3
   -> a4 -> a5 -> a6 -> a7 -> a8 -> (a1, a2, a3, a4, a5, a6, a7, a8))
-> Result a3
-> Result
     (a4 -> a5 -> a6 -> a7 -> a8 -> (a1, a2, a3, a4, a5, a6, a7, a8))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a3
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a3 Result
  (a4 -> a5 -> a6 -> a7 -> a8 -> (a1, a2, a3, a4, a5, a6, a7, a8))
-> Result a4
-> Result
     (a5 -> a6 -> a7 -> a8 -> (a1, a2, a3, a4, a5, a6, a7, a8))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a4
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a4 Result (a5 -> a6 -> a7 -> a8 -> (a1, a2, a3, a4, a5, a6, a7, a8))
-> Result a5
-> Result (a6 -> a7 -> a8 -> (a1, a2, a3, a4, a5, a6, a7, a8))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a5
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a5 Result (a6 -> a7 -> a8 -> (a1, a2, a3, a4, a5, a6, a7, a8))
-> Result a6
-> Result (a7 -> a8 -> (a1, a2, a3, a4, a5, a6, a7, a8))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a6
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a6 Result (a7 -> a8 -> (a1, a2, a3, a4, a5, a6, a7, a8))
-> Result a7 -> Result (a8 -> (a1, a2, a3, a4, a5, a6, a7, a8))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a7
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a7 Result (a8 -> (a1, a2, a3, a4, a5, a6, a7, a8))
-> Result a8 -> Result (a1, a2, a3, a4, a5, a6, a7, a8)
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a8
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a8
  fromPs Ps
obj = Text -> Ps -> Result (a1, a2, a3, a4, a5, a6, a7, a8)
forall a. Text -> Ps -> Result a
typeMismatch Text
"8-tuple" Ps
obj

instance (PackStream a1, PackStream a2, PackStream a3, PackStream a4, PackStream a5, PackStream a6, PackStream a7, PackStream a8, PackStream a9) => PackStream (a1, a2, a3, a4, a5, a6, a7, a8, a9) where
  toPs :: (a1, a2, a3, a4, a5, a6, a7, a8, a9) -> Ps
toPs (a1
a1, a2
a2, a3
a3, a4
a4, a5
a5, a6
a6, a7
a7, a8
a8, a9
a9) = Vector Ps -> Ps
PsList [a1 -> Ps
forall a. PackStream a => a -> Ps
toPs a1
a1, a2 -> Ps
forall a. PackStream a => a -> Ps
toPs a2
a2, a3 -> Ps
forall a. PackStream a => a -> Ps
toPs a3
a3, a4 -> Ps
forall a. PackStream a => a -> Ps
toPs a4
a4, a5 -> Ps
forall a. PackStream a => a -> Ps
toPs a5
a5, a6 -> Ps
forall a. PackStream a => a -> Ps
toPs a6
a6, a7 -> Ps
forall a. PackStream a => a -> Ps
toPs a7
a7, a8 -> Ps
forall a. PackStream a => a -> Ps
toPs a8
a8, a9 -> Ps
forall a. PackStream a => a -> Ps
toPs a9
a9]
  toBinary :: (a1, a2, a3, a4, a5, a6, a7, a8, a9) -> Put
toBinary (a1
a1, a2
a2, a3
a3, a4
a4, a5
a5, a6
a6, a7
a7, a8
a8, a9
a9) = Word32 -> Put -> Put
putList' Word32
8 (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ do { a1 -> Put
forall a. PackStream a => a -> Put
toBinary a1
a1; a2 -> Put
forall a. PackStream a => a -> Put
toBinary a2
a2; a3 -> Put
forall a. PackStream a => a -> Put
toBinary a3
a3; a4 -> Put
forall a. PackStream a => a -> Put
toBinary a4
a4; a5 -> Put
forall a. PackStream a => a -> Put
toBinary a5
a5; a6 -> Put
forall a. PackStream a => a -> Put
toBinary a6
a6; a7 -> Put
forall a. PackStream a => a -> Put
toBinary a7
a7; a8 -> Put
forall a. PackStream a => a -> Put
toBinary a8
a8; a9 -> Put
forall a. PackStream a => a -> Put
toBinary a9
a9 }
  fromPs :: Ps -> Result (a1, a2, a3, a4, a5, a6, a7, a8, a9)
fromPs (PsList [Item (Vector Ps)
a1, Item (Vector Ps)
a2, Item (Vector Ps)
a3, Item (Vector Ps)
a4, Item (Vector Ps)
a5, Item (Vector Ps)
a6, Item (Vector Ps)
a7, Item (Vector Ps)
a8, Item (Vector Ps)
a9]) = (,,,,,,,,) (a1
 -> a2
 -> a3
 -> a4
 -> a5
 -> a6
 -> a7
 -> a8
 -> a9
 -> (a1, a2, a3, a4, a5, a6, a7, a8, a9))
-> Result a1
-> Result
     (a2
      -> a3
      -> a4
      -> a5
      -> a6
      -> a7
      -> a8
      -> a9
      -> (a1, a2, a3, a4, a5, a6, a7, a8, a9))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ps -> Result a1
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a1 Result
  (a2
   -> a3
   -> a4
   -> a5
   -> a6
   -> a7
   -> a8
   -> a9
   -> (a1, a2, a3, a4, a5, a6, a7, a8, a9))
-> Result a2
-> Result
     (a3
      -> a4
      -> a5
      -> a6
      -> a7
      -> a8
      -> a9
      -> (a1, a2, a3, a4, a5, a6, a7, a8, a9))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a2
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a2 Result
  (a3
   -> a4
   -> a5
   -> a6
   -> a7
   -> a8
   -> a9
   -> (a1, a2, a3, a4, a5, a6, a7, a8, a9))
-> Result a3
-> Result
     (a4
      -> a5
      -> a6
      -> a7
      -> a8
      -> a9
      -> (a1, a2, a3, a4, a5, a6, a7, a8, a9))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a3
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a3 Result
  (a4
   -> a5
   -> a6
   -> a7
   -> a8
   -> a9
   -> (a1, a2, a3, a4, a5, a6, a7, a8, a9))
-> Result a4
-> Result
     (a5
      -> a6 -> a7 -> a8 -> a9 -> (a1, a2, a3, a4, a5, a6, a7, a8, a9))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a4
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a4 Result
  (a5
   -> a6 -> a7 -> a8 -> a9 -> (a1, a2, a3, a4, a5, a6, a7, a8, a9))
-> Result a5
-> Result
     (a6 -> a7 -> a8 -> a9 -> (a1, a2, a3, a4, a5, a6, a7, a8, a9))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a5
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a5 Result
  (a6 -> a7 -> a8 -> a9 -> (a1, a2, a3, a4, a5, a6, a7, a8, a9))
-> Result a6
-> Result (a7 -> a8 -> a9 -> (a1, a2, a3, a4, a5, a6, a7, a8, a9))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a6
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a6 Result (a7 -> a8 -> a9 -> (a1, a2, a3, a4, a5, a6, a7, a8, a9))
-> Result a7
-> Result (a8 -> a9 -> (a1, a2, a3, a4, a5, a6, a7, a8, a9))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a7
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a7 Result (a8 -> a9 -> (a1, a2, a3, a4, a5, a6, a7, a8, a9))
-> Result a8 -> Result (a9 -> (a1, a2, a3, a4, a5, a6, a7, a8, a9))
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a8
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a8 Result (a9 -> (a1, a2, a3, a4, a5, a6, a7, a8, a9))
-> Result a9 -> Result (a1, a2, a3, a4, a5, a6, a7, a8, a9)
forall a b. Result (a -> b) -> Result a -> Result b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ps -> Result a9
forall a. PackStream a => Ps -> Result a
fromPs Item (Vector Ps)
Ps
a9
  fromPs Ps
obj = Text -> Ps -> Result (a1, a2, a3, a4, a5, a6, a7, a8, a9)
forall a. Text -> Ps -> Result a
typeMismatch Text
"9-tuple" Ps
obj

-- | Report a type mismatch error for the expected type and actual 'Ps' value.
typeMismatch :: T.Text -> Ps -> Result a
typeMismatch :: forall a. Text -> Ps -> Result a
typeMismatch Text
expected Ps
obj = [Char] -> Result a
forall a. [Char] -> Result a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Result a) -> [Char] -> Result a
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Text
"PackStream " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
got Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" type cannot be decoded into " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
expected)
  where
    got :: Text
got = case Ps
obj of
      Ps
PsNull           -> Text
"nil"
      PsList Vector Ps
v         -> Text
"array[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. TextShow a => a -> Text
showt (Vector Ps -> Int
forall a. Vector a -> Int
V.length Vector Ps
v) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
      PsDictionary HashMap Text Ps
v   -> Text
"map[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. TextShow a => a -> Text
showt (HashMap Text Ps -> Int
forall k v. HashMap k v -> Int
H.size HashMap Text Ps
v) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
      PsString Text
_       -> Text
"str"
      PsBoolean Bool
_      -> Text
"bool"
      PsInteger PSInteger
_      -> Text
"int"
      PsFloat Double
_        -> Text
"float"
      PsBytes ByteString
_        -> Text
"bin"
      PsStructure Word8
ty Vector Ps
_ -> Text
"structure[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word8 -> Text
forall a. TextShow a => a -> Text
showt Word8
ty Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"

-- | Match a 'PsNull', or report a type mismatch.
withNull :: T.Text -> Result a -> Ps -> Result a
withNull :: forall a. Text -> Result a -> Ps -> Result a
withNull Text
_ Result a
f Ps
PsNull  = Result a
f
withNull Text
expected Result a
_ Ps
got = Text -> Ps -> Result a
forall a. Text -> Ps -> Result a
typeMismatch Text
expected Ps
got

-- | Match a 'PsBoolean', or report a type mismatch.
withBoolean :: T.Text -> (Bool -> Result a) -> Ps -> Result a
withBoolean :: forall a. Text -> (Bool -> Result a) -> Ps -> Result a
withBoolean Text
_ Bool -> Result a
f (PsBoolean Bool
b) = Bool -> Result a
f Bool
b
withBoolean Text
expected Bool -> Result a
_ Ps
got = Text -> Ps -> Result a
forall a. Text -> Ps -> Result a
typeMismatch Text
expected Ps
got

-- | Match a 'PsInteger', or report a type mismatch.
withInteger :: T.Text -> (PSInteger -> Result a) -> Ps -> Result a
withInteger :: forall a. Text -> (PSInteger -> Result a) -> Ps -> Result a
withInteger Text
_ PSInteger -> Result a
f (PsInteger PSInteger
i) = PSInteger -> Result a
f PSInteger
i
withInteger Text
expected PSInteger -> Result a
_ Ps
got = Text -> Ps -> Result a
forall a. Text -> Ps -> Result a
typeMismatch Text
expected Ps
got

-- | Match a 'PsFloat', or report a type mismatch.
withFloat :: T.Text -> (Double -> Result a) -> Ps -> Result a
withFloat :: forall a. Text -> (Double -> Result a) -> Ps -> Result a
withFloat Text
_ Double -> Result a
f (PsFloat Double
x) = Double -> Result a
f Double
x
withFloat Text
expected Double -> Result a
_ Ps
got   = Text -> Ps -> Result a
forall a. Text -> Ps -> Result a
typeMismatch Text
expected Ps
got

-- | Match a 'PsBytes', or report a type mismatch.
withBytes :: T.Text -> (S.ByteString -> Result a) -> Ps -> Result a
withBytes :: forall a. Text -> (ByteString -> Result a) -> Ps -> Result a
withBytes Text
_ ByteString -> Result a
f (PsBytes ByteString
i) = ByteString -> Result a
f ByteString
i
withBytes Text
expected ByteString -> Result a
_ Ps
got = Text -> Ps -> Result a
forall a. Text -> Ps -> Result a
typeMismatch Text
expected Ps
got

-- | Match a 'PsString', or report a type mismatch.
withString :: T.Text -> (T.Text -> Result a) -> Ps -> Result a
withString :: forall a. Text -> (Text -> Result a) -> Ps -> Result a
withString Text
_ Text -> Result a
f (PsString Text
i) = Text -> Result a
f Text
i
withString Text
expected Text -> Result a
_ Ps
got = Text -> Ps -> Result a
forall a. Text -> Ps -> Result a
typeMismatch Text
expected Ps
got

-- | Match a 'PsList', or report a type mismatch.
withList :: T.Text -> (V.Vector Ps -> Result a) -> Ps -> Result a
withList :: forall a. Text -> (Vector Ps -> Result a) -> Ps -> Result a
withList Text
_ Vector Ps -> Result a
f (PsList Vector Ps
xs) = Vector Ps -> Result a
f Vector Ps
xs
withList Text
expected Vector Ps -> Result a
_ Ps
got   = Text -> Ps -> Result a
forall a. Text -> Ps -> Result a
typeMismatch Text
expected Ps
got

-- | Match a 'PsDictionary', or report a type mismatch.
withDictionary :: T.Text -> (H.HashMap T.Text Ps -> Result a) -> Ps -> Result a
withDictionary :: forall a. Text -> (HashMap Text Ps -> Result a) -> Ps -> Result a
withDictionary Text
_ HashMap Text Ps -> Result a
f (PsDictionary HashMap Text Ps
xs) = HashMap Text Ps -> Result a
f HashMap Text Ps
xs
withDictionary Text
expected HashMap Text Ps -> Result a
_ Ps
got = Text -> Ps -> Result a
forall a. Text -> Ps -> Result a
typeMismatch Text
expected Ps
got