{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
#if __GLASGOW_HASKELL__ < 806
{-# LANGUAGE TypeInType #-}
#endif
module Codec.Winery.Class (Serialise(..)
  , VarInt(..)
  , BundleSerialise(..)
  , bundleRecord
  , bundleRecordDefault
  , bundleVariant
  , getSchema
  , schema
  , unexpectedSchema
  , mkExtractor
  , extractListBy
  , buildVariantExtractor
  , gschemaGenRecord
  , gtoBuilderRecord
  , gextractorRecord
  , extractorRecord'
  , gdecodeCurrentRecord
  , GEncodeProduct(..)
  , GDecodeProduct(..)
  , GSerialiseRecord(..)
  , GSerialiseProduct(..)
  , gschemaGenProduct
  , gtoBuilderProduct
  , gextractorProduct
  , gdecodeCurrentProduct
  , extractorProduct'
  , GConstructorCount(..)
  , GDecodeVariant(..)
  , GEncodeVariant(..)
  , GSerialiseVariant(..)
  , gschemaGenVariant
  , gtoBuilderVariant
  , gextractorVariant
  , gdecodeCurrentVariant
  , gvariantExtractors
  , Subextractor(..)
  , extractField
  , extractFieldBy
  , buildExtractor
  , buildRecordExtractor
  , bextractors
  , buildRecordExtractorF
  , bextractorsF
  ) where

import Barbies hiding (Void)
import Barbies.Constraints
import Barbies.TH
import Control.Applicative
import Control.Exception
import Control.Monad.Reader
import qualified Data.ByteString as B
import qualified Data.ByteString.FastBuilder as BB
import qualified Data.ByteString.Lazy as BL
import Data.Bits
import Data.Complex
import Data.Dynamic
import Data.Fixed
import Data.Functor.Compose
import Data.Functor.Identity
import qualified Data.Functor.Product as F
import Data.List (elemIndex)
import Data.Monoid as M
import Data.Kind (Type)
import Data.Proxy
import Data.Ratio (Ratio, (%), numerator, denominator)
import Data.Scientific (Scientific, scientific, coefficient, base10Exponent)
import Data.Semigroup as S
import Data.Hashable (Hashable)
import qualified Data.HashMap.Strict as HM
import Data.Int
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.Map as M
import Data.Ord (Down(..))
import Data.Word
import Codec.Winery.Base as W
import Codec.Winery.Internal
import qualified Data.Sequence as Seq
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Encoding.Error as T
import qualified Data.Vector as V
import qualified Data.Vector.Storable as SV
import qualified Data.Vector.Unboxed as UV
import Prettyprinter hiding ((<>), SText, SChar)
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Data.Typeable
import Data.Void (Void)
import Unsafe.Coerce
import GHC.Float (castWord32ToFloat, castWord64ToDouble)
import GHC.Natural
import GHC.Generics
import GHC.TypeLits

-- | Serialisable datatype
--
class Typeable a => Serialise a where
  -- | Obtain the schema of the datatype.
  schemaGen :: Proxy a -> SchemaGen Schema
  schemaGen = BundleSerialise a -> Proxy a -> SchemaGen Schema
forall a. BundleSerialise a -> Proxy a -> SchemaGen Schema
bundleSchemaGen BundleSerialise a
forall a. Serialise a => BundleSerialise a
bundleSerialise
  {-# INLINE schemaGen #-}

  -- | Serialise a value.
  toBuilder :: a -> BB.Builder
  toBuilder = BundleSerialise a -> a -> Builder
forall a. BundleSerialise a -> a -> Builder
bundleToBuilder BundleSerialise a
forall a. Serialise a => BundleSerialise a
bundleSerialise
  {-# INLINE toBuilder #-}

  -- | A value of 'Extractor a' interprets a schema and builds a function from
  -- 'Term' to @a@. This must be equivalent to 'decodeCurrent' when the schema
  -- is the current one.
  --
  -- If @'extractor' s@ returns a function, the function must return a
  -- non-bottom for any 'Term' @'decodeTerm' s@ returns.
  --
  -- It must not return a function if an unsupported schema is supplied.
  --
  -- @getDecoderBy extractor (schema (Proxy @ a))@ must be @Right d@
  -- where @d@ is equivalent to 'decodeCurrent'.
  --
  extractor :: Extractor a
  extractor = BundleSerialise a -> Extractor a
forall a. BundleSerialise a -> Extractor a
bundleExtractor BundleSerialise a
forall a. Serialise a => BundleSerialise a
bundleSerialise
  {-# INLINE extractor #-}

  -- | Decode a value with the current schema.
  --
  -- @'decodeCurrent' `evalDecoder` 'toBuilder' x@ ≡ x
  decodeCurrent :: Decoder a
  decodeCurrent = BundleSerialise a -> Decoder a
forall a. BundleSerialise a -> Decoder a
bundleDecodeCurrent BundleSerialise a
forall a. Serialise a => BundleSerialise a
bundleSerialise
  {-# INLINE decodeCurrent #-}

  -- | Instead of the four methods above, you can supply a bundle.
  bundleSerialise :: BundleSerialise a
  bundleSerialise = BundleSerialise :: forall a.
(Proxy a -> SchemaGen Schema)
-> (a -> Builder) -> Extractor a -> Decoder a -> BundleSerialise a
BundleSerialise
    { bundleSchemaGen :: Proxy a -> SchemaGen Schema
bundleSchemaGen = Proxy a -> SchemaGen Schema
forall a. Serialise a => Proxy a -> SchemaGen Schema
schemaGen
    , bundleToBuilder :: a -> Builder
bundleToBuilder = a -> Builder
forall a. Serialise a => a -> Builder
toBuilder
    , bundleExtractor :: Extractor a
bundleExtractor = Extractor a
forall a. Serialise a => Extractor a
extractor
    , bundleDecodeCurrent :: Decoder a
bundleDecodeCurrent = Decoder a
forall a. Serialise a => Decoder a
decodeCurrent
    }

  {-# MINIMAL schemaGen, toBuilder, extractor, decodeCurrent | bundleSerialise #-}

-- | A bundle of 'Serialise' methods
data BundleSerialise a = BundleSerialise
  { BundleSerialise a -> Proxy a -> SchemaGen Schema
bundleSchemaGen :: Proxy a -> SchemaGen Schema
  , BundleSerialise a -> a -> Builder
bundleToBuilder :: a -> BB.Builder
  , BundleSerialise a -> Extractor a
bundleExtractor :: Extractor a
  , BundleSerialise a -> Decoder a
bundleDecodeCurrent :: Decoder a
  }

-- | A bundle of generic implementations for records
bundleRecord :: (GEncodeProduct (Rep a), GSerialiseRecord (Rep a), GDecodeProduct (Rep a), Generic a, Typeable a)
  => (Extractor a -> Extractor a) -- extractor modifier
  -> BundleSerialise a
bundleRecord :: (Extractor a -> Extractor a) -> BundleSerialise a
bundleRecord Extractor a -> Extractor a
f = BundleSerialise :: forall a.
(Proxy a -> SchemaGen Schema)
-> (a -> Builder) -> Extractor a -> Decoder a -> BundleSerialise a
BundleSerialise
  { bundleSchemaGen :: Proxy a -> SchemaGen Schema
bundleSchemaGen = Proxy a -> SchemaGen Schema
forall (proxy :: * -> *) a.
(GSerialiseRecord (Rep a), Generic a, Typeable a) =>
proxy a -> SchemaGen Schema
gschemaGenRecord
  , bundleToBuilder :: a -> Builder
bundleToBuilder = a -> Builder
forall a. (GEncodeProduct (Rep a), Generic a) => a -> Builder
gtoBuilderRecord
  , bundleExtractor :: Extractor a
bundleExtractor = Extractor a -> Extractor a
f (Extractor a -> Extractor a) -> Extractor a -> Extractor a
forall a b. (a -> b) -> a -> b
$ Maybe a -> Extractor a
forall a.
(GSerialiseRecord (Rep a), Generic a, Typeable a) =>
Maybe a -> Extractor a
gextractorRecord Maybe a
forall a. Maybe a
Nothing
  , bundleDecodeCurrent :: Decoder a
bundleDecodeCurrent = Decoder a
forall a. (GDecodeProduct (Rep a), Generic a) => Decoder a
gdecodeCurrentRecord
  }
{-# INLINE bundleRecord #-}
{-# DEPRECATED bundleRecord "Use bundleVia instead" #-}

-- | A bundle of generic implementations for records, with a default value
bundleRecordDefault :: (GEncodeProduct (Rep a), GSerialiseRecord (Rep a), GDecodeProduct (Rep a), Generic a, Typeable a)
  => a -- default value
  -> (Extractor a -> Extractor a) -- extractor modifier
  -> BundleSerialise a
bundleRecordDefault :: a -> (Extractor a -> Extractor a) -> BundleSerialise a
bundleRecordDefault a
def Extractor a -> Extractor a
f = BundleSerialise :: forall a.
(Proxy a -> SchemaGen Schema)
-> (a -> Builder) -> Extractor a -> Decoder a -> BundleSerialise a
BundleSerialise
  { bundleSchemaGen :: Proxy a -> SchemaGen Schema
bundleSchemaGen = Proxy a -> SchemaGen Schema
forall (proxy :: * -> *) a.
(GSerialiseRecord (Rep a), Generic a, Typeable a) =>
proxy a -> SchemaGen Schema
gschemaGenRecord
  , bundleToBuilder :: a -> Builder
bundleToBuilder = a -> Builder
forall a. (GEncodeProduct (Rep a), Generic a) => a -> Builder
gtoBuilderRecord
  , bundleExtractor :: Extractor a
bundleExtractor = Extractor a -> Extractor a
f (Extractor a -> Extractor a) -> Extractor a -> Extractor a
forall a b. (a -> b) -> a -> b
$ Maybe a -> Extractor a
forall a.
(GSerialiseRecord (Rep a), Generic a, Typeable a) =>
Maybe a -> Extractor a
gextractorRecord (Maybe a -> Extractor a) -> Maybe a -> Extractor a
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
def
  , bundleDecodeCurrent :: Decoder a
bundleDecodeCurrent = Decoder a
forall a. (GDecodeProduct (Rep a), Generic a) => Decoder a
gdecodeCurrentRecord
  }
{-# INLINE bundleRecordDefault #-}
{-# DEPRECATED bundleRecordDefault "Use bundleVia instead" #-}

-- | A bundle of generic implementations for variants
bundleVariant :: (GSerialiseVariant (Rep a), GConstructorCount (Rep a), GEncodeVariant (Rep a), GDecodeVariant (Rep a), Generic a, Typeable a)
  => (Extractor a -> Extractor a) -- extractor modifier
  -> BundleSerialise a
bundleVariant :: (Extractor a -> Extractor a) -> BundleSerialise a
bundleVariant Extractor a -> Extractor a
f = BundleSerialise :: forall a.
(Proxy a -> SchemaGen Schema)
-> (a -> Builder) -> Extractor a -> Decoder a -> BundleSerialise a
BundleSerialise
  { bundleSchemaGen :: Proxy a -> SchemaGen Schema
bundleSchemaGen = Proxy a -> SchemaGen Schema
forall (proxy :: * -> *) a.
(GSerialiseVariant (Rep a), Typeable a, Generic a) =>
proxy a -> SchemaGen Schema
gschemaGenVariant
  , bundleToBuilder :: a -> Builder
bundleToBuilder = a -> Builder
forall a.
(GConstructorCount (Rep a), GEncodeVariant (Rep a), Generic a) =>
a -> Builder
gtoBuilderVariant
  , bundleExtractor :: Extractor a
bundleExtractor = Extractor a -> Extractor a
f (Extractor a -> Extractor a) -> Extractor a -> Extractor a
forall a b. (a -> b) -> a -> b
$ Extractor a
forall a.
(GSerialiseVariant (Rep a), Generic a, Typeable a) =>
Extractor a
gextractorVariant
  , bundleDecodeCurrent :: Decoder a
bundleDecodeCurrent = Decoder a
forall a.
(GConstructorCount (Rep a), GEncodeVariant (Rep a),
 GDecodeVariant (Rep a), Generic a) =>
Decoder a
gdecodeCurrentVariant
  }
{-# INLINE bundleVariant #-}
{-# DEPRECATED bundleVariant "Use bundleVia instead" #-}

-- | Obtain a schema on 'SchemaGen', binding a fixpoint when necessary.
-- If you are hand-rolling a definition of 'schemaGen', you should call this
-- instead of 'schemaGen'.
getSchema :: forall proxy a. Serialise a => proxy a -> SchemaGen Schema
getSchema :: proxy a -> SchemaGen Schema
getSchema proxy a
p = (Set TypeRep -> (Set TypeRep, [TypeRep] -> Schema))
-> SchemaGen Schema
forall a.
(Set TypeRep -> (Set TypeRep, [TypeRep] -> a)) -> SchemaGen a
SchemaGen ((Set TypeRep -> (Set TypeRep, [TypeRep] -> Schema))
 -> SchemaGen Schema)
-> (Set TypeRep -> (Set TypeRep, [TypeRep] -> Schema))
-> SchemaGen Schema
forall a b. (a -> b) -> a -> b
$ \Set TypeRep
seen -> if TypeRep -> Set TypeRep -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member TypeRep
rep Set TypeRep
seen
  then (TypeRep -> Set TypeRep
forall a. a -> Set a
S.singleton TypeRep
rep, \[TypeRep]
xs -> case TypeRep -> [TypeRep] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex TypeRep
rep [TypeRep]
xs of
    Just Int
i -> Int -> Schema
forall a. a -> SchemaP a
SVar Int
i
    Maybe Int
Nothing -> [Char] -> Schema
forall a. HasCallStack => [Char] -> a
error ([Char] -> Schema) -> [Char] -> Schema
forall a b. (a -> b) -> a -> b
$ [Char]
"getSchema: impossible " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (TypeRep, Set TypeRep, [TypeRep]) -> [Char]
forall a. Show a => a -> [Char]
show (TypeRep
rep, Set TypeRep
seen, [TypeRep]
xs))
    -- request a fixpoint for rep when it detects a recursion
  else case SchemaGen Schema
-> Set TypeRep -> (Set TypeRep, [TypeRep] -> Schema)
forall a.
SchemaGen a -> Set TypeRep -> (Set TypeRep, [TypeRep] -> a)
unSchemaGen (Proxy a -> SchemaGen Schema
forall a. Serialise a => Proxy a -> SchemaGen Schema
schemaGen (Proxy a
forall k (t :: k). Proxy t
Proxy @ a)) (TypeRep -> Set TypeRep -> Set TypeRep
forall a. Ord a => a -> Set a -> Set a
S.insert TypeRep
rep Set TypeRep
seen) of
    (Set TypeRep
reps, [TypeRep] -> Schema
f)
      | TypeRep -> Set TypeRep -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member TypeRep
rep Set TypeRep
reps -> (Set TypeRep
reps, \[TypeRep]
xs -> Schema -> Schema
forall a. SchemaP a -> SchemaP a
SFix (Schema -> Schema) -> Schema -> Schema
forall a b. (a -> b) -> a -> b
$ [TypeRep] -> Schema
f (TypeRep
rep TypeRep -> [TypeRep] -> [TypeRep]
forall a. a -> [a] -> [a]
: [TypeRep]
xs))
      | Bool
otherwise -> (Set TypeRep
reps, [TypeRep] -> Schema
f)
  where
    rep :: TypeRep
rep = proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep proxy a
p

-- | Obtain the schema of the datatype.
--
-- /"Tell me what you drink, and I will tell you what you are."/
schema :: forall proxy a. Serialise a => proxy a -> Schema
schema :: proxy a -> Schema
schema proxy a
p = case SchemaGen Schema
-> Set TypeRep -> (Set TypeRep, [TypeRep] -> Schema)
forall a.
SchemaGen a -> Set TypeRep -> (Set TypeRep, [TypeRep] -> a)
unSchemaGen (Proxy a -> SchemaGen Schema
forall a. Serialise a => Proxy a -> SchemaGen Schema
schemaGen (Proxy a
forall k (t :: k). Proxy t
Proxy @ a)) (TypeRep -> Set TypeRep
forall a. a -> Set a
S.singleton TypeRep
rep) of
  (Set TypeRep
reps, [TypeRep] -> Schema
f)
    | TypeRep -> Set TypeRep -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member TypeRep
rep Set TypeRep
reps -> Schema -> Schema
forall a. SchemaP a -> SchemaP a
SFix (Schema -> Schema) -> Schema -> Schema
forall a b. (a -> b) -> a -> b
$ [TypeRep] -> Schema
f [TypeRep
rep]
    | Bool
otherwise -> [TypeRep] -> Schema
f []
  where
    rep :: TypeRep
rep = proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep proxy a
p

unexpectedSchema :: forall f a. Serialise a => Schema -> Strategy' (f a)
unexpectedSchema :: Schema -> Strategy' (f a)
unexpectedSchema Schema
actual = WineryException -> Strategy' (f a)
forall e r a. e -> Strategy e r a
throwStrategy
  (WineryException -> Strategy' (f a))
-> WineryException -> Strategy' (f a)
forall a b. (a -> b) -> a -> b
$ [TypeRep] -> Doc AnsiStyle -> Schema -> WineryException
UnexpectedSchema [] (Schema -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty (Schema -> Doc AnsiStyle) -> Schema -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$ Proxy a -> Schema
forall (proxy :: * -> *) a. Serialise a => proxy a -> Schema
schema (Proxy a
forall k (t :: k). Proxy t
Proxy @ a)) Schema
actual

mkExtractor :: forall a. Typeable a => (Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor :: (Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor = (Schema -> Strategy' (Term -> a)) -> Extractor a
forall a. (Schema -> Strategy' (Term -> a)) -> Extractor a
Extractor ((Schema -> Strategy' (Term -> a)) -> Extractor a)
-> ((Schema -> Strategy' (Term -> a))
    -> Schema -> Strategy' (Term -> a))
-> (Schema -> Strategy' (Term -> a))
-> Extractor a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Strategy' (Term -> a) -> Strategy' (Term -> a))
-> (Schema -> Strategy' (Term -> a))
-> Schema
-> Strategy' (Term -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Strategy' (Term -> a) -> Strategy' (Term -> a)
addTrail ((Schema -> Strategy' (Term -> a))
 -> Schema -> Strategy' (Term -> a))
-> ((Schema -> Strategy' (Term -> a))
    -> Schema -> Strategy' (Term -> a))
-> (Schema -> Strategy' (Term -> a))
-> Schema
-> Strategy' (Term -> a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Schema -> Strategy' (Term -> a))
-> Schema -> Strategy' (Term -> a)
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a))
-> Schema -> Strategy' (Term -> a)
recursiveStrategy where
  addTrail :: Strategy' (Term -> a) -> Strategy' (Term -> a)
addTrail (Strategy StrategyEnv -> Either WineryException (Term -> a)
f) = (StrategyEnv -> Either WineryException (Term -> a))
-> Strategy' (Term -> a)
forall e r a. (r -> Either e a) -> Strategy e r a
Strategy ((StrategyEnv -> Either WineryException (Term -> a))
 -> Strategy' (Term -> a))
-> (StrategyEnv -> Either WineryException (Term -> a))
-> Strategy' (Term -> a)
forall a b. (a -> b) -> a -> b
$ \StrategyEnv
env -> case StrategyEnv -> Either WineryException (Term -> a)
f StrategyEnv
env of
    Left WineryException
e -> WineryException -> Either WineryException (Term -> a)
forall a b. a -> Either a b
Left (WineryException -> Either WineryException (Term -> a))
-> WineryException -> Either WineryException (Term -> a)
forall a b. (a -> b) -> a -> b
$! TypeRep -> WineryException -> WineryException
pushTrace (Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall k (t :: k). Proxy t
Proxy @ a)) WineryException
e
    Right Term -> a
a -> (Term -> a) -> Either WineryException (Term -> a)
forall a b. b -> Either a b
Right Term -> a
a
{-# INLINE mkExtractor #-}

-- | Handle (recursive) schema bindings.
recursiveStrategy :: forall a. Typeable a => (Schema -> Strategy' (Term -> a)) -> Schema -> Strategy' (Term -> a)
recursiveStrategy :: (Schema -> Strategy' (Term -> a))
-> Schema -> Strategy' (Term -> a)
recursiveStrategy Schema -> Strategy' (Term -> a)
k Schema
sch = (StrategyEnv -> Either WineryException (Term -> a))
-> Strategy' (Term -> a)
forall e r a. (r -> Either e a) -> Strategy e r a
Strategy ((StrategyEnv -> Either WineryException (Term -> a))
 -> Strategy' (Term -> a))
-> (StrategyEnv -> Either WineryException (Term -> a))
-> Strategy' (Term -> a)
forall a b. (a -> b) -> a -> b
$ \(StrategyEnv Int
ofs [StrategyBind]
decs) -> case Schema
sch of
  SVar Int
i
    | StrategyBind
point : [StrategyBind]
_ <- Int -> [StrategyBind] -> [StrategyBind]
forall a. Int -> [a] -> [a]
drop Int
i [StrategyBind]
decs -> case StrategyBind
point of
      BoundSchema Int
ofs' Schema
sch' -> (Schema -> Strategy' (Term -> a))
-> Schema -> Strategy' (Term -> a)
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a))
-> Schema -> Strategy' (Term -> a)
recursiveStrategy Schema -> Strategy' (Term -> a)
k Schema
sch' Strategy' (Term -> a)
-> StrategyEnv -> Either WineryException (Term -> a)
forall e r a. Strategy e r a -> r -> Either e a
`unStrategy` Int -> [StrategyBind] -> StrategyEnv
StrategyEnv Int
ofs' (Int -> [StrategyBind] -> [StrategyBind]
forall a. Int -> [a] -> [a]
drop (Int
ofs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ofs') [StrategyBind]
decs)
      DynDecoder Dynamic
dyn -> case Dynamic -> Maybe (Term -> a)
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic Dynamic
dyn of
        Maybe (Term -> a)
Nothing -> WineryException -> Either WineryException (Term -> a)
forall a b. a -> Either a b
Left (WineryException -> Either WineryException (Term -> a))
-> WineryException -> Either WineryException (Term -> a)
forall a b. (a -> b) -> a -> b
$ [TypeRep] -> Int -> TypeRep -> TypeRep -> WineryException
TypeMismatch [] Int
i
          (Proxy (Term -> a) -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy (Term -> a)
forall k (t :: k). Proxy t
Proxy @ (Term -> a)))
          (Dynamic -> TypeRep
dynTypeRep Dynamic
dyn)
        Just Term -> a
a -> (Term -> a) -> Either WineryException (Term -> a)
forall a b. b -> Either a b
Right Term -> a
a
    | Bool
otherwise -> WineryException -> Either WineryException (Term -> a)
forall a b. a -> Either a b
Left (WineryException -> Either WineryException (Term -> a))
-> WineryException -> Either WineryException (Term -> a)
forall a b. (a -> b) -> a -> b
$ [TypeRep] -> Int -> WineryException
UnboundVariable [] Int
i
  SFix Schema
s -> ((Term -> a) -> Either WineryException (Term -> a))
-> Either WineryException (Term -> a)
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (((Term -> a) -> Either WineryException (Term -> a))
 -> Either WineryException (Term -> a))
-> ((Term -> a) -> Either WineryException (Term -> a))
-> Either WineryException (Term -> a)
forall a b. (a -> b) -> a -> b
$ \Term -> a
a -> (Schema -> Strategy' (Term -> a))
-> Schema -> Strategy' (Term -> a)
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a))
-> Schema -> Strategy' (Term -> a)
recursiveStrategy Schema -> Strategy' (Term -> a)
k Schema
s Strategy' (Term -> a)
-> StrategyEnv -> Either WineryException (Term -> a)
forall e r a. Strategy e r a -> r -> Either e a
`unStrategy` Int -> [StrategyBind] -> StrategyEnv
StrategyEnv (Int
ofs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Dynamic -> StrategyBind
DynDecoder ((Term -> a) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Term -> a
a) StrategyBind -> [StrategyBind] -> [StrategyBind]
forall a. a -> [a] -> [a]
: [StrategyBind]
decs)
  SLet Schema
s Schema
t -> (Schema -> Strategy' (Term -> a))
-> Schema -> Strategy' (Term -> a)
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a))
-> Schema -> Strategy' (Term -> a)
recursiveStrategy Schema -> Strategy' (Term -> a)
k Schema
t Strategy' (Term -> a)
-> StrategyEnv -> Either WineryException (Term -> a)
forall e r a. Strategy e r a -> r -> Either e a
`unStrategy` Int -> [StrategyBind] -> StrategyEnv
StrategyEnv (Int
ofs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Schema -> StrategyBind
BoundSchema Int
ofs Schema
s StrategyBind -> [StrategyBind] -> [StrategyBind]
forall a. a -> [a] -> [a]
: [StrategyBind]
decs)
  Schema
s -> Schema -> Strategy' (Term -> a)
k Schema
s Strategy' (Term -> a)
-> StrategyEnv -> Either WineryException (Term -> a)
forall e r a. Strategy e r a -> r -> Either e a
`unStrategy` Int -> [StrategyBind] -> StrategyEnv
StrategyEnv Int
ofs [StrategyBind]
decs

instance Serialise Tag where
  schemaGen :: Proxy Tag -> SchemaGen Schema
schemaGen = Proxy Tag -> SchemaGen Schema
forall (proxy :: * -> *) a.
(GSerialiseVariant (Rep a), Typeable a, Generic a) =>
proxy a -> SchemaGen Schema
gschemaGenVariant
  toBuilder :: Tag -> Builder
toBuilder = Tag -> Builder
forall a.
(GConstructorCount (Rep a), GEncodeVariant (Rep a), Generic a) =>
a -> Builder
gtoBuilderVariant
  extractor :: Extractor Tag
extractor = Extractor Tag
forall a.
(GSerialiseVariant (Rep a), Generic a, Typeable a) =>
Extractor a
gextractorVariant
  decodeCurrent :: Decoder Tag
decodeCurrent = Decoder Tag
forall a.
(GConstructorCount (Rep a), GEncodeVariant (Rep a),
 GDecodeVariant (Rep a), Generic a) =>
Decoder a
gdecodeCurrentVariant

instance Serialise Schema where
  schemaGen :: Proxy Schema -> SchemaGen Schema
schemaGen = Proxy Schema -> SchemaGen Schema
forall (proxy :: * -> *) a.
(GSerialiseVariant (Rep a), Typeable a, Generic a) =>
proxy a -> SchemaGen Schema
gschemaGenVariant
  toBuilder :: Schema -> Builder
toBuilder = Schema -> Builder
forall a.
(GConstructorCount (Rep a), GEncodeVariant (Rep a), Generic a) =>
a -> Builder
gtoBuilderVariant
  extractor :: Extractor Schema
extractor = Extractor Schema
forall a.
(GSerialiseVariant (Rep a), Generic a, Typeable a) =>
Extractor a
gextractorVariant
  decodeCurrent :: Decoder Schema
decodeCurrent = Decoder Schema
forall a.
(GConstructorCount (Rep a), GEncodeVariant (Rep a),
 GDecodeVariant (Rep a), Generic a) =>
Decoder a
gdecodeCurrentVariant

instance Serialise () where
  schemaGen :: Proxy () -> SchemaGen Schema
schemaGen Proxy ()
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> SchemaGen Schema) -> Schema -> SchemaGen Schema
forall a b. (a -> b) -> a -> b
$ Vector Schema -> Schema
forall a. Vector (SchemaP a) -> SchemaP a
SProduct Vector Schema
forall a. Monoid a => a
mempty
  toBuilder :: () -> Builder
toBuilder = () -> Builder
forall a. Monoid a => a
mempty
  {-# INLINE toBuilder #-}
  extractor :: Extractor ()
extractor = () -> Extractor ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  decodeCurrent :: Decoder ()
decodeCurrent = () -> Decoder ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance Serialise Bool where
  schemaGen :: Proxy Bool -> SchemaGen Schema
schemaGen Proxy Bool
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
forall a. SchemaP a
SBool
  toBuilder :: Bool -> Builder
toBuilder Bool
False = Word8 -> Builder
BB.word8 Word8
0
  toBuilder Bool
True = Word8 -> Builder
BB.word8 Word8
1
  {-# INLINE toBuilder #-}
  extractor :: Extractor Bool
extractor = (Schema -> Strategy' (Term -> Bool)) -> Extractor Bool
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor ((Schema -> Strategy' (Term -> Bool)) -> Extractor Bool)
-> (Schema -> Strategy' (Term -> Bool)) -> Extractor Bool
forall a b. (a -> b) -> a -> b
$ \case
    Schema
SBool -> (Term -> Bool) -> Strategy' (Term -> Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Term -> Bool) -> Strategy' (Term -> Bool))
-> (Term -> Bool) -> Strategy' (Term -> Bool)
forall a b. (a -> b) -> a -> b
$ \case
      TBool Bool
b -> Bool
b
      Term
t -> ExtractException -> Bool
forall a e. Exception e => e -> a
throw (ExtractException -> Bool) -> ExtractException -> Bool
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t
    Schema
s -> Schema -> Strategy' (Term -> Bool)
forall (f :: * -> *) a. Serialise a => Schema -> Strategy' (f a)
unexpectedSchema Schema
s
  decodeCurrent :: Decoder Bool
decodeCurrent = (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/=Word8
0) (Word8 -> Bool) -> Decoder Word8 -> Decoder Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder Word8
getWord8

instance Serialise Word8 where
  schemaGen :: Proxy Word8 -> SchemaGen Schema
schemaGen Proxy Word8
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
forall a. SchemaP a
SWord8
  toBuilder :: Word8 -> Builder
toBuilder = Word8 -> Builder
BB.word8
  {-# INLINE toBuilder #-}
  extractor :: Extractor Word8
extractor = (Schema -> Strategy' (Term -> Word8)) -> Extractor Word8
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor ((Schema -> Strategy' (Term -> Word8)) -> Extractor Word8)
-> (Schema -> Strategy' (Term -> Word8)) -> Extractor Word8
forall a b. (a -> b) -> a -> b
$ \case
    Schema
SWord8 -> (Term -> Word8) -> Strategy' (Term -> Word8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Term -> Word8) -> Strategy' (Term -> Word8))
-> (Term -> Word8) -> Strategy' (Term -> Word8)
forall a b. (a -> b) -> a -> b
$ \case
      TWord8 Word8
i -> Word8
i
      Term
t -> ExtractException -> Word8
forall a e. Exception e => e -> a
throw (ExtractException -> Word8) -> ExtractException -> Word8
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t
    Schema
s -> Schema -> Strategy' (Term -> Word8)
forall (f :: * -> *) a. Serialise a => Schema -> Strategy' (f a)
unexpectedSchema Schema
s
  decodeCurrent :: Decoder Word8
decodeCurrent = Decoder Word8
getWord8

instance Serialise Word16 where
  schemaGen :: Proxy Word16 -> SchemaGen Schema
schemaGen Proxy Word16
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
forall a. SchemaP a
SWord16
  toBuilder :: Word16 -> Builder
toBuilder = Word16 -> Builder
BB.word16LE
  {-# INLINE toBuilder #-}
  extractor :: Extractor Word16
extractor = (Schema -> Strategy' (Term -> Word16)) -> Extractor Word16
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor ((Schema -> Strategy' (Term -> Word16)) -> Extractor Word16)
-> (Schema -> Strategy' (Term -> Word16)) -> Extractor Word16
forall a b. (a -> b) -> a -> b
$ \case
    Schema
SWord16 -> (Term -> Word16) -> Strategy' (Term -> Word16)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Term -> Word16) -> Strategy' (Term -> Word16))
-> (Term -> Word16) -> Strategy' (Term -> Word16)
forall a b. (a -> b) -> a -> b
$ \case
      TWord16 Word16
i -> Word16
i
      Term
t -> ExtractException -> Word16
forall a e. Exception e => e -> a
throw (ExtractException -> Word16) -> ExtractException -> Word16
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t
    Schema
s -> Schema -> Strategy' (Term -> Word16)
forall (f :: * -> *) a. Serialise a => Schema -> Strategy' (f a)
unexpectedSchema Schema
s
  decodeCurrent :: Decoder Word16
decodeCurrent = Decoder Word16
getWord16

instance Serialise Word32 where
  schemaGen :: Proxy Word32 -> SchemaGen Schema
schemaGen Proxy Word32
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
forall a. SchemaP a
SWord32
  toBuilder :: Word32 -> Builder
toBuilder = Word32 -> Builder
BB.word32LE
  {-# INLINE toBuilder #-}
  extractor :: Extractor Word32
extractor = (Schema -> Strategy' (Term -> Word32)) -> Extractor Word32
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor ((Schema -> Strategy' (Term -> Word32)) -> Extractor Word32)
-> (Schema -> Strategy' (Term -> Word32)) -> Extractor Word32
forall a b. (a -> b) -> a -> b
$ \case
    Schema
SWord32 -> (Term -> Word32) -> Strategy' (Term -> Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Term -> Word32) -> Strategy' (Term -> Word32))
-> (Term -> Word32) -> Strategy' (Term -> Word32)
forall a b. (a -> b) -> a -> b
$ \case
      TWord32 Word32
i -> Word32
i
      Term
t -> ExtractException -> Word32
forall a e. Exception e => e -> a
throw (ExtractException -> Word32) -> ExtractException -> Word32
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t
    Schema
s -> Schema -> Strategy' (Term -> Word32)
forall (f :: * -> *) a. Serialise a => Schema -> Strategy' (f a)
unexpectedSchema Schema
s
  decodeCurrent :: Decoder Word32
decodeCurrent = Decoder Word32
getWord32

instance Serialise Word64 where
  schemaGen :: Proxy Word64 -> SchemaGen Schema
schemaGen Proxy Word64
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
forall a. SchemaP a
SWord64
  toBuilder :: Word64 -> Builder
toBuilder = Word64 -> Builder
BB.word64LE
  {-# INLINE toBuilder #-}
  extractor :: Extractor Word64
extractor = (Schema -> Strategy' (Term -> Word64)) -> Extractor Word64
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor ((Schema -> Strategy' (Term -> Word64)) -> Extractor Word64)
-> (Schema -> Strategy' (Term -> Word64)) -> Extractor Word64
forall a b. (a -> b) -> a -> b
$ \case
    Schema
SWord64 -> (Term -> Word64) -> Strategy' (Term -> Word64)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Term -> Word64) -> Strategy' (Term -> Word64))
-> (Term -> Word64) -> Strategy' (Term -> Word64)
forall a b. (a -> b) -> a -> b
$ \case
      TWord64 Word64
i -> Word64
i
      Term
t -> ExtractException -> Word64
forall a e. Exception e => e -> a
throw (ExtractException -> Word64) -> ExtractException -> Word64
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t
    Schema
s -> Schema -> Strategy' (Term -> Word64)
forall (f :: * -> *) a. Serialise a => Schema -> Strategy' (f a)
unexpectedSchema Schema
s
  decodeCurrent :: Decoder Word64
decodeCurrent = Decoder Word64
getWord64

instance Serialise Word where
  schemaGen :: Proxy Word -> SchemaGen Schema
schemaGen Proxy Word
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
forall a. SchemaP a
SWord64
  toBuilder :: Word -> Builder
toBuilder = Word64 -> Builder
BB.word64LE (Word64 -> Builder) -> (Word -> Word64) -> Word -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE toBuilder #-}
  extractor :: Extractor Word
extractor = (Schema -> Strategy' (Term -> Word)) -> Extractor Word
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor ((Schema -> Strategy' (Term -> Word)) -> Extractor Word)
-> (Schema -> Strategy' (Term -> Word)) -> Extractor Word
forall a b. (a -> b) -> a -> b
$ \case
    Schema
SWord64 -> (Term -> Word) -> Strategy' (Term -> Word)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Term -> Word) -> Strategy' (Term -> Word))
-> (Term -> Word) -> Strategy' (Term -> Word)
forall a b. (a -> b) -> a -> b
$ \case
      TWord64 Word64
i -> Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i
      Term
t -> ExtractException -> Word
forall a e. Exception e => e -> a
throw (ExtractException -> Word) -> ExtractException -> Word
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t
    Schema
s -> Schema -> Strategy' (Term -> Word)
forall (f :: * -> *) a. Serialise a => Schema -> Strategy' (f a)
unexpectedSchema Schema
s
  decodeCurrent :: Decoder Word
decodeCurrent = Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word) -> Decoder Word64 -> Decoder Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder Word64
getWord64

instance Serialise Int8 where
  schemaGen :: Proxy Int8 -> SchemaGen Schema
schemaGen Proxy Int8
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
forall a. SchemaP a
SInt8
  toBuilder :: Int8 -> Builder
toBuilder = Word8 -> Builder
BB.word8 (Word8 -> Builder) -> (Int8 -> Word8) -> Int8 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE toBuilder #-}
  extractor :: Extractor Int8
extractor = (Schema -> Strategy' (Term -> Int8)) -> Extractor Int8
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor ((Schema -> Strategy' (Term -> Int8)) -> Extractor Int8)
-> (Schema -> Strategy' (Term -> Int8)) -> Extractor Int8
forall a b. (a -> b) -> a -> b
$ \case
    Schema
SInt8 -> (Term -> Int8) -> Strategy' (Term -> Int8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Term -> Int8) -> Strategy' (Term -> Int8))
-> (Term -> Int8) -> Strategy' (Term -> Int8)
forall a b. (a -> b) -> a -> b
$ \case
      TInt8 Int8
i -> Int8
i
      Term
t -> ExtractException -> Int8
forall a e. Exception e => e -> a
throw (ExtractException -> Int8) -> ExtractException -> Int8
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t
    Schema
s -> Schema -> Strategy' (Term -> Int8)
forall (f :: * -> *) a. Serialise a => Schema -> Strategy' (f a)
unexpectedSchema Schema
s
  decodeCurrent :: Decoder Int8
decodeCurrent = Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int8) -> Decoder Word8 -> Decoder Int8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder Word8
getWord8

instance Serialise Int16 where
  schemaGen :: Proxy Int16 -> SchemaGen Schema
schemaGen Proxy Int16
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
forall a. SchemaP a
SInt16
  toBuilder :: Int16 -> Builder
toBuilder = Word16 -> Builder
BB.word16LE (Word16 -> Builder) -> (Int16 -> Word16) -> Int16 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE toBuilder #-}
  extractor :: Extractor Int16
extractor = (Schema -> Strategy' (Term -> Int16)) -> Extractor Int16
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor ((Schema -> Strategy' (Term -> Int16)) -> Extractor Int16)
-> (Schema -> Strategy' (Term -> Int16)) -> Extractor Int16
forall a b. (a -> b) -> a -> b
$ \case
    Schema
SInt16 -> (Term -> Int16) -> Strategy' (Term -> Int16)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Term -> Int16) -> Strategy' (Term -> Int16))
-> (Term -> Int16) -> Strategy' (Term -> Int16)
forall a b. (a -> b) -> a -> b
$ \case
      TInt16 Int16
i -> Int16
i
      Term
t -> ExtractException -> Int16
forall a e. Exception e => e -> a
throw (ExtractException -> Int16) -> ExtractException -> Int16
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t
    Schema
s -> Schema -> Strategy' (Term -> Int16)
forall (f :: * -> *) a. Serialise a => Schema -> Strategy' (f a)
unexpectedSchema Schema
s
  decodeCurrent :: Decoder Int16
decodeCurrent = Word16 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int16) -> Decoder Word16 -> Decoder Int16
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder Word16
getWord16

instance Serialise Int32 where
  schemaGen :: Proxy Int32 -> SchemaGen Schema
schemaGen Proxy Int32
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
forall a. SchemaP a
SInt32
  toBuilder :: Int32 -> Builder
toBuilder = Word32 -> Builder
BB.word32LE (Word32 -> Builder) -> (Int32 -> Word32) -> Int32 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE toBuilder #-}
  extractor :: Extractor Int32
extractor = (Schema -> Strategy' (Term -> Int32)) -> Extractor Int32
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor ((Schema -> Strategy' (Term -> Int32)) -> Extractor Int32)
-> (Schema -> Strategy' (Term -> Int32)) -> Extractor Int32
forall a b. (a -> b) -> a -> b
$ \case
    Schema
SInt32 -> (Term -> Int32) -> Strategy' (Term -> Int32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Term -> Int32) -> Strategy' (Term -> Int32))
-> (Term -> Int32) -> Strategy' (Term -> Int32)
forall a b. (a -> b) -> a -> b
$ \case
      TInt32 Int32
i -> Int32
i
      Term
t -> ExtractException -> Int32
forall a e. Exception e => e -> a
throw (ExtractException -> Int32) -> ExtractException -> Int32
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t
    Schema
s -> Schema -> Strategy' (Term -> Int32)
forall (f :: * -> *) a. Serialise a => Schema -> Strategy' (f a)
unexpectedSchema Schema
s
  decodeCurrent :: Decoder Int32
decodeCurrent = Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32) -> Decoder Word32 -> Decoder Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder Word32
getWord32

instance Serialise Int64 where
  schemaGen :: Proxy Int64 -> SchemaGen Schema
schemaGen Proxy Int64
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
forall a. SchemaP a
SInt64
  toBuilder :: Int64 -> Builder
toBuilder = Word64 -> Builder
BB.word64LE (Word64 -> Builder) -> (Int64 -> Word64) -> Int64 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  {-# INLINE toBuilder #-}
  extractor :: Extractor Int64
extractor = (Schema -> Strategy' (Term -> Int64)) -> Extractor Int64
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor ((Schema -> Strategy' (Term -> Int64)) -> Extractor Int64)
-> (Schema -> Strategy' (Term -> Int64)) -> Extractor Int64
forall a b. (a -> b) -> a -> b
$ \case
    Schema
SInt64 -> (Term -> Int64) -> Strategy' (Term -> Int64)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Term -> Int64) -> Strategy' (Term -> Int64))
-> (Term -> Int64) -> Strategy' (Term -> Int64)
forall a b. (a -> b) -> a -> b
$ \case
      TInt64 Int64
i -> Int64
i
      Term
t -> ExtractException -> Int64
forall a e. Exception e => e -> a
throw (ExtractException -> Int64) -> ExtractException -> Int64
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t
    Schema
s -> Schema -> Strategy' (Term -> Int64)
forall (f :: * -> *) a. Serialise a => Schema -> Strategy' (f a)
unexpectedSchema Schema
s
  decodeCurrent :: Decoder Int64
decodeCurrent = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Decoder Word64 -> Decoder Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder Word64
getWord64

instance Serialise Int where
  schemaGen :: Proxy Int -> SchemaGen Schema
schemaGen Proxy Int
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
forall a. SchemaP a
SInteger
  toBuilder :: Int -> Builder
toBuilder = VarInt Int -> Builder
forall a. Serialise a => a -> Builder
toBuilder (VarInt Int -> Builder) -> (Int -> VarInt Int) -> Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> VarInt Int
forall a. a -> VarInt a
VarInt
  {-# INLINE toBuilder #-}
  extractor :: Extractor Int
extractor = (Schema -> Strategy' (Term -> Int)) -> Extractor Int
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor ((Schema -> Strategy' (Term -> Int)) -> Extractor Int)
-> (Schema -> Strategy' (Term -> Int)) -> Extractor Int
forall a b. (a -> b) -> a -> b
$ \case
    Schema
SInteger -> (Term -> Int) -> Strategy' (Term -> Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Term -> Int) -> Strategy' (Term -> Int))
-> (Term -> Int) -> Strategy' (Term -> Int)
forall a b. (a -> b) -> a -> b
$ \case
      TInteger Integer
i -> Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i
      Term
t -> ExtractException -> Int
forall a e. Exception e => e -> a
throw (ExtractException -> Int) -> ExtractException -> Int
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t
    Schema
s -> Schema -> Strategy' (Term -> Int)
forall (f :: * -> *) a. Serialise a => Schema -> Strategy' (f a)
unexpectedSchema Schema
s
  decodeCurrent :: Decoder Int
decodeCurrent = Decoder Int
forall a. (Num a, FiniteBits a) => Decoder a
decodeVarIntFinite

instance Serialise Float where
  schemaGen :: Proxy Float -> SchemaGen Schema
schemaGen Proxy Float
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
forall a. SchemaP a
SFloat
  toBuilder :: Float -> Builder
toBuilder = Float -> Builder
BB.floatLE
  {-# INLINE toBuilder #-}
  extractor :: Extractor Float
extractor = (Schema -> Strategy' (Term -> Float)) -> Extractor Float
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor ((Schema -> Strategy' (Term -> Float)) -> Extractor Float)
-> (Schema -> Strategy' (Term -> Float)) -> Extractor Float
forall a b. (a -> b) -> a -> b
$ \case
    Schema
SFloat -> (Term -> Float) -> Strategy' (Term -> Float)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Term -> Float) -> Strategy' (Term -> Float))
-> (Term -> Float) -> Strategy' (Term -> Float)
forall a b. (a -> b) -> a -> b
$ \case
      TFloat Float
x -> Float
x
      Term
t -> ExtractException -> Float
forall a e. Exception e => e -> a
throw (ExtractException -> Float) -> ExtractException -> Float
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t
    Schema
s -> Schema -> Strategy' (Term -> Float)
forall (f :: * -> *) a. Serialise a => Schema -> Strategy' (f a)
unexpectedSchema Schema
s
  decodeCurrent :: Decoder Float
decodeCurrent = Word32 -> Float
castWord32ToFloat (Word32 -> Float) -> Decoder Word32 -> Decoder Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder Word32
getWord32

instance Serialise Double where
  schemaGen :: Proxy Double -> SchemaGen Schema
schemaGen Proxy Double
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
forall a. SchemaP a
SDouble
  toBuilder :: Double -> Builder
toBuilder = Double -> Builder
BB.doubleLE
  {-# INLINE toBuilder #-}
  extractor :: Extractor Double
extractor = (Schema -> Strategy' (Term -> Double)) -> Extractor Double
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor ((Schema -> Strategy' (Term -> Double)) -> Extractor Double)
-> (Schema -> Strategy' (Term -> Double)) -> Extractor Double
forall a b. (a -> b) -> a -> b
$ \case
    Schema
SDouble -> (Term -> Double) -> Strategy' (Term -> Double)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Term -> Double) -> Strategy' (Term -> Double))
-> (Term -> Double) -> Strategy' (Term -> Double)
forall a b. (a -> b) -> a -> b
$ \case
      TDouble Double
x -> Double
x
      Term
t -> ExtractException -> Double
forall a e. Exception e => e -> a
throw (ExtractException -> Double) -> ExtractException -> Double
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t
    Schema
s -> Schema -> Strategy' (Term -> Double)
forall (f :: * -> *) a. Serialise a => Schema -> Strategy' (f a)
unexpectedSchema Schema
s
  decodeCurrent :: Decoder Double
decodeCurrent = Word64 -> Double
castWord64ToDouble (Word64 -> Double) -> Decoder Word64 -> Decoder Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder Word64
getWord64

instance Serialise T.Text where
  schemaGen :: Proxy Text -> SchemaGen Schema
schemaGen Proxy Text
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
forall a. SchemaP a
SText
  toBuilder :: Text -> Builder
toBuilder = ByteString -> Builder
forall a. Serialise a => a -> Builder
toBuilder (ByteString -> Builder) -> (Text -> ByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
  {-# INLINE toBuilder #-}
  extractor :: Extractor Text
extractor = (Schema -> Strategy' (Term -> Text)) -> Extractor Text
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor ((Schema -> Strategy' (Term -> Text)) -> Extractor Text)
-> (Schema -> Strategy' (Term -> Text)) -> Extractor Text
forall a b. (a -> b) -> a -> b
$ \case
    Schema
SText -> (Term -> Text) -> Strategy' (Term -> Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Term -> Text) -> Strategy' (Term -> Text))
-> (Term -> Text) -> Strategy' (Term -> Text)
forall a b. (a -> b) -> a -> b
$ \case
      TText Text
t -> Text
t
      Term
t -> ExtractException -> Text
forall a e. Exception e => e -> a
throw (ExtractException -> Text) -> ExtractException -> Text
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t
    Schema
s -> Schema -> Strategy' (Term -> Text)
forall (f :: * -> *) a. Serialise a => Schema -> Strategy' (f a)
unexpectedSchema Schema
s
  decodeCurrent :: Decoder Text
decodeCurrent = do
    Int
len <- Decoder Int
forall a. (Num a, Bits a) => Decoder a
decodeVarInt
    OnDecodeError -> ByteString -> Text
T.decodeUtf8With OnDecodeError
T.lenientDecode (ByteString -> Text) -> Decoder ByteString -> Decoder Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Decoder ByteString
getBytes Int
len

-- | Encoded in variable-length quantity.
newtype VarInt a = VarInt { VarInt a -> a
getVarInt :: a } deriving (Int -> VarInt a -> [Char] -> [Char]
[VarInt a] -> [Char] -> [Char]
VarInt a -> [Char]
(Int -> VarInt a -> [Char] -> [Char])
-> (VarInt a -> [Char])
-> ([VarInt a] -> [Char] -> [Char])
-> Show (VarInt a)
forall a. Show a => Int -> VarInt a -> [Char] -> [Char]
forall a. Show a => [VarInt a] -> [Char] -> [Char]
forall a. Show a => VarInt a -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [VarInt a] -> [Char] -> [Char]
$cshowList :: forall a. Show a => [VarInt a] -> [Char] -> [Char]
show :: VarInt a -> [Char]
$cshow :: forall a. Show a => VarInt a -> [Char]
showsPrec :: Int -> VarInt a -> [Char] -> [Char]
$cshowsPrec :: forall a. Show a => Int -> VarInt a -> [Char] -> [Char]
Show, ReadPrec [VarInt a]
ReadPrec (VarInt a)
Int -> ReadS (VarInt a)
ReadS [VarInt a]
(Int -> ReadS (VarInt a))
-> ReadS [VarInt a]
-> ReadPrec (VarInt a)
-> ReadPrec [VarInt a]
-> Read (VarInt a)
forall a. Read a => ReadPrec [VarInt a]
forall a. Read a => ReadPrec (VarInt a)
forall a. Read a => Int -> ReadS (VarInt a)
forall a. Read a => ReadS [VarInt a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [VarInt a]
$creadListPrec :: forall a. Read a => ReadPrec [VarInt a]
readPrec :: ReadPrec (VarInt a)
$creadPrec :: forall a. Read a => ReadPrec (VarInt a)
readList :: ReadS [VarInt a]
$creadList :: forall a. Read a => ReadS [VarInt a]
readsPrec :: Int -> ReadS (VarInt a)
$creadsPrec :: forall a. Read a => Int -> ReadS (VarInt a)
Read, VarInt a -> VarInt a -> Bool
(VarInt a -> VarInt a -> Bool)
-> (VarInt a -> VarInt a -> Bool) -> Eq (VarInt a)
forall a. Eq a => VarInt a -> VarInt a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VarInt a -> VarInt a -> Bool
$c/= :: forall a. Eq a => VarInt a -> VarInt a -> Bool
== :: VarInt a -> VarInt a -> Bool
$c== :: forall a. Eq a => VarInt a -> VarInt a -> Bool
Eq, Eq (VarInt a)
Eq (VarInt a)
-> (VarInt a -> VarInt a -> Ordering)
-> (VarInt a -> VarInt a -> Bool)
-> (VarInt a -> VarInt a -> Bool)
-> (VarInt a -> VarInt a -> Bool)
-> (VarInt a -> VarInt a -> Bool)
-> (VarInt a -> VarInt a -> VarInt a)
-> (VarInt a -> VarInt a -> VarInt a)
-> Ord (VarInt a)
VarInt a -> VarInt a -> Bool
VarInt a -> VarInt a -> Ordering
VarInt a -> VarInt a -> VarInt a
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
forall a. Ord a => Eq (VarInt a)
forall a. Ord a => VarInt a -> VarInt a -> Bool
forall a. Ord a => VarInt a -> VarInt a -> Ordering
forall a. Ord a => VarInt a -> VarInt a -> VarInt a
min :: VarInt a -> VarInt a -> VarInt a
$cmin :: forall a. Ord a => VarInt a -> VarInt a -> VarInt a
max :: VarInt a -> VarInt a -> VarInt a
$cmax :: forall a. Ord a => VarInt a -> VarInt a -> VarInt a
>= :: VarInt a -> VarInt a -> Bool
$c>= :: forall a. Ord a => VarInt a -> VarInt a -> Bool
> :: VarInt a -> VarInt a -> Bool
$c> :: forall a. Ord a => VarInt a -> VarInt a -> Bool
<= :: VarInt a -> VarInt a -> Bool
$c<= :: forall a. Ord a => VarInt a -> VarInt a -> Bool
< :: VarInt a -> VarInt a -> Bool
$c< :: forall a. Ord a => VarInt a -> VarInt a -> Bool
compare :: VarInt a -> VarInt a -> Ordering
$ccompare :: forall a. Ord a => VarInt a -> VarInt a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (VarInt a)
Ord, Int -> VarInt a
VarInt a -> Int
VarInt a -> [VarInt a]
VarInt a -> VarInt a
VarInt a -> VarInt a -> [VarInt a]
VarInt a -> VarInt a -> VarInt a -> [VarInt a]
(VarInt a -> VarInt a)
-> (VarInt a -> VarInt a)
-> (Int -> VarInt a)
-> (VarInt a -> Int)
-> (VarInt a -> [VarInt a])
-> (VarInt a -> VarInt a -> [VarInt a])
-> (VarInt a -> VarInt a -> [VarInt a])
-> (VarInt a -> VarInt a -> VarInt a -> [VarInt a])
-> Enum (VarInt a)
forall a. Enum a => Int -> VarInt a
forall a. Enum a => VarInt a -> Int
forall a. Enum a => VarInt a -> [VarInt a]
forall a. Enum a => VarInt a -> VarInt a
forall a. Enum a => VarInt a -> VarInt a -> [VarInt a]
forall a. Enum a => VarInt a -> VarInt a -> VarInt a -> [VarInt a]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: VarInt a -> VarInt a -> VarInt a -> [VarInt a]
$cenumFromThenTo :: forall a. Enum a => VarInt a -> VarInt a -> VarInt a -> [VarInt a]
enumFromTo :: VarInt a -> VarInt a -> [VarInt a]
$cenumFromTo :: forall a. Enum a => VarInt a -> VarInt a -> [VarInt a]
enumFromThen :: VarInt a -> VarInt a -> [VarInt a]
$cenumFromThen :: forall a. Enum a => VarInt a -> VarInt a -> [VarInt a]
enumFrom :: VarInt a -> [VarInt a]
$cenumFrom :: forall a. Enum a => VarInt a -> [VarInt a]
fromEnum :: VarInt a -> Int
$cfromEnum :: forall a. Enum a => VarInt a -> Int
toEnum :: Int -> VarInt a
$ctoEnum :: forall a. Enum a => Int -> VarInt a
pred :: VarInt a -> VarInt a
$cpred :: forall a. Enum a => VarInt a -> VarInt a
succ :: VarInt a -> VarInt a
$csucc :: forall a. Enum a => VarInt a -> VarInt a
Enum
  , VarInt a
VarInt a -> VarInt a -> Bounded (VarInt a)
forall a. a -> a -> Bounded a
forall a. Bounded a => VarInt a
maxBound :: VarInt a
$cmaxBound :: forall a. Bounded a => VarInt a
minBound :: VarInt a
$cminBound :: forall a. Bounded a => VarInt a
Bounded, Integer -> VarInt a
VarInt a -> VarInt a
VarInt a -> VarInt a -> VarInt a
(VarInt a -> VarInt a -> VarInt a)
-> (VarInt a -> VarInt a -> VarInt a)
-> (VarInt a -> VarInt a -> VarInt a)
-> (VarInt a -> VarInt a)
-> (VarInt a -> VarInt a)
-> (VarInt a -> VarInt a)
-> (Integer -> VarInt a)
-> Num (VarInt a)
forall a. Num a => Integer -> VarInt a
forall a. Num a => VarInt a -> VarInt a
forall a. Num a => VarInt a -> VarInt a -> VarInt a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> VarInt a
$cfromInteger :: forall a. Num a => Integer -> VarInt a
signum :: VarInt a -> VarInt a
$csignum :: forall a. Num a => VarInt a -> VarInt a
abs :: VarInt a -> VarInt a
$cabs :: forall a. Num a => VarInt a -> VarInt a
negate :: VarInt a -> VarInt a
$cnegate :: forall a. Num a => VarInt a -> VarInt a
* :: VarInt a -> VarInt a -> VarInt a
$c* :: forall a. Num a => VarInt a -> VarInt a -> VarInt a
- :: VarInt a -> VarInt a -> VarInt a
$c- :: forall a. Num a => VarInt a -> VarInt a -> VarInt a
+ :: VarInt a -> VarInt a -> VarInt a
$c+ :: forall a. Num a => VarInt a -> VarInt a -> VarInt a
Num, Num (VarInt a)
Ord (VarInt a)
Num (VarInt a)
-> Ord (VarInt a) -> (VarInt a -> Rational) -> Real (VarInt a)
VarInt a -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
forall a. Real a => Num (VarInt a)
forall a. Real a => Ord (VarInt a)
forall a. Real a => VarInt a -> Rational
toRational :: VarInt a -> Rational
$ctoRational :: forall a. Real a => VarInt a -> Rational
$cp2Real :: forall a. Real a => Ord (VarInt a)
$cp1Real :: forall a. Real a => Num (VarInt a)
Real, Enum (VarInt a)
Real (VarInt a)
Real (VarInt a)
-> Enum (VarInt a)
-> (VarInt a -> VarInt a -> VarInt a)
-> (VarInt a -> VarInt a -> VarInt a)
-> (VarInt a -> VarInt a -> VarInt a)
-> (VarInt a -> VarInt a -> VarInt a)
-> (VarInt a -> VarInt a -> (VarInt a, VarInt a))
-> (VarInt a -> VarInt a -> (VarInt a, VarInt a))
-> (VarInt a -> Integer)
-> Integral (VarInt a)
VarInt a -> Integer
VarInt a -> VarInt a -> (VarInt a, VarInt a)
VarInt a -> VarInt a -> VarInt a
forall a. Integral a => Enum (VarInt a)
forall a. Integral a => Real (VarInt a)
forall a. Integral a => VarInt a -> Integer
forall a.
Integral a =>
VarInt a -> VarInt a -> (VarInt a, VarInt a)
forall a. Integral a => VarInt a -> VarInt a -> VarInt a
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: VarInt a -> Integer
$ctoInteger :: forall a. Integral a => VarInt a -> Integer
divMod :: VarInt a -> VarInt a -> (VarInt a, VarInt a)
$cdivMod :: forall a.
Integral a =>
VarInt a -> VarInt a -> (VarInt a, VarInt a)
quotRem :: VarInt a -> VarInt a -> (VarInt a, VarInt a)
$cquotRem :: forall a.
Integral a =>
VarInt a -> VarInt a -> (VarInt a, VarInt a)
mod :: VarInt a -> VarInt a -> VarInt a
$cmod :: forall a. Integral a => VarInt a -> VarInt a -> VarInt a
div :: VarInt a -> VarInt a -> VarInt a
$cdiv :: forall a. Integral a => VarInt a -> VarInt a -> VarInt a
rem :: VarInt a -> VarInt a -> VarInt a
$crem :: forall a. Integral a => VarInt a -> VarInt a -> VarInt a
quot :: VarInt a -> VarInt a -> VarInt a
$cquot :: forall a. Integral a => VarInt a -> VarInt a -> VarInt a
$cp2Integral :: forall a. Integral a => Enum (VarInt a)
$cp1Integral :: forall a. Integral a => Real (VarInt a)
Integral, Eq (VarInt a)
VarInt a
Eq (VarInt a)
-> (VarInt a -> VarInt a -> VarInt a)
-> (VarInt a -> VarInt a -> VarInt a)
-> (VarInt a -> VarInt a -> VarInt a)
-> (VarInt a -> VarInt a)
-> (VarInt a -> Int -> VarInt a)
-> (VarInt a -> Int -> VarInt a)
-> VarInt a
-> (Int -> VarInt a)
-> (VarInt a -> Int -> VarInt a)
-> (VarInt a -> Int -> VarInt a)
-> (VarInt a -> Int -> VarInt a)
-> (VarInt a -> Int -> Bool)
-> (VarInt a -> Maybe Int)
-> (VarInt a -> Int)
-> (VarInt a -> Bool)
-> (VarInt a -> Int -> VarInt a)
-> (VarInt a -> Int -> VarInt a)
-> (VarInt a -> Int -> VarInt a)
-> (VarInt a -> Int -> VarInt a)
-> (VarInt a -> Int -> VarInt a)
-> (VarInt a -> Int -> VarInt a)
-> (VarInt a -> Int)
-> Bits (VarInt a)
Int -> VarInt a
VarInt a -> Bool
VarInt a -> Int
VarInt a -> Maybe Int
VarInt a -> VarInt a
VarInt a -> Int -> Bool
VarInt a -> Int -> VarInt a
VarInt a -> VarInt a -> VarInt a
forall a.
Eq a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> a
-> (Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> Bool)
-> (a -> Maybe Int)
-> (a -> Int)
-> (a -> Bool)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int -> a)
-> (a -> Int)
-> Bits a
forall a. Bits a => Eq (VarInt a)
forall a. Bits a => VarInt a
forall a. Bits a => Int -> VarInt a
forall a. Bits a => VarInt a -> Bool
forall a. Bits a => VarInt a -> Int
forall a. Bits a => VarInt a -> Maybe Int
forall a. Bits a => VarInt a -> VarInt a
forall a. Bits a => VarInt a -> Int -> Bool
forall a. Bits a => VarInt a -> Int -> VarInt a
forall a. Bits a => VarInt a -> VarInt a -> VarInt a
popCount :: VarInt a -> Int
$cpopCount :: forall a. Bits a => VarInt a -> Int
rotateR :: VarInt a -> Int -> VarInt a
$crotateR :: forall a. Bits a => VarInt a -> Int -> VarInt a
rotateL :: VarInt a -> Int -> VarInt a
$crotateL :: forall a. Bits a => VarInt a -> Int -> VarInt a
unsafeShiftR :: VarInt a -> Int -> VarInt a
$cunsafeShiftR :: forall a. Bits a => VarInt a -> Int -> VarInt a
shiftR :: VarInt a -> Int -> VarInt a
$cshiftR :: forall a. Bits a => VarInt a -> Int -> VarInt a
unsafeShiftL :: VarInt a -> Int -> VarInt a
$cunsafeShiftL :: forall a. Bits a => VarInt a -> Int -> VarInt a
shiftL :: VarInt a -> Int -> VarInt a
$cshiftL :: forall a. Bits a => VarInt a -> Int -> VarInt a
isSigned :: VarInt a -> Bool
$cisSigned :: forall a. Bits a => VarInt a -> Bool
bitSize :: VarInt a -> Int
$cbitSize :: forall a. Bits a => VarInt a -> Int
bitSizeMaybe :: VarInt a -> Maybe Int
$cbitSizeMaybe :: forall a. Bits a => VarInt a -> Maybe Int
testBit :: VarInt a -> Int -> Bool
$ctestBit :: forall a. Bits a => VarInt a -> Int -> Bool
complementBit :: VarInt a -> Int -> VarInt a
$ccomplementBit :: forall a. Bits a => VarInt a -> Int -> VarInt a
clearBit :: VarInt a -> Int -> VarInt a
$cclearBit :: forall a. Bits a => VarInt a -> Int -> VarInt a
setBit :: VarInt a -> Int -> VarInt a
$csetBit :: forall a. Bits a => VarInt a -> Int -> VarInt a
bit :: Int -> VarInt a
$cbit :: forall a. Bits a => Int -> VarInt a
zeroBits :: VarInt a
$czeroBits :: forall a. Bits a => VarInt a
rotate :: VarInt a -> Int -> VarInt a
$crotate :: forall a. Bits a => VarInt a -> Int -> VarInt a
shift :: VarInt a -> Int -> VarInt a
$cshift :: forall a. Bits a => VarInt a -> Int -> VarInt a
complement :: VarInt a -> VarInt a
$ccomplement :: forall a. Bits a => VarInt a -> VarInt a
xor :: VarInt a -> VarInt a -> VarInt a
$cxor :: forall a. Bits a => VarInt a -> VarInt a -> VarInt a
.|. :: VarInt a -> VarInt a -> VarInt a
$c.|. :: forall a. Bits a => VarInt a -> VarInt a -> VarInt a
.&. :: VarInt a -> VarInt a -> VarInt a
$c.&. :: forall a. Bits a => VarInt a -> VarInt a -> VarInt a
$cp1Bits :: forall a. Bits a => Eq (VarInt a)
Bits, Typeable)

instance (Typeable a, Bits a, Integral a) => Serialise (VarInt a) where
  schemaGen :: Proxy (VarInt a) -> SchemaGen Schema
schemaGen Proxy (VarInt a)
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
forall a. SchemaP a
SInteger
  toBuilder :: VarInt a -> Builder
toBuilder = a -> Builder
forall a. (Bits a, Integral a) => a -> Builder
varInt (a -> Builder) -> (VarInt a -> a) -> VarInt a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarInt a -> a
forall a. VarInt a -> a
getVarInt
  {-# INLINE toBuilder #-}
  extractor :: Extractor (VarInt a)
extractor = (Schema -> Strategy' (Term -> VarInt a)) -> Extractor (VarInt a)
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor ((Schema -> Strategy' (Term -> VarInt a)) -> Extractor (VarInt a))
-> (Schema -> Strategy' (Term -> VarInt a)) -> Extractor (VarInt a)
forall a b. (a -> b) -> a -> b
$ \case
    Schema
SInteger -> (Term -> VarInt a) -> Strategy' (Term -> VarInt a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Term -> VarInt a) -> Strategy' (Term -> VarInt a))
-> (Term -> VarInt a) -> Strategy' (Term -> VarInt a)
forall a b. (a -> b) -> a -> b
$ \case
      TInteger Integer
i -> Integer -> VarInt a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i
      Term
t -> ExtractException -> VarInt a
forall a e. Exception e => e -> a
throw (ExtractException -> VarInt a) -> ExtractException -> VarInt a
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t
    Schema
s -> Schema -> Strategy' (Term -> VarInt a)
forall (f :: * -> *) a. Serialise a => Schema -> Strategy' (f a)
unexpectedSchema Schema
s
  decodeCurrent :: Decoder (VarInt a)
decodeCurrent = a -> VarInt a
forall a. a -> VarInt a
VarInt (a -> VarInt a) -> Decoder a -> Decoder (VarInt a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder a
forall a. (Num a, Bits a) => Decoder a
decodeVarInt

instance Serialise Integer where
  schemaGen :: Proxy Integer -> SchemaGen Schema
schemaGen Proxy Integer
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
forall a. SchemaP a
SInteger
  toBuilder :: Integer -> Builder
toBuilder = VarInt Integer -> Builder
forall a. Serialise a => a -> Builder
toBuilder (VarInt Integer -> Builder)
-> (Integer -> VarInt Integer) -> Integer -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> VarInt Integer
forall a. a -> VarInt a
VarInt
  {-# INLINE toBuilder #-}
  extractor :: Extractor Integer
extractor = VarInt Integer -> Integer
forall a. VarInt a -> a
getVarInt (VarInt Integer -> Integer)
-> Extractor (VarInt Integer) -> Extractor Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Extractor (VarInt Integer)
forall a. Serialise a => Extractor a
extractor
  decodeCurrent :: Decoder Integer
decodeCurrent = VarInt Integer -> Integer
forall a. VarInt a -> a
getVarInt (VarInt Integer -> Integer)
-> Decoder (VarInt Integer) -> Decoder Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder (VarInt Integer)
forall a. Serialise a => Decoder a
decodeCurrent

instance Serialise Natural where
  schemaGen :: Proxy Natural -> SchemaGen Schema
schemaGen Proxy Natural
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
forall a. SchemaP a
SInteger
  toBuilder :: Natural -> Builder
toBuilder = Integer -> Builder
forall a. Serialise a => a -> Builder
toBuilder (Integer -> Builder) -> (Natural -> Integer) -> Natural -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a. Integral a => a -> Integer
toInteger
  extractor :: Extractor Natural
extractor = Integer -> Natural
naturalFromInteger (Integer -> Natural) -> Extractor Integer -> Extractor Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Extractor Integer
forall a. Serialise a => Extractor a
extractor
  decodeCurrent :: Decoder Natural
decodeCurrent = Integer -> Natural
naturalFromInteger (Integer -> Natural) -> Decoder Integer -> Decoder Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder Integer
forall a. Serialise a => Decoder a
decodeCurrent

instance Serialise Char where
  schemaGen :: Proxy Char -> SchemaGen Schema
schemaGen Proxy Char
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
forall a. SchemaP a
SChar
  toBuilder :: Char -> Builder
toBuilder = Int -> Builder
forall a. Serialise a => a -> Builder
toBuilder (Int -> Builder) -> (Char -> Int) -> Char -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum
  {-# INLINE toBuilder #-}
  extractor :: Extractor Char
extractor = (Schema -> Strategy' (Term -> Char)) -> Extractor Char
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor ((Schema -> Strategy' (Term -> Char)) -> Extractor Char)
-> (Schema -> Strategy' (Term -> Char)) -> Extractor Char
forall a b. (a -> b) -> a -> b
$ \case
    Schema
SChar -> (Term -> Char) -> Strategy' (Term -> Char)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Term -> Char) -> Strategy' (Term -> Char))
-> (Term -> Char) -> Strategy' (Term -> Char)
forall a b. (a -> b) -> a -> b
$ \case
      TChar Char
c -> Char
c
      Term
t -> ExtractException -> Char
forall a e. Exception e => e -> a
throw (ExtractException -> Char) -> ExtractException -> Char
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t
    Schema
s -> Schema -> Strategy' (Term -> Char)
forall (f :: * -> *) a. Serialise a => Schema -> Strategy' (f a)
unexpectedSchema Schema
s
  decodeCurrent :: Decoder Char
decodeCurrent = Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> Decoder Int -> Decoder Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder Int
forall a. (Num a, Bits a) => Decoder a
decodeVarInt

instance Serialise a => Serialise (Maybe a) where
  schemaGen :: Proxy (Maybe a) -> SchemaGen Schema
schemaGen = Proxy (Maybe a) -> SchemaGen Schema
forall (proxy :: * -> *) a.
(GSerialiseVariant (Rep a), Typeable a, Generic a) =>
proxy a -> SchemaGen Schema
gschemaGenVariant
  toBuilder :: Maybe a -> Builder
toBuilder = Maybe a -> Builder
forall a.
(GConstructorCount (Rep a), GEncodeVariant (Rep a), Generic a) =>
a -> Builder
gtoBuilderVariant
  extractor :: Extractor (Maybe a)
extractor = Extractor (Maybe a)
forall a.
(GSerialiseVariant (Rep a), Generic a, Typeable a) =>
Extractor a
gextractorVariant
  decodeCurrent :: Decoder (Maybe a)
decodeCurrent = Decoder (Maybe a)
forall a.
(GConstructorCount (Rep a), GEncodeVariant (Rep a),
 GDecodeVariant (Rep a), Generic a) =>
Decoder a
gdecodeCurrentVariant

instance Serialise B.ByteString where
  schemaGen :: Proxy ByteString -> SchemaGen Schema
schemaGen Proxy ByteString
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
forall a. SchemaP a
SBytes
  toBuilder :: ByteString -> Builder
toBuilder ByteString
bs = Int -> Builder
forall a. (Bits a, Integral a) => a -> Builder
varInt (ByteString -> Int
B.length ByteString
bs) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BB.byteString ByteString
bs
  {-# INLINE toBuilder #-}
  extractor :: Extractor ByteString
extractor = (Schema -> Strategy' (Term -> ByteString)) -> Extractor ByteString
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor ((Schema -> Strategy' (Term -> ByteString))
 -> Extractor ByteString)
-> (Schema -> Strategy' (Term -> ByteString))
-> Extractor ByteString
forall a b. (a -> b) -> a -> b
$ \case
    Schema
SBytes -> (Term -> ByteString) -> Strategy' (Term -> ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Term -> ByteString) -> Strategy' (Term -> ByteString))
-> (Term -> ByteString) -> Strategy' (Term -> ByteString)
forall a b. (a -> b) -> a -> b
$ \case
      TBytes ByteString
bs -> ByteString
bs
      Term
t -> ExtractException -> ByteString
forall a e. Exception e => e -> a
throw (ExtractException -> ByteString) -> ExtractException -> ByteString
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t
    Schema
s -> Schema -> Strategy' (Term -> ByteString)
forall (f :: * -> *) a. Serialise a => Schema -> Strategy' (f a)
unexpectedSchema Schema
s
  decodeCurrent :: Decoder ByteString
decodeCurrent = Decoder Int
forall a. (Num a, Bits a) => Decoder a
decodeVarInt Decoder Int -> (Int -> Decoder ByteString) -> Decoder ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Decoder ByteString
getBytes

instance Serialise BL.ByteString where
  schemaGen :: Proxy ByteString -> SchemaGen Schema
schemaGen Proxy ByteString
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
forall a. SchemaP a
SBytes
  toBuilder :: ByteString -> Builder
toBuilder = ByteString -> Builder
forall a. Serialise a => a -> Builder
toBuilder (ByteString -> Builder)
-> (ByteString -> ByteString) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict
  {-# INLINE toBuilder #-}
  extractor :: Extractor ByteString
extractor = ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> Extractor ByteString -> Extractor ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Extractor ByteString
forall a. Serialise a => Extractor a
extractor
  decodeCurrent :: Decoder ByteString
decodeCurrent = ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> Decoder ByteString -> Decoder ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder ByteString
forall a. Serialise a => Decoder a
decodeCurrent

-- | time-1.9.1
nanosecondsToNominalDiffTime :: Int64 -> NominalDiffTime
nanosecondsToNominalDiffTime :: Int64 -> NominalDiffTime
nanosecondsToNominalDiffTime = Fixed Any -> NominalDiffTime
forall a b. a -> b
unsafeCoerce (Fixed Any -> NominalDiffTime)
-> (Int64 -> Fixed Any) -> Int64 -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Fixed Any
forall k (a :: k). Integer -> Fixed a
MkFixed (Integer -> Fixed Any) -> (Int64 -> Integer) -> Int64 -> Fixed Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
1000) (Integer -> Integer) -> (Int64 -> Integer) -> Int64 -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance Serialise UTCTime where
  schemaGen :: Proxy UTCTime -> SchemaGen Schema
schemaGen Proxy UTCTime
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
forall a. SchemaP a
SUTCTime
  toBuilder :: UTCTime -> Builder
toBuilder = NominalDiffTime -> Builder
forall a. Serialise a => a -> Builder
toBuilder (NominalDiffTime -> Builder)
-> (UTCTime -> NominalDiffTime) -> UTCTime -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> NominalDiffTime
utcTimeToPOSIXSeconds
  {-# INLINE toBuilder #-}
  extractor :: Extractor UTCTime
extractor = (Schema -> Strategy' (Term -> UTCTime)) -> Extractor UTCTime
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor ((Schema -> Strategy' (Term -> UTCTime)) -> Extractor UTCTime)
-> (Schema -> Strategy' (Term -> UTCTime)) -> Extractor UTCTime
forall a b. (a -> b) -> a -> b
$ \case
    Schema
SUTCTime -> (Term -> UTCTime) -> Strategy' (Term -> UTCTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Term -> UTCTime) -> Strategy' (Term -> UTCTime))
-> (Term -> UTCTime) -> Strategy' (Term -> UTCTime)
forall a b. (a -> b) -> a -> b
$ \case
      TUTCTime UTCTime
bs -> UTCTime
bs
      Term
t -> ExtractException -> UTCTime
forall a e. Exception e => e -> a
throw (ExtractException -> UTCTime) -> ExtractException -> UTCTime
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t
    Schema
s -> Schema -> Strategy' (Term -> UTCTime)
forall (f :: * -> *) a. Serialise a => Schema -> Strategy' (f a)
unexpectedSchema Schema
s
  decodeCurrent :: Decoder UTCTime
decodeCurrent = NominalDiffTime -> UTCTime
posixSecondsToUTCTime (NominalDiffTime -> UTCTime)
-> Decoder NominalDiffTime -> Decoder UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder NominalDiffTime
forall a. Serialise a => Decoder a
decodeCurrent

instance Serialise NominalDiffTime where
  schemaGen :: Proxy NominalDiffTime -> SchemaGen Schema
schemaGen Proxy NominalDiffTime
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
forall a. SchemaP a
SInt64
  toBuilder :: NominalDiffTime -> Builder
toBuilder NominalDiffTime
x = case NominalDiffTime -> Fixed Any
forall a b. a -> b
unsafeCoerce NominalDiffTime
x of
    MkFixed Integer
p -> Int64 -> Builder
forall a. Serialise a => a -> Builder
toBuilder (Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
p Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
1000) :: Int64)
  {-# INLINE toBuilder #-}
  extractor :: Extractor NominalDiffTime
extractor = Int64 -> NominalDiffTime
nanosecondsToNominalDiffTime (Int64 -> NominalDiffTime)
-> Extractor Int64 -> Extractor NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Extractor Int64
forall a. Serialise a => Extractor a
extractor
  decodeCurrent :: Decoder NominalDiffTime
decodeCurrent = Int64 -> NominalDiffTime
nanosecondsToNominalDiffTime (Int64 -> NominalDiffTime)
-> Decoder Int64 -> Decoder NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder Int64
forall a. Serialise a => Decoder a
decodeCurrent

-- | Extract a list or an array of values.
extractListBy :: Typeable a => Extractor a -> Extractor (V.Vector a)
extractListBy :: Extractor a -> Extractor (Vector a)
extractListBy (Extractor Schema -> Strategy' (Term -> a)
plan) = (Schema -> Strategy' (Term -> Vector a)) -> Extractor (Vector a)
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor ((Schema -> Strategy' (Term -> Vector a)) -> Extractor (Vector a))
-> (Schema -> Strategy' (Term -> Vector a)) -> Extractor (Vector a)
forall a b. (a -> b) -> a -> b
$ \case
  SVector Schema
s -> do
    Term -> a
getItem <- Schema -> Strategy' (Term -> a)
plan Schema
s
    return $ \case
      TVector Vector Term
xs -> (Term -> a) -> Vector Term -> Vector a
forall a b. (a -> b) -> Vector a -> Vector b
V.map Term -> a
getItem Vector Term
xs
      Term
t -> ExtractException -> Vector a
forall a e. Exception e => e -> a
throw (ExtractException -> Vector a) -> ExtractException -> Vector a
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t
  Schema
s -> WineryException -> Strategy' (Term -> Vector a)
forall e r a. e -> Strategy e r a
throwStrategy (WineryException -> Strategy' (Term -> Vector a))
-> WineryException -> Strategy' (Term -> Vector a)
forall a b. (a -> b) -> a -> b
$ [TypeRep] -> Doc AnsiStyle -> Schema -> WineryException
UnexpectedSchema [] Doc AnsiStyle
"SVector" Schema
s
{-# INLINE extractListBy #-}

instance Serialise a => Serialise [a] where
  schemaGen :: Proxy [a] -> SchemaGen Schema
schemaGen Proxy [a]
_ = Schema -> Schema
forall a. SchemaP a -> SchemaP a
SVector (Schema -> Schema) -> SchemaGen Schema -> SchemaGen Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy a -> SchemaGen Schema
forall (proxy :: * -> *) a.
Serialise a =>
proxy a -> SchemaGen Schema
getSchema (Proxy a
forall k (t :: k). Proxy t
Proxy @ a)
  toBuilder :: [a] -> Builder
toBuilder [a]
xs = Int -> Builder
forall a. (Bits a, Integral a) => a -> Builder
varInt ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs)
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (a -> Builder) -> [a] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Builder
forall a. Serialise a => a -> Builder
toBuilder [a]
xs
  {-# INLINE toBuilder #-}
  extractor :: Extractor [a]
extractor = Vector a -> [a]
forall a. Vector a -> [a]
V.toList (Vector a -> [a]) -> Extractor (Vector a) -> Extractor [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Extractor a -> Extractor (Vector a)
forall a. Typeable a => Extractor a -> Extractor (Vector a)
extractListBy Extractor a
forall a. Serialise a => Extractor a
extractor
  decodeCurrent :: Decoder [a]
decodeCurrent = do
    Int
n <- Decoder Int
forall a. (Num a, Bits a) => Decoder a
decodeVarInt
    Int -> Decoder a -> Decoder [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n Decoder a
forall a. Serialise a => Decoder a
decodeCurrent

instance Serialise a => Serialise (V.Vector a) where
  schemaGen :: Proxy (Vector a) -> SchemaGen Schema
schemaGen Proxy (Vector a)
_ = Schema -> Schema
forall a. SchemaP a -> SchemaP a
SVector (Schema -> Schema) -> SchemaGen Schema -> SchemaGen Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy a -> SchemaGen Schema
forall (proxy :: * -> *) a.
Serialise a =>
proxy a -> SchemaGen Schema
getSchema (Proxy a
forall k (t :: k). Proxy t
Proxy @ a)
  toBuilder :: Vector a -> Builder
toBuilder Vector a
xs = Int -> Builder
forall a. (Bits a, Integral a) => a -> Builder
varInt (Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
xs)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (a -> Builder) -> Vector a -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Builder
forall a. Serialise a => a -> Builder
toBuilder Vector a
xs
  {-# INLINE toBuilder #-}
  extractor :: Extractor (Vector a)
extractor = Extractor a -> Extractor (Vector a)
forall a. Typeable a => Extractor a -> Extractor (Vector a)
extractListBy Extractor a
forall a. Serialise a => Extractor a
extractor
  decodeCurrent :: Decoder (Vector a)
decodeCurrent = do
    Int
n <- Decoder Int
forall a. (Num a, Bits a) => Decoder a
decodeVarInt
    Int -> Decoder a -> Decoder (Vector a)
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM Int
n Decoder a
forall a. Serialise a => Decoder a
decodeCurrent

instance (SV.Storable a, Serialise a) => Serialise (SV.Vector a) where
  schemaGen :: Proxy (Vector a) -> SchemaGen Schema
schemaGen Proxy (Vector a)
_ = Schema -> Schema
forall a. SchemaP a -> SchemaP a
SVector (Schema -> Schema) -> SchemaGen Schema -> SchemaGen Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy a -> SchemaGen Schema
forall (proxy :: * -> *) a.
Serialise a =>
proxy a -> SchemaGen Schema
getSchema (Proxy a
forall k (t :: k). Proxy t
Proxy @ a)
  toBuilder :: Vector a -> Builder
toBuilder = Vector a -> Builder
forall a. Serialise a => a -> Builder
toBuilder (Vector a -> Builder)
-> (Vector a -> Vector a) -> Vector a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector a -> Vector a
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
SV.convert :: SV.Vector a -> V.Vector a)
  {-# INLINE toBuilder #-}
  extractor :: Extractor (Vector a)
extractor = Vector a -> Vector a
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
SV.convert (Vector a -> Vector a)
-> Extractor (Vector a) -> Extractor (Vector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Extractor a -> Extractor (Vector a)
forall a. Typeable a => Extractor a -> Extractor (Vector a)
extractListBy Extractor a
forall a. Serialise a => Extractor a
extractor
  decodeCurrent :: Decoder (Vector a)
decodeCurrent = do
    Int
n <- Decoder Int
forall a. (Num a, Bits a) => Decoder a
decodeVarInt
    Int -> Decoder a -> Decoder (Vector a)
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Int -> m a -> m (Vector a)
SV.replicateM Int
n Decoder a
forall a. Serialise a => Decoder a
decodeCurrent

instance (UV.Unbox a, Serialise a) => Serialise (UV.Vector a) where
  schemaGen :: Proxy (Vector a) -> SchemaGen Schema
schemaGen Proxy (Vector a)
_ = Schema -> Schema
forall a. SchemaP a -> SchemaP a
SVector (Schema -> Schema) -> SchemaGen Schema -> SchemaGen Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy a -> SchemaGen Schema
forall (proxy :: * -> *) a.
Serialise a =>
proxy a -> SchemaGen Schema
getSchema (Proxy a
forall k (t :: k). Proxy t
Proxy @ a)
  toBuilder :: Vector a -> Builder
toBuilder = Vector a -> Builder
forall a. Serialise a => a -> Builder
toBuilder (Vector a -> Builder)
-> (Vector a -> Vector a) -> Vector a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector a -> Vector a
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
UV.convert :: UV.Vector a -> V.Vector a)
  {-# INLINE toBuilder #-}
  extractor :: Extractor (Vector a)
extractor = Vector a -> Vector a
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
UV.convert (Vector a -> Vector a)
-> Extractor (Vector a) -> Extractor (Vector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Extractor a -> Extractor (Vector a)
forall a. Typeable a => Extractor a -> Extractor (Vector a)
extractListBy Extractor a
forall a. Serialise a => Extractor a
extractor
  decodeCurrent :: Decoder (Vector a)
decodeCurrent = do
    Int
n <- Decoder Int
forall a. (Num a, Bits a) => Decoder a
decodeVarInt
    Int -> Decoder a -> Decoder (Vector a)
forall (m :: * -> *) a.
(Monad m, Unbox a) =>
Int -> m a -> m (Vector a)
UV.replicateM Int
n Decoder a
forall a. Serialise a => Decoder a
decodeCurrent

instance (Ord k, Serialise k, Serialise v) => Serialise (M.Map k v) where
  schemaGen :: Proxy (Map k v) -> SchemaGen Schema
schemaGen Proxy (Map k v)
_ = Proxy [(k, v)] -> SchemaGen Schema
forall a. Serialise a => Proxy a -> SchemaGen Schema
schemaGen (Proxy [(k, v)]
forall k (t :: k). Proxy t
Proxy @ [(k, v)])
  toBuilder :: Map k v -> Builder
toBuilder Map k v
m = Int -> Builder
forall a. Serialise a => a -> Builder
toBuilder (Map k v -> Int
forall k a. Map k a -> Int
M.size Map k v
m)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (k -> v -> Builder) -> Map k v -> Builder
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
M.foldMapWithKey (((k, v) -> Builder) -> k -> v -> Builder
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (k, v) -> Builder
forall a. Serialise a => a -> Builder
toBuilder) Map k v
m
  {-# INLINE toBuilder #-}
  extractor :: Extractor (Map k v)
extractor = [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(k, v)] -> Map k v) -> Extractor [(k, v)] -> Extractor (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Extractor [(k, v)]
forall a. Serialise a => Extractor a
extractor
  decodeCurrent :: Decoder (Map k v)
decodeCurrent = [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(k, v)] -> Map k v) -> Decoder [(k, v)] -> Decoder (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder [(k, v)]
forall a. Serialise a => Decoder a
decodeCurrent

instance (Eq k, Hashable k, Serialise k, Serialise v) => Serialise (HM.HashMap k v) where
  schemaGen :: Proxy (HashMap k v) -> SchemaGen Schema
schemaGen Proxy (HashMap k v)
_ = Proxy [(k, v)] -> SchemaGen Schema
forall a. Serialise a => Proxy a -> SchemaGen Schema
schemaGen (Proxy [(k, v)]
forall k (t :: k). Proxy t
Proxy @ [(k, v)])
  toBuilder :: HashMap k v -> Builder
toBuilder HashMap k v
m = Int -> Builder
forall a. Serialise a => a -> Builder
toBuilder (HashMap k v -> Int
forall k v. HashMap k v -> Int
HM.size HashMap k v
m)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (k -> v -> Builder -> Builder) -> Builder -> HashMap k v -> Builder
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HM.foldrWithKey (\k
k v
v Builder
r -> (k, v) -> Builder
forall a. Serialise a => a -> Builder
toBuilder (k
k, v
v) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
r) Builder
forall a. Monoid a => a
mempty HashMap k v
m
  {-# INLINE toBuilder #-}
  extractor :: Extractor (HashMap k v)
extractor = [(k, v)] -> HashMap k v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(k, v)] -> HashMap k v)
-> Extractor [(k, v)] -> Extractor (HashMap k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Extractor [(k, v)]
forall a. Serialise a => Extractor a
extractor
  decodeCurrent :: Decoder (HashMap k v)
decodeCurrent = [(k, v)] -> HashMap k v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(k, v)] -> HashMap k v)
-> Decoder [(k, v)] -> Decoder (HashMap k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder [(k, v)]
forall a. Serialise a => Decoder a
decodeCurrent

instance (Serialise v) => Serialise (IM.IntMap v) where
  schemaGen :: Proxy (IntMap v) -> SchemaGen Schema
schemaGen Proxy (IntMap v)
_ = Proxy [(Int, v)] -> SchemaGen Schema
forall a. Serialise a => Proxy a -> SchemaGen Schema
schemaGen (Proxy [(Int, v)]
forall k (t :: k). Proxy t
Proxy @ [(Int, v)])
  toBuilder :: IntMap v -> Builder
toBuilder IntMap v
m = Int -> Builder
forall a. Serialise a => a -> Builder
toBuilder (IntMap v -> Int
forall a. IntMap a -> Int
IM.size IntMap v
m)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Int -> v -> Builder) -> IntMap v -> Builder
forall m a. Monoid m => (Int -> a -> m) -> IntMap a -> m
IM.foldMapWithKey (((Int, v) -> Builder) -> Int -> v -> Builder
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Int, v) -> Builder
forall a. Serialise a => a -> Builder
toBuilder) IntMap v
m
  {-# INLINE toBuilder #-}
  extractor :: Extractor (IntMap v)
extractor = [(Int, v)] -> IntMap v
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Int, v)] -> IntMap v)
-> Extractor [(Int, v)] -> Extractor (IntMap v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Extractor [(Int, v)]
forall a. Serialise a => Extractor a
extractor
  decodeCurrent :: Decoder (IntMap v)
decodeCurrent = [(Int, v)] -> IntMap v
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Int, v)] -> IntMap v)
-> Decoder [(Int, v)] -> Decoder (IntMap v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder [(Int, v)]
forall a. Serialise a => Decoder a
decodeCurrent

instance (Ord a, Serialise a) => Serialise (S.Set a) where
  schemaGen :: Proxy (Set a) -> SchemaGen Schema
schemaGen Proxy (Set a)
_ = Proxy [a] -> SchemaGen Schema
forall a. Serialise a => Proxy a -> SchemaGen Schema
schemaGen (Proxy [a]
forall k (t :: k). Proxy t
Proxy @ [a])
  toBuilder :: Set a -> Builder
toBuilder Set a
s = Int -> Builder
forall a. Serialise a => a -> Builder
toBuilder (Set a -> Int
forall a. Set a -> Int
S.size Set a
s) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (a -> Builder) -> Set a -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Builder
forall a. Serialise a => a -> Builder
toBuilder Set a
s
  {-# INLINE toBuilder #-}
  extractor :: Extractor (Set a)
extractor = [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList ([a] -> Set a) -> Extractor [a] -> Extractor (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Extractor [a]
forall a. Serialise a => Extractor a
extractor
  decodeCurrent :: Decoder (Set a)
decodeCurrent = [a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList ([a] -> Set a) -> Decoder [a] -> Decoder (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder [a]
forall a. Serialise a => Decoder a
decodeCurrent

instance Serialise IS.IntSet where
  schemaGen :: Proxy IntSet -> SchemaGen Schema
schemaGen Proxy IntSet
_ = Proxy [Int] -> SchemaGen Schema
forall a. Serialise a => Proxy a -> SchemaGen Schema
schemaGen (Proxy [Int]
forall k (t :: k). Proxy t
Proxy @ [Int])
  toBuilder :: IntSet -> Builder
toBuilder IntSet
s = Int -> Builder
forall a. Serialise a => a -> Builder
toBuilder (IntSet -> Int
IS.size IntSet
s) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Int -> Builder -> Builder) -> Builder -> IntSet -> Builder
forall b. (Int -> b -> b) -> b -> IntSet -> b
IS.foldr (Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend (Builder -> Builder -> Builder)
-> (Int -> Builder) -> Int -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder
forall a. Serialise a => a -> Builder
toBuilder) Builder
forall a. Monoid a => a
mempty IntSet
s
  {-# INLINE toBuilder #-}
  extractor :: Extractor IntSet
extractor = [Int] -> IntSet
IS.fromList ([Int] -> IntSet) -> Extractor [Int] -> Extractor IntSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Extractor [Int]
forall a. Serialise a => Extractor a
extractor
  decodeCurrent :: Decoder IntSet
decodeCurrent = [Int] -> IntSet
IS.fromList ([Int] -> IntSet) -> Decoder [Int] -> Decoder IntSet
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder [Int]
forall a. Serialise a => Decoder a
decodeCurrent

instance Serialise a => Serialise (Seq.Seq a) where
  schemaGen :: Proxy (Seq a) -> SchemaGen Schema
schemaGen Proxy (Seq a)
_ = Proxy [a] -> SchemaGen Schema
forall a. Serialise a => Proxy a -> SchemaGen Schema
schemaGen (Proxy [a]
forall k (t :: k). Proxy t
Proxy @ [a])
  toBuilder :: Seq a -> Builder
toBuilder Seq a
s = Int -> Builder
forall a. Serialise a => a -> Builder
toBuilder (Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq a
s) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (a -> Builder) -> Seq a -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Builder
forall a. Serialise a => a -> Builder
toBuilder Seq a
s
  {-# INLINE toBuilder #-}
  extractor :: Extractor (Seq a)
extractor = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList ([a] -> Seq a) -> Extractor [a] -> Extractor (Seq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Extractor [a]
forall a. Serialise a => Extractor a
extractor
  decodeCurrent :: Decoder (Seq a)
decodeCurrent = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList ([a] -> Seq a) -> Decoder [a] -> Decoder (Seq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder [a]
forall a. Serialise a => Decoder a
decodeCurrent

instance (Integral a, Serialise a) => Serialise (Ratio a) where
  schemaGen :: Proxy (Ratio a) -> SchemaGen Schema
schemaGen Proxy (Ratio a)
_ = Proxy (a, a) -> SchemaGen Schema
forall a. Serialise a => Proxy a -> SchemaGen Schema
schemaGen (Proxy (a, a)
forall k (t :: k). Proxy t
Proxy @ (a, a))
  toBuilder :: Ratio a -> Builder
toBuilder Ratio a
x = (a, a) -> Builder
forall a. Serialise a => a -> Builder
toBuilder (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
x, Ratio a -> a
forall a. Ratio a -> a
denominator Ratio a
x)
  {-# INLINE toBuilder #-}
  extractor :: Extractor (Ratio a)
extractor = (a -> a -> Ratio a) -> (a, a) -> Ratio a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
(%) ((a, a) -> Ratio a) -> Extractor (a, a) -> Extractor (Ratio a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Extractor (a, a)
forall a. Serialise a => Extractor a
extractor
  decodeCurrent :: Decoder (Ratio a)
decodeCurrent = (a -> a -> Ratio a) -> (a, a) -> Ratio a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
(%) ((a, a) -> Ratio a) -> Decoder (a, a) -> Decoder (Ratio a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder (a, a)
forall a. Serialise a => Decoder a
decodeCurrent

instance Serialise Scientific where
  schemaGen :: Proxy Scientific -> SchemaGen Schema
schemaGen Proxy Scientific
_ = Proxy (Integer, Int) -> SchemaGen Schema
forall a. Serialise a => Proxy a -> SchemaGen Schema
schemaGen (Proxy (Integer, Int)
forall k (t :: k). Proxy t
Proxy @ (Integer, Int))
  toBuilder :: Scientific -> Builder
toBuilder Scientific
s = (Integer, Int) -> Builder
forall a. Serialise a => a -> Builder
toBuilder (Scientific -> Integer
coefficient Scientific
s, Scientific -> Int
base10Exponent Scientific
s)
  {-# INLINE toBuilder #-}
  extractor :: Extractor Scientific
extractor = (Schema -> Strategy' (Term -> Scientific)) -> Extractor Scientific
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor ((Schema -> Strategy' (Term -> Scientific))
 -> Extractor Scientific)
-> (Schema -> Strategy' (Term -> Scientific))
-> Extractor Scientific
forall a b. (a -> b) -> a -> b
$ \Schema
s -> case Schema
s of
    Schema
SWord8 -> (Word8 -> Scientific) -> Schema -> Strategy' (Term -> Scientific)
forall a a.
Serialise a =>
(a -> a) -> Schema -> Strategy' (Term -> a)
f (Word8 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word8 -> Scientific) Schema
s
    Schema
SWord16 -> (Word16 -> Scientific) -> Schema -> Strategy' (Term -> Scientific)
forall a a.
Serialise a =>
(a -> a) -> Schema -> Strategy' (Term -> a)
f (Word16 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word16 -> Scientific) Schema
s
    Schema
SWord32 -> (Word32 -> Scientific) -> Schema -> Strategy' (Term -> Scientific)
forall a a.
Serialise a =>
(a -> a) -> Schema -> Strategy' (Term -> a)
f (Word32 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word32 -> Scientific) Schema
s
    Schema
SWord64 -> (Word64 -> Scientific) -> Schema -> Strategy' (Term -> Scientific)
forall a a.
Serialise a =>
(a -> a) -> Schema -> Strategy' (Term -> a)
f (Word64 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word64 -> Scientific) Schema
s
    Schema
SInt8 -> (Int8 -> Scientific) -> Schema -> Strategy' (Term -> Scientific)
forall a a.
Serialise a =>
(a -> a) -> Schema -> Strategy' (Term -> a)
f (Int8 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int8 -> Scientific) Schema
s
    Schema
SInt16 -> (Int16 -> Scientific) -> Schema -> Strategy' (Term -> Scientific)
forall a a.
Serialise a =>
(a -> a) -> Schema -> Strategy' (Term -> a)
f (Int16 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int16 -> Scientific) Schema
s
    Schema
SInt32 -> (Int32 -> Scientific) -> Schema -> Strategy' (Term -> Scientific)
forall a a.
Serialise a =>
(a -> a) -> Schema -> Strategy' (Term -> a)
f (Int32 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int32 -> Scientific) Schema
s
    Schema
SInt64 -> (Int64 -> Scientific) -> Schema -> Strategy' (Term -> Scientific)
forall a a.
Serialise a =>
(a -> a) -> Schema -> Strategy' (Term -> a)
f (Int64 -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int64 -> Scientific) Schema
s
    Schema
SInteger -> (Integer -> Scientific) -> Schema -> Strategy' (Term -> Scientific)
forall a a.
Serialise a =>
(a -> a) -> Schema -> Strategy' (Term -> a)
f Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger Schema
s
    Schema
SFloat -> (Float -> Scientific) -> Schema -> Strategy' (Term -> Scientific)
forall a a.
Serialise a =>
(a -> a) -> Schema -> Strategy' (Term -> a)
f (Float -> Scientific
forall a b. (Real a, Fractional b) => a -> b
realToFrac :: Float -> Scientific) Schema
s
    Schema
SDouble -> (Double -> Scientific) -> Schema -> Strategy' (Term -> Scientific)
forall a a.
Serialise a =>
(a -> a) -> Schema -> Strategy' (Term -> a)
f (Double -> Scientific
forall a b. (Real a, Fractional b) => a -> b
realToFrac :: Double -> Scientific) Schema
s
    Schema
_ -> ((Integer, Int) -> Scientific)
-> Schema -> Strategy' (Term -> Scientific)
forall a a.
Serialise a =>
(a -> a) -> Schema -> Strategy' (Term -> a)
f ((Integer -> Int -> Scientific) -> (Integer, Int) -> Scientific
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Integer -> Int -> Scientific
scientific) Schema
s
    where
      f :: (a -> a) -> Schema -> Strategy' (Term -> a)
f a -> a
c = Extractor a -> Schema -> Strategy' (Term -> a)
forall a. Extractor a -> Schema -> Strategy' (Term -> a)
runExtractor (a -> a
c (a -> a) -> Extractor a -> Extractor a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Extractor a
forall a. Serialise a => Extractor a
extractor)
  decodeCurrent :: Decoder Scientific
decodeCurrent = Integer -> Int -> Scientific
scientific (Integer -> Int -> Scientific)
-> Decoder Integer -> Decoder (Int -> Scientific)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder Integer
forall a. Serialise a => Decoder a
decodeCurrent Decoder (Int -> Scientific) -> Decoder Int -> Decoder Scientific
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder Int
forall a. Serialise a => Decoder a
decodeCurrent

instance (Serialise a, Serialise b) => Serialise (a, b) where
  schemaGen :: Proxy (a, b) -> SchemaGen Schema
schemaGen = Proxy (a, b) -> SchemaGen Schema
forall (proxy :: * -> *) a.
(Generic a, GSerialiseProduct (Rep a)) =>
proxy a -> SchemaGen Schema
gschemaGenProduct
  toBuilder :: (a, b) -> Builder
toBuilder = (a, b) -> Builder
forall a. (Generic a, GEncodeProduct (Rep a)) => a -> Builder
gtoBuilderProduct
  extractor :: Extractor (a, b)
extractor = Extractor (a, b)
forall a.
(GSerialiseProduct (Rep a), Generic a, Typeable a) =>
Extractor a
gextractorProduct
  decodeCurrent :: Decoder (a, b)
decodeCurrent = Decoder (a, b)
forall a. (GDecodeProduct (Rep a), Generic a) => Decoder a
gdecodeCurrentProduct
  {-# INLINE toBuilder #-}
  {-# INLINE decodeCurrent #-}

instance (Serialise a, Serialise b, Serialise c) => Serialise (a, b, c) where
  schemaGen :: Proxy (a, b, c) -> SchemaGen Schema
schemaGen = Proxy (a, b, c) -> SchemaGen Schema
forall (proxy :: * -> *) a.
(Generic a, GSerialiseProduct (Rep a)) =>
proxy a -> SchemaGen Schema
gschemaGenProduct
  toBuilder :: (a, b, c) -> Builder
toBuilder = (a, b, c) -> Builder
forall a. (Generic a, GEncodeProduct (Rep a)) => a -> Builder
gtoBuilderProduct
  extractor :: Extractor (a, b, c)
extractor = Extractor (a, b, c)
forall a.
(GSerialiseProduct (Rep a), Generic a, Typeable a) =>
Extractor a
gextractorProduct
  decodeCurrent :: Decoder (a, b, c)
decodeCurrent = Decoder (a, b, c)
forall a. (GDecodeProduct (Rep a), Generic a) => Decoder a
gdecodeCurrentProduct
  {-# INLINE toBuilder #-}
  {-# INLINE decodeCurrent #-}

instance (Serialise a, Serialise b, Serialise c, Serialise d) => Serialise (a, b, c, d) where
  schemaGen :: Proxy (a, b, c, d) -> SchemaGen Schema
schemaGen = Proxy (a, b, c, d) -> SchemaGen Schema
forall (proxy :: * -> *) a.
(Generic a, GSerialiseProduct (Rep a)) =>
proxy a -> SchemaGen Schema
gschemaGenProduct
  toBuilder :: (a, b, c, d) -> Builder
toBuilder = (a, b, c, d) -> Builder
forall a. (Generic a, GEncodeProduct (Rep a)) => a -> Builder
gtoBuilderProduct
  extractor :: Extractor (a, b, c, d)
extractor = Extractor (a, b, c, d)
forall a.
(GSerialiseProduct (Rep a), Generic a, Typeable a) =>
Extractor a
gextractorProduct
  decodeCurrent :: Decoder (a, b, c, d)
decodeCurrent = Decoder (a, b, c, d)
forall a. (GDecodeProduct (Rep a), Generic a) => Decoder a
gdecodeCurrentProduct
  {-# INLINE toBuilder #-}
  {-# INLINE decodeCurrent #-}

instance (Serialise a, Serialise b, Serialise c, Serialise d, Serialise e) => Serialise (a, b, c, d, e) where
  schemaGen :: Proxy (a, b, c, d, e) -> SchemaGen Schema
schemaGen = Proxy (a, b, c, d, e) -> SchemaGen Schema
forall (proxy :: * -> *) a.
(Generic a, GSerialiseProduct (Rep a)) =>
proxy a -> SchemaGen Schema
gschemaGenProduct
  toBuilder :: (a, b, c, d, e) -> Builder
toBuilder = (a, b, c, d, e) -> Builder
forall a. (Generic a, GEncodeProduct (Rep a)) => a -> Builder
gtoBuilderProduct
  extractor :: Extractor (a, b, c, d, e)
extractor = Extractor (a, b, c, d, e)
forall a.
(GSerialiseProduct (Rep a), Generic a, Typeable a) =>
Extractor a
gextractorProduct
  decodeCurrent :: Decoder (a, b, c, d, e)
decodeCurrent = Decoder (a, b, c, d, e)
forall a. (GDecodeProduct (Rep a), Generic a) => Decoder a
gdecodeCurrentProduct
  {-# INLINE toBuilder #-}
  {-# INLINE decodeCurrent #-}

instance (Serialise a, Serialise b, Serialise c, Serialise d, Serialise e, Serialise f) => Serialise (a, b, c, d, e, f) where
  schemaGen :: Proxy (a, b, c, d, e, f) -> SchemaGen Schema
schemaGen = Proxy (a, b, c, d, e, f) -> SchemaGen Schema
forall (proxy :: * -> *) a.
(Generic a, GSerialiseProduct (Rep a)) =>
proxy a -> SchemaGen Schema
gschemaGenProduct
  toBuilder :: (a, b, c, d, e, f) -> Builder
toBuilder = (a, b, c, d, e, f) -> Builder
forall a. (Generic a, GEncodeProduct (Rep a)) => a -> Builder
gtoBuilderProduct
  extractor :: Extractor (a, b, c, d, e, f)
extractor = Extractor (a, b, c, d, e, f)
forall a.
(GSerialiseProduct (Rep a), Generic a, Typeable a) =>
Extractor a
gextractorProduct
  decodeCurrent :: Decoder (a, b, c, d, e, f)
decodeCurrent = Decoder (a, b, c, d, e, f)
forall a. (GDecodeProduct (Rep a), Generic a) => Decoder a
gdecodeCurrentProduct
  {-# INLINE toBuilder #-}
  {-# INLINE decodeCurrent #-}

instance (Serialise a, Serialise b) => Serialise (Either a b) where
  schemaGen :: Proxy (Either a b) -> SchemaGen Schema
schemaGen = Proxy (Either a b) -> SchemaGen Schema
forall (proxy :: * -> *) a.
(GSerialiseVariant (Rep a), Typeable a, Generic a) =>
proxy a -> SchemaGen Schema
gschemaGenVariant
  toBuilder :: Either a b -> Builder
toBuilder = Either a b -> Builder
forall a.
(GConstructorCount (Rep a), GEncodeVariant (Rep a), Generic a) =>
a -> Builder
gtoBuilderVariant
  extractor :: Extractor (Either a b)
extractor = Extractor (Either a b)
forall a.
(GSerialiseVariant (Rep a), Generic a, Typeable a) =>
Extractor a
gextractorVariant
  decodeCurrent :: Decoder (Either a b)
decodeCurrent = Decoder (Either a b)
forall a.
(GConstructorCount (Rep a), GEncodeVariant (Rep a),
 GDecodeVariant (Rep a), Generic a) =>
Decoder a
gdecodeCurrentVariant
  {-# INLINE toBuilder #-}
  {-# INLINE decodeCurrent #-}


instance Serialise Ordering where
  schemaGen :: Proxy Ordering -> SchemaGen Schema
schemaGen = Proxy Ordering -> SchemaGen Schema
forall (proxy :: * -> *) a.
(GSerialiseVariant (Rep a), Typeable a, Generic a) =>
proxy a -> SchemaGen Schema
gschemaGenVariant
  toBuilder :: Ordering -> Builder
toBuilder = Ordering -> Builder
forall a.
(GConstructorCount (Rep a), GEncodeVariant (Rep a), Generic a) =>
a -> Builder
gtoBuilderVariant
  extractor :: Extractor Ordering
extractor = Extractor Ordering
forall a.
(GSerialiseVariant (Rep a), Generic a, Typeable a) =>
Extractor a
gextractorVariant
  decodeCurrent :: Decoder Ordering
decodeCurrent = Decoder Ordering
forall a.
(GConstructorCount (Rep a), GEncodeVariant (Rep a),
 GDecodeVariant (Rep a), Generic a) =>
Decoder a
gdecodeCurrentVariant
  {-# INLINE toBuilder #-}
  {-# INLINE decodeCurrent #-}

deriving instance Serialise a => Serialise (Identity a)
deriving instance (Serialise a, Typeable b, Typeable k) => Serialise (Const a (b :: k))

deriving instance Serialise Any
deriving instance Serialise All
deriving instance Serialise a => Serialise (Down a)
deriving instance Serialise a => Serialise (Product a)
deriving instance Serialise a => Serialise (Sum a)
deriving instance Serialise a => Serialise (Dual a)
deriving instance Serialise a => Serialise (M.Last a)
deriving instance Serialise a => Serialise (M.First a)
deriving instance Serialise a => Serialise (S.Last a)
deriving instance Serialise a => Serialise (S.First a)
deriving instance Serialise a => Serialise (ZipList a)
deriving instance Serialise a => Serialise (Option a)
deriving instance Serialise a => Serialise (Max a)
deriving instance Serialise a => Serialise (Min a)
deriving instance (Typeable k, Typeable f, Typeable a, Serialise (f a)) => Serialise (Alt f (a :: k))
deriving instance (Typeable j, Typeable k, Typeable f, Typeable g, Typeable a, Serialise (f (g a))) => Serialise (Compose f (g :: j -> k) (a :: j))
#if MIN_VERSION_base(4,12,0)
deriving instance (Typeable k, Typeable f, Typeable a, Serialise (f a)) => Serialise (Ap f (a :: k))
#endif

instance (Typeable k, Typeable a, Typeable b, a ~ b) => Serialise ((a :: k) :~: b) where
  schemaGen :: Proxy (a :~: b) -> SchemaGen Schema
schemaGen Proxy (a :~: b)
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> SchemaGen Schema) -> Schema -> SchemaGen Schema
forall a b. (a -> b) -> a -> b
$ Vector Schema -> Schema
forall a. Vector (SchemaP a) -> SchemaP a
SProduct Vector Schema
forall a. Monoid a => a
mempty
  toBuilder :: (a :~: b) -> Builder
toBuilder = (a :~: b) -> Builder
forall a. Monoid a => a
mempty
  extractor :: Extractor (a :~: b)
extractor = (a :~: a) -> Extractor (a :~: a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a :~: a
forall k (a :: k). a :~: a
Refl
  decodeCurrent :: Decoder (a :~: b)
decodeCurrent = (a :~: a) -> Decoder (a :~: a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a :~: a
forall k (a :: k). a :~: a
Refl
  {-# INLINE toBuilder #-}
  {-# INLINE decodeCurrent #-}

instance (Serialise a, Serialise b) => Serialise (Arg a b) where
  schemaGen :: Proxy (Arg a b) -> SchemaGen Schema
schemaGen = Proxy (Arg a b) -> SchemaGen Schema
forall (proxy :: * -> *) a.
(Generic a, GSerialiseProduct (Rep a)) =>
proxy a -> SchemaGen Schema
gschemaGenProduct
  toBuilder :: Arg a b -> Builder
toBuilder = Arg a b -> Builder
forall a. (Generic a, GEncodeProduct (Rep a)) => a -> Builder
gtoBuilderProduct
  extractor :: Extractor (Arg a b)
extractor = Extractor (Arg a b)
forall a.
(GSerialiseProduct (Rep a), Generic a, Typeable a) =>
Extractor a
gextractorProduct
  decodeCurrent :: Decoder (Arg a b)
decodeCurrent = Decoder (Arg a b)
forall a. (GDecodeProduct (Rep a), Generic a) => Decoder a
gdecodeCurrentProduct
  {-# INLINE toBuilder #-}
  {-# INLINE decodeCurrent #-}

instance Serialise a => Serialise (Complex a) where
  schemaGen :: Proxy (Complex a) -> SchemaGen Schema
schemaGen = Proxy (Complex a) -> SchemaGen Schema
forall (proxy :: * -> *) a.
(Generic a, GSerialiseProduct (Rep a)) =>
proxy a -> SchemaGen Schema
gschemaGenProduct
  toBuilder :: Complex a -> Builder
toBuilder = Complex a -> Builder
forall a. (Generic a, GEncodeProduct (Rep a)) => a -> Builder
gtoBuilderProduct
  extractor :: Extractor (Complex a)
extractor = Extractor (Complex a)
forall a.
(GSerialiseProduct (Rep a), Generic a, Typeable a) =>
Extractor a
gextractorProduct
  decodeCurrent :: Decoder (Complex a)
decodeCurrent = Decoder (Complex a)
forall a. (GDecodeProduct (Rep a), Generic a) => Decoder a
gdecodeCurrentProduct
  {-# INLINE toBuilder #-}
  {-# INLINE decodeCurrent #-}

instance Serialise Void where
  schemaGen :: Proxy Void -> SchemaGen Schema
schemaGen Proxy Void
_ = Schema -> SchemaGen Schema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> SchemaGen Schema) -> Schema -> SchemaGen Schema
forall a b. (a -> b) -> a -> b
$ Vector (Text, Schema) -> Schema
forall a. Vector (Text, SchemaP a) -> SchemaP a
SVariant Vector (Text, Schema)
forall a. Vector a
V.empty
  toBuilder :: Void -> Builder
toBuilder = Void -> Builder
forall a. Monoid a => a
mempty
  extractor :: Extractor Void
extractor = (Schema -> Strategy' (Term -> Void)) -> Extractor Void
forall a. (Schema -> Strategy' (Term -> a)) -> Extractor a
Extractor ((Schema -> Strategy' (Term -> Void)) -> Extractor Void)
-> (Schema -> Strategy' (Term -> Void)) -> Extractor Void
forall a b. (a -> b) -> a -> b
$ Strategy' (Term -> Void) -> Schema -> Strategy' (Term -> Void)
forall a b. a -> b -> a
const (Strategy' (Term -> Void) -> Schema -> Strategy' (Term -> Void))
-> Strategy' (Term -> Void) -> Schema -> Strategy' (Term -> Void)
forall a b. (a -> b) -> a -> b
$ WineryException -> Strategy' (Term -> Void)
forall e r a. e -> Strategy e r a
throwStrategy WineryException
"No extractor for Void"
  decodeCurrent :: Decoder Void
decodeCurrent = [Char] -> Decoder Void
forall a. HasCallStack => [Char] -> a
error [Char]
"No decodeCurrent for Void"
  {-# INLINE toBuilder #-}
  {-# INLINE decodeCurrent #-}

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

-- | Generic implementation of 'schemaGen' for a record.
gschemaGenRecord :: forall proxy a. (GSerialiseRecord (Rep a), Generic a, Typeable a) => proxy a -> SchemaGen Schema
gschemaGenRecord :: proxy a -> SchemaGen Schema
gschemaGenRecord proxy a
_ = Vector (Text, Schema) -> Schema
forall a. Vector (Text, SchemaP a) -> SchemaP a
SRecord (Vector (Text, Schema) -> Schema)
-> ([(Text, Schema)] -> Vector (Text, Schema))
-> [(Text, Schema)]
-> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Schema)] -> Vector (Text, Schema)
forall a. [a] -> Vector a
V.fromList ([(Text, Schema)] -> Schema)
-> SchemaGen [(Text, Schema)] -> SchemaGen Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (Rep a) -> SchemaGen [(Text, Schema)]
forall k (f :: k -> *) (proxy :: (k -> *) -> *).
GSerialiseRecord f =>
proxy f -> SchemaGen [(Text, Schema)]
recordSchema (Proxy (Rep a)
forall k (t :: k). Proxy t
Proxy @ (Rep a))

-- | Generic implementation of 'toBuilder' for a record.
gtoBuilderRecord :: (GEncodeProduct (Rep a), Generic a) => a -> BB.Builder
gtoBuilderRecord :: a -> Builder
gtoBuilderRecord = Rep a Any -> Builder
forall k (f :: k -> *) (x :: k). GEncodeProduct f => f x -> Builder
productEncoder (Rep a Any -> Builder) -> (a -> Rep a Any) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from
{-# INLINE gtoBuilderRecord #-}

data FieldDecoder i a = FieldDecoder !i !(Maybe a) !(Schema -> Strategy' (Term -> a))

-- | Generic implementation of 'extractor' for a record.
gextractorRecord :: forall a. (GSerialiseRecord (Rep a), Generic a, Typeable a)
  => Maybe a -- ^ default value (optional)
  -> Extractor a
gextractorRecord :: Maybe a -> Extractor a
gextractorRecord Maybe a
def = (Schema -> Strategy' (Term -> a)) -> Extractor a
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor
  ((Schema -> Strategy' (Term -> a)) -> Extractor a)
-> (Schema -> Strategy' (Term -> a)) -> Extractor a
forall a b. (a -> b) -> a -> b
$ (Strategy WineryException StrategyEnv (Term -> Rep a Any)
 -> Strategy' (Term -> a))
-> (Schema
    -> Strategy WineryException StrategyEnv (Term -> Rep a Any))
-> Schema
-> Strategy' (Term -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Term -> Rep a Any) -> Term -> a)
-> Strategy WineryException StrategyEnv (Term -> Rep a Any)
-> Strategy' (Term -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> (Term -> Rep a Any) -> Term -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)) ((Schema
  -> Strategy WineryException StrategyEnv (Term -> Rep a Any))
 -> Schema -> Strategy' (Term -> a))
-> (Schema
    -> Strategy WineryException StrategyEnv (Term -> Rep a Any))
-> Schema
-> Strategy' (Term -> a)
forall a b. (a -> b) -> a -> b
$ Maybe (Rep a Any)
-> Schema
-> Strategy WineryException StrategyEnv (Term -> Rep a Any)
forall k (f :: k -> *) (x :: k).
GSerialiseRecord f =>
Maybe (f x) -> Schema -> Strategy' (Term -> f x)
extractorRecord'
  (a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from (a -> Rep a Any) -> Maybe a -> Maybe (Rep a Any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
def)

-- | Generic implementation of 'extractor' for a record.
extractorRecord' :: (GSerialiseRecord f)
  => Maybe (f x) -- ^ default value (optional)
  -> Schema -> Strategy' (Term -> f x)
extractorRecord' :: Maybe (f x) -> Schema -> Strategy' (Term -> f x)
extractorRecord' Maybe (f x)
def (SRecord Vector (Text, Schema)
schs) = (StrategyEnv -> Either WineryException (Term -> f x))
-> Strategy' (Term -> f x)
forall e r a. (r -> Either e a) -> Strategy e r a
Strategy ((StrategyEnv -> Either WineryException (Term -> f x))
 -> Strategy' (Term -> f x))
-> (StrategyEnv -> Either WineryException (Term -> f x))
-> Strategy' (Term -> f x)
forall a b. (a -> b) -> a -> b
$ \StrategyEnv
decs -> do
    let go :: FieldDecoder T.Text x -> Either WineryException (Term -> x)
        go :: FieldDecoder Text x -> Either WineryException (Term -> x)
go (FieldDecoder Text
name Maybe x
def' Schema -> Strategy' (Term -> x)
p) = case Text -> Vector (Text, Schema) -> Maybe (Int, Schema)
forall k v. Eq k => k -> Vector (k, v) -> Maybe (Int, v)
lookupWithIndexV Text
name Vector (Text, Schema)
schs of
          Maybe (Int, Schema)
Nothing -> case Maybe x
def' of
            Just x
d -> (Term -> x) -> Either WineryException (Term -> x)
forall a b. b -> Either a b
Right (x -> Term -> x
forall a b. a -> b -> a
const x
d)
            Maybe x
Nothing -> WineryException -> Either WineryException (Term -> x)
forall a b. a -> Either a b
Left (WineryException -> Either WineryException (Term -> x))
-> WineryException -> Either WineryException (Term -> x)
forall a b. (a -> b) -> a -> b
$ [TypeRep] -> Text -> [Text] -> WineryException
FieldNotFound [] Text
name (((Text, Schema) -> Text) -> [(Text, Schema)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Schema) -> Text
forall a b. (a, b) -> a
fst ([(Text, Schema)] -> [Text]) -> [(Text, Schema)] -> [Text]
forall a b. (a -> b) -> a -> b
$ Vector (Text, Schema) -> [(Text, Schema)]
forall a. Vector a -> [a]
V.toList Vector (Text, Schema)
schs)
          Just (Int
i, Schema
sch) -> case Schema -> Strategy' (Term -> x)
p Schema
sch Strategy' (Term -> x)
-> StrategyEnv -> Either WineryException (Term -> x)
forall e r a. Strategy e r a -> r -> Either e a
`unStrategy` StrategyEnv
decs of
            Right Term -> x
getItem -> (Term -> x) -> Either WineryException (Term -> x)
forall a b. b -> Either a b
Right ((Term -> x) -> Either WineryException (Term -> x))
-> (Term -> x) -> Either WineryException (Term -> x)
forall a b. (a -> b) -> a -> b
$ \case
              t :: Term
t@(TRecord Vector (Text, Term)
xs) -> x -> ((Text, Term) -> x) -> Maybe (Text, Term) -> x
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ExtractException -> x
forall a e. Exception e => e -> a
throw (ExtractException -> x) -> ExtractException -> x
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t) (Term -> x
getItem (Term -> x) -> ((Text, Term) -> Term) -> (Text, Term) -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Term) -> Term
forall a b. (a, b) -> b
snd) (Maybe (Text, Term) -> x) -> Maybe (Text, Term) -> x
forall a b. (a -> b) -> a -> b
$ Vector (Text, Term)
xs Vector (Text, Term) -> Int -> Maybe (Text, Term)
forall a. Vector a -> Int -> Maybe a
V.!? Int
i
              Term
t -> ExtractException -> x
forall a e. Exception e => e -> a
throw (ExtractException -> x) -> ExtractException -> x
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t
            Left WineryException
e -> WineryException -> Either WineryException (Term -> x)
forall a b. a -> Either a b
Left WineryException
e
    TransFusion (FieldDecoder Text) ((->) Term) (Term -> f x)
-> (forall x.
    FieldDecoder Text x -> Either WineryException (Term -> x))
-> Either WineryException (Term -> f x)
forall (f :: * -> *) (g :: * -> *) a.
TransFusion f g a
-> forall (h :: * -> *).
   Applicative h =>
   (forall x. f x -> h (g x)) -> h a
unTransFusion (Maybe (f x)
-> TransFusion (FieldDecoder Text) ((->) Term) (Term -> f x)
forall k (f :: k -> *) (x :: k).
GSerialiseRecord f =>
Maybe (f x)
-> TransFusion (FieldDecoder Text) ((->) Term) (Term -> f x)
recordExtractor Maybe (f x)
def) forall x. FieldDecoder Text x -> Either WineryException (Term -> x)
go
extractorRecord' Maybe (f x)
_ Schema
s = WineryException -> Strategy' (Term -> f x)
forall e r a. e -> Strategy e r a
throwStrategy (WineryException -> Strategy' (Term -> f x))
-> WineryException -> Strategy' (Term -> f x)
forall a b. (a -> b) -> a -> b
$ [TypeRep] -> Doc AnsiStyle -> Schema -> WineryException
UnexpectedSchema [] Doc AnsiStyle
"a record" Schema
s
{-# INLINE gextractorRecord #-}

-- | Synonym for 'gdecodeCurrentProduct'
gdecodeCurrentRecord :: (GDecodeProduct (Rep a), Generic a) => Decoder a
gdecodeCurrentRecord :: Decoder a
gdecodeCurrentRecord = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> Decoder (Rep a Any) -> Decoder a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder (Rep a Any)
forall k (f :: k -> *) (x :: k). GDecodeProduct f => Decoder (f x)
productDecoder
{-# INLINE gdecodeCurrentRecord #-}

-- | Encode all the fields
class GEncodeProduct f where
  productEncoder :: f x -> BB.Builder

instance GEncodeProduct U1 where
  productEncoder :: U1 x -> Builder
productEncoder U1 x
_ = Builder
forall a. Monoid a => a
mempty
  {-# INLINE productEncoder #-}

instance (GEncodeProduct f, GEncodeProduct g) => GEncodeProduct (f :*: g) where
  productEncoder :: (:*:) f g x -> Builder
productEncoder (f x
f :*: g x
g) = f x -> Builder
forall k (f :: k -> *) (x :: k). GEncodeProduct f => f x -> Builder
productEncoder f x
f Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> g x -> Builder
forall k (f :: k -> *) (x :: k). GEncodeProduct f => f x -> Builder
productEncoder g x
g
  {-# INLINE productEncoder #-}

instance Serialise a => GEncodeProduct (S1 c (K1 i a)) where
  productEncoder :: S1 c (K1 i a) x -> Builder
productEncoder (M1 (K1 a
a)) = a -> Builder
forall a. Serialise a => a -> Builder
toBuilder a
a
  {-# INLINE productEncoder #-}

instance GEncodeProduct f => GEncodeProduct (C1 c f) where
  productEncoder :: C1 c f x -> Builder
productEncoder (M1 f x
a) = f x -> Builder
forall k (f :: k -> *) (x :: k). GEncodeProduct f => f x -> Builder
productEncoder f x
a
  {-# INLINE productEncoder #-}

instance GEncodeProduct f => GEncodeProduct (D1 c f) where
  productEncoder :: D1 c f x -> Builder
productEncoder (M1 f x
a) = f x -> Builder
forall k (f :: k -> *) (x :: k). GEncodeProduct f => f x -> Builder
productEncoder f x
a
  {-# INLINE productEncoder #-}

class GDecodeProduct f where
  productDecoder :: Decoder (f x)

instance GDecodeProduct U1 where
  productDecoder :: Decoder (U1 x)
productDecoder = U1 x -> Decoder (U1 x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 x
forall k (p :: k). U1 p
U1

instance Serialise a => GDecodeProduct (K1 i a) where
  productDecoder :: Decoder (K1 i a x)
productDecoder = a -> K1 i a x
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 i a x) -> Decoder a -> Decoder (K1 i a x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder a
forall a. Serialise a => Decoder a
decodeCurrent
  {-# INLINE productDecoder #-}

instance GDecodeProduct f => GDecodeProduct (M1 i c f) where
  productDecoder :: Decoder (M1 i c f x)
productDecoder = f x -> M1 i c f x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f x -> M1 i c f x) -> Decoder (f x) -> Decoder (M1 i c f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder (f x)
forall k (f :: k -> *) (x :: k). GDecodeProduct f => Decoder (f x)
productDecoder
  {-# INLINE productDecoder #-}

instance (GDecodeProduct f, GDecodeProduct g) => GDecodeProduct (f :*: g) where
  productDecoder :: Decoder ((:*:) f g x)
productDecoder = f x -> g x -> (:*:) f g x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (f x -> g x -> (:*:) f g x)
-> Decoder (f x) -> Decoder (g x -> (:*:) f g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder (f x)
forall k (f :: k -> *) (x :: k). GDecodeProduct f => Decoder (f x)
productDecoder Decoder (g x -> (:*:) f g x)
-> Decoder (g x) -> Decoder ((:*:) f g x)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder (g x)
forall k (f :: k -> *) (x :: k). GDecodeProduct f => Decoder (f x)
productDecoder
  {-# INLINE productDecoder #-}

class GSerialiseRecord f where
  recordSchema :: proxy f -> SchemaGen [(T.Text, Schema)]
  recordExtractor :: Maybe (f x) -> TransFusion (FieldDecoder T.Text) ((->) Term) (Term -> f x)

instance (GSerialiseRecord f, GSerialiseRecord g) => GSerialiseRecord (f :*: g) where
  recordSchema :: proxy (f :*: g) -> SchemaGen [(Text, Schema)]
recordSchema proxy (f :*: g)
_ = [(Text, Schema)] -> [(Text, Schema)] -> [(Text, Schema)]
forall a. [a] -> [a] -> [a]
(++) ([(Text, Schema)] -> [(Text, Schema)] -> [(Text, Schema)])
-> SchemaGen [(Text, Schema)]
-> SchemaGen ([(Text, Schema)] -> [(Text, Schema)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy f -> SchemaGen [(Text, Schema)]
forall k (f :: k -> *) (proxy :: (k -> *) -> *).
GSerialiseRecord f =>
proxy f -> SchemaGen [(Text, Schema)]
recordSchema (Proxy f
forall k (t :: k). Proxy t
Proxy @ f) SchemaGen ([(Text, Schema)] -> [(Text, Schema)])
-> SchemaGen [(Text, Schema)] -> SchemaGen [(Text, Schema)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy g -> SchemaGen [(Text, Schema)]
forall k (f :: k -> *) (proxy :: (k -> *) -> *).
GSerialiseRecord f =>
proxy f -> SchemaGen [(Text, Schema)]
recordSchema (Proxy g
forall k (t :: k). Proxy t
Proxy @ g)
  recordExtractor :: Maybe ((:*:) f g x)
-> TransFusion
     (FieldDecoder Text) ((->) Term) (Term -> (:*:) f g x)
recordExtractor Maybe ((:*:) f g x)
def = (\Term -> f x
f Term -> g x
g -> f x -> g x -> (:*:) f g x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (f x -> g x -> (:*:) f g x)
-> (Term -> f x) -> Term -> g x -> (:*:) f g x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term -> f x
f (Term -> g x -> (:*:) f g x)
-> (Term -> g x) -> Term -> (:*:) f g x
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Term -> g x
g)
    ((Term -> f x) -> (Term -> g x) -> Term -> (:*:) f g x)
-> TransFusion (FieldDecoder Text) ((->) Term) (Term -> f x)
-> TransFusion
     (FieldDecoder Text)
     ((->) Term)
     ((Term -> g x) -> Term -> (:*:) f g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (f x)
-> TransFusion (FieldDecoder Text) ((->) Term) (Term -> f x)
forall k (f :: k -> *) (x :: k).
GSerialiseRecord f =>
Maybe (f x)
-> TransFusion (FieldDecoder Text) ((->) Term) (Term -> f x)
recordExtractor ((\(f x
x :*: g x
_) -> f x
x) ((:*:) f g x -> f x) -> Maybe ((:*:) f g x) -> Maybe (f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ((:*:) f g x)
def)
    TransFusion
  (FieldDecoder Text)
  ((->) Term)
  ((Term -> g x) -> Term -> (:*:) f g x)
-> TransFusion (FieldDecoder Text) ((->) Term) (Term -> g x)
-> TransFusion
     (FieldDecoder Text) ((->) Term) (Term -> (:*:) f g x)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (g x)
-> TransFusion (FieldDecoder Text) ((->) Term) (Term -> g x)
forall k (f :: k -> *) (x :: k).
GSerialiseRecord f =>
Maybe (f x)
-> TransFusion (FieldDecoder Text) ((->) Term) (Term -> f x)
recordExtractor ((\(f x
_ :*: g x
x) -> g x
x) ((:*:) f g x -> g x) -> Maybe ((:*:) f g x) -> Maybe (g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ((:*:) f g x)
def)
  {-# INLINE recordExtractor #-}

instance (Serialise a, Selector c) => GSerialiseRecord (S1 c (K1 i a)) where
  recordSchema :: proxy (S1 c (K1 i a)) -> SchemaGen [(Text, Schema)]
recordSchema proxy (S1 c (K1 i a))
_ = do
    Schema
s <- Proxy a -> SchemaGen Schema
forall (proxy :: * -> *) a.
Serialise a =>
proxy a -> SchemaGen Schema
getSchema (Proxy a
forall k (t :: k). Proxy t
Proxy @ a)
    pure [([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ M1 i c (K1 i a) Any -> [Char]
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
selName (K1 i a x -> M1 i c (K1 i a) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 K1 i a x
forall a. HasCallStack => a
undefined :: M1 i c (K1 i a) x), Schema
s)]
  recordExtractor :: Maybe (S1 c (K1 i a) x)
-> TransFusion
     (FieldDecoder Text) ((->) Term) (Term -> S1 c (K1 i a) x)
recordExtractor Maybe (S1 c (K1 i a) x)
def = (forall (h :: * -> *).
 Applicative h =>
 (forall x. FieldDecoder Text x -> h (Term -> x))
 -> h (Term -> S1 c (K1 i a) x))
-> TransFusion
     (FieldDecoder Text) ((->) Term) (Term -> S1 c (K1 i a) x)
forall (f :: * -> *) (g :: * -> *) a.
(forall (h :: * -> *).
 Applicative h =>
 (forall x. f x -> h (g x)) -> h a)
-> TransFusion f g a
TransFusion ((forall (h :: * -> *).
  Applicative h =>
  (forall x. FieldDecoder Text x -> h (Term -> x))
  -> h (Term -> S1 c (K1 i a) x))
 -> TransFusion
      (FieldDecoder Text) ((->) Term) (Term -> S1 c (K1 i a) x))
-> (forall (h :: * -> *).
    Applicative h =>
    (forall x. FieldDecoder Text x -> h (Term -> x))
    -> h (Term -> S1 c (K1 i a) x))
-> TransFusion
     (FieldDecoder Text) ((->) Term) (Term -> S1 c (K1 i a) x)
forall a b. (a -> b) -> a -> b
$ \forall x. FieldDecoder Text x -> h (Term -> x)
k -> ((Term -> a) -> Term -> S1 c (K1 i a) x)
-> h (Term -> a) -> h (Term -> S1 c (K1 i a) x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> S1 c (K1 i a) x) -> (Term -> a) -> Term -> S1 c (K1 i a) x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (K1 i a x -> S1 c (K1 i a) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 i a x -> S1 c (K1 i a) x)
-> (a -> K1 i a x) -> a -> S1 c (K1 i a) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> K1 i a x
forall k i c (p :: k). c -> K1 i c p
K1)) (h (Term -> a) -> h (Term -> S1 c (K1 i a) x))
-> h (Term -> a) -> h (Term -> S1 c (K1 i a) x)
forall a b. (a -> b) -> a -> b
$ FieldDecoder Text a -> h (Term -> a)
forall x. FieldDecoder Text x -> h (Term -> x)
k (FieldDecoder Text a -> h (Term -> a))
-> FieldDecoder Text a -> h (Term -> a)
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe a
-> (Schema -> Strategy' (Term -> a))
-> FieldDecoder Text a
forall i a.
i
-> Maybe a -> (Schema -> Strategy' (Term -> a)) -> FieldDecoder i a
FieldDecoder
    ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ M1 i c (K1 i a) Any -> [Char]
forall k (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
selName (K1 i a x -> M1 i c (K1 i a) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 K1 i a x
forall a. HasCallStack => a
undefined :: M1 i c (K1 i a) x))
    (K1 i a x -> a
forall i c k (p :: k). K1 i c p -> c
unK1 (K1 i a x -> a)
-> (S1 c (K1 i a) x -> K1 i a x) -> S1 c (K1 i a) x -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S1 c (K1 i a) x -> K1 i a x
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (S1 c (K1 i a) x -> a) -> Maybe (S1 c (K1 i a) x) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (S1 c (K1 i a) x)
def)
    (Extractor a -> Schema -> Strategy' (Term -> a)
forall a. Extractor a -> Schema -> Strategy' (Term -> a)
runExtractor Extractor a
forall a. Serialise a => Extractor a
extractor)
  {-# INLINE recordExtractor #-}

instance (GSerialiseRecord f) => GSerialiseRecord (C1 c f) where
  recordSchema :: proxy (C1 c f) -> SchemaGen [(Text, Schema)]
recordSchema proxy (C1 c f)
_ = Proxy f -> SchemaGen [(Text, Schema)]
forall k (f :: k -> *) (proxy :: (k -> *) -> *).
GSerialiseRecord f =>
proxy f -> SchemaGen [(Text, Schema)]
recordSchema (Proxy f
forall k (t :: k). Proxy t
Proxy @ f)
  recordExtractor :: Maybe (C1 c f x)
-> TransFusion (FieldDecoder Text) ((->) Term) (Term -> C1 c f x)
recordExtractor Maybe (C1 c f x)
def = (f x -> C1 c f x) -> (Term -> f x) -> Term -> C1 c f x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f x -> C1 c f x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 ((Term -> f x) -> Term -> C1 c f x)
-> TransFusion (FieldDecoder Text) ((->) Term) (Term -> f x)
-> TransFusion (FieldDecoder Text) ((->) Term) (Term -> C1 c f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (f x)
-> TransFusion (FieldDecoder Text) ((->) Term) (Term -> f x)
forall k (f :: k -> *) (x :: k).
GSerialiseRecord f =>
Maybe (f x)
-> TransFusion (FieldDecoder Text) ((->) Term) (Term -> f x)
recordExtractor (C1 c f x -> f x
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (C1 c f x -> f x) -> Maybe (C1 c f x) -> Maybe (f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (C1 c f x)
def)

instance (GSerialiseRecord f) => GSerialiseRecord (D1 c f) where
  recordSchema :: proxy (D1 c f) -> SchemaGen [(Text, Schema)]
recordSchema proxy (D1 c f)
_ = Proxy f -> SchemaGen [(Text, Schema)]
forall k (f :: k -> *) (proxy :: (k -> *) -> *).
GSerialiseRecord f =>
proxy f -> SchemaGen [(Text, Schema)]
recordSchema (Proxy f
forall k (t :: k). Proxy t
Proxy @ f)
  recordExtractor :: Maybe (D1 c f x)
-> TransFusion (FieldDecoder Text) ((->) Term) (Term -> D1 c f x)
recordExtractor Maybe (D1 c f x)
def = (f x -> D1 c f x) -> (Term -> f x) -> Term -> D1 c f x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f x -> D1 c f x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 ((Term -> f x) -> Term -> D1 c f x)
-> TransFusion (FieldDecoder Text) ((->) Term) (Term -> f x)
-> TransFusion (FieldDecoder Text) ((->) Term) (Term -> D1 c f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (f x)
-> TransFusion (FieldDecoder Text) ((->) Term) (Term -> f x)
forall k (f :: k -> *) (x :: k).
GSerialiseRecord f =>
Maybe (f x)
-> TransFusion (FieldDecoder Text) ((->) Term) (Term -> f x)
recordExtractor (D1 c f x -> f x
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (D1 c f x -> f x) -> Maybe (D1 c f x) -> Maybe (f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (D1 c f x)
def)

class GSerialiseProduct f where
  productSchema :: proxy f -> SchemaGen [Schema]
  productExtractor :: Compose (State Int) (TransFusion (FieldDecoder Int) ((->) Term)) (Term -> f x)

instance GSerialiseProduct U1 where
  productSchema :: proxy U1 -> SchemaGen [Schema]
productSchema proxy U1
_ = [Schema] -> SchemaGen [Schema]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  productExtractor :: Compose
  (State Int)
  (TransFusion (FieldDecoder Int) ((->) Term))
  (Term -> U1 x)
productExtractor = (Term -> U1 x)
-> Compose
     (State Int)
     (TransFusion (FieldDecoder Int) ((->) Term))
     (Term -> U1 x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (U1 x -> Term -> U1 x
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 x
forall k (p :: k). U1 p
U1)

instance (Serialise a) => GSerialiseProduct (K1 i a) where
  productSchema :: proxy (K1 i a) -> SchemaGen [Schema]
productSchema proxy (K1 i a)
_ = Schema -> [Schema]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Schema -> [Schema]) -> SchemaGen Schema -> SchemaGen [Schema]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy a -> SchemaGen Schema
forall (proxy :: * -> *) a.
Serialise a =>
proxy a -> SchemaGen Schema
getSchema (Proxy a
forall k (t :: k). Proxy t
Proxy @ a)
  productExtractor :: Compose
  (State Int)
  (TransFusion (FieldDecoder Int) ((->) Term))
  (Term -> K1 i a x)
productExtractor = State
  Int (TransFusion (FieldDecoder Int) ((->) Term) (Term -> K1 i a x))
-> Compose
     (State Int)
     (TransFusion (FieldDecoder Int) ((->) Term))
     (Term -> K1 i a x)
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (State
   Int (TransFusion (FieldDecoder Int) ((->) Term) (Term -> K1 i a x))
 -> Compose
      (State Int)
      (TransFusion (FieldDecoder Int) ((->) Term))
      (Term -> K1 i a x))
-> State
     Int (TransFusion (FieldDecoder Int) ((->) Term) (Term -> K1 i a x))
-> Compose
     (State Int)
     (TransFusion (FieldDecoder Int) ((->) Term))
     (Term -> K1 i a x)
forall a b. (a -> b) -> a -> b
$ (Int
 -> (TransFusion (FieldDecoder Int) ((->) Term) (Term -> K1 i a x),
     Int))
-> State
     Int (TransFusion (FieldDecoder Int) ((->) Term) (Term -> K1 i a x))
forall s a. (s -> (a, s)) -> State s a
State ((Int
  -> (TransFusion (FieldDecoder Int) ((->) Term) (Term -> K1 i a x),
      Int))
 -> State
      Int
      (TransFusion (FieldDecoder Int) ((->) Term) (Term -> K1 i a x)))
-> (Int
    -> (TransFusion (FieldDecoder Int) ((->) Term) (Term -> K1 i a x),
        Int))
-> State
     Int (TransFusion (FieldDecoder Int) ((->) Term) (Term -> K1 i a x))
forall a b. (a -> b) -> a -> b
$ \Int
i ->
    ( (forall (h :: * -> *).
 Applicative h =>
 (forall x. FieldDecoder Int x -> h (Term -> x))
 -> h (Term -> K1 i a x))
-> TransFusion (FieldDecoder Int) ((->) Term) (Term -> K1 i a x)
forall (f :: * -> *) (g :: * -> *) a.
(forall (h :: * -> *).
 Applicative h =>
 (forall x. f x -> h (g x)) -> h a)
-> TransFusion f g a
TransFusion ((forall (h :: * -> *).
  Applicative h =>
  (forall x. FieldDecoder Int x -> h (Term -> x))
  -> h (Term -> K1 i a x))
 -> TransFusion (FieldDecoder Int) ((->) Term) (Term -> K1 i a x))
-> (forall (h :: * -> *).
    Applicative h =>
    (forall x. FieldDecoder Int x -> h (Term -> x))
    -> h (Term -> K1 i a x))
-> TransFusion (FieldDecoder Int) ((->) Term) (Term -> K1 i a x)
forall a b. (a -> b) -> a -> b
$ \forall x. FieldDecoder Int x -> h (Term -> x)
k -> ((Term -> a) -> Term -> K1 i a x)
-> h (Term -> a) -> h (Term -> K1 i a x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> K1 i a x) -> (Term -> a) -> Term -> K1 i a x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> K1 i a x
forall k i c (p :: k). c -> K1 i c p
K1) (h (Term -> a) -> h (Term -> K1 i a x))
-> h (Term -> a) -> h (Term -> K1 i a x)
forall a b. (a -> b) -> a -> b
$ FieldDecoder Int a -> h (Term -> a)
forall x. FieldDecoder Int x -> h (Term -> x)
k (FieldDecoder Int a -> h (Term -> a))
-> FieldDecoder Int a -> h (Term -> a)
forall a b. (a -> b) -> a -> b
$ Int
-> Maybe a
-> (Schema -> Strategy' (Term -> a))
-> FieldDecoder Int a
forall i a.
i
-> Maybe a -> (Schema -> Strategy' (Term -> a)) -> FieldDecoder i a
FieldDecoder Int
i Maybe a
forall a. Maybe a
Nothing (Extractor a -> Schema -> Strategy' (Term -> a)
forall a. Extractor a -> Schema -> Strategy' (Term -> a)
runExtractor Extractor a
forall a. Serialise a => Extractor a
extractor)
    , Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

instance GSerialiseProduct f => GSerialiseProduct (M1 i c f) where
  productSchema :: proxy (M1 i c f) -> SchemaGen [Schema]
productSchema proxy (M1 i c f)
_ = Proxy f -> SchemaGen [Schema]
forall k (f :: k -> *) (proxy :: (k -> *) -> *).
GSerialiseProduct f =>
proxy f -> SchemaGen [Schema]
productSchema (Proxy f
forall k (t :: k). Proxy t
Proxy @ f)
  productExtractor :: Compose
  (State Int)
  (TransFusion (FieldDecoder Int) ((->) Term))
  (Term -> M1 i c f x)
productExtractor = (f x -> M1 i c f x) -> (Term -> f x) -> Term -> M1 i c f x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f x -> M1 i c f x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 ((Term -> f x) -> Term -> M1 i c f x)
-> Compose
     (State Int)
     (TransFusion (FieldDecoder Int) ((->) Term))
     (Term -> f x)
-> Compose
     (State Int)
     (TransFusion (FieldDecoder Int) ((->) Term))
     (Term -> M1 i c f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compose
  (State Int)
  (TransFusion (FieldDecoder Int) ((->) Term))
  (Term -> f x)
forall k (f :: k -> *) (x :: k).
GSerialiseProduct f =>
Compose
  (State Int)
  (TransFusion (FieldDecoder Int) ((->) Term))
  (Term -> f x)
productExtractor

instance (GSerialiseProduct f, GSerialiseProduct g) => GSerialiseProduct (f :*: g) where
  productSchema :: proxy (f :*: g) -> SchemaGen [Schema]
productSchema proxy (f :*: g)
_ = [Schema] -> [Schema] -> [Schema]
forall a. [a] -> [a] -> [a]
(++) ([Schema] -> [Schema] -> [Schema])
-> SchemaGen [Schema] -> SchemaGen ([Schema] -> [Schema])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy f -> SchemaGen [Schema]
forall k (f :: k -> *) (proxy :: (k -> *) -> *).
GSerialiseProduct f =>
proxy f -> SchemaGen [Schema]
productSchema (Proxy f
forall k (t :: k). Proxy t
Proxy @ f) SchemaGen ([Schema] -> [Schema])
-> SchemaGen [Schema] -> SchemaGen [Schema]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy g -> SchemaGen [Schema]
forall k (f :: k -> *) (proxy :: (k -> *) -> *).
GSerialiseProduct f =>
proxy f -> SchemaGen [Schema]
productSchema (Proxy g
forall k (t :: k). Proxy t
Proxy @ g)
  productExtractor :: Compose
  (State Int)
  (TransFusion (FieldDecoder Int) ((->) Term))
  (Term -> (:*:) f g x)
productExtractor = (f x -> g x -> (:*:) f g x)
-> (Term -> f x) -> (Term -> g x) -> Term -> (:*:) f g x
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 f x -> g x -> (:*:) f g x
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) ((Term -> f x) -> (Term -> g x) -> Term -> (:*:) f g x)
-> Compose
     (State Int)
     (TransFusion (FieldDecoder Int) ((->) Term))
     (Term -> f x)
-> Compose
     (State Int)
     (TransFusion (FieldDecoder Int) ((->) Term))
     ((Term -> g x) -> Term -> (:*:) f g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Compose
  (State Int)
  (TransFusion (FieldDecoder Int) ((->) Term))
  (Term -> f x)
forall k (f :: k -> *) (x :: k).
GSerialiseProduct f =>
Compose
  (State Int)
  (TransFusion (FieldDecoder Int) ((->) Term))
  (Term -> f x)
productExtractor Compose
  (State Int)
  (TransFusion (FieldDecoder Int) ((->) Term))
  ((Term -> g x) -> Term -> (:*:) f g x)
-> Compose
     (State Int)
     (TransFusion (FieldDecoder Int) ((->) Term))
     (Term -> g x)
-> Compose
     (State Int)
     (TransFusion (FieldDecoder Int) ((->) Term))
     (Term -> (:*:) f g x)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Compose
  (State Int)
  (TransFusion (FieldDecoder Int) ((->) Term))
  (Term -> g x)
forall k (f :: k -> *) (x :: k).
GSerialiseProduct f =>
Compose
  (State Int)
  (TransFusion (FieldDecoder Int) ((->) Term))
  (Term -> f x)
productExtractor

gschemaGenProduct :: forall proxy a. (Generic a, GSerialiseProduct (Rep a)) => proxy a -> SchemaGen Schema
gschemaGenProduct :: proxy a -> SchemaGen Schema
gschemaGenProduct proxy a
_ = Vector Schema -> Schema
forall a. Vector (SchemaP a) -> SchemaP a
SProduct (Vector Schema -> Schema)
-> ([Schema] -> Vector Schema) -> [Schema] -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Schema] -> Vector Schema
forall a. [a] -> Vector a
V.fromList ([Schema] -> Schema) -> SchemaGen [Schema] -> SchemaGen Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (Rep a) -> SchemaGen [Schema]
forall k (f :: k -> *) (proxy :: (k -> *) -> *).
GSerialiseProduct f =>
proxy f -> SchemaGen [Schema]
productSchema (Proxy (Rep a)
forall k (t :: k). Proxy t
Proxy @ (Rep a))
{-# INLINE gschemaGenProduct #-}

gtoBuilderProduct :: (Generic a, GEncodeProduct (Rep a)) => a -> BB.Builder
gtoBuilderProduct :: a -> Builder
gtoBuilderProduct = Rep a Any -> Builder
forall k (f :: k -> *) (x :: k). GEncodeProduct f => f x -> Builder
productEncoder (Rep a Any -> Builder) -> (a -> Rep a Any) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from
{-# INLINE gtoBuilderProduct #-}

-- | Generic implementation of 'extractor' for a record.
gextractorProduct :: forall a. (GSerialiseProduct (Rep a), Generic a, Typeable a)
  => Extractor a
gextractorProduct :: Extractor a
gextractorProduct = (Schema -> Strategy' (Term -> a)) -> Extractor a
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor ((Schema -> Strategy' (Term -> a)) -> Extractor a)
-> (Schema -> Strategy' (Term -> a)) -> Extractor a
forall a b. (a -> b) -> a -> b
$ ((Term -> Rep a Any) -> Term -> a)
-> Strategy WineryException StrategyEnv (Term -> Rep a Any)
-> Strategy' (Term -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> (Term -> Rep a Any) -> Term -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (Strategy WineryException StrategyEnv (Term -> Rep a Any)
 -> Strategy' (Term -> a))
-> (Schema
    -> Strategy WineryException StrategyEnv (Term -> Rep a Any))
-> Schema
-> Strategy' (Term -> a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> Strategy WineryException StrategyEnv (Term -> Rep a Any)
forall k (f :: k -> *) (x :: k).
GSerialiseProduct f =>
Schema -> Strategy' (Term -> f x)
extractorProduct'
{-# INLINE gextractorProduct #-}

-- | Generic implementation of 'extractor' for a record.
gdecodeCurrentProduct :: forall a. (GDecodeProduct (Rep a), Generic a)
  => Decoder a
gdecodeCurrentProduct :: Decoder a
gdecodeCurrentProduct = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> Decoder (Rep a Any) -> Decoder a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder (Rep a Any)
forall k (f :: k -> *) (x :: k). GDecodeProduct f => Decoder (f x)
productDecoder
{-# INLINE gdecodeCurrentProduct #-}

extractorProduct' :: GSerialiseProduct f => Schema -> Strategy' (Term -> f x)
extractorProduct' :: Schema -> Strategy' (Term -> f x)
extractorProduct' Schema
sch
  | Just Vector Schema
schs <- Schema -> Maybe (Vector Schema)
forall a. SchemaP a -> Maybe (Vector (SchemaP a))
strip Schema
sch = (StrategyEnv -> Either WineryException (Term -> f x))
-> Strategy' (Term -> f x)
forall e r a. (r -> Either e a) -> Strategy e r a
Strategy ((StrategyEnv -> Either WineryException (Term -> f x))
 -> Strategy' (Term -> f x))
-> (StrategyEnv -> Either WineryException (Term -> f x))
-> Strategy' (Term -> f x)
forall a b. (a -> b) -> a -> b
$ \StrategyEnv
recs -> do
    let go :: FieldDecoder Int x -> Either WineryException (Term -> x)
        go :: FieldDecoder Int x -> Either WineryException (Term -> x)
go (FieldDecoder Int
i Maybe x
_ Schema -> Strategy' (Term -> x)
p) = do
          Term -> x
getItem <- if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Vector Schema -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector Schema
schs
            then Schema -> Strategy' (Term -> x)
p (Vector Schema
schs Vector Schema -> Int -> Schema
forall a. Vector a -> Int -> a
V.! Int
i) Strategy' (Term -> x)
-> StrategyEnv -> Either WineryException (Term -> x)
forall e r a. Strategy e r a -> r -> Either e a
`unStrategy` StrategyEnv
recs
            else WineryException -> Either WineryException (Term -> x)
forall a b. a -> Either a b
Left (WineryException -> Either WineryException (Term -> x))
-> WineryException -> Either WineryException (Term -> x)
forall a b. (a -> b) -> a -> b
$ [TypeRep] -> Int -> WineryException
ProductTooSmall [] (Int -> WineryException) -> Int -> WineryException
forall a b. (a -> b) -> a -> b
$ Vector Schema -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector Schema
schs
          return $ \case
            TProduct Vector Term
xs -> Term -> x
getItem (Term -> x) -> Term -> x
forall a b. (a -> b) -> a -> b
$ Term -> (Term -> Term) -> Maybe Term -> Term
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ExtractException -> Term
forall a e. Exception e => e -> a
throw (ExtractException -> Term) -> ExtractException -> Term
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm (Vector Term -> Term
TProduct Vector Term
xs)) Term -> Term
forall a. a -> a
id
              (Maybe Term -> Term) -> Maybe Term -> Term
forall a b. (a -> b) -> a -> b
$ Vector Term
xs Vector Term -> Int -> Maybe Term
forall a. Vector a -> Int -> Maybe a
V.!? Int
i
            Term
t -> ExtractException -> x
forall a e. Exception e => e -> a
throw (ExtractException -> x) -> ExtractException -> x
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t
    TransFusion (FieldDecoder Int) ((->) Term) (Term -> f x)
-> (forall x.
    FieldDecoder Int x -> Either WineryException (Term -> x))
-> Either WineryException (Term -> f x)
forall (f :: * -> *) (g :: * -> *) a.
TransFusion f g a
-> forall (h :: * -> *).
   Applicative h =>
   (forall x. f x -> h (g x)) -> h a
unTransFusion (Compose
  (State Int)
  (TransFusion (FieldDecoder Int) ((->) Term))
  (Term -> f x)
-> State
     Int (TransFusion (FieldDecoder Int) ((->) Term) (Term -> f x))
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose Compose
  (State Int)
  (TransFusion (FieldDecoder Int) ((->) Term))
  (Term -> f x)
forall k (f :: k -> *) (x :: k).
GSerialiseProduct f =>
Compose
  (State Int)
  (TransFusion (FieldDecoder Int) ((->) Term))
  (Term -> f x)
productExtractor State
  Int (TransFusion (FieldDecoder Int) ((->) Term) (Term -> f x))
-> Int -> TransFusion (FieldDecoder Int) ((->) Term) (Term -> f x)
forall s a. State s a -> s -> a
`evalState` Int
0) forall x. FieldDecoder Int x -> Either WineryException (Term -> x)
go
  where
    strip :: SchemaP a -> Maybe (Vector (SchemaP a))
strip (SProduct Vector (SchemaP a)
xs) = Vector (SchemaP a) -> Maybe (Vector (SchemaP a))
forall a. a -> Maybe a
Just Vector (SchemaP a)
xs
    strip (SRecord Vector (Text, SchemaP a)
xs) = Vector (SchemaP a) -> Maybe (Vector (SchemaP a))
forall a. a -> Maybe a
Just (Vector (SchemaP a) -> Maybe (Vector (SchemaP a)))
-> Vector (SchemaP a) -> Maybe (Vector (SchemaP a))
forall a b. (a -> b) -> a -> b
$ ((Text, SchemaP a) -> SchemaP a)
-> Vector (Text, SchemaP a) -> Vector (SchemaP a)
forall a b. (a -> b) -> Vector a -> Vector b
V.map (Text, SchemaP a) -> SchemaP a
forall a b. (a, b) -> b
snd Vector (Text, SchemaP a)
xs
    strip SchemaP a
_ = Maybe (Vector (SchemaP a))
forall a. Maybe a
Nothing
extractorProduct' Schema
sch = WineryException -> Strategy' (Term -> f x)
forall e r a. e -> Strategy e r a
throwStrategy (WineryException -> Strategy' (Term -> f x))
-> WineryException -> Strategy' (Term -> f x)
forall a b. (a -> b) -> a -> b
$ [TypeRep] -> Doc AnsiStyle -> Schema -> WineryException
UnexpectedSchema [] Doc AnsiStyle
"a product" Schema
sch

-- | Generic implementation of 'schemaGen' for an ADT.
gschemaGenVariant :: forall proxy a. (GSerialiseVariant (Rep a), Typeable a, Generic a) => proxy a -> SchemaGen Schema
gschemaGenVariant :: proxy a -> SchemaGen Schema
gschemaGenVariant proxy a
_ = Vector (Text, Schema) -> Schema
forall a. Vector (Text, SchemaP a) -> SchemaP a
SVariant (Vector (Text, Schema) -> Schema)
-> ([(Text, Schema)] -> Vector (Text, Schema))
-> [(Text, Schema)]
-> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Schema)] -> Vector (Text, Schema)
forall a. [a] -> Vector a
V.fromList ([(Text, Schema)] -> Schema)
-> SchemaGen [(Text, Schema)] -> SchemaGen Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (Rep a) -> SchemaGen [(Text, Schema)]
forall k (f :: k -> *) (proxy :: (k -> *) -> *).
GSerialiseVariant f =>
proxy f -> SchemaGen [(Text, Schema)]
variantSchema (Proxy (Rep a)
forall k (t :: k). Proxy t
Proxy @ (Rep a))

-- | Generic implementation of 'toBuilder' for an ADT.
gtoBuilderVariant :: forall a. (GConstructorCount (Rep a), GEncodeVariant (Rep a), Generic a) => a -> BB.Builder
gtoBuilderVariant :: a -> Builder
gtoBuilderVariant = Int -> Int -> Rep a Any -> Builder
forall k (f :: k -> *) (x :: k).
GEncodeVariant f =>
Int -> Int -> f x -> Builder
variantEncoder (Proxy (Rep a) -> Int
forall k (f :: k) (proxy :: k -> *).
GConstructorCount f =>
proxy f -> Int
variantCount (Proxy (Rep a)
forall k (t :: k). Proxy t
Proxy :: Proxy (Rep a))) Int
0 (Rep a Any -> Builder) -> (a -> Rep a Any) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from
{-# INLINE gtoBuilderVariant #-}

-- | Generic implementation of 'extractor' for an ADT.
gextractorVariant :: (GSerialiseVariant (Rep a), Generic a, Typeable a)
  => Extractor a
gextractorVariant :: Extractor a
gextractorVariant = HashMap Text (Extractor a) -> Extractor a
forall a.
(Generic a, Typeable a) =>
HashMap Text (Extractor a) -> Extractor a
buildVariantExtractor HashMap Text (Extractor a)
forall a.
(GSerialiseVariant (Rep a), Generic a) =>
HashMap Text (Extractor a)
gvariantExtractors
{-# INLINE gextractorVariant #-}

-- | Collect extractors as a 'HM.HashMap' keyed by constructor names
gvariantExtractors :: (GSerialiseVariant (Rep a), Generic a) => HM.HashMap T.Text (Extractor a)
gvariantExtractors :: HashMap Text (Extractor a)
gvariantExtractors = (Rep a Any -> a) -> Extractor (Rep a Any) -> Extractor a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Extractor (Rep a Any) -> Extractor a)
-> HashMap Text (Extractor (Rep a Any))
-> HashMap Text (Extractor a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text (Extractor (Rep a Any))
forall k (f :: k -> *) (x :: k).
GSerialiseVariant f =>
HashMap Text (Extractor (f x))
variantExtractor
{-# INLINE gvariantExtractors #-}

-- | Bundle a 'HM.HashMap' of 'Extractor's into an extractor of a variant.
buildVariantExtractor :: (Generic a, Typeable a)
  => HM.HashMap T.Text (Extractor a)
  -> Extractor a
buildVariantExtractor :: HashMap Text (Extractor a) -> Extractor a
buildVariantExtractor HashMap Text (Extractor a)
extractors = (Schema -> Strategy' (Term -> a)) -> Extractor a
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor ((Schema -> Strategy' (Term -> a)) -> Extractor a)
-> (Schema -> Strategy' (Term -> a)) -> Extractor a
forall a b. (a -> b) -> a -> b
$ \case
  SVariant Vector (Text, Schema)
schs0 -> (StrategyEnv -> Either WineryException (Term -> a))
-> Strategy' (Term -> a)
forall e r a. (r -> Either e a) -> Strategy e r a
Strategy ((StrategyEnv -> Either WineryException (Term -> a))
 -> Strategy' (Term -> a))
-> (StrategyEnv -> Either WineryException (Term -> a))
-> Strategy' (Term -> a)
forall a b. (a -> b) -> a -> b
$ \StrategyEnv
decs -> do
    Vector (Term -> a)
ds' <- ((Text, Schema) -> Either WineryException (Term -> a))
-> Vector (Text, Schema)
-> Either WineryException (Vector (Term -> a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\(Text
name, Schema
sch) -> case Text -> HashMap Text (Extractor a) -> Maybe (Extractor a)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
name HashMap Text (Extractor a)
extractors of
      Maybe (Extractor a)
Nothing -> WineryException -> Either WineryException (Term -> a)
forall a b. a -> Either a b
Left (WineryException -> Either WineryException (Term -> a))
-> WineryException -> Either WineryException (Term -> a)
forall a b. (a -> b) -> a -> b
$ [TypeRep] -> Text -> [Text] -> WineryException
FieldNotFound [] Text
name (HashMap Text (Extractor a) -> [Text]
forall k v. HashMap k v -> [k]
HM.keys HashMap Text (Extractor a)
extractors)
      Just Extractor a
f -> Extractor a -> Schema -> Strategy' (Term -> a)
forall a. Extractor a -> Schema -> Strategy' (Term -> a)
runExtractor Extractor a
f Schema
sch Strategy' (Term -> a)
-> StrategyEnv -> Either WineryException (Term -> a)
forall e r a. Strategy e r a -> r -> Either e a
`unStrategy` StrategyEnv
decs) Vector (Text, Schema)
schs0
    return $ \case
      TVariant Int
i Text
_ Term
v -> a -> ((Term -> a) -> a) -> Maybe (Term -> a) -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DecodeException -> a
forall a e. Exception e => e -> a
throw DecodeException
InvalidTag) ((Term -> a) -> Term -> a
forall a b. (a -> b) -> a -> b
$ Term
v) (Maybe (Term -> a) -> a) -> Maybe (Term -> a) -> a
forall a b. (a -> b) -> a -> b
$ Vector (Term -> a)
ds' Vector (Term -> a) -> Int -> Maybe (Term -> a)
forall a. Vector a -> Int -> Maybe a
V.!? Int
i
      Term
t -> ExtractException -> a
forall a e. Exception e => e -> a
throw (ExtractException -> a) -> ExtractException -> a
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t
  Schema
s -> WineryException -> Strategy' (Term -> a)
forall e r a. e -> Strategy e r a
throwStrategy (WineryException -> Strategy' (Term -> a))
-> WineryException -> Strategy' (Term -> a)
forall a b. (a -> b) -> a -> b
$ [TypeRep] -> Doc AnsiStyle -> Schema -> WineryException
UnexpectedSchema [] Doc AnsiStyle
"a variant" Schema
s

gdecodeCurrentVariant :: forall a. (GConstructorCount (Rep a), GEncodeVariant (Rep a), GDecodeVariant (Rep a), Generic a) => Decoder a
gdecodeCurrentVariant :: Decoder a
gdecodeCurrentVariant = Decoder Int
forall a. (Num a, Bits a) => Decoder a
decodeVarInt Decoder Int -> (Int -> Decoder a) -> Decoder a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Rep a Any -> a) -> Decoder (Rep a Any) -> Decoder a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Decoder (Rep a Any) -> Decoder a)
-> (Int -> Decoder (Rep a Any)) -> Int -> Decoder a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Decoder (Rep a Any)
forall k (f :: k -> *) (x :: k).
GDecodeVariant f =>
Int -> Int -> Decoder (f x)
variantDecoder (Proxy (Rep a) -> Int
forall k (f :: k) (proxy :: k -> *).
GConstructorCount f =>
proxy f -> Int
variantCount (Proxy (Rep a)
forall k (t :: k). Proxy t
Proxy :: Proxy (Rep a)))
{-# INLINE gdecodeCurrentVariant #-}

class GConstructorCount f where
  variantCount :: proxy f -> Int

instance (GConstructorCount f, GConstructorCount g) => GConstructorCount (f :+: g) where
  variantCount :: proxy (f :+: g) -> Int
variantCount proxy (f :+: g)
_ = Proxy f -> Int
forall k (f :: k) (proxy :: k -> *).
GConstructorCount f =>
proxy f -> Int
variantCount (Proxy f
forall k (t :: k). Proxy t
Proxy @ f) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy g -> Int
forall k (f :: k) (proxy :: k -> *).
GConstructorCount f =>
proxy f -> Int
variantCount (Proxy g
forall k (t :: k). Proxy t
Proxy @ g)
  {-# INLINE variantCount #-}

instance GConstructorCount (C1 i f) where
  variantCount :: proxy (C1 i f) -> Int
variantCount proxy (C1 i f)
_ = Int
1
  {-# INLINE variantCount #-}

instance GConstructorCount f => GConstructorCount (D1 i f) where
  variantCount :: proxy (D1 i f) -> Int
variantCount proxy (D1 i f)
_ = Proxy f -> Int
forall k (f :: k) (proxy :: k -> *).
GConstructorCount f =>
proxy f -> Int
variantCount (Proxy f
forall k (t :: k). Proxy t
Proxy @ f)
  {-# INLINE variantCount #-}

class GDecodeVariant f where
  variantDecoder :: Int -> Int -> Decoder (f x)

instance (GDecodeVariant f, GDecodeVariant g) => GDecodeVariant (f :+: g) where
  variantDecoder :: Int -> Int -> Decoder ((:+:) f g x)
variantDecoder Int
len Int
i
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len' = f x -> (:+:) f g x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (f x -> (:+:) f g x) -> Decoder (f x) -> Decoder ((:+:) f g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Decoder (f x)
forall k (f :: k -> *) (x :: k).
GDecodeVariant f =>
Int -> Int -> Decoder (f x)
variantDecoder Int
len' Int
i
    | Bool
otherwise = g x -> (:+:) f g x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (g x -> (:+:) f g x) -> Decoder (g x) -> Decoder ((:+:) f g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Decoder (g x)
forall k (f :: k -> *) (x :: k).
GDecodeVariant f =>
Int -> Int -> Decoder (f x)
variantDecoder (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len') (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len')
    where
      -- Nested ':+:' are balanced
      -- cf. https://github.com/GaloisInc/cereal/blob/cereal-0.5.8.1/src/Data/Serialize.hs#L659
      len' :: Int
len' = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR Int
len Int
1
  {-# INLINE variantDecoder #-}

instance GDecodeProduct f => GDecodeVariant (C1 i f) where
  variantDecoder :: Int -> Int -> Decoder (C1 i f x)
variantDecoder Int
_ Int
_ = f x -> C1 i f x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f x -> C1 i f x) -> Decoder (f x) -> Decoder (C1 i f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder (f x)
forall k (f :: k -> *) (x :: k). GDecodeProduct f => Decoder (f x)
productDecoder
  {-# INLINE variantDecoder #-}

instance GDecodeVariant f => GDecodeVariant (D1 i f) where
  variantDecoder :: Int -> Int -> Decoder (D1 i f x)
variantDecoder Int
len Int
i = f x -> D1 i f x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f x -> D1 i f x) -> Decoder (f x) -> Decoder (D1 i f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Decoder (f x)
forall k (f :: k -> *) (x :: k).
GDecodeVariant f =>
Int -> Int -> Decoder (f x)
variantDecoder Int
len Int
i
  {-# INLINE variantDecoder #-}

class GEncodeVariant f where
  variantEncoder :: Int -> Int -> f x -> BB.Builder

instance (GEncodeVariant f, GEncodeVariant g) => GEncodeVariant (f :+: g) where
  variantEncoder :: Int -> Int -> (:+:) f g x -> Builder
variantEncoder Int
len Int
i (L1 f x
f) = Int -> Int -> f x -> Builder
forall k (f :: k -> *) (x :: k).
GEncodeVariant f =>
Int -> Int -> f x -> Builder
variantEncoder (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR Int
len Int
1) Int
i f x
f
  variantEncoder Int
len Int
i (R1 g x
g) = Int -> Int -> g x -> Builder
forall k (f :: k -> *) (x :: k).
GEncodeVariant f =>
Int -> Int -> f x -> Builder
variantEncoder (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len') (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len') g x
g
    where
      -- Nested ':+:' are balanced
      -- cf. https://github.com/GaloisInc/cereal/blob/cereal-0.5.8.1/src/Data/Serialize.hs#L659
      len' :: Int
len' = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR Int
len Int
1
  {-# INLINE variantEncoder #-}

instance (GEncodeProduct f) => GEncodeVariant (C1 i f) where
  variantEncoder :: Int -> Int -> C1 i f x -> Builder
variantEncoder Int
_ !Int
i (M1 f x
a) = Int -> Builder
forall a. (Bits a, Integral a) => a -> Builder
varInt Int
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> f x -> Builder
forall k (f :: k -> *) (x :: k). GEncodeProduct f => f x -> Builder
productEncoder f x
a
  {-# INLINE variantEncoder #-}

instance GEncodeVariant f => GEncodeVariant (D1 i f) where
  variantEncoder :: Int -> Int -> D1 i f x -> Builder
variantEncoder Int
len Int
i (M1 f x
a) = Int -> Int -> f x -> Builder
forall k (f :: k -> *) (x :: k).
GEncodeVariant f =>
Int -> Int -> f x -> Builder
variantEncoder Int
len Int
i f x
a
  {-# INLINE variantEncoder #-}

class GSerialiseVariant f where
  variantSchema :: proxy f -> SchemaGen [(T.Text, Schema)]
  variantExtractor :: HM.HashMap T.Text (Extractor (f x))

instance (GSerialiseVariant f, GSerialiseVariant g) => GSerialiseVariant (f :+: g) where
  variantSchema :: proxy (f :+: g) -> SchemaGen [(Text, Schema)]
variantSchema proxy (f :+: g)
_ = [(Text, Schema)] -> [(Text, Schema)] -> [(Text, Schema)]
forall a. [a] -> [a] -> [a]
(++) ([(Text, Schema)] -> [(Text, Schema)] -> [(Text, Schema)])
-> SchemaGen [(Text, Schema)]
-> SchemaGen ([(Text, Schema)] -> [(Text, Schema)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy f -> SchemaGen [(Text, Schema)]
forall k (f :: k -> *) (proxy :: (k -> *) -> *).
GSerialiseVariant f =>
proxy f -> SchemaGen [(Text, Schema)]
variantSchema (Proxy f
forall k (t :: k). Proxy t
Proxy @ f) SchemaGen ([(Text, Schema)] -> [(Text, Schema)])
-> SchemaGen [(Text, Schema)] -> SchemaGen [(Text, Schema)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy g -> SchemaGen [(Text, Schema)]
forall k (f :: k -> *) (proxy :: (k -> *) -> *).
GSerialiseVariant f =>
proxy f -> SchemaGen [(Text, Schema)]
variantSchema (Proxy g
forall k (t :: k). Proxy t
Proxy @ g)
  variantExtractor :: HashMap Text (Extractor ((:+:) f g x))
variantExtractor = (Extractor (f x) -> Extractor ((:+:) f g x))
-> HashMap Text (Extractor (f x))
-> HashMap Text (Extractor ((:+:) f g x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((f x -> (:+:) f g x) -> Extractor (f x) -> Extractor ((:+:) f g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f x -> (:+:) f g x
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1) HashMap Text (Extractor (f x))
forall k (f :: k -> *) (x :: k).
GSerialiseVariant f =>
HashMap Text (Extractor (f x))
variantExtractor
    HashMap Text (Extractor ((:+:) f g x))
-> HashMap Text (Extractor ((:+:) f g x))
-> HashMap Text (Extractor ((:+:) f g x))
forall a. Semigroup a => a -> a -> a
<> (Extractor (g x) -> Extractor ((:+:) f g x))
-> HashMap Text (Extractor (g x))
-> HashMap Text (Extractor ((:+:) f g x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((g x -> (:+:) f g x) -> Extractor (g x) -> Extractor ((:+:) f g x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g x -> (:+:) f g x
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1) HashMap Text (Extractor (g x))
forall k (f :: k -> *) (x :: k).
GSerialiseVariant f =>
HashMap Text (Extractor (f x))
variantExtractor

instance (GSerialiseProduct f, KnownSymbol name) => GSerialiseVariant (C1 ('MetaCons name fixity 'False) f) where
  variantSchema :: proxy (C1 ('MetaCons name fixity 'False) f)
-> SchemaGen [(Text, Schema)]
variantSchema proxy (C1 ('MetaCons name fixity 'False) f)
_ = do
    [Schema]
s <- Proxy f -> SchemaGen [Schema]
forall k (f :: k -> *) (proxy :: (k -> *) -> *).
GSerialiseProduct f =>
proxy f -> SchemaGen [Schema]
productSchema (Proxy f
forall k (t :: k). Proxy t
Proxy @ f)
    return [([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy name -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (Proxy name
forall k (t :: k). Proxy t
Proxy @ name), Vector Schema -> Schema
forall a. Vector (SchemaP a) -> SchemaP a
SProduct (Vector Schema -> Schema) -> Vector Schema -> Schema
forall a b. (a -> b) -> a -> b
$ [Schema] -> Vector Schema
forall a. [a] -> Vector a
V.fromList [Schema]
s)]
  variantExtractor :: HashMap Text (Extractor (C1 ('MetaCons name fixity 'False) f x))
variantExtractor = Text
-> Extractor (C1 ('MetaCons name fixity 'False) f x)
-> HashMap Text (Extractor (C1 ('MetaCons name fixity 'False) f x))
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy name -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (Proxy name
forall k (t :: k). Proxy t
Proxy @ name)) (f x -> C1 ('MetaCons name fixity 'False) f x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f x -> C1 ('MetaCons name fixity 'False) f x)
-> Extractor (f x)
-> Extractor (C1 ('MetaCons name fixity 'False) f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Schema -> Strategy' (Term -> f x)) -> Extractor (f x)
forall a. (Schema -> Strategy' (Term -> a)) -> Extractor a
Extractor Schema -> Strategy' (Term -> f x)
forall k (f :: k -> *) (x :: k).
GSerialiseProduct f =>
Schema -> Strategy' (Term -> f x)
extractorProduct')

instance (GSerialiseRecord f, KnownSymbol name) => GSerialiseVariant (C1 ('MetaCons name fixity 'True) f) where
  variantSchema :: proxy (C1 ('MetaCons name fixity 'True) f)
-> SchemaGen [(Text, Schema)]
variantSchema proxy (C1 ('MetaCons name fixity 'True) f)
_ = do
    [(Text, Schema)]
s <- Proxy f -> SchemaGen [(Text, Schema)]
forall k (f :: k -> *) (proxy :: (k -> *) -> *).
GSerialiseRecord f =>
proxy f -> SchemaGen [(Text, Schema)]
recordSchema (Proxy f
forall k (t :: k). Proxy t
Proxy @ f)
    return [([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy name -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (Proxy name
forall k (t :: k). Proxy t
Proxy @ name), Vector (Text, Schema) -> Schema
forall a. Vector (Text, SchemaP a) -> SchemaP a
SRecord (Vector (Text, Schema) -> Schema)
-> Vector (Text, Schema) -> Schema
forall a b. (a -> b) -> a -> b
$ [(Text, Schema)] -> Vector (Text, Schema)
forall a. [a] -> Vector a
V.fromList [(Text, Schema)]
s)]
  variantExtractor :: HashMap Text (Extractor (C1 ('MetaCons name fixity 'True) f x))
variantExtractor = Text
-> Extractor (C1 ('MetaCons name fixity 'True) f x)
-> HashMap Text (Extractor (C1 ('MetaCons name fixity 'True) f x))
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton ([Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Proxy name -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (Proxy name
forall k (t :: k). Proxy t
Proxy @ name)) (f x -> C1 ('MetaCons name fixity 'True) f x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f x -> C1 ('MetaCons name fixity 'True) f x)
-> Extractor (f x)
-> Extractor (C1 ('MetaCons name fixity 'True) f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Schema -> Strategy' (Term -> f x)) -> Extractor (f x)
forall a. (Schema -> Strategy' (Term -> a)) -> Extractor a
Extractor (Maybe (f x) -> Schema -> Strategy' (Term -> f x)
forall k (f :: k -> *) (x :: k).
GSerialiseRecord f =>
Maybe (f x) -> Schema -> Strategy' (Term -> f x)
extractorRecord' Maybe (f x)
forall a. Maybe a
Nothing))

instance (GSerialiseVariant f) => GSerialiseVariant (D1 c f) where
  variantSchema :: proxy (D1 c f) -> SchemaGen [(Text, Schema)]
variantSchema proxy (D1 c f)
_ = Proxy f -> SchemaGen [(Text, Schema)]
forall k (f :: k -> *) (proxy :: (k -> *) -> *).
GSerialiseVariant f =>
proxy f -> SchemaGen [(Text, Schema)]
variantSchema (Proxy f
forall k (t :: k). Proxy t
Proxy @ f)
  variantExtractor :: HashMap Text (Extractor (D1 c f x))
variantExtractor = (f x -> D1 c f x) -> Extractor (f x) -> Extractor (D1 c f x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f x -> D1 c f x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Extractor (f x) -> Extractor (D1 c f x))
-> HashMap Text (Extractor (f x))
-> HashMap Text (Extractor (D1 c f x))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text (Extractor (f x))
forall k (f :: k -> *) (x :: k).
GSerialiseVariant f =>
HashMap Text (Extractor (f x))
variantExtractor

-- | An extractor for individual fields. This distinction is required for
-- handling recursions correctly.
--
-- Recommended extension: ApplicativeDo
newtype Subextractor a = Subextractor { Subextractor a -> Extractor a
unSubextractor :: Extractor a }
  deriving (a -> Subextractor b -> Subextractor a
(a -> b) -> Subextractor a -> Subextractor b
(forall a b. (a -> b) -> Subextractor a -> Subextractor b)
-> (forall a b. a -> Subextractor b -> Subextractor a)
-> Functor Subextractor
forall a b. a -> Subextractor b -> Subextractor a
forall a b. (a -> b) -> Subextractor a -> Subextractor b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Subextractor b -> Subextractor a
$c<$ :: forall a b. a -> Subextractor b -> Subextractor a
fmap :: (a -> b) -> Subextractor a -> Subextractor b
$cfmap :: forall a b. (a -> b) -> Subextractor a -> Subextractor b
Functor, Functor Subextractor
a -> Subextractor a
Functor Subextractor
-> (forall a. a -> Subextractor a)
-> (forall a b.
    Subextractor (a -> b) -> Subextractor a -> Subextractor b)
-> (forall a b c.
    (a -> b -> c)
    -> Subextractor a -> Subextractor b -> Subextractor c)
-> (forall a b. Subextractor a -> Subextractor b -> Subextractor b)
-> (forall a b. Subextractor a -> Subextractor b -> Subextractor a)
-> Applicative Subextractor
Subextractor a -> Subextractor b -> Subextractor b
Subextractor a -> Subextractor b -> Subextractor a
Subextractor (a -> b) -> Subextractor a -> Subextractor b
(a -> b -> c) -> Subextractor a -> Subextractor b -> Subextractor c
forall a. a -> Subextractor a
forall a b. Subextractor a -> Subextractor b -> Subextractor a
forall a b. Subextractor a -> Subextractor b -> Subextractor b
forall a b.
Subextractor (a -> b) -> Subextractor a -> Subextractor b
forall a b c.
(a -> b -> c) -> Subextractor a -> Subextractor b -> Subextractor c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Subextractor a -> Subextractor b -> Subextractor a
$c<* :: forall a b. Subextractor a -> Subextractor b -> Subextractor a
*> :: Subextractor a -> Subextractor b -> Subextractor b
$c*> :: forall a b. Subextractor a -> Subextractor b -> Subextractor b
liftA2 :: (a -> b -> c) -> Subextractor a -> Subextractor b -> Subextractor c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Subextractor a -> Subextractor b -> Subextractor c
<*> :: Subextractor (a -> b) -> Subextractor a -> Subextractor b
$c<*> :: forall a b.
Subextractor (a -> b) -> Subextractor a -> Subextractor b
pure :: a -> Subextractor a
$cpure :: forall a. a -> Subextractor a
$cp1Applicative :: Functor Subextractor
Applicative, Applicative Subextractor
Subextractor a
Applicative Subextractor
-> (forall a. Subextractor a)
-> (forall a. Subextractor a -> Subextractor a -> Subextractor a)
-> (forall a. Subextractor a -> Subextractor [a])
-> (forall a. Subextractor a -> Subextractor [a])
-> Alternative Subextractor
Subextractor a -> Subextractor a -> Subextractor a
Subextractor a -> Subextractor [a]
Subextractor a -> Subextractor [a]
forall a. Subextractor a
forall a. Subextractor a -> Subextractor [a]
forall a. Subextractor a -> Subextractor a -> Subextractor a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: Subextractor a -> Subextractor [a]
$cmany :: forall a. Subextractor a -> Subextractor [a]
some :: Subextractor a -> Subextractor [a]
$csome :: forall a. Subextractor a -> Subextractor [a]
<|> :: Subextractor a -> Subextractor a -> Subextractor a
$c<|> :: forall a. Subextractor a -> Subextractor a -> Subextractor a
empty :: Subextractor a
$cempty :: forall a. Subextractor a
$cp1Alternative :: Applicative Subextractor
Alternative)

-- | Extract a field of a record.
extractField :: Serialise a => T.Text -> Subextractor a
extractField :: Text -> Subextractor a
extractField = Extractor a -> Text -> Subextractor a
forall a. Extractor a -> Text -> Subextractor a
extractFieldBy Extractor a
forall a. Serialise a => Extractor a
extractor
{-# INLINE extractField #-}

-- | Extract a field using the supplied 'Extractor'.
extractFieldBy :: Extractor a -> T.Text -> Subextractor a
extractFieldBy :: Extractor a -> Text -> Subextractor a
extractFieldBy (Extractor Schema -> Strategy' (Term -> a)
g) Text
name = Extractor a -> Subextractor a
forall a. Extractor a -> Subextractor a
Subextractor (Extractor a -> Subextractor a) -> Extractor a -> Subextractor a
forall a b. (a -> b) -> a -> b
$ (Schema -> Strategy' (Term -> a)) -> Extractor a
forall a. (Schema -> Strategy' (Term -> a)) -> Extractor a
Extractor ((Schema -> Strategy' (Term -> a)) -> Extractor a)
-> (Schema -> Strategy' (Term -> a)) -> Extractor a
forall a b. (a -> b) -> a -> b
$ \case
  SRecord Vector (Text, Schema)
schs -> case Text -> Vector (Text, Schema) -> Maybe (Int, Schema)
forall k v. Eq k => k -> Vector (k, v) -> Maybe (Int, v)
lookupWithIndexV Text
name Vector (Text, Schema)
schs of
    Just (Int
i, Schema
sch) -> do
      Term -> a
m <- Schema -> Strategy' (Term -> a)
g Schema
sch
      return $ \case
        TRecord Vector (Text, Term)
xs -> a -> ((Text, Term) -> a) -> Maybe (Text, Term) -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ExtractException -> a
forall a e. Exception e => e -> a
throw (ExtractException -> a) -> ExtractException -> a
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm (Vector (Text, Term) -> Term
TRecord Vector (Text, Term)
xs)) (Term -> a
m (Term -> a) -> ((Text, Term) -> Term) -> (Text, Term) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Term) -> Term
forall a b. (a, b) -> b
snd) (Maybe (Text, Term) -> a) -> Maybe (Text, Term) -> a
forall a b. (a -> b) -> a -> b
$ Vector (Text, Term)
xs Vector (Text, Term) -> Int -> Maybe (Text, Term)
forall a. Vector a -> Int -> Maybe a
V.!? Int
i
        Term
t -> ExtractException -> a
forall a e. Exception e => e -> a
throw (ExtractException -> a) -> ExtractException -> a
forall a b. (a -> b) -> a -> b
$ Term -> ExtractException
InvalidTerm Term
t
    Maybe (Int, Schema)
_ -> WineryException -> Strategy' (Term -> a)
forall e r a. e -> Strategy e r a
throwStrategy (WineryException -> Strategy' (Term -> a))
-> WineryException -> Strategy' (Term -> a)
forall a b. (a -> b) -> a -> b
$ [TypeRep] -> Text -> [Text] -> WineryException
FieldNotFound [] Text
name (((Text, Schema) -> Text) -> [(Text, Schema)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Schema) -> Text
forall a b. (a, b) -> a
fst ([(Text, Schema)] -> [Text]) -> [(Text, Schema)] -> [Text]
forall a b. (a -> b) -> a -> b
$ Vector (Text, Schema) -> [(Text, Schema)]
forall a. Vector a -> [a]
V.toList Vector (Text, Schema)
schs)
  Schema
s -> WineryException -> Strategy' (Term -> a)
forall e r a. e -> Strategy e r a
throwStrategy (WineryException -> Strategy' (Term -> a))
-> WineryException -> Strategy' (Term -> a)
forall a b. (a -> b) -> a -> b
$ [TypeRep] -> Doc AnsiStyle -> Schema -> WineryException
UnexpectedSchema [] Doc AnsiStyle
"a record" Schema
s

-- | Build an extractor from a 'Subextractor'.
buildExtractor :: Typeable a => Subextractor a -> Extractor a
buildExtractor :: Subextractor a -> Extractor a
buildExtractor (Subextractor Extractor a
e) = (Schema -> Strategy' (Term -> a)) -> Extractor a
forall a.
Typeable a =>
(Schema -> Strategy' (Term -> a)) -> Extractor a
mkExtractor ((Schema -> Strategy' (Term -> a)) -> Extractor a)
-> (Schema -> Strategy' (Term -> a)) -> Extractor a
forall a b. (a -> b) -> a -> b
$ Extractor a -> Schema -> Strategy' (Term -> a)
forall a. Extractor a -> Schema -> Strategy' (Term -> a)
runExtractor Extractor a
e
{-# INLINE buildExtractor #-}

instance (Typeable k, Typeable b, Typeable h, ApplicativeB b, ConstraintsB b, TraversableB b, AllBF Serialise h b, FieldNamesB b) => Serialise (Barbie b (h :: k -> Type)) where
  schemaGen :: Proxy (Barbie b h) -> SchemaGen Schema
schemaGen Proxy (Barbie b h)
_ = (b (Const (Endo [(Text, Schema)])) -> Schema)
-> SchemaGen (b (Const (Endo [(Text, Schema)])))
-> SchemaGen Schema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vector (Text, Schema) -> Schema
forall a. Vector (Text, SchemaP a) -> SchemaP a
SRecord (Vector (Text, Schema) -> Schema)
-> (b (Const (Endo [(Text, Schema)])) -> Vector (Text, Schema))
-> b (Const (Endo [(Text, Schema)]))
-> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Schema)] -> Vector (Text, Schema)
forall a. [a] -> Vector a
V.fromList ([(Text, Schema)] -> Vector (Text, Schema))
-> (b (Const (Endo [(Text, Schema)])) -> [(Text, Schema)])
-> b (Const (Endo [(Text, Schema)]))
-> Vector (Text, Schema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Endo [(Text, Schema)] -> [(Text, Schema)] -> [(Text, Schema)]
forall a. Endo a -> a -> a
`appEndo`[]) (Endo [(Text, Schema)] -> [(Text, Schema)])
-> (b (Const (Endo [(Text, Schema)])) -> Endo [(Text, Schema)])
-> b (Const (Endo [(Text, Schema)]))
-> [(Text, Schema)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (a :: k).
 Const (Endo [(Text, Schema)]) a -> Endo [(Text, Schema)])
-> b (Const (Endo [(Text, Schema)])) -> Endo [(Text, Schema)]
forall k (b :: (k -> *) -> *) m (f :: k -> *).
(TraversableB b, Monoid m) =>
(forall (a :: k). f a -> m) -> b f -> m
bfoldMap forall (a :: k).
Const (Endo [(Text, Schema)]) a -> Endo [(Text, Schema)]
forall a k (b :: k). Const a b -> a
getConst)
    (SchemaGen (b (Const (Endo [(Text, Schema)]))) -> SchemaGen Schema)
-> SchemaGen (b (Const (Endo [(Text, Schema)])))
-> SchemaGen Schema
forall a b. (a -> b) -> a -> b
$ (forall (a :: k).
 Product (Dict (ClassF Serialise h)) (Const Text) a
 -> SchemaGen (Const (Endo [(Text, Schema)]) a))
-> b (Product (Dict (ClassF Serialise h)) (Const Text))
-> SchemaGen (b (Const (Endo [(Text, Schema)])))
forall k (b :: (k -> *) -> *) (e :: * -> *) (f :: k -> *)
       (g :: k -> *).
(TraversableB b, Applicative e) =>
(forall (a :: k). f a -> e (g a)) -> b f -> e (b g)
btraverse (\(F.Pair (Dict :: Dict (ClassF Serialise h) a) (Const k))
        -> Endo [(Text, Schema)] -> Const (Endo [(Text, Schema)]) a
forall k a (b :: k). a -> Const a b
Const (Endo [(Text, Schema)] -> Const (Endo [(Text, Schema)]) a)
-> (Schema -> Endo [(Text, Schema)])
-> Schema
-> Const (Endo [(Text, Schema)]) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Text, Schema)] -> [(Text, Schema)]) -> Endo [(Text, Schema)]
forall a. (a -> a) -> Endo a
Endo (([(Text, Schema)] -> [(Text, Schema)]) -> Endo [(Text, Schema)])
-> (Schema -> [(Text, Schema)] -> [(Text, Schema)])
-> Schema
-> Endo [(Text, Schema)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) ((Text, Schema) -> [(Text, Schema)] -> [(Text, Schema)])
-> (Schema -> (Text, Schema))
-> Schema
-> [(Text, Schema)]
-> [(Text, Schema)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) Text
k (Schema -> Const (Endo [(Text, Schema)]) a)
-> SchemaGen Schema -> SchemaGen (Const (Endo [(Text, Schema)]) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy (h a) -> SchemaGen Schema
forall a. Serialise a => Proxy a -> SchemaGen Schema
schemaGen (Proxy (h a)
forall k (t :: k). Proxy t
Proxy @ (h a)))
    (b (Product (Dict (ClassF Serialise h)) (Const Text))
 -> SchemaGen (b (Const (Endo [(Text, Schema)]))))
-> b (Product (Dict (ClassF Serialise h)) (Const Text))
-> SchemaGen (b (Const (Endo [(Text, Schema)])))
forall a b. (a -> b) -> a -> b
$ b (Const Text)
-> b (Product (Dict (ClassF Serialise h)) (Const Text))
forall k (b :: (k -> *) -> *) (c :: k -> Constraint) (f :: k -> *).
(ConstraintsB b, AllB c b) =>
b f -> b (Product (Dict c) f)
baddDicts (b (Const Text)
forall k (b :: (k -> *) -> *) a.
(FieldNamesB b, IsString a) =>
b (Const a)
bfieldNames :: b (Const T.Text))
  toBuilder :: Barbie b h -> Builder
toBuilder = (forall (a :: k).
 Product (Dict (ClassF Serialise h)) h a -> Builder)
-> Barbie b (Product (Dict (ClassF Serialise h)) h) -> Builder
forall k (b :: (k -> *) -> *) m (f :: k -> *).
(TraversableB b, Monoid m) =>
(forall (a :: k). f a -> m) -> b f -> m
bfoldMap (\(F.Pair (Dict :: Dict (ClassF Serialise h) a) x) -> h a -> Builder
forall a. Serialise a => a -> Builder
toBuilder h a
x) (Barbie b (Product (Dict (ClassF Serialise h)) h) -> Builder)
-> (Barbie b h -> Barbie b (Product (Dict (ClassF Serialise h)) h))
-> Barbie b h
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Barbie b h -> Barbie b (Product (Dict (ClassF Serialise h)) h)
forall k (b :: (k -> *) -> *) (c :: k -> Constraint) (f :: k -> *).
(ConstraintsB b, AllB c b) =>
b f -> b (Product (Dict c) f)
baddDicts
  {-# INLINE toBuilder #-}
  decodeCurrent :: Decoder (Barbie b h)
decodeCurrent = (b h -> Barbie b h) -> Decoder (b h) -> Decoder (Barbie b h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b h -> Barbie b h
forall k (b :: (k -> *) -> *) (f :: k -> *). b f -> Barbie b f
Barbie (Decoder (b h) -> Decoder (Barbie b h))
-> Decoder (b h) -> Decoder (Barbie b h)
forall a b. (a -> b) -> a -> b
$ (forall (a :: k). Dict (ClassF Serialise h) a -> Decoder (h a))
-> b (Dict (ClassF Serialise h)) -> Decoder (b h)
forall k (b :: (k -> *) -> *) (e :: * -> *) (f :: k -> *)
       (g :: k -> *).
(TraversableB b, Applicative e) =>
(forall (a :: k). f a -> e (g a)) -> b f -> e (b g)
btraverse (\Dict (ClassF Serialise h) a
Dict -> Decoder (h a)
forall a. Serialise a => Decoder a
decodeCurrent) (b (Dict (ClassF Serialise h))
forall k (c :: k -> Constraint) (b :: (k -> *) -> *).
(ConstraintsB b, ApplicativeB b, AllB c b) =>
b (Dict c)
bdicts :: b (Dict (ClassF Serialise h)))
  {-# INLINE decodeCurrent #-}
  extractor :: Extractor (Barbie b h)
extractor = (b h -> Barbie b h) -> Extractor (b h) -> Extractor (Barbie b h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b h -> Barbie b h
forall k (b :: (k -> *) -> *) (f :: k -> *). b f -> Barbie b f
Barbie (Extractor (b h) -> Extractor (Barbie b h))
-> Extractor (b h) -> Extractor (Barbie b h)
forall a b. (a -> b) -> a -> b
$ b (Compose Subextractor h) -> Extractor (b h)
forall k (b :: (k -> *) -> *) (h :: k -> *).
(Typeable b, Typeable h, TraversableB b) =>
b (Compose Subextractor h) -> Extractor (b h)
buildRecordExtractorF b (Compose Subextractor h)
forall k1 (b :: (k1 -> *) -> *) (h :: k1 -> *).
(ConstraintsB b, AllBF Serialise h b, FieldNamesB b) =>
b (Compose Subextractor h)
bextractorsF

buildRecordExtractorF :: (Typeable b, Typeable h, TraversableB b) => b (Compose Subextractor h) -> Extractor (b h)
buildRecordExtractorF :: b (Compose Subextractor h) -> Extractor (b h)
buildRecordExtractorF = Subextractor (b h) -> Extractor (b h)
forall a. Typeable a => Subextractor a -> Extractor a
buildExtractor (Subextractor (b h) -> Extractor (b h))
-> (b (Compose Subextractor h) -> Subextractor (b h))
-> b (Compose Subextractor h)
-> Extractor (b h)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (a :: k). Compose Subextractor h a -> Subextractor (h a))
-> b (Compose Subextractor h) -> Subextractor (b h)
forall k (b :: (k -> *) -> *) (e :: * -> *) (f :: k -> *)
       (g :: k -> *).
(TraversableB b, Applicative e) =>
(forall (a :: k). f a -> e (g a)) -> b f -> e (b g)
btraverse forall (a :: k). Compose Subextractor h a -> Subextractor (h a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
{-# INLINE buildRecordExtractorF #-}

-- | Collect extractors for record fields
bextractorsF :: forall b h. (ConstraintsB b, AllBF Serialise h b, FieldNamesB b) => b (Compose Subextractor h)
bextractorsF :: b (Compose Subextractor h)
bextractorsF = (forall (a :: k1).
 ClassF Serialise h a =>
 Const Text a -> Compose Subextractor h a)
-> b (Const Text) -> b (Compose Subextractor h)
forall k (c :: k -> Constraint) (b :: (k -> *) -> *) (f :: k -> *)
       (g :: k -> *).
(AllB c b, ConstraintsB b) =>
(forall (a :: k). c a => f a -> g a) -> b f -> b g
bmapC @(ClassF Serialise h) (Subextractor (h a) -> Compose Subextractor h a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Subextractor (h a) -> Compose Subextractor h a)
-> (Const Text a -> Subextractor (h a))
-> Const Text a
-> Compose Subextractor h a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Subextractor (h a)
forall a. Serialise a => Text -> Subextractor a
extractField (Text -> Subextractor (h a))
-> (Const Text a -> Text) -> Const Text a -> Subextractor (h a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const Text a -> Text
forall a k (b :: k). Const a b -> a
getConst) b (Const Text)
forall k (b :: (k -> *) -> *) a.
(FieldNamesB b, IsString a) =>
b (Const a)
bfieldNames
{-# INLINABLE bextractorsF #-}

buildRecordExtractor :: (Typeable b, TraversableB b) => b Subextractor -> Extractor (b Identity)
buildRecordExtractor :: b Subextractor -> Extractor (b Identity)
buildRecordExtractor = Subextractor (b Identity) -> Extractor (b Identity)
forall a. Typeable a => Subextractor a -> Extractor a
buildExtractor (Subextractor (b Identity) -> Extractor (b Identity))
-> (b Subextractor -> Subextractor (b Identity))
-> b Subextractor
-> Extractor (b Identity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Subextractor a -> Subextractor (Identity a))
-> b Subextractor -> Subextractor (b Identity)
forall k (b :: (k -> *) -> *) (e :: * -> *) (f :: k -> *)
       (g :: k -> *).
(TraversableB b, Applicative e) =>
(forall (a :: k). f a -> e (g a)) -> b f -> e (b g)
btraverse ((a -> Identity a) -> Subextractor a -> Subextractor (Identity a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Identity a
forall a. a -> Identity a
Identity)
{-# INLINE buildRecordExtractor #-}

-- | Collect extractors for record fields
bextractors :: forall b. (ConstraintsB b, AllB Serialise b, FieldNamesB b) => b Subextractor
bextractors :: b Subextractor
bextractors = (forall a. Serialise a => Const Text a -> Subextractor a)
-> b (Const Text) -> b Subextractor
forall k (c :: k -> Constraint) (b :: (k -> *) -> *) (f :: k -> *)
       (g :: k -> *).
(AllB c b, ConstraintsB b) =>
(forall (a :: k). c a => f a -> g a) -> b f -> b g
bmapC @Serialise (Text -> Subextractor a
forall a. Serialise a => Text -> Subextractor a
extractField (Text -> Subextractor a)
-> (Const Text a -> Text) -> Const Text a -> Subextractor a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const Text a -> Text
forall a k (b :: k). Const a b -> a
getConst) b (Const Text)
forall k (b :: (k -> *) -> *) a.
(FieldNamesB b, IsString a) =>
b (Const a)
bfieldNames
{-# INLINABLE bextractors #-}