{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FunctionalDependencies #-}
module Data.Coders
( Encode (..),
Decode (..),
(!>),
(<!),
(<*!),
Density(..),
Wrapped (..),
Annotator(..),
Dual(..),
Field(..),
field,
encode,
decode,
runE,
decodeList,
decodeSeq,
decodeStrictSeq,
decodeSet,
decodeRecordNamed,
decodeRecordSum,
invalidKey,
unusedRequiredKeys,
duplicateKey,
wrapCBORArray,
encodeFoldable,
decodeCollectionWithLen,
decodeCollection,
encodeFoldableEncoder,
dualList,
dualSeq,
dualSet,
dualMaybeAsList,
dualMaybeAsNull,
dualText,
dualStrictSeq,
dualCBOR,
to,
from,
Decoder,
Encoding,
encodeNullMaybe,
decodeNullMaybe,
decodeSparse,
)
where
import Cardano.Prelude (cborError)
import Control.Monad (replicateM,unless)
import Codec.CBOR.Decoding (Decoder)
import Codec.CBOR.Encoding (Encoding)
import Cardano.Binary
( FromCBOR (fromCBOR),
ToCBOR (toCBOR),
Annotator (..),
encodeListLen,
encodeMapLen,
encodeWord,
encodeBreak,
encodeListLenIndef,
DecoderError( DecoderErrorCustom ),
decodeBreakOr,
decodeListLenOrIndef,
decodeMapLenOrIndef,
decodeWord,
matchSize,
TokenType(TypeNull),
peekTokenType,
decodeNull,
encodeNull,
)
import qualified Data.Sequence as Seq
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import qualified Data.Text as Text
import Data.Sequence.Strict (StrictSeq)
import Data.Sequence (Seq)
import Data.Set (Set,insert,member)
import Data.Foldable (foldl')
import Data.Typeable
decodeRecordNamed :: Text.Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed :: Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
name a -> Int
getRecordSize Decoder s a
decoder = do
Maybe Int
lenOrIndef <- Decoder s (Maybe Int)
forall s. Decoder s (Maybe Int)
decodeListLenOrIndef
a
x <- Decoder s a
decoder
case Maybe Int
lenOrIndef of
Just Int
n -> Text -> Int -> Int -> Decoder s ()
forall s. Text -> Int -> Int -> Decoder s ()
matchSize (String -> Text
Text.pack String
"\nRecord " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name) Int
n (a -> Int
getRecordSize a
x)
Maybe Int
Nothing -> do
Bool
isBreak <- Decoder s Bool
forall s. Decoder s Bool
decodeBreakOr
Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isBreak (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ DecoderError -> Decoder s ()
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s ()) -> DecoderError -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
name Text
"Excess terms in array"
a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
decodeRecordSum :: String -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum :: String -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum String
name Word -> Decoder s (Int, a)
decoder = do
Maybe Int
lenOrIndef <- Decoder s (Maybe Int)
forall s. Decoder s (Maybe Int)
decodeListLenOrIndef
Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
(Int
size, a
x) <- Word -> Decoder s (Int, a)
decoder Word
tag
case Maybe Int
lenOrIndef of
Just Int
n -> Text -> Int -> Int -> Decoder s ()
forall s. Text -> Int -> Int -> Decoder s ()
matchSize (String -> Text
Text.pack (String
"\nSum " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\nreturned=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
size String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" actually read= " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n)) Int
size Int
n
Maybe Int
Nothing -> do
Bool
isBreak <- Decoder s Bool
forall s. Decoder s Bool
decodeBreakOr
Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isBreak (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ DecoderError -> Decoder s ()
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s ()) -> DecoderError -> Decoder s ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom (String -> Text
Text.pack String
name) Text
"Excess terms in array"
a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
encodeNullMaybe :: (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe :: (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe a -> Encoding
_ Maybe a
Nothing = Encoding
encodeNull
encodeNullMaybe a -> Encoding
encoder (Just a
x) = a -> Encoding
encoder a
x
decodeNullMaybe :: Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe :: Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe Decoder s a
decoder = do
Decoder s TokenType
forall s. Decoder s TokenType
peekTokenType Decoder s TokenType
-> (TokenType -> Decoder s (Maybe a)) -> Decoder s (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
TokenType
TypeNull -> do
Decoder s ()
forall s. Decoder s ()
decodeNull
Maybe a -> Decoder s (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
TokenType
_ -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Decoder s a -> Decoder s (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a
decoder
invalidKey :: Word -> Decoder s a
invalidKey :: Word -> Decoder s a
invalidKey Word
k = DecoderError -> Decoder s a
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s a) -> DecoderError -> Decoder s a
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
"not a valid key:" (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Word -> String
forall a. Show a => a -> String
show Word
k)
duplicateKey :: String -> Word -> Decoder s a
duplicateKey :: String -> Word -> Decoder s a
duplicateKey String
name Word
k = DecoderError -> Decoder s a
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s a) -> DecoderError -> Decoder s a
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom Text
"Duplicate key:" (String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Word -> String
forall a. Show a => a -> String
show Word
kString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" while decoding type "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
name)
unusedRequiredKeys :: Set Word -> [(Word,String)] -> String -> Decoder s a
unusedRequiredKeys :: Set Word -> [(Word, String)] -> String -> Decoder s a
unusedRequiredKeys Set Word
used [(Word, String)]
required String
name =
DecoderError -> Decoder s a
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s a) -> DecoderError -> Decoder s a
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
DecoderErrorCustom (String -> Text
Text.pack(String
"value of type "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
name)) (String -> Text
Text.pack ([(Word, String)] -> String
forall a. Show a => [(a, String)] -> String
message (((Word, String) -> Bool) -> [(Word, String)] -> [(Word, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Word, String) -> Bool
bad [(Word, String)]
required)))
where bad :: (Word, String) -> Bool
bad (Word
k,String
_) = Bool -> Bool
not(Word -> Set Word -> Bool
forall a. Ord a => a -> Set a -> Bool
member Word
k Set Word
used)
message :: [(a, String)] -> String
message [] = String
", not decoded."
message [(a, String)
pair] = (a, String) -> String
forall a. Show a => (a, String) -> String
report (a, String)
pair String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(a, String)] -> String
message []
message ((a, String)
pair:[(a, String)]
more) = (a, String) -> String
forall a. Show a => (a, String) -> String
report (a, String)
pair String -> String -> String
forall a. [a] -> [a] -> [a]
++String
", and "String -> String -> String
forall a. [a] -> [a] -> [a]
++[(a, String)] -> String
message [(a, String)]
more
report :: (a, String) -> String
report (a
k,String
f) = (String
"field "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
fString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" with key "String -> String -> String
forall a. [a] -> [a] -> [a]
++a -> String
forall a. Show a => a -> String
show a
k)
decodeList :: Decoder s a -> Decoder s [a]
decodeList :: Decoder s a -> Decoder s [a]
decodeList = Decoder s (Maybe Int) -> Decoder s a -> Decoder s [a]
forall s a. Decoder s (Maybe Int) -> Decoder s a -> Decoder s [a]
decodeCollection Decoder s (Maybe Int)
forall s. Decoder s (Maybe Int)
decodeListLenOrIndef
decodeSeq :: Decoder s a -> Decoder s (Seq a)
decodeSeq :: Decoder s a -> Decoder s (Seq a)
decodeSeq Decoder s a
decoder = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList ([a] -> Seq a) -> Decoder s [a] -> Decoder s (Seq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a -> Decoder s [a]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s a
decoder
decodeStrictSeq :: Decoder s a -> Decoder s (StrictSeq a)
decodeStrictSeq :: Decoder s a -> Decoder s (StrictSeq a)
decodeStrictSeq Decoder s a
decoder = [a] -> StrictSeq a
forall a. [a] -> StrictSeq a
StrictSeq.fromList ([a] -> StrictSeq a) -> Decoder s [a] -> Decoder s (StrictSeq a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a -> Decoder s [a]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s a
decoder
decodeSet :: Ord a => Decoder s a -> Decoder s (Set a)
decodeSet :: Decoder s a -> Decoder s (Set a)
decodeSet Decoder s a
decoder = [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList ([a] -> Set a) -> Decoder s [a] -> Decoder s (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s a -> Decoder s [a]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s a
decoder
decodeCollection :: Decoder s (Maybe Int) -> Decoder s a -> Decoder s [a]
decodeCollection :: Decoder s (Maybe Int) -> Decoder s a -> Decoder s [a]
decodeCollection Decoder s (Maybe Int)
lenOrIndef Decoder s a
el = (Int, [a]) -> [a]
forall a b. (a, b) -> b
snd ((Int, [a]) -> [a]) -> Decoder s (Int, [a]) -> Decoder s [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Maybe Int) -> Decoder s a -> Decoder s (Int, [a])
forall s a.
Decoder s (Maybe Int) -> Decoder s a -> Decoder s (Int, [a])
decodeCollectionWithLen Decoder s (Maybe Int)
lenOrIndef Decoder s a
el
decodeCollectionWithLen ::
Decoder s (Maybe Int) ->
Decoder s a ->
Decoder s (Int, [a])
decodeCollectionWithLen :: Decoder s (Maybe Int) -> Decoder s a -> Decoder s (Int, [a])
decodeCollectionWithLen Decoder s (Maybe Int)
lenOrIndef Decoder s a
el = do
Decoder s (Maybe Int)
lenOrIndef Decoder s (Maybe Int)
-> (Maybe Int -> Decoder s (Int, [a])) -> Decoder s (Int, [a])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just Int
len -> (,) Int
len ([a] -> (Int, [a])) -> Decoder s [a] -> Decoder s (Int, [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Decoder s a -> Decoder s [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
len Decoder s a
el
Maybe Int
Nothing -> (Int, [a]) -> Decoder s Bool -> Decoder s a -> Decoder s (Int, [a])
forall (m :: * -> *) a a.
(Monad m, Num a) =>
(a, [a]) -> m Bool -> m a -> m (a, [a])
loop (Int
0, []) (Bool -> Bool
not (Bool -> Bool) -> Decoder s Bool -> Decoder s Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Bool
forall s. Decoder s Bool
decodeBreakOr) Decoder s a
el
where
loop :: (a, [a]) -> m Bool -> m a -> m (a, [a])
loop (a
n, [a]
acc) m Bool
condition m a
action =
m Bool
condition m Bool -> (Bool -> m (a, [a])) -> m (a, [a])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
False -> (a, [a]) -> m (a, [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
n, [a] -> [a]
forall a. [a] -> [a]
reverse [a]
acc)
Bool
True -> m a
action m a -> (a -> m (a, [a])) -> m (a, [a])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
v -> (a, [a]) -> m Bool -> m a -> m (a, [a])
loop (a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, (a
v a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc)) m Bool
condition m a
action
encodeFoldable :: (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable :: f a -> Encoding
encodeFoldable = (a -> Encoding) -> f a -> Encoding
forall (f :: * -> *) a.
Foldable f =>
(a -> Encoding) -> f a -> Encoding
encodeFoldableEncoder a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
encodeFoldableEncoder :: (Foldable f) => (a -> Encoding) -> f a -> Encoding
encodeFoldableEncoder :: (a -> Encoding) -> f a -> Encoding
encodeFoldableEncoder a -> Encoding
encoder f a
xs = Word -> Encoding -> Encoding
wrapCBORArray Word
len Encoding
contents
where
(Word
len, Encoding
contents) = ((Word, Encoding) -> a -> (Word, Encoding))
-> (Word, Encoding) -> f a -> (Word, Encoding)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Word, Encoding) -> a -> (Word, Encoding)
go (Word
0, Encoding
forall a. Monoid a => a
mempty) f a
xs
go :: (Word, Encoding) -> a -> (Word, Encoding)
go (!Word
l, !Encoding
enc) a
next = (Word
l Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1, Encoding
enc Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
encoder a
next)
wrapCBORArray :: Word -> Encoding -> Encoding
wrapCBORArray :: Word -> Encoding -> Encoding
wrapCBORArray Word
len Encoding
contents =
if Word
len Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
23
then Word -> Encoding
encodeListLen Word
len Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
contents
else Encoding
encodeListLenIndef Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
contents Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
encodeBreak
data Density = Dense | Sparse
data Wrapped where
Open :: Wrapped
Closed :: Density -> Wrapped
data Dual t = Dual (t -> Encoding) (forall s . Decoder s t)
data Field t where
Field:: (x -> t -> t) -> (forall s. Decoder s x) -> Field t
field :: (x -> t -> t) -> Decode ('Closed d) x -> Field t
field :: (x -> t -> t) -> Decode ('Closed d) x -> Field t
field x -> t -> t
update Decode ('Closed d) x
dec = (x -> t -> t) -> (forall s. Decoder s x) -> Field t
forall x t. (x -> t -> t) -> (forall s. Decoder s x) -> Field t
Field x -> t -> t
update (Decode ('Closed d) x -> Decoder s x
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode Decode ('Closed d) x
dec)
data Encode (w :: Wrapped) t where
Rec:: t -> Encode ('Closed 'Dense) t
Sum:: t -> Word -> Encode 'Open t
Keyed:: t -> Encode ('Closed 'Sparse) t
To :: ToCBOR a => a -> Encode ('Closed 'Dense) a
E :: (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
ED :: Dual t -> t -> Encode ('Closed 'Dense) t
OmitC :: t -> Encode w t
Omit:: (t -> Bool) -> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Key :: Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
ApplyE :: Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
infixl 4 !>
(!>) :: Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
Encode w (a -> t)
x !> :: Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Encode ('Closed r) a
y = Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
ApplyE Encode w (a -> t)
x Encode ('Closed r) a
y
runE :: Encode w t -> t
runE :: Encode w t -> t
runE (Sum t
cn Word
_) = t
cn
runE (Rec t
cn) = t
cn
runE (ApplyE Encode w (a -> t)
f Encode ('Closed r) a
x) = Encode w (a -> t) -> a -> t
forall (w :: Wrapped) t. Encode w t -> t
runE Encode w (a -> t)
f (Encode ('Closed r) a -> a
forall (w :: Wrapped) t. Encode w t -> t
runE Encode ('Closed r) a
x)
runE (To t
x) = t
x
runE (E t -> Encoding
_ t
x) = t
x
runE (ED Dual t
_ t
x) = t
x
runE (OmitC t
x) = t
x
runE (Omit t -> Bool
_ Encode ('Closed 'Sparse) t
x) = Encode ('Closed 'Sparse) t -> t
forall (w :: Wrapped) t. Encode w t -> t
runE Encode ('Closed 'Sparse) t
x
runE (Key Word
_ Encode ('Closed 'Dense) t
x) = Encode ('Closed 'Dense) t -> t
forall (w :: Wrapped) t. Encode w t -> t
runE Encode ('Closed 'Dense) t
x
runE (Keyed t
cn) = t
cn
gsize :: Encode w t -> Word
gsize :: Encode w t -> Word
gsize (Sum t
_ Word
_) = Word
0
gsize (Rec t
_) = Word
0
gsize (To t
_) = Word
1
gsize (E t -> Encoding
_ t
_) = Word
1
gsize (ApplyE Encode w (a -> t)
f Encode ('Closed r) a
x) = Encode w (a -> t) -> Word
forall (w :: Wrapped) t. Encode w t -> Word
gsize Encode w (a -> t)
f Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Encode ('Closed r) a -> Word
forall (w :: Wrapped) t. Encode w t -> Word
gsize Encode ('Closed r) a
x
gsize (ED Dual t
_ t
_) = Word
1
gsize (OmitC t
_) = Word
0
gsize (Omit t -> Bool
p Encode ('Closed 'Sparse) t
x) = if t -> Bool
p (Encode ('Closed 'Sparse) t -> t
forall (w :: Wrapped) t. Encode w t -> t
runE Encode ('Closed 'Sparse) t
x) then Word
0 else Encode ('Closed 'Sparse) t -> Word
forall (w :: Wrapped) t. Encode w t -> Word
gsize Encode ('Closed 'Sparse) t
x
gsize (Key Word
_ Encode ('Closed 'Dense) t
x) = Encode ('Closed 'Dense) t -> Word
forall (w :: Wrapped) t. Encode w t -> Word
gsize Encode ('Closed 'Dense) t
x
gsize (Keyed t
_) = Word
0
encode :: Encode w t -> Encoding
encode :: Encode w t -> Encoding
encode Encode w t
sym = Word -> Encode w t -> Encoding
forall (w :: Wrapped) t. Word -> Encode w t -> Encoding
encodeCountPrefix Word
0 Encode w t
sym
where
encodeCountPrefix :: Word -> Encode w t -> Encoding
encodeCountPrefix :: Word -> Encode w t -> Encoding
encodeCountPrefix Word
n (Sum t
_ Word
tag) = Word -> Encoding
encodeListLen (Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
tag
encodeCountPrefix Word
n (Keyed t
_) = Word -> Encoding
encodeMapLen Word
n
encodeCountPrefix Word
n (Rec t
_) = Word -> Encoding
encodeListLen Word
n
encodeCountPrefix Word
_ (To t
x) = t -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR t
x
encodeCountPrefix Word
_ (E t -> Encoding
enc t
x) = t -> Encoding
enc t
x
encodeCountPrefix Word
_ (ED (Dual t -> Encoding
enc forall s. Decoder s t
_) t
x) = t -> Encoding
enc t
x
encodeCountPrefix Word
_ (OmitC t
_) = Encoding
forall a. Monoid a => a
mempty
encodeCountPrefix Word
n (Key Word
tag Encode ('Closed 'Dense) t
x) = Word -> Encoding
encodeWord Word
tag Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encode ('Closed 'Dense) t -> Encoding
forall (w :: Wrapped) t. Word -> Encode w t -> Encoding
encodeCountPrefix Word
n Encode ('Closed 'Dense) t
x
encodeCountPrefix Word
n (Omit t -> Bool
p Encode ('Closed 'Sparse) t
x) =
if t -> Bool
p (Encode ('Closed 'Sparse) t -> t
forall (w :: Wrapped) t. Encode w t -> t
runE Encode ('Closed 'Sparse) t
x) then Encoding
forall a. Monoid a => a
mempty else Word -> Encode ('Closed 'Sparse) t -> Encoding
forall (w :: Wrapped) t. Word -> Encode w t -> Encoding
encodeCountPrefix Word
n Encode ('Closed 'Sparse) t
x
encodeCountPrefix Word
n (ApplyE Encode w (a -> t)
ff Encode ('Closed r) a
xx) = Word -> Encode w (a -> t) -> Encoding
forall (w :: Wrapped) t. Word -> Encode w t -> Encoding
encodeCountPrefix (Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Encode ('Closed r) a -> Word
forall (w :: Wrapped) t. Encode w t -> Word
gsize Encode ('Closed r) a
xx) Encode w (a -> t)
ff Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encode ('Closed r) a -> Encoding
forall (d :: Density) t. Encode ('Closed d) t -> Encoding
encodeClosed Encode ('Closed r) a
xx
where encodeClosed :: Encode ('Closed d) t -> Encoding
encodeClosed :: Encode ('Closed d) t -> Encoding
encodeClosed (Rec t
_) = Encoding
forall a. Monoid a => a
mempty
encodeClosed (To t
x) = t -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR t
x
encodeClosed (E t -> Encoding
enc t
x) = t -> Encoding
enc t
x
encodeClosed (ApplyE Encode ('Closed d) (a -> t)
f Encode ('Closed r) a
x) = Encode ('Closed d) (a -> t) -> Encoding
forall (d :: Density) t. Encode ('Closed d) t -> Encoding
encodeClosed Encode ('Closed d) (a -> t)
f Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encode ('Closed r) a -> Encoding
forall (d :: Density) t. Encode ('Closed d) t -> Encoding
encodeClosed Encode ('Closed r) a
x
encodeClosed (ED (Dual t -> Encoding
enc forall s. Decoder s t
_) t
x) = t -> Encoding
enc t
x
encodeClosed (OmitC t
_) = Encoding
forall a. Monoid a => a
mempty
encodeClosed (Omit t -> Bool
p Encode ('Closed 'Sparse) t
x) =
if t -> Bool
p (Encode ('Closed 'Sparse) t -> t
forall (w :: Wrapped) t. Encode w t -> t
runE Encode ('Closed 'Sparse) t
x) then Encoding
forall a. Monoid a => a
mempty else Encode ('Closed 'Sparse) t -> Encoding
forall (d :: Density) t. Encode ('Closed d) t -> Encoding
encodeClosed Encode ('Closed 'Sparse) t
x
encodeClosed (Key Word
tag Encode ('Closed 'Dense) t
x) = Word -> Encoding
encodeWord Word
tag Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encode ('Closed 'Dense) t -> Encoding
forall (d :: Density) t. Encode ('Closed d) t -> Encoding
encodeClosed Encode ('Closed 'Dense) t
x
encodeClosed (Keyed t
_) = Encoding
forall a. Monoid a => a
mempty
data Decode (w :: Wrapped) t where
Summands :: String -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
SparseKeyed :: Typeable t => String -> t -> (Word -> Field t) -> [(Word,String)] -> Decode ('Closed 'Dense) t
SumD :: t -> Decode 'Open t
RecD :: t -> Decode ('Closed 'Dense) t
KeyedD :: t -> Decode ('Closed 'Sparse) t
From :: FromCBOR t => Decode w t
D :: (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
ApplyD :: Decode w1 (a -> t) -> Decode ('Closed d) a -> Decode w1 t
Invalid :: Word -> Decode w t
Map :: (a -> b) -> Decode w a -> Decode w b
DD :: Dual t -> Decode ('Closed 'Dense) t
Emit :: t -> Decode w t
Ann :: Decode w t -> Decode w (Annotator t)
ApplyAnn :: Decode w1 (Annotator(a -> t)) -> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
infixl 4 <!
infixl 4 <*!
(<!) :: Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
Decode w1 (a -> t)
x <! :: Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed w) a
y = Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (a -> t) -> Decode ('Closed d) a -> Decode w1 t
ApplyD Decode w1 (a -> t)
x Decode ('Closed w) a
y
(<*!) :: Decode w1 (Annotator(a -> t)) -> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
Decode w1 (Annotator (a -> t))
x <*! :: Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! Decode ('Closed d) (Annotator a)
y = Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
ApplyAnn Decode w1 (Annotator (a -> t))
x Decode ('Closed d) (Annotator a)
y
hsize :: Decode w t -> Int
hsize :: Decode w t -> Int
hsize (Summands String
_ Word -> Decode 'Open t
_) = Int
1
hsize (SumD t
_) = Int
0
hsize (RecD t
_) = Int
0
hsize (KeyedD t
_) = Int
0
hsize Decode w t
From = Int
1
hsize (D forall s. Decoder s t
_) = Int
1
hsize (DD Dual t
_) = Int
1
hsize (ApplyD Decode w (a -> t)
f Decode ('Closed d) a
x) = Decode w (a -> t) -> Int
forall (w :: Wrapped) t. Decode w t -> Int
hsize Decode w (a -> t)
f Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Decode ('Closed d) a -> Int
forall (w :: Wrapped) t. Decode w t -> Int
hsize Decode ('Closed d) a
x
hsize (Invalid Word
_) = Int
0
hsize (Map a -> t
_ Decode w a
x) = Decode w a -> Int
forall (w :: Wrapped) t. Decode w t -> Int
hsize Decode w a
x
hsize (Emit t
_) = Int
0
hsize (SparseKeyed String
_ t
_ Word -> Field t
_ [(Word, String)]
_) = Int
1
hsize (Ann Decode w t
x) = Decode w t -> Int
forall (w :: Wrapped) t. Decode w t -> Int
hsize Decode w t
x
hsize (ApplyAnn Decode w (Annotator (a -> t))
f Decode ('Closed d) (Annotator a)
x) = Decode w (Annotator (a -> t)) -> Int
forall (w :: Wrapped) t. Decode w t -> Int
hsize Decode w (Annotator (a -> t))
f Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Decode ('Closed d) (Annotator a) -> Int
forall (w :: Wrapped) t. Decode w t -> Int
hsize Decode ('Closed d) (Annotator a)
x
decode :: Decode w t -> Decoder s t
decode :: Decode w t -> Decoder s t
decode Decode w t
x = ((Int, t) -> t) -> Decoder s (Int, t) -> Decoder s t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, t) -> t
forall a b. (a, b) -> b
snd (Decode w t -> Decoder s (Int, t)
forall (w :: Wrapped) t s. Decode w t -> Decoder s (Int, t)
decodE Decode w t
x)
decodE :: Decode w t -> Decoder s (Int, t)
decodE :: Decode w t -> Decoder s (Int, t)
decodE Decode w t
x = Decode w t -> Int -> Decoder s (Int, t)
forall (w :: Wrapped) s t. Decode w t -> Int -> Decoder s (Int, t)
decodeCount Decode w t
x Int
0
decodeCount :: forall (w::Wrapped) s t. Decode w t -> Int -> Decoder s (Int, t)
decodeCount :: Decode w t -> Int -> Decoder s (Int, t)
decodeCount (Summands String
nm Word -> Decode 'Open t
f) Int
n = (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1,) (t -> (Int, t)) -> Decoder s t -> Decoder s (Int, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> (Word -> Decoder s (Int, t)) -> Decoder s t
forall s a. String -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum String
nm (\Word
x -> Decode 'Open t -> Decoder s (Int, t)
forall (w :: Wrapped) t s. Decode w t -> Decoder s (Int, t)
decodE (Word -> Decode 'Open t
f Word
x))
decodeCount (SumD t
cn) Int
n = (Int, t) -> Decoder s (Int, t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, t
cn)
decodeCount (KeyedD t
cn) Int
n = (Int, t) -> Decoder s (Int, t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,t
cn)
decodeCount (RecD t
cn) Int
n = Text
-> ((Int, t) -> Int) -> Decoder s (Int, t) -> Decoder s (Int, t)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"RecD" (Int -> (Int, t) -> Int
forall a b. a -> b -> a
const Int
n) ((Int, t) -> Decoder s (Int, t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
n, t
cn))
decodeCount Decode w t
From Int
n = (Int
n,) (t -> (Int, t)) -> Decoder s t -> Decoder s (Int, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s t
forall a s. FromCBOR a => Decoder s a
fromCBOR
decodeCount (D forall s. Decoder s t
dec) Int
n = (Int
n,) (t -> (Int, t)) -> Decoder s t -> Decoder s (Int, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s t
forall s. Decoder s t
dec
decodeCount (Invalid Word
k) Int
_ = Word -> Decoder s (Int, t)
forall s a. Word -> Decoder s a
invalidKey Word
k
decodeCount (Map a -> t
f Decode w a
x) Int
n = do (Int
m, a
y) <- Decode w a -> Int -> Decoder s (Int, a)
forall (w :: Wrapped) s t. Decode w t -> Int -> Decoder s (Int, t)
decodeCount Decode w a
x Int
n; (Int, t) -> Decoder s (Int, t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
m, a -> t
f a
y)
decodeCount (DD (Dual t -> Encoding
_enc forall s. Decoder s t
dec)) Int
n = (Int
n,) (t -> (Int, t)) -> Decoder s t -> Decoder s (Int, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s t
forall s. Decoder s t
dec
decodeCount (Emit t
x) Int
n = (Int, t) -> Decoder s (Int, t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure(Int
n,t
x)
decodeCount (SparseKeyed String
name t
initial Word -> Field t
pick [(Word, String)]
required) Int
n =
(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,) (t -> (Int, t)) -> Decoder s t -> Decoder s (Int, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> t -> (Word -> Field t) -> [(Word, String)] -> Decoder s t
forall a s.
Typeable a =>
String -> a -> (Word -> Field a) -> [(Word, String)] -> Decoder s a
decodeSparse String
name t
initial Word -> Field t
pick [(Word, String)]
required
decodeCount (Ann Decode w t
x) Int
n = do (Int
m,t
y) <- Decode w t -> Int -> Decoder s (Int, t)
forall (w :: Wrapped) s t. Decode w t -> Int -> Decoder s (Int, t)
decodeCount Decode w t
x Int
n; (Int, Annotator t) -> Decoder s (Int, Annotator t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure(Int
m,t -> Annotator t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
y)
decodeCount (ApplyAnn Decode w (Annotator (a -> t))
g Decode ('Closed d) (Annotator a)
x) Int
n = do
(Int
i,Annotator (a -> t)
f) <- Decode w (Annotator (a -> t))
-> Int -> Decoder s (Int, Annotator (a -> t))
forall (w :: Wrapped) s t. Decode w t -> Int -> Decoder s (Int, t)
decodeCount Decode w (Annotator (a -> t))
g (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Decode ('Closed d) (Annotator a) -> Int
forall (w :: Wrapped) t. Decode w t -> Int
hsize Decode ('Closed d) (Annotator a)
x)
Annotator a
y <- Decode ('Closed d) (Annotator a) -> Decoder s (Annotator a)
forall (d :: Density) t s. Decode ('Closed d) t -> Decoder s t
decodeClosed Decode ('Closed d) (Annotator a)
x
(Int, Annotator t) -> Decoder s (Int, Annotator t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
i,Annotator (a -> t)
f Annotator (a -> t) -> Annotator a -> Annotator t
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator a
y)
decodeCount (ApplyD Decode w (a -> t)
cn Decode ('Closed d) a
g) Int
n = do
(Int
i, a -> t
f) <- Decode w (a -> t) -> Int -> Decoder s (Int, a -> t)
forall (w :: Wrapped) s t. Decode w t -> Int -> Decoder s (Int, t)
decodeCount Decode w (a -> t)
cn (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Decode ('Closed d) a -> Int
forall (w :: Wrapped) t. Decode w t -> Int
hsize Decode ('Closed d) a
g)
a
y <- Decode ('Closed d) a -> Decoder s a
forall (d :: Density) t s. Decode ('Closed d) t -> Decoder s t
decodeClosed Decode ('Closed d) a
g
(Int, t) -> Decoder s (Int, t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
i, a -> t
f a
y)
decodeClosed :: Decode ('Closed d) t -> Decoder s t
decodeClosed :: Decode ('Closed d) t -> Decoder s t
decodeClosed (Summands String
nm Word -> Decode 'Open t
f) = String -> (Word -> Decoder s (Int, t)) -> Decoder s t
forall s a. String -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum String
nm (\Word
x -> Decode 'Open t -> Decoder s (Int, t)
forall (w :: Wrapped) t s. Decode w t -> Decoder s (Int, t)
decodE (Word -> Decode 'Open t
f Word
x))
decodeClosed (KeyedD t
cn) = t -> Decoder s t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
cn
decodeClosed (RecD t
cn) = t -> Decoder s t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
cn
decodeClosed Decode ('Closed d) t
From = do t
x <- Decoder s t
forall a s. FromCBOR a => Decoder s a
fromCBOR; t -> Decoder s t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
x
decodeClosed (D forall s. Decoder s t
dec) = Decoder s t
forall s. Decoder s t
dec
decodeClosed (ApplyD Decode ('Closed d) (a -> t)
cn Decode ('Closed d) a
g) = do
a -> t
f <- Decode ('Closed d) (a -> t) -> Decoder s (a -> t)
forall (d :: Density) t s. Decode ('Closed d) t -> Decoder s t
decodeClosed Decode ('Closed d) (a -> t)
cn
a
y <- Decode ('Closed d) a -> Decoder s a
forall (d :: Density) t s. Decode ('Closed d) t -> Decoder s t
decodeClosed Decode ('Closed d) a
g
t -> Decoder s t
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> t
f a
y)
decodeClosed (Invalid Word
k) = Word -> Decoder s t
forall s a. Word -> Decoder s a
invalidKey Word
k
decodeClosed (Map a -> t
f Decode ('Closed d) a
x) = a -> t
f (a -> t) -> Decoder s a -> Decoder s t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decode ('Closed d) a -> Decoder s a
forall (d :: Density) t s. Decode ('Closed d) t -> Decoder s t
decodeClosed Decode ('Closed d) a
x
decodeClosed (DD (Dual t -> Encoding
_enc forall s. Decoder s t
dec)) = Decoder s t
forall s. Decoder s t
dec
decodeClosed (Emit t
n) = t -> Decoder s t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
n
decodeClosed (SparseKeyed String
name t
initial Word -> Field t
pick [(Word, String)]
required) =
String -> t -> (Word -> Field t) -> [(Word, String)] -> Decoder s t
forall a s.
Typeable a =>
String -> a -> (Word -> Field a) -> [(Word, String)] -> Decoder s a
decodeSparse String
name t
initial Word -> Field t
pick [(Word, String)]
required
decodeClosed (Ann Decode ('Closed d) t
x) = (t -> Annotator t) -> Decoder s t -> Decoder s (Annotator t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t -> Annotator t
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Decode ('Closed d) t -> Decoder s t
forall (d :: Density) t s. Decode ('Closed d) t -> Decoder s t
decodeClosed Decode ('Closed d) t
x)
decodeClosed (ApplyAnn Decode ('Closed d) (Annotator (a -> t))
g Decode ('Closed d) (Annotator a)
x) = do
Annotator (a -> t)
f <- Decode ('Closed d) (Annotator (a -> t))
-> Decoder s (Annotator (a -> t))
forall (d :: Density) t s. Decode ('Closed d) t -> Decoder s t
decodeClosed Decode ('Closed d) (Annotator (a -> t))
g
Annotator a
y <- Decode ('Closed d) (Annotator a) -> Decoder s (Annotator a)
forall (d :: Density) t s. Decode ('Closed d) t -> Decoder s t
decodeClosed Decode ('Closed d) (Annotator a)
x
Annotator t -> Decoder s (Annotator t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Annotator (a -> t)
f Annotator (a -> t) -> Annotator a -> Annotator t
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator a
y)
decodeSparse ::
Typeable a =>
String -> a -> (Word -> Field a) -> [(Word, String)] -> Decoder s a
decodeSparse :: String -> a -> (Word -> Field a) -> [(Word, String)] -> Decoder s a
decodeSparse String
name a
initial Word -> Field a
pick [(Word, String)]
required = do
Maybe Int
lenOrIndef <- Decoder s (Maybe Int)
forall s. Decoder s (Maybe Int)
decodeMapLenOrIndef
(!a
v,Set Word
used) <- Maybe Int
-> a
-> (Word -> Field a)
-> Set Word
-> String
-> Decoder s (a, Set Word)
forall t s.
Maybe Int
-> t
-> (Word -> Field t)
-> Set Word
-> String
-> Decoder s (t, Set Word)
getSparseBlock Maybe Int
lenOrIndef a
initial Word -> Field a
pick (Set Word
forall a. Set a
Set.empty) String
name
if ((Word, String) -> Bool) -> [(Word, String)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\ (Word
key,String
_name) -> Word -> Set Word -> Bool
forall a. Ord a => a -> Set a -> Bool
member Word
key Set Word
used) [(Word, String)]
required
then a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
else Set Word -> [(Word, String)] -> String -> Decoder s a
forall s a. Set Word -> [(Word, String)] -> String -> Decoder s a
unusedRequiredKeys Set Word
used [(Word, String)]
required (TypeRep -> String
forall a. Show a => a -> String
show(a -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf a
initial))
applyField :: (Word -> Field t) -> Set Word -> String -> Decoder s (t -> t,Set Word)
applyField :: (Word -> Field t)
-> Set Word -> String -> Decoder s (t -> t, Set Word)
applyField Word -> Field t
f Set Word
seen String
name = do
Word
tag <- Decoder s Word
forall s. Decoder s Word
decodeWord
if Word -> Set Word -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Word
tag Set Word
seen
then String -> Word -> Decoder s (t -> t, Set Word)
forall s a. String -> Word -> Decoder s a
duplicateKey String
name Word
tag
else case Word -> Field t
f Word
tag of
Field x -> t -> t
update forall s. Decoder s x
d -> do x
v <- Decoder s x
forall s. Decoder s x
d; (t -> t, Set Word) -> Decoder s (t -> t, Set Word)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (x -> t -> t
update x
v,Word -> Set Word -> Set Word
forall a. Ord a => a -> Set a -> Set a
insert Word
tag Set Word
seen)
getSparseBlock :: Maybe Int -> t -> (Word -> Field t) -> Set Word -> String -> Decoder s (t,Set Word)
getSparseBlock :: Maybe Int
-> t
-> (Word -> Field t)
-> Set Word
-> String
-> Decoder s (t, Set Word)
getSparseBlock (Just Int
0) t
initial Word -> Field t
_pick Set Word
seen String
_name = (t, Set Word) -> Decoder s (t, Set Word)
forall (f :: * -> *) a. Applicative f => a -> f a
pure(t
initial,Set Word
seen)
getSparseBlock (Just Int
n) t
initial Word -> Field t
pick Set Word
seen String
name = do
(t -> t
transform,Set Word
seen2) <- (Word -> Field t)
-> Set Word -> String -> Decoder s (t -> t, Set Word)
forall t s.
(Word -> Field t)
-> Set Word -> String -> Decoder s (t -> t, Set Word)
applyField Word -> Field t
pick Set Word
seen String
name
Maybe Int
-> t
-> (Word -> Field t)
-> Set Word
-> String
-> Decoder s (t, Set Word)
forall t s.
Maybe Int
-> t
-> (Word -> Field t)
-> Set Word
-> String
-> Decoder s (t, Set Word)
getSparseBlock (Int -> Maybe Int
forall a. a -> Maybe a
Just(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) (t -> t
transform t
initial) Word -> Field t
pick Set Word
seen2 String
name
getSparseBlock Maybe Int
Nothing t
initial Word -> Field t
pick Set Word
seen String
name =
Decoder s Bool
forall s. Decoder s Bool
decodeBreakOr Decoder s Bool
-> (Bool -> Decoder s (t, Set Word)) -> Decoder s (t, Set Word)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> (t, Set Word) -> Decoder s (t, Set Word)
forall (f :: * -> *) a. Applicative f => a -> f a
pure(t
initial,Set Word
seen)
Bool
False -> do (t -> t
transform,Set Word
seen2) <- (Word -> Field t)
-> Set Word -> String -> Decoder s (t -> t, Set Word)
forall t s.
(Word -> Field t)
-> Set Word -> String -> Decoder s (t -> t, Set Word)
applyField Word -> Field t
pick Set Word
seen String
name
Maybe Int
-> t
-> (Word -> Field t)
-> Set Word
-> String
-> Decoder s (t, Set Word)
forall t s.
Maybe Int
-> t
-> (Word -> Field t)
-> Set Word
-> String
-> Decoder s (t, Set Word)
getSparseBlock Maybe Int
forall a. Maybe a
Nothing (t -> t
transform t
initial) Word -> Field t
pick Set Word
seen2 String
name
instance Functor (Decode w) where
fmap :: (a -> b) -> Decode w a -> Decode w b
fmap a -> b
f (Map a -> a
g Decode w a
x) = (a -> b) -> Decode w a -> Decode w b
forall a b (w :: Wrapped). (a -> b) -> Decode w a -> Decode w b
Map (a -> b
f (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
g) Decode w a
x
fmap a -> b
f Decode w a
x = (a -> b) -> Decode w a -> Decode w b
forall a b (w :: Wrapped). (a -> b) -> Decode w a -> Decode w b
Map a -> b
f Decode w a
x
instance Applicative (Decode ('Closed d)) where
pure :: a -> Decode ('Closed d) a
pure a
x = a -> Decode ('Closed d) a
forall t (w :: Wrapped). t -> Decode w t
Emit a
x
Decode ('Closed d) (a -> b)
f <*> :: Decode ('Closed d) (a -> b)
-> Decode ('Closed d) a -> Decode ('Closed d) b
<*> Decode ('Closed d) a
x = Decode ('Closed d) (a -> b)
-> Decode ('Closed d) a -> Decode ('Closed d) b
forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (a -> t) -> Decode ('Closed d) a -> Decode w1 t
ApplyD Decode ('Closed d) (a -> b)
f Decode ('Closed d) a
x
dualList :: (ToCBOR a, FromCBOR a) => Dual [a]
dualList :: Dual [a]
dualList = ([a] -> Encoding) -> (forall s. Decoder s [a]) -> Dual [a]
forall t. (t -> Encoding) -> (forall s. Decoder s t) -> Dual t
Dual [a] -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable (Decoder s a -> Decoder s [a]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR)
dualSeq :: (ToCBOR a, FromCBOR a) => Dual (Seq a)
dualSeq :: Dual (Seq a)
dualSeq = (Seq a -> Encoding)
-> (forall s. Decoder s (Seq a)) -> Dual (Seq a)
forall t. (t -> Encoding) -> (forall s. Decoder s t) -> Dual t
Dual Seq a -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable (Decoder s a -> Decoder s (Seq a)
forall s a. Decoder s a -> Decoder s (Seq a)
decodeSeq Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR)
dualSet :: (Ord a,ToCBOR a, FromCBOR a) => Dual (Set a)
dualSet :: Dual (Set a)
dualSet = (Set a -> Encoding)
-> (forall s. Decoder s (Set a)) -> Dual (Set a)
forall t. (t -> Encoding) -> (forall s. Decoder s t) -> Dual t
Dual Set a -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable (Decoder s a -> Decoder s (Set a)
forall a s. Ord a => Decoder s a -> Decoder s (Set a)
decodeSet Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR)
dualMaybeAsList :: (ToCBOR a, FromCBOR a) => Dual (Maybe a)
dualMaybeAsList :: Dual (Maybe a)
dualMaybeAsList = (Maybe a -> Encoding)
-> (forall s. Decoder s (Maybe a)) -> Dual (Maybe a)
forall t. (t -> Encoding) -> (forall s. Decoder s t) -> Dual t
Dual Maybe a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR forall s. Decoder s (Maybe a)
forall a s. FromCBOR a => Decoder s a
fromCBOR
dualMaybeAsNull :: (ToCBOR a, FromCBOR a) => Dual (Maybe a)
dualMaybeAsNull :: Dual (Maybe a)
dualMaybeAsNull = (Maybe a -> Encoding)
-> (forall s. Decoder s (Maybe a)) -> Dual (Maybe a)
forall t. (t -> Encoding) -> (forall s. Decoder s t) -> Dual t
Dual ((a -> Encoding) -> Maybe a -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
encodeNullMaybe a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR) (Decoder s a -> Decoder s (Maybe a)
forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR)
dualStrictSeq :: (ToCBOR a, FromCBOR a) => Dual (StrictSeq a)
dualStrictSeq :: Dual (StrictSeq a)
dualStrictSeq = (StrictSeq a -> Encoding)
-> (forall s. Decoder s (StrictSeq a)) -> Dual (StrictSeq a)
forall t. (t -> Encoding) -> (forall s. Decoder s t) -> Dual t
Dual StrictSeq a -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable (Decoder s a -> Decoder s (StrictSeq a)
forall s a. Decoder s a -> Decoder s (StrictSeq a)
decodeStrictSeq Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR)
dualText :: Dual Text.Text
dualText :: Dual Text
dualText = (Text -> Encoding) -> (forall s. Decoder s Text) -> Dual Text
forall t. (t -> Encoding) -> (forall s. Decoder s t) -> Dual t
Dual Text -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR forall s. Decoder s Text
forall a s. FromCBOR a => Decoder s a
fromCBOR
dualCBOR :: (ToCBOR a, FromCBOR a) => Dual a
dualCBOR :: Dual a
dualCBOR = (a -> Encoding) -> (forall s. Decoder s a) -> Dual a
forall t. (t -> Encoding) -> (forall s. Decoder s t) -> Dual t
Dual a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR forall s. Decoder s a
forall a s. FromCBOR a => Decoder s a
fromCBOR
to :: (ToCBOR t, FromCBOR t) => t -> Encode ('Closed 'Dense) t
to :: t -> Encode ('Closed 'Dense) t
to t
xs = Dual t -> t -> Encode ('Closed 'Dense) t
forall t. Dual t -> t -> Encode ('Closed 'Dense) t
ED Dual t
forall a. (ToCBOR a, FromCBOR a) => Dual a
dualCBOR t
xs
from :: (ToCBOR t, FromCBOR t) => Decode ('Closed 'Dense) t
from :: Decode ('Closed 'Dense) t
from = Dual t -> Decode ('Closed 'Dense) t
forall t. Dual t -> Decode ('Closed 'Dense) t
DD Dual t
forall a. (ToCBOR a, FromCBOR a) => Dual a
dualCBOR