{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Binary.Vintage.Coders (spec) where

import Cardano.Ledger.Binary
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Binary.FlatTerm (FlatTerm, toFlatTerm)
import Data.Sequence.Strict (StrictSeq, fromList)
import Data.Text (Text, pack)
import Data.Typeable
import Test.Cardano.Ledger.Binary.RoundTrip (Trip (..), cborTrip, mkTrip, roundTripExpectation)
import Test.Hspec

-- ==========================================================================

data TT
  = A Int
  | B Int Bool
  | G [Int]
  | H (StrictSeq Bool)
  deriving (Int -> TT -> ShowS
[TT] -> ShowS
TT -> String
(Int -> TT -> ShowS)
-> (TT -> String) -> ([TT] -> ShowS) -> Show TT
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TT -> ShowS
showsPrec :: Int -> TT -> ShowS
$cshow :: TT -> String
show :: TT -> String
$cshowList :: [TT] -> ShowS
showList :: [TT] -> ShowS
Show, TT -> TT -> Bool
(TT -> TT -> Bool) -> (TT -> TT -> Bool) -> Eq TT
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TT -> TT -> Bool
== :: TT -> TT -> Bool
$c/= :: TT -> TT -> Bool
/= :: TT -> TT -> Bool
Eq)

instance DecCBOR TT where
  decCBOR :: forall s. Decoder s TT
decCBOR = Text -> (Word -> Decoder s (Int, TT)) -> Decoder s TT
forall s a. Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum Text
"TT" ((Word -> Decoder s (Int, TT)) -> Decoder s TT)
-> (Word -> Decoder s (Int, TT)) -> Decoder s TT
forall a b. (a -> b) -> a -> b
$
    \case
      Word
0 -> (\Int
i -> (Int
2, Int -> TT
A Int
i)) (Int -> (Int, TT)) -> Decoder s Int -> Decoder s (Int, TT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Int
forall s. Decoder s Int
forall a s. DecCBOR a => Decoder s a
decCBOR -- Tag for A is 0
      Word
1 -> do
        -- (,) 3 . B <$> decCBOR <*> decCBOR
        Int
i <- Decoder s Int
forall s. Decoder s Int
forall a s. DecCBOR a => Decoder s a
decCBOR
        Bool
b <- Decoder s Bool
forall s. Decoder s Bool
forall a s. DecCBOR a => Decoder s a
decCBOR
        (Int, TT) -> Decoder s (Int, TT)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, Int -> Bool -> TT
B Int
i Bool
b) -- Tag for B is 1
      Word
2 -> do
        [Int]
l <- Decoder s Int -> Decoder s [Int]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s Int
forall s. Decoder s Int
forall a s. DecCBOR a => Decoder s a
decCBOR
        (Int, TT) -> Decoder s (Int, TT)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, [Int] -> TT
G [Int]
l) -- Tag for G is 2
      Word
3 -> do
        StrictSeq Bool
i <- Decoder s Bool -> Decoder s (StrictSeq Bool)
forall s a. Decoder s a -> Decoder s (StrictSeq a)
decodeStrictSeq Decoder s Bool
forall s. Decoder s Bool
forall a s. DecCBOR a => Decoder s a
decCBOR
        (Int, TT) -> Decoder s (Int, TT)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, StrictSeq Bool -> TT
H StrictSeq Bool
i) -- Tag for H is 3
      Word
k -> Word -> Decoder s (Int, TT)
forall a (m :: * -> *). (Typeable a, MonadFail m) => Word -> m a
invalidKey Word
k

-- =============================================================================================
-- JUST A NOTE about the (instance EncCBOR a => EncCBOR [a]). This uses the Begin .. End encoding,
-- while encodeList uses the list-length encoding.
--     encCBOR [5::Int,2]     --> [TkListBegin,TkInt 5,TkInt 2,TkBreak].
--     encodeList [5::Int,2] --> [TkListLen 2,TkInt 5,TkInt 2]
-- the (instance DecCBOR a => DecCBOR [a]) will ONLY RECOGNIZE THE BEGIN END ENCODING.
-- but the decoder (decodeList decCBOR) will recognize both styles of encoding. So in a decoder
-- or DecCBOR instance it is always preferable to use (decodeList decCBOR) over (decCBOR)
-- For example in the instance above, we could write either of these 2 lines
--       2 -> do { l <- decodeList decCBOR; pure(2,G l) }
--       2 -> do { l <- decCBOR; pure(2,G l) }
-- BUT THE FIRST IS MORE GENERAL. The following instance should be replaced
-- instance DecCBOR a => DecCBOR [a]  -- Defined in ‘cardano-binary-1.5.0:Cardano.Binary.DecCBOR’

instance EncCBOR TT where
  encCBOR :: TT -> Encoding
encCBOR (A Int
i) = Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
0 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Int
i
  encCBOR (B Int
i Bool
b) = Word -> Encoding
encodeListLen Word
3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Int
i Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Bool -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Bool
b
  encCBOR (G [Int]
is) = Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [Int] -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR [Int]
is
  encCBOR (H StrictSeq Bool
bs) = Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> StrictSeq Bool -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR StrictSeq Bool
bs

-- The Key is that in (G constr tag <@> ...)
-- The 'tag' for 'constr' aligns with the Tag in the case match
-- in the DecCBOR instance for TT above.

-- ===============================================================

-- ===================================
-- Examples

data Two = Two Int Bool
  deriving (Int -> Two -> ShowS
[Two] -> ShowS
Two -> String
(Int -> Two -> ShowS)
-> (Two -> String) -> ([Two] -> ShowS) -> Show Two
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Two -> ShowS
showsPrec :: Int -> Two -> ShowS
$cshow :: Two -> String
show :: Two -> String
$cshowList :: [Two] -> ShowS
showList :: [Two] -> ShowS
Show, Two -> Two -> Bool
(Two -> Two -> Bool) -> (Two -> Two -> Bool) -> Eq Two
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Two -> Two -> Bool
== :: Two -> Two -> Bool
$c/= :: Two -> Two -> Bool
/= :: Two -> Two -> Bool
Eq)

decTwo :: Decode ('Closed 'Dense) Two
encTwo :: Two -> Encode ('Closed 'Dense) Two
decTwo :: Decode ('Closed 'Dense) Two
decTwo = (Int -> Bool -> Two)
-> Decode ('Closed 'Dense) (Int -> Bool -> Two)
forall t. t -> Decode ('Closed 'Dense) t
RecD Int -> Bool -> Two
Two Decode ('Closed 'Dense) (Int -> Bool -> Two)
-> Decode ('Closed Any) Int
-> Decode ('Closed 'Dense) (Bool -> Two)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Int
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode ('Closed 'Dense) (Bool -> Two)
-> Decode ('Closed Any) Bool -> Decode ('Closed 'Dense) Two
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Bool
forall t (w :: Wrapped). DecCBOR t => Decode w t
From

encTwo :: Two -> Encode ('Closed 'Dense) Two
encTwo (Two Int
a Bool
b) = (Int -> Bool -> Two)
-> Encode ('Closed 'Dense) (Int -> Bool -> Two)
forall t. t -> Encode ('Closed 'Dense) t
Rec Int -> Bool -> Two
Two Encode ('Closed 'Dense) (Int -> Bool -> Two)
-> Encode ('Closed 'Dense) Int
-> Encode ('Closed 'Dense) (Bool -> Two)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Int -> Encode ('Closed 'Dense) Int
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
a Encode ('Closed 'Dense) (Bool -> Two)
-> Encode ('Closed 'Dense) Bool -> Encode ('Closed 'Dense) Two
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Bool -> Encode ('Closed 'Dense) Bool
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Bool
b

instance EncCBOR Two where
  encCBOR :: Two -> Encoding
encCBOR Two
two = Encode ('Closed 'Dense) Two -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) Two -> Encoding)
-> Encode ('Closed 'Dense) Two -> Encoding
forall a b. (a -> b) -> a -> b
$ Two -> Encode ('Closed 'Dense) Two
encTwo Two
two

instance DecCBOR Two where
  decCBOR :: forall s. Decoder s Two
decCBOR = Decode ('Closed 'Dense) Two -> Decoder s Two
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode Decode ('Closed 'Dense) Two
decTwo

-- ============

data Test = Test Int Two Integer
  deriving (Int -> Test -> ShowS
[Test] -> ShowS
Test -> String
(Int -> Test -> ShowS)
-> (Test -> String) -> ([Test] -> ShowS) -> Show Test
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Test -> ShowS
showsPrec :: Int -> Test -> ShowS
$cshow :: Test -> String
show :: Test -> String
$cshowList :: [Test] -> ShowS
showList :: [Test] -> ShowS
Show, Test -> Test -> Bool
(Test -> Test -> Bool) -> (Test -> Test -> Bool) -> Eq Test
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Test -> Test -> Bool
== :: Test -> Test -> Bool
$c/= :: Test -> Test -> Bool
/= :: Test -> Test -> Bool
Eq)

test1 :: Test
test1 :: Test
test1 = Int -> Two -> Integer -> Test
Test Int
3 (Int -> Bool -> Two
Two Int
9 Bool
True) Integer
33

decTestWithGroupForTwo :: Decode ('Closed 'Dense) Test
encTestWithGroupForTwo :: Test -> Encode ('Closed 'Dense) Test
decTestWithGroupForTwo :: Decode ('Closed 'Dense) Test
decTestWithGroupForTwo = (Int -> Two -> Integer -> Test)
-> Decode ('Closed 'Dense) (Int -> Two -> Integer -> Test)
forall t. t -> Decode ('Closed 'Dense) t
RecD Int -> Two -> Integer -> Test
Test Decode ('Closed 'Dense) (Int -> Two -> Integer -> Test)
-> Decode ('Closed Any) Int
-> Decode ('Closed 'Dense) (Two -> Integer -> Test)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Int
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode ('Closed 'Dense) (Two -> Integer -> Test)
-> Decode ('Closed 'Dense) Two
-> Decode ('Closed 'Dense) (Integer -> Test)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed 'Dense) Two
decTwo Decode ('Closed 'Dense) (Integer -> Test)
-> Decode ('Closed Any) Integer -> Decode ('Closed 'Dense) Test
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Integer
forall t (w :: Wrapped). DecCBOR t => Decode w t
From

encTestWithGroupForTwo :: Test -> Encode ('Closed 'Dense) Test
encTestWithGroupForTwo (Test Int
a Two
b Integer
c) = (Int -> Two -> Integer -> Test)
-> Encode ('Closed 'Dense) (Int -> Two -> Integer -> Test)
forall t. t -> Encode ('Closed 'Dense) t
Rec Int -> Two -> Integer -> Test
Test Encode ('Closed 'Dense) (Int -> Two -> Integer -> Test)
-> Encode ('Closed 'Dense) Int
-> Encode ('Closed 'Dense) (Two -> Integer -> Test)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Int -> Encode ('Closed 'Dense) Int
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
a Encode ('Closed 'Dense) (Two -> Integer -> Test)
-> Encode ('Closed 'Dense) Two
-> Encode ('Closed 'Dense) (Integer -> Test)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Two -> Encode ('Closed 'Dense) Two
encTwo Two
b Encode ('Closed 'Dense) (Integer -> Test)
-> Encode ('Closed 'Dense) Integer -> Encode ('Closed 'Dense) Test
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Integer -> Encode ('Closed 'Dense) Integer
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Integer
c

instance EncCBOR Test where
  encCBOR :: Test -> Encoding
encCBOR = Encode ('Closed 'Dense) Test -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) Test -> Encoding)
-> (Test -> Encode ('Closed 'Dense) Test) -> Test -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Test -> Encode ('Closed 'Dense) Test
encTestWithGroupForTwo

instance DecCBOR Test where
  decCBOR :: forall s. Decoder s Test
decCBOR = Decode ('Closed 'Dense) Test -> Decoder s Test
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode Decode ('Closed 'Dense) Test
decTestWithGroupForTwo

-- ===========

data Three = In Int | N Bool Integer | F Two
  deriving (Int -> Three -> ShowS
[Three] -> ShowS
Three -> String
(Int -> Three -> ShowS)
-> (Three -> String) -> ([Three] -> ShowS) -> Show Three
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Three -> ShowS
showsPrec :: Int -> Three -> ShowS
$cshow :: Three -> String
show :: Three -> String
$cshowList :: [Three] -> ShowS
showList :: [Three] -> ShowS
Show, Three -> Three -> Bool
(Three -> Three -> Bool) -> (Three -> Three -> Bool) -> Eq Three
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Three -> Three -> Bool
== :: Three -> Three -> Bool
$c/= :: Three -> Three -> Bool
/= :: Three -> Three -> Bool
Eq)

three1, three2, three3 :: Three
three1 :: Three
three1 = Int -> Three
In Int
7
three2 :: Three
three2 = Bool -> Integer -> Three
N Bool
True Integer
22
three3 :: Three
three3 = Two -> Three
F (Int -> Bool -> Two
Two Int
1 Bool
False)

-- The following values 'decThree' and 'encThree' are meant to simulate the following instances
{-
instance EncCBOR Three where
  encCBOR (In x) = encodeListLen 2 <> encodeWord 0 <> encCBOR x
  encCBOR (N b i) = encodeListLen 3 <> encodeWord 1 <> encCBOR b <> encCBOR i
  encCBOR (F (Two i b)) = encodeListLen 3 <> encodeWord 2 <> encCBOR i <>  encCBOR b
     -- even though F has only 1 argument, we inline the two parts of Two,
     -- so it appears to have 2 arguments. This mimics CBORGROUP instances

instance DecCBOR Three where
  decCBOR = decodeRecordSum "Three" $
    \case
      0 -> do
        x <- decCBOR
        pure (2, In x)
      1 -> do
        b <- decCBOR
        i <- decCBOR
        pure (3, N b i)
      2 -> do
        i <- decCBOR
        b <- decCBOR
        pure (3,F (Two i b))
      k -> invalidKey k
-}

decThree :: Word -> Decode 'Open Three
decThree :: Word -> Decode 'Open Three
decThree Word
0 = (Int -> Three) -> Decode 'Open (Int -> Three)
forall t. t -> Decode 'Open t
SumD Int -> Three
In Decode 'Open (Int -> Three)
-> Decode ('Closed Any) Int -> Decode 'Open Three
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Int
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
decThree Word
1 = (Bool -> Integer -> Three)
-> Decode 'Open (Bool -> Integer -> Three)
forall t. t -> Decode 'Open t
SumD Bool -> Integer -> Three
N Decode 'Open (Bool -> Integer -> Three)
-> Decode ('Closed Any) Bool -> Decode 'Open (Integer -> Three)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Bool
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode 'Open (Integer -> Three)
-> Decode ('Closed Any) Integer -> Decode 'Open Three
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Integer
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
decThree Word
2 = (Two -> Three) -> Decode 'Open (Two -> Three)
forall t. t -> Decode 'Open t
SumD Two -> Three
F Decode 'Open (Two -> Three)
-> Decode ('Closed 'Dense) Two -> Decode 'Open Three
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed 'Dense) Two
decTwo
decThree Word
k = Word -> Decode 'Open Three
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
k

encThree :: Three -> Encode 'Open Three
encThree :: Three -> Encode 'Open Three
encThree (In Int
x) = (Int -> Three) -> Word -> Encode 'Open (Int -> Three)
forall t. t -> Word -> Encode 'Open t
Sum Int -> Three
In Word
0 Encode 'Open (Int -> Three)
-> Encode ('Closed 'Dense) Int -> Encode 'Open Three
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Int -> Encode ('Closed 'Dense) Int
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
x
encThree (N Bool
b Integer
i) = (Bool -> Integer -> Three)
-> Word -> Encode 'Open (Bool -> Integer -> Three)
forall t. t -> Word -> Encode 'Open t
Sum Bool -> Integer -> Three
N Word
1 Encode 'Open (Bool -> Integer -> Three)
-> Encode ('Closed 'Dense) Bool -> Encode 'Open (Integer -> Three)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Bool -> Encode ('Closed 'Dense) Bool
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Bool
b Encode 'Open (Integer -> Three)
-> Encode ('Closed 'Dense) Integer -> Encode 'Open Three
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Integer -> Encode ('Closed 'Dense) Integer
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Integer
i
encThree (F Two
t) = (Two -> Three) -> Word -> Encode 'Open (Two -> Three)
forall t. t -> Word -> Encode 'Open t
Sum Two -> Three
F Word
2 Encode 'Open (Two -> Three)
-> Encode ('Closed 'Dense) Two -> Encode 'Open Three
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Two -> Encode ('Closed 'Dense) Two
encTwo Two
t

instance DecCBOR Three where
  decCBOR :: forall s. Decoder s Three
decCBOR = Decode ('Closed 'Dense) Three -> Decoder s Three
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Text
-> (Word -> Decode 'Open Three) -> Decode ('Closed 'Dense) Three
forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"Three" Word -> Decode 'Open Three
decThree)

instance EncCBOR Three where
  encCBOR :: Three -> Encoding
encCBOR Three
x = Encode 'Open Three -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Three -> Encode 'Open Three
encThree Three
x)

-- ================================================================
-- In this test we nest many Records, and flatten out everything

data Big = Big Int Bool Integer
  deriving (Int -> Big -> ShowS
[Big] -> ShowS
Big -> String
(Int -> Big -> ShowS)
-> (Big -> String) -> ([Big] -> ShowS) -> Show Big
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Big -> ShowS
showsPrec :: Int -> Big -> ShowS
$cshow :: Big -> String
show :: Big -> String
$cshowList :: [Big] -> ShowS
showList :: [Big] -> ShowS
Show, Big -> Big -> Bool
(Big -> Big -> Bool) -> (Big -> Big -> Bool) -> Eq Big
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Big -> Big -> Bool
== :: Big -> Big -> Bool
$c/= :: Big -> Big -> Bool
/= :: Big -> Big -> Bool
Eq)

data Bigger = Bigger Test Two Big
  deriving (Int -> Bigger -> ShowS
[Bigger] -> ShowS
Bigger -> String
(Int -> Bigger -> ShowS)
-> (Bigger -> String) -> ([Bigger] -> ShowS) -> Show Bigger
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Bigger -> ShowS
showsPrec :: Int -> Bigger -> ShowS
$cshow :: Bigger -> String
show :: Bigger -> String
$cshowList :: [Bigger] -> ShowS
showList :: [Bigger] -> ShowS
Show, Bigger -> Bigger -> Bool
(Bigger -> Bigger -> Bool)
-> (Bigger -> Bigger -> Bool) -> Eq Bigger
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Bigger -> Bigger -> Bool
== :: Bigger -> Bigger -> Bool
$c/= :: Bigger -> Bigger -> Bool
/= :: Bigger -> Bigger -> Bool
Eq)

bigger :: Bigger
bigger :: Bigger
bigger = Test -> Two -> Big -> Bigger
Bigger (Int -> Two -> Integer -> Test
Test Int
2 (Int -> Bool -> Two
Two Int
4 Bool
True) Integer
99) (Int -> Bool -> Two
Two Int
7 Bool
False) (Int -> Bool -> Integer -> Big
Big Int
5 Bool
False Integer
102)

-- Note there are 9 individual items, each which fits in one CBOR Token
-- So we expect the encoding to have 10 items, 1 prefix and 9 others

biggerItems :: FlatTerm
biggerItems :: FlatTerm
biggerItems = Version -> Encoding -> FlatTerm
toFlatTerm Version
shelleyProtVer (Encode ('Closed 'Dense) Bigger -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Bigger -> Encode ('Closed 'Dense) Bigger
encBigger Bigger
bigger))

decBigger :: Decode ('Closed 'Dense) Bigger
decBigger :: Decode ('Closed 'Dense) Bigger
decBigger =
  (Test -> Two -> Big -> Bigger)
-> Decode ('Closed 'Dense) (Test -> Two -> Big -> Bigger)
forall t. t -> Decode ('Closed 'Dense) t
RecD Test -> Two -> Big -> Bigger
Bigger
    Decode ('Closed 'Dense) (Test -> Two -> Big -> Bigger)
-> Decode ('Closed 'Dense) Test
-> Decode ('Closed 'Dense) (Two -> Big -> Bigger)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! ((Int -> Two -> Integer -> Test)
-> Decode ('Closed 'Dense) (Int -> Two -> Integer -> Test)
forall t. t -> Decode ('Closed 'Dense) t
RecD Int -> Two -> Integer -> Test
Test Decode ('Closed 'Dense) (Int -> Two -> Integer -> Test)
-> Decode ('Closed Any) Int
-> Decode ('Closed 'Dense) (Two -> Integer -> Test)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Int
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode ('Closed 'Dense) (Two -> Integer -> Test)
-> Decode ('Closed 'Dense) Two
-> Decode ('Closed 'Dense) (Integer -> Test)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! ((Int -> Bool -> Two)
-> Decode ('Closed 'Dense) (Int -> Bool -> Two)
forall t. t -> Decode ('Closed 'Dense) t
RecD Int -> Bool -> Two
Two Decode ('Closed 'Dense) (Int -> Bool -> Two)
-> Decode ('Closed Any) Int
-> Decode ('Closed 'Dense) (Bool -> Two)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Int
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode ('Closed 'Dense) (Bool -> Two)
-> Decode ('Closed Any) Bool -> Decode ('Closed 'Dense) Two
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Bool
forall t (w :: Wrapped). DecCBOR t => Decode w t
From) Decode ('Closed 'Dense) (Integer -> Test)
-> Decode ('Closed Any) Integer -> Decode ('Closed 'Dense) Test
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Integer
forall t (w :: Wrapped). DecCBOR t => Decode w t
From)
    Decode ('Closed 'Dense) (Two -> Big -> Bigger)
-> Decode ('Closed 'Dense) Two
-> Decode ('Closed 'Dense) (Big -> Bigger)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! ((Int -> Bool -> Two)
-> Decode ('Closed 'Dense) (Int -> Bool -> Two)
forall t. t -> Decode ('Closed 'Dense) t
RecD Int -> Bool -> Two
Two Decode ('Closed 'Dense) (Int -> Bool -> Two)
-> Decode ('Closed Any) Int
-> Decode ('Closed 'Dense) (Bool -> Two)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Int
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode ('Closed 'Dense) (Bool -> Two)
-> Decode ('Closed Any) Bool -> Decode ('Closed 'Dense) Two
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Bool
forall t (w :: Wrapped). DecCBOR t => Decode w t
From)
    Decode ('Closed 'Dense) (Big -> Bigger)
-> Decode ('Closed 'Dense) Big -> Decode ('Closed 'Dense) Bigger
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! ((Int -> Bool -> Integer -> Big)
-> Decode ('Closed 'Dense) (Int -> Bool -> Integer -> Big)
forall t. t -> Decode ('Closed 'Dense) t
RecD Int -> Bool -> Integer -> Big
Big Decode ('Closed 'Dense) (Int -> Bool -> Integer -> Big)
-> Decode ('Closed Any) Int
-> Decode ('Closed 'Dense) (Bool -> Integer -> Big)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Int
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode ('Closed 'Dense) (Bool -> Integer -> Big)
-> Decode ('Closed Any) Bool
-> Decode ('Closed 'Dense) (Integer -> Big)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Bool
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode ('Closed 'Dense) (Integer -> Big)
-> Decode ('Closed Any) Integer -> Decode ('Closed 'Dense) Big
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Integer
forall t (w :: Wrapped). DecCBOR t => Decode w t
From)

encBigger :: Bigger -> Encode ('Closed 'Dense) Bigger
encBigger :: Bigger -> Encode ('Closed 'Dense) Bigger
encBigger (Bigger (Test Int
a (Two Int
b Bool
c) Integer
d) (Two Int
e Bool
f) (Big Int
g Bool
h Integer
i)) =
  (Test -> Two -> Big -> Bigger)
-> Encode ('Closed 'Dense) (Test -> Two -> Big -> Bigger)
forall t. t -> Encode ('Closed 'Dense) t
Rec Test -> Two -> Big -> Bigger
Bigger
    Encode ('Closed 'Dense) (Test -> Two -> Big -> Bigger)
-> Encode ('Closed 'Dense) Test
-> Encode ('Closed 'Dense) (Two -> Big -> Bigger)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ((Int -> Two -> Integer -> Test)
-> Encode ('Closed 'Dense) (Int -> Two -> Integer -> Test)
forall t. t -> Encode ('Closed 'Dense) t
Rec Int -> Two -> Integer -> Test
Test Encode ('Closed 'Dense) (Int -> Two -> Integer -> Test)
-> Encode ('Closed 'Dense) Int
-> Encode ('Closed 'Dense) (Two -> Integer -> Test)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Int -> Encode ('Closed 'Dense) Int
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
a Encode ('Closed 'Dense) (Two -> Integer -> Test)
-> Encode ('Closed 'Dense) Two
-> Encode ('Closed 'Dense) (Integer -> Test)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ((Int -> Bool -> Two)
-> Encode ('Closed 'Dense) (Int -> Bool -> Two)
forall t. t -> Encode ('Closed 'Dense) t
Rec Int -> Bool -> Two
Two Encode ('Closed 'Dense) (Int -> Bool -> Two)
-> Encode ('Closed 'Dense) Int
-> Encode ('Closed 'Dense) (Bool -> Two)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Int -> Encode ('Closed 'Dense) Int
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
b Encode ('Closed 'Dense) (Bool -> Two)
-> Encode ('Closed 'Dense) Bool -> Encode ('Closed 'Dense) Two
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Bool -> Encode ('Closed 'Dense) Bool
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Bool
c) Encode ('Closed 'Dense) (Integer -> Test)
-> Encode ('Closed 'Dense) Integer -> Encode ('Closed 'Dense) Test
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Integer -> Encode ('Closed 'Dense) Integer
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Integer
d)
    Encode ('Closed 'Dense) (Two -> Big -> Bigger)
-> Encode ('Closed 'Dense) Two
-> Encode ('Closed 'Dense) (Big -> Bigger)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ((Int -> Bool -> Two)
-> Encode ('Closed 'Dense) (Int -> Bool -> Two)
forall t. t -> Encode ('Closed 'Dense) t
Rec Int -> Bool -> Two
Two Encode ('Closed 'Dense) (Int -> Bool -> Two)
-> Encode ('Closed 'Dense) Int
-> Encode ('Closed 'Dense) (Bool -> Two)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Int -> Encode ('Closed 'Dense) Int
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
e Encode ('Closed 'Dense) (Bool -> Two)
-> Encode ('Closed 'Dense) Bool -> Encode ('Closed 'Dense) Two
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Bool -> Encode ('Closed 'Dense) Bool
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Bool
f)
    Encode ('Closed 'Dense) (Big -> Bigger)
-> Encode ('Closed 'Dense) Big -> Encode ('Closed 'Dense) Bigger
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ((Int -> Bool -> Integer -> Big)
-> Encode ('Closed 'Dense) (Int -> Bool -> Integer -> Big)
forall t. t -> Encode ('Closed 'Dense) t
Rec Int -> Bool -> Integer -> Big
Big Encode ('Closed 'Dense) (Int -> Bool -> Integer -> Big)
-> Encode ('Closed 'Dense) Int
-> Encode ('Closed 'Dense) (Bool -> Integer -> Big)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Int -> Encode ('Closed 'Dense) Int
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
g Encode ('Closed 'Dense) (Bool -> Integer -> Big)
-> Encode ('Closed 'Dense) Bool
-> Encode ('Closed 'Dense) (Integer -> Big)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Bool -> Encode ('Closed 'Dense) Bool
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Bool
h Encode ('Closed 'Dense) (Integer -> Big)
-> Encode ('Closed 'Dense) Integer -> Encode ('Closed 'Dense) Big
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Integer -> Encode ('Closed 'Dense) Integer
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Integer
i)

instance EncCBOR Bigger where
  encCBOR :: Bigger -> Encoding
encCBOR = Encode ('Closed 'Dense) Bigger -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) Bigger -> Encoding)
-> (Bigger -> Encode ('Closed 'Dense) Bigger) -> Bigger -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bigger -> Encode ('Closed 'Dense) Bigger
encBigger

instance DecCBOR Bigger where
  decCBOR :: forall s. Decoder s Bigger
decCBOR = Decode ('Closed 'Dense) Bigger -> Decoder s Bigger
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode Decode ('Closed 'Dense) Bigger
decBigger

-- ======================================================================
-- There are two ways to write smart encoders and decoders that don't put
-- fields with default values in the Encoding, and that reconstruct them
-- on the decoding side. These techniques work on record datatypes, i.e.
-- those with only one constructor. We will illustrate the two approaches
-- in the datatype A

data M = M Int [Bool] Text
  deriving (Int -> M -> ShowS
[M] -> ShowS
M -> String
(Int -> M -> ShowS) -> (M -> String) -> ([M] -> ShowS) -> Show M
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> M -> ShowS
showsPrec :: Int -> M -> ShowS
$cshow :: M -> String
show :: M -> String
$cshowList :: [M] -> ShowS
showList :: [M] -> ShowS
Show, M -> M -> Bool
(M -> M -> Bool) -> (M -> M -> Bool) -> Eq M
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: M -> M -> Bool
== :: M -> M -> Bool
$c/= :: M -> M -> Bool
/= :: M -> M -> Bool
Eq)

a0, a1, a2, a3 :: M
a0 :: M
a0 = Int -> [Bool] -> Text -> M
M Int
0 [] Text
"ABC"
a1 :: M
a1 = Int -> [Bool] -> Text -> M
M Int
0 [Bool
True] Text
"ABC"
a2 :: M
a2 = Int -> [Bool] -> Text -> M
M Int
9 [] Text
"ABC"
a3 :: M
a3 = Int -> [Bool] -> Text -> M
M Int
9 [Bool
False] Text
"ABC"

-- ==========================================================================
-- The virtual constructor stategy pretends there are mutiple constructors
-- Even though there is only one. We use invariants about the data to avoid
-- encoding some of the values.

encM :: M -> Encode 'Open M
encM :: M -> Encode 'Open M
encM (M Int
0 [] Text
t) = (Int -> [Bool] -> Text -> M)
-> Word -> Encode 'Open (Int -> [Bool] -> Text -> M)
forall t. t -> Word -> Encode 'Open t
Sum Int -> [Bool] -> Text -> M
M Word
0 Encode 'Open (Int -> [Bool] -> Text -> M)
-> Encode ('Closed Any) Int -> Encode 'Open ([Bool] -> Text -> M)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Int -> Encode ('Closed Any) Int
forall t (w :: Wrapped). t -> Encode w t
OmitC Int
0 Encode 'Open ([Bool] -> Text -> M)
-> Encode ('Closed Any) [Bool] -> Encode 'Open (Text -> M)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> [Bool] -> Encode ('Closed Any) [Bool]
forall t (w :: Wrapped). t -> Encode w t
OmitC [] Encode 'Open (Text -> M)
-> Encode ('Closed 'Dense) Text -> Encode 'Open M
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Text -> Encode ('Closed 'Dense) Text
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Text
t
encM (M Int
0 [Bool]
bs Text
t) = (Int -> [Bool] -> Text -> M)
-> Word -> Encode 'Open (Int -> [Bool] -> Text -> M)
forall t. t -> Word -> Encode 'Open t
Sum Int -> [Bool] -> Text -> M
M Word
1 Encode 'Open (Int -> [Bool] -> Text -> M)
-> Encode ('Closed Any) Int -> Encode 'Open ([Bool] -> Text -> M)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Int -> Encode ('Closed Any) Int
forall t (w :: Wrapped). t -> Encode w t
OmitC Int
0 Encode 'Open ([Bool] -> Text -> M)
-> Encode ('Closed 'Dense) [Bool] -> Encode 'Open (Text -> M)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> [Bool] -> Encode ('Closed 'Dense) [Bool]
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To [Bool]
bs Encode 'Open (Text -> M)
-> Encode ('Closed 'Dense) Text -> Encode 'Open M
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Text -> Encode ('Closed 'Dense) Text
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Text
t
encM (M Int
n [] Text
t) = (Int -> [Bool] -> Text -> M)
-> Word -> Encode 'Open (Int -> [Bool] -> Text -> M)
forall t. t -> Word -> Encode 'Open t
Sum Int -> [Bool] -> Text -> M
M Word
2 Encode 'Open (Int -> [Bool] -> Text -> M)
-> Encode ('Closed 'Dense) Int
-> Encode 'Open ([Bool] -> Text -> M)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Int -> Encode ('Closed 'Dense) Int
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
n Encode 'Open ([Bool] -> Text -> M)
-> Encode ('Closed Any) [Bool] -> Encode 'Open (Text -> M)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> [Bool] -> Encode ('Closed Any) [Bool]
forall t (w :: Wrapped). t -> Encode w t
OmitC [] Encode 'Open (Text -> M)
-> Encode ('Closed 'Dense) Text -> Encode 'Open M
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Text -> Encode ('Closed 'Dense) Text
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Text
t
encM (M Int
n [Bool]
bs Text
t) = (Int -> [Bool] -> Text -> M)
-> Word -> Encode 'Open (Int -> [Bool] -> Text -> M)
forall t. t -> Word -> Encode 'Open t
Sum Int -> [Bool] -> Text -> M
M Word
3 Encode 'Open (Int -> [Bool] -> Text -> M)
-> Encode ('Closed 'Dense) Int
-> Encode 'Open ([Bool] -> Text -> M)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Int -> Encode ('Closed 'Dense) Int
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
n Encode 'Open ([Bool] -> Text -> M)
-> Encode ('Closed 'Dense) [Bool] -> Encode 'Open (Text -> M)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> [Bool] -> Encode ('Closed 'Dense) [Bool]
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To [Bool]
bs Encode 'Open (Text -> M)
-> Encode ('Closed 'Dense) Text -> Encode 'Open M
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Text -> Encode ('Closed 'Dense) Text
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Text
t

decM :: Word -> Decode 'Open M
decM :: Word -> Decode 'Open M
decM Word
0 = (Int -> [Bool] -> Text -> M)
-> Decode 'Open (Int -> [Bool] -> Text -> M)
forall t. t -> Decode 'Open t
SumD Int -> [Bool] -> Text -> M
M Decode 'Open (Int -> [Bool] -> Text -> M)
-> Decode ('Closed Any) Int -> Decode 'Open ([Bool] -> Text -> M)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Int -> Decode ('Closed Any) Int
forall t (w :: Wrapped). t -> Decode w t
Emit Int
0 Decode 'Open ([Bool] -> Text -> M)
-> Decode ('Closed Any) [Bool] -> Decode 'Open (Text -> M)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! [Bool] -> Decode ('Closed Any) [Bool]
forall t (w :: Wrapped). t -> Decode w t
Emit [] Decode 'Open (Text -> M)
-> Decode ('Closed Any) Text -> Decode 'Open M
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Text
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
decM Word
1 = (Int -> [Bool] -> Text -> M)
-> Decode 'Open (Int -> [Bool] -> Text -> M)
forall t. t -> Decode 'Open t
SumD Int -> [Bool] -> Text -> M
M Decode 'Open (Int -> [Bool] -> Text -> M)
-> Decode ('Closed Any) Int -> Decode 'Open ([Bool] -> Text -> M)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Int -> Decode ('Closed Any) Int
forall t (w :: Wrapped). t -> Decode w t
Emit Int
0 Decode 'Open ([Bool] -> Text -> M)
-> Decode ('Closed Any) [Bool] -> Decode 'Open (Text -> M)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) [Bool]
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode 'Open (Text -> M)
-> Decode ('Closed Any) Text -> Decode 'Open M
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Text
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
decM Word
2 = (Int -> [Bool] -> Text -> M)
-> Decode 'Open (Int -> [Bool] -> Text -> M)
forall t. t -> Decode 'Open t
SumD Int -> [Bool] -> Text -> M
M Decode 'Open (Int -> [Bool] -> Text -> M)
-> Decode ('Closed Any) Int -> Decode 'Open ([Bool] -> Text -> M)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Int
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode 'Open ([Bool] -> Text -> M)
-> Decode ('Closed Any) [Bool] -> Decode 'Open (Text -> M)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! [Bool] -> Decode ('Closed Any) [Bool]
forall t (w :: Wrapped). t -> Decode w t
Emit [] Decode 'Open (Text -> M)
-> Decode ('Closed Any) Text -> Decode 'Open M
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Text
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
decM Word
3 = (Int -> [Bool] -> Text -> M)
-> Decode 'Open (Int -> [Bool] -> Text -> M)
forall t. t -> Decode 'Open t
SumD Int -> [Bool] -> Text -> M
M Decode 'Open (Int -> [Bool] -> Text -> M)
-> Decode ('Closed Any) Int -> Decode 'Open ([Bool] -> Text -> M)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Int
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode 'Open ([Bool] -> Text -> M)
-> Decode ('Closed Any) [Bool] -> Decode 'Open (Text -> M)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) [Bool]
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode 'Open (Text -> M)
-> Decode ('Closed Any) Text -> Decode 'Open M
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Text
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
decM Word
n = Word -> Decode 'Open M
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

dualMvirtual :: Trip M M
dualMvirtual :: Trip M M
dualMvirtual = (M -> Encoding) -> (forall s. Decoder s M) -> Trip M M
forall a b. (a -> Encoding) -> (forall s. Decoder s b) -> Trip a b
mkTrip (Encode 'Open M -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open M -> Encoding)
-> (M -> Encode 'Open M) -> M -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M -> Encode 'Open M
encM) (Decode ('Closed 'Dense) M -> Decoder s M
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Text -> (Word -> Decode 'Open M) -> Decode ('Closed 'Dense) M
forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"M" Word -> Decode 'Open M
decM))

-- ================================================================================
-- The Sparse encoding strategy uses N keys, one for each field that is not defaulted
-- encode (baz (M 9 [True] (pack "hi"))) --Here No fields are defaulted, should be 3 keys
-- [TkMapLen 3,TkInt 0,TkInt 9,TkInt 1,TkListBegin,TkBool True,TkBreak,TkInt 2,TkString "hi"]
--                   ^key            ^key                                    ^key
-- So the user supplies a function, that encodes every field, each field must use a unique
-- key, and fields with default values have Omit wrapped around the Key encoding.
-- The user must ensure that there is NOT an Omit on a required field. 'baz' is an example.

baz :: M -> Encode ('Closed 'Sparse) M
baz :: M -> Encode ('Closed 'Sparse) M
baz (M Int
n [Bool]
xs Text
t) = (Int -> [Bool] -> Text -> M)
-> Encode ('Closed 'Sparse) (Int -> [Bool] -> Text -> M)
forall t. t -> Encode ('Closed 'Sparse) t
Keyed Int -> [Bool] -> Text -> M
M Encode ('Closed 'Sparse) (Int -> [Bool] -> Text -> M)
-> Encode ('Closed 'Sparse) Int
-> Encode ('Closed 'Sparse) ([Bool] -> Text -> M)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Int -> Bool)
-> Encode ('Closed 'Sparse) Int -> Encode ('Closed 'Sparse) Int
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Word -> Encode ('Closed 'Dense) Int -> Encode ('Closed 'Sparse) Int
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
0 (Int -> Encode ('Closed 'Dense) Int
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
n)) Encode ('Closed 'Sparse) ([Bool] -> Text -> M)
-> Encode ('Closed 'Sparse) [Bool]
-> Encode ('Closed 'Sparse) (Text -> M)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ([Bool] -> Bool)
-> Encode ('Closed 'Sparse) [Bool]
-> Encode ('Closed 'Sparse) [Bool]
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit [Bool] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Word
-> Encode ('Closed 'Dense) [Bool]
-> Encode ('Closed 'Sparse) [Bool]
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
1 ([Bool] -> Encode ('Closed 'Dense) [Bool]
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To [Bool]
xs)) Encode ('Closed 'Sparse) (Text -> M)
-> Encode ('Closed 'Sparse) Text -> Encode ('Closed 'Sparse) M
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> Encode ('Closed 'Dense) Text -> Encode ('Closed 'Sparse) Text
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
2 (Text -> Encode ('Closed 'Dense) Text
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Text
t)

-- To write an Decoder we must pair a decoder for each field, with a function that updates only
-- that field. We use the Field GADT to construct these pairs, and we must write a function, that
-- for each field tag, picks out the correct pair. If the Encode and Decode don't agree on how the
-- tags correspond to a particular field, things will fail.

boxM :: Word -> Field M
boxM :: Word -> Field M
boxM Word
0 = (Int -> M -> M) -> Decode ('Closed Any) Int -> Field M
forall x t (d :: Density).
Typeable x =>
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field Int -> M -> M
update0 Decode ('Closed Any) Int
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
  where
    update0 :: Int -> M -> M
update0 Int
n (M Int
_ [Bool]
xs Text
t) = Int -> [Bool] -> Text -> M
M Int
n [Bool]
xs Text
t
boxM Word
1 = ([Bool] -> M -> M) -> Decode ('Closed Any) [Bool] -> Field M
forall x t (d :: Density).
Typeable x =>
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field [Bool] -> M -> M
update1 Decode ('Closed Any) [Bool]
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
  where
    update1 :: [Bool] -> M -> M
update1 [Bool]
xs (M Int
n [Bool]
_ Text
t) = Int -> [Bool] -> Text -> M
M Int
n [Bool]
xs Text
t
boxM Word
2 = (Text -> M -> M) -> Decode ('Closed Any) Text -> Field M
forall x t (d :: Density).
Typeable x =>
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field Text -> M -> M
update2 Decode ('Closed Any) Text
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
  where
    update2 :: Text -> M -> M
update2 Text
t (M Int
n [Bool]
xs Text
_) = Int -> [Bool] -> Text -> M
M Int
n [Bool]
xs Text
t
boxM Word
n = Word -> Field M
forall t. Word -> Field t
invalidField Word
n

-- Finally there is a new constructor for Decode, called SparseKeyed, that decodes field
-- keyed sparse objects. The user supplies an initial value and pick function, and a list
-- of tags of the required fields. The initial value should have default values and
-- any well type value in required fields. If the encode function (baz above) is
-- encoded properly the required fields in the initial value should always be over
-- overwritten. If it is not written properly, or a bad encoding comes from somewhere
-- else, the intial values in the required fields might survive decoding. The list
-- of required fields is checked.

decodeM :: Decode ('Closed 'Dense) M -- Only the field with Key 2 is required
decodeM :: Decode ('Closed 'Dense) M
decodeM = String
-> M
-> (Word -> Field M)
-> [(Word, String)]
-> Decode ('Closed 'Dense) M
forall t.
Typeable t =>
String
-> t
-> (Word -> Field t)
-> [(Word, String)]
-> Decode ('Closed 'Dense) t
SparseKeyed String
"M" (Int -> [Bool] -> Text -> M
M Int
0 [] (String -> Text
pack String
"a")) Word -> Field M
boxM [(Word
2, String
"Stringpart")]

dualM :: Trip M M
dualM :: Trip M M
dualM = (M -> Encoding) -> (forall s. Decoder s M) -> Trip M M
forall a b. (a -> Encoding) -> (forall s. Decoder s b) -> Trip a b
mkTrip (Encode ('Closed 'Sparse) M -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Sparse) M -> Encoding)
-> (M -> Encode ('Closed 'Sparse) M) -> M -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M -> Encode ('Closed 'Sparse) M
baz) (Decode ('Closed 'Dense) M -> Decoder s M
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode Decode ('Closed 'Dense) M
decodeM)

roundTripSpec :: (HasCallStack, Show t, Eq t, Typeable t) => String -> Trip t t -> t -> Spec
roundTripSpec :: forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
name Trip t t
trip t
val = String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
name (Expectation -> SpecM (Arg Expectation) ())
-> Expectation -> SpecM (Arg Expectation) ()
forall a b. (a -> b) -> a -> b
$ Trip t t -> t -> Expectation
forall t.
(Show t, Eq t, Typeable t, HasCallStack) =>
Trip t t -> t -> Expectation
roundTripExpectation Trip t t
trip t
val

-- | Check that a value can be encoded using Coders and decoded using DecCBOR
encodeSpec :: (HasCallStack, Show t, Eq t, DecCBOR t) => String -> Encode w t -> t -> Spec
encodeSpec :: forall t (w :: Wrapped).
(HasCallStack, Show t, Eq t, DecCBOR t) =>
String -> Encode w t -> t -> Spec
encodeSpec String
name Encode w t
enc = String -> Trip t t -> t -> Spec
forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
name ((t -> Encoding) -> (forall s. Decoder s t) -> Trip t t
forall a b. (a -> Encoding) -> (forall s. Decoder s b) -> Trip a b
mkTrip (Encoding -> t -> Encoding
forall a b. a -> b -> a
const (Encode w t -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode Encode w t
enc)) Decoder s t
forall s. Decoder s t
forall a s. DecCBOR a => Decoder s a
decCBOR)

newtype C = C Text
  deriving (Int -> C -> ShowS
[C] -> ShowS
C -> String
(Int -> C -> ShowS) -> (C -> String) -> ([C] -> ShowS) -> Show C
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> C -> ShowS
showsPrec :: Int -> C -> ShowS
$cshow :: C -> String
show :: C -> String
$cshowList :: [C] -> ShowS
showList :: [C] -> ShowS
Show, C -> C -> Bool
(C -> C -> Bool) -> (C -> C -> Bool) -> Eq C
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: C -> C -> Bool
== :: C -> C -> Bool
$c/= :: C -> C -> Bool
/= :: C -> C -> Bool
Eq)

instance EncCBOR C where
  encCBOR :: C -> Encoding
encCBOR (C Text
t) = Text -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Text
t

instance DecCBOR C where
  decCBOR :: forall s. Decoder s C
decCBOR = Text -> C
C (Text -> C) -> Decoder s Text -> Decoder s C
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Text
forall s. Decoder s Text
forall a s. DecCBOR a => Decoder s a
decCBOR

newtype BB = BB Text
  deriving (Int -> BB -> ShowS
[BB] -> ShowS
BB -> String
(Int -> BB -> ShowS)
-> (BB -> String) -> ([BB] -> ShowS) -> Show BB
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BB -> ShowS
showsPrec :: Int -> BB -> ShowS
$cshow :: BB -> String
show :: BB -> String
$cshowList :: [BB] -> ShowS
showList :: [BB] -> ShowS
Show, BB -> BB -> Bool
(BB -> BB -> Bool) -> (BB -> BB -> Bool) -> Eq BB
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BB -> BB -> Bool
== :: BB -> BB -> Bool
$c/= :: BB -> BB -> Bool
/= :: BB -> BB -> Bool
Eq)

dualBB :: Trip BB BB
dualBB :: Trip BB BB
dualBB = (BB -> Encoding) -> (forall s. Decoder s BB) -> Trip BB BB
forall a b. (a -> Encoding) -> (forall s. Decoder s b) -> Trip a b
mkTrip (\(BB Text
t) -> Text -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Text
t) (Text -> BB
BB (Text -> BB) -> Decoder s Text -> Decoder s BB
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Text
forall s. Decoder s Text
forall a s. DecCBOR a => Decoder s a
decCBOR)

-- Record Type

data A = ACon Int BB C
  deriving (Int -> A -> ShowS
[A] -> ShowS
A -> String
(Int -> A -> ShowS) -> (A -> String) -> ([A] -> ShowS) -> Show A
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> A -> ShowS
showsPrec :: Int -> A -> ShowS
$cshow :: A -> String
show :: A -> String
$cshowList :: [A] -> ShowS
showList :: [A] -> ShowS
Show, A -> A -> Bool
(A -> A -> Bool) -> (A -> A -> Bool) -> Eq A
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: A -> A -> Bool
== :: A -> A -> Bool
$c/= :: A -> A -> Bool
/= :: A -> A -> Bool
Eq)

encodeA :: A -> Encode ('Closed 'Dense) A
encodeA :: A -> Encode ('Closed 'Dense) A
encodeA (ACon Int
i BB
b C
c) = (Int -> BB -> C -> A)
-> Encode ('Closed 'Dense) (Int -> BB -> C -> A)
forall t. t -> Encode ('Closed 'Dense) t
Rec Int -> BB -> C -> A
ACon Encode ('Closed 'Dense) (Int -> BB -> C -> A)
-> Encode ('Closed 'Dense) Int
-> Encode ('Closed 'Dense) (BB -> C -> A)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Int -> Encode ('Closed 'Dense) Int
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
i Encode ('Closed 'Dense) (BB -> C -> A)
-> Encode ('Closed 'Dense) BB -> Encode ('Closed 'Dense) (C -> A)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (BB -> Encoding) -> BB -> Encode ('Closed 'Dense) BB
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E (Trip BB BB -> BB -> Encoding
forall a b. Trip a b -> a -> Encoding
tripEncoder Trip BB BB
dualBB) BB
b Encode ('Closed 'Dense) (C -> A)
-> Encode ('Closed 'Dense) C -> Encode ('Closed 'Dense) A
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> C -> Encode ('Closed 'Dense) C
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To C
c

decodeA :: Decode ('Closed 'Dense) A
decodeA :: Decode ('Closed 'Dense) A
decodeA = (Int -> BB -> C -> A)
-> Decode ('Closed 'Dense) (Int -> BB -> C -> A)
forall t. t -> Decode ('Closed 'Dense) t
RecD Int -> BB -> C -> A
ACon Decode ('Closed 'Dense) (Int -> BB -> C -> A)
-> Decode ('Closed Any) Int
-> Decode ('Closed 'Dense) (BB -> C -> A)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Int
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode ('Closed 'Dense) (BB -> C -> A)
-> Decode ('Closed 'Dense) BB -> Decode ('Closed 'Dense) (C -> A)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s BB) -> Decode ('Closed 'Dense) BB
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Trip BB BB -> forall s. Decoder s BB
forall a b. Trip a b -> forall s. Decoder s b
tripDecoder Trip BB BB
dualBB) Decode ('Closed 'Dense) (C -> A)
-> Decode ('Closed Any) C -> Decode ('Closed 'Dense) A
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) C
forall t (w :: Wrapped). DecCBOR t => Decode w t
From

instance EncCBOR A where
  encCBOR :: A -> Encoding
encCBOR A
x = Encode ('Closed 'Dense) A -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (A -> Encode ('Closed 'Dense) A
encodeA A
x)

instance DecCBOR A where
  decCBOR :: forall s. Decoder s A
decCBOR = Decode ('Closed 'Dense) A -> Decoder s A
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode Decode ('Closed 'Dense) A
decodeA

dualA :: Trip A A
dualA :: Trip A A
dualA = Trip A A
forall a b. (EncCBOR a, DecCBOR b) => Trip a b
cborTrip

recordTests :: Spec
recordTests :: Spec
recordTests =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Record tests" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> Trip A A -> A -> Spec
forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
"A1" Trip A A
dualA (Int -> BB -> C -> A
ACon Int
34 (Text -> BB
BB Text
"HI") (Text -> C
C Text
"There"))
    String -> Trip A A -> A -> Spec
forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
"A2" Trip A A
dualA (Int -> BB -> C -> A
ACon Int
9 (Text -> BB
BB Text
"One") (Text -> C
C Text
"Two"))

-- An example with multiple constructors uses Sum, SumD, and Summands

data N
  = N1 Int
  | N2 BB Bool
  | N3 A
  deriving (Int -> N -> ShowS
[N] -> ShowS
N -> String
(Int -> N -> ShowS) -> (N -> String) -> ([N] -> ShowS) -> Show N
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> N -> ShowS
showsPrec :: Int -> N -> ShowS
$cshow :: N -> String
show :: N -> String
$cshowList :: [N] -> ShowS
showList :: [N] -> ShowS
Show, N -> N -> Bool
(N -> N -> Bool) -> (N -> N -> Bool) -> Eq N
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: N -> N -> Bool
== :: N -> N -> Bool
$c/= :: N -> N -> Bool
/= :: N -> N -> Bool
Eq)

encodeN :: N -> Encode 'Open N
encodeN :: N -> Encode 'Open N
encodeN (N1 Int
i) = (Int -> N) -> Word -> Encode 'Open (Int -> N)
forall t. t -> Word -> Encode 'Open t
Sum Int -> N
N1 Word
0 Encode 'Open (Int -> N)
-> Encode ('Closed 'Dense) Int -> Encode 'Open N
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Int -> Encode ('Closed 'Dense) Int
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
i
encodeN (N2 BB
b Bool
tf) = (BB -> Bool -> N) -> Word -> Encode 'Open (BB -> Bool -> N)
forall t. t -> Word -> Encode 'Open t
Sum BB -> Bool -> N
N2 Word
1 Encode 'Open (BB -> Bool -> N)
-> Encode ('Closed 'Dense) BB -> Encode 'Open (Bool -> N)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (BB -> Encoding) -> BB -> Encode ('Closed 'Dense) BB
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E (Trip BB BB -> BB -> Encoding
forall a b. Trip a b -> a -> Encoding
tripEncoder Trip BB BB
dualBB) BB
b Encode 'Open (Bool -> N)
-> Encode ('Closed 'Dense) Bool -> Encode 'Open N
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Bool -> Encode ('Closed 'Dense) Bool
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Bool
tf
encodeN (N3 A
a) = (A -> N) -> Word -> Encode 'Open (A -> N)
forall t. t -> Word -> Encode 'Open t
Sum A -> N
N3 Word
2 Encode 'Open (A -> N)
-> Encode ('Closed 'Dense) A -> Encode 'Open N
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> A -> Encode ('Closed 'Dense) A
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To A
a

decodeN :: Decode ('Closed 'Dense) N
decodeN :: Decode ('Closed 'Dense) N
decodeN = Text -> (Word -> Decode 'Open N) -> Decode ('Closed 'Dense) N
forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"N" Word -> Decode 'Open N
decodeNx
  where
    decodeNx :: Word -> Decode 'Open N
decodeNx Word
0 = (Int -> N) -> Decode 'Open (Int -> N)
forall t. t -> Decode 'Open t
SumD Int -> N
N1 Decode 'Open (Int -> N)
-> Decode ('Closed Any) Int -> Decode 'Open N
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Int
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    decodeNx Word
1 = (BB -> Bool -> N) -> Decode 'Open (BB -> Bool -> N)
forall t. t -> Decode 'Open t
SumD BB -> Bool -> N
N2 Decode 'Open (BB -> Bool -> N)
-> Decode ('Closed 'Dense) BB -> Decode 'Open (Bool -> N)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s BB) -> Decode ('Closed 'Dense) BB
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (Trip BB BB -> forall s. Decoder s BB
forall a b. Trip a b -> forall s. Decoder s b
tripDecoder Trip BB BB
dualBB) Decode 'Open (Bool -> N)
-> Decode ('Closed Any) Bool -> Decode 'Open N
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Bool
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    decodeNx Word
2 = (A -> N) -> Decode 'Open (A -> N)
forall t. t -> Decode 'Open t
SumD A -> N
N3 Decode 'Open (A -> N) -> Decode ('Closed Any) A -> Decode 'Open N
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) A
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    decodeNx Word
k = Word -> Decode 'Open N
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
k

dualN :: Trip N N
dualN :: Trip N N
dualN = (N -> Encoding) -> (forall s. Decoder s N) -> Trip N N
forall a b. (a -> Encoding) -> (forall s. Decoder s b) -> Trip a b
mkTrip (Encode 'Open N -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open N -> Encoding)
-> (N -> Encode 'Open N) -> N -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. N -> Encode 'Open N
encodeN) (Decode ('Closed 'Dense) N -> Decoder s N
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode Decode ('Closed 'Dense) N
decodeN)

-- ============================================================

ttSpec :: Spec
ttSpec :: Spec
ttSpec =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Encode TT" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    -- Tag for A is 0
    String -> Encode 'Open TT -> TT -> Spec
forall t (w :: Wrapped).
(HasCallStack, Show t, Eq t, DecCBOR t) =>
String -> Encode w t -> t -> Spec
encodeSpec String
"sA" ((Int -> TT) -> Word -> Encode 'Open (Int -> TT)
forall t. t -> Word -> Encode 'Open t
Sum Int -> TT
A Word
0 Encode 'Open (Int -> TT)
-> Encode ('Closed 'Dense) Int -> Encode 'Open TT
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Int -> Encode ('Closed 'Dense) Int
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
7) (Int -> TT
A Int
7)
    -- Tag for B is 1
    String -> Encode 'Open TT -> TT -> Spec
forall t (w :: Wrapped).
(HasCallStack, Show t, Eq t, DecCBOR t) =>
String -> Encode w t -> t -> Spec
encodeSpec String
"sB" ((Int -> Bool -> TT) -> Word -> Encode 'Open (Int -> Bool -> TT)
forall t. t -> Word -> Encode 'Open t
Sum Int -> Bool -> TT
B Word
1 Encode 'Open (Int -> Bool -> TT)
-> Encode ('Closed 'Dense) Int -> Encode 'Open (Bool -> TT)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Int -> Encode ('Closed 'Dense) Int
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
13 Encode 'Open (Bool -> TT)
-> Encode ('Closed 'Dense) Bool -> Encode 'Open TT
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Bool -> Encode ('Closed 'Dense) Bool
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Bool
True) (Int -> Bool -> TT
B Int
13 Bool
True)
    -- Tag for G is 2
    String -> Encode 'Open TT -> TT -> Spec
forall t (w :: Wrapped).
(HasCallStack, Show t, Eq t, DecCBOR t) =>
String -> Encode w t -> t -> Spec
encodeSpec String
"sG" (([Int] -> TT) -> Word -> Encode 'Open ([Int] -> TT)
forall t. t -> Word -> Encode 'Open t
Sum [Int] -> TT
G Word
2 Encode 'Open ([Int] -> TT)
-> Encode ('Closed 'Dense) [Int] -> Encode 'Open TT
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> [Int] -> Encode ('Closed 'Dense) [Int]
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To [Int
3, Int
4, Int
5]) ([Int] -> TT
G [Int
3, Int
4, Int
5])
    String -> Encode 'Open TT -> TT -> Spec
forall t (w :: Wrapped).
(HasCallStack, Show t, Eq t, DecCBOR t) =>
String -> Encode w t -> t -> Spec
encodeSpec String
"sGa" (([Int] -> TT) -> Word -> Encode 'Open ([Int] -> TT)
forall t. t -> Word -> Encode 'Open t
Sum [Int] -> TT
G Word
2 Encode 'Open ([Int] -> TT)
-> Encode ('Closed 'Dense) [Int] -> Encode 'Open TT
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ([Int] -> Encoding) -> [Int] -> Encode ('Closed 'Dense) [Int]
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E [Int] -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR [Int
2, Int
5]) ([Int] -> TT
G [Int
2, Int
5])
    -- Tag for H is 3
    let sseq :: StrictSeq Bool
sseq = [Bool] -> StrictSeq Bool
forall a. [a] -> StrictSeq a
fromList [Bool
False, Bool
True]
    String -> Encode 'Open TT -> TT -> Spec
forall t (w :: Wrapped).
(HasCallStack, Show t, Eq t, DecCBOR t) =>
String -> Encode w t -> t -> Spec
encodeSpec String
"sH" ((StrictSeq Bool -> TT)
-> Word -> Encode 'Open (StrictSeq Bool -> TT)
forall t. t -> Word -> Encode 'Open t
Sum StrictSeq Bool -> TT
H Word
3 Encode 'Open (StrictSeq Bool -> TT)
-> Encode ('Closed 'Dense) (StrictSeq Bool) -> Encode 'Open TT
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictSeq Bool -> Encoding)
-> StrictSeq Bool -> Encode ('Closed 'Dense) (StrictSeq Bool)
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E StrictSeq Bool -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR StrictSeq Bool
sseq) (StrictSeq Bool -> TT
H StrictSeq Bool
sseq)

spec :: Spec
spec :: Spec
spec =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Coders" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Simple Coders" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> Expectation -> SpecM (Arg Expectation) ()
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"encode Bigger is compact" (FlatTerm -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FlatTerm
biggerItems Int -> Int -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Int
10)
      Spec
ttSpec
      String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Encode TT" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
        String -> Encode 'Open Three -> Three -> Spec
forall t (w :: Wrapped).
(HasCallStack, Show t, Eq t, DecCBOR t) =>
String -> Encode w t -> t -> Spec
encodeSpec String
"Three1" (Three -> Encode 'Open Three
encThree Three
three1) Three
three1
        String -> Encode 'Open Three -> Three -> Spec
forall t (w :: Wrapped).
(HasCallStack, Show t, Eq t, DecCBOR t) =>
String -> Encode w t -> t -> Spec
encodeSpec String
"Three2" (Three -> Encode 'Open Three
encThree Three
three2) Three
three2
        String -> Encode 'Open Three -> Three -> Spec
forall t (w :: Wrapped).
(HasCallStack, Show t, Eq t, DecCBOR t) =>
String -> Encode w t -> t -> Spec
encodeSpec String
"Three3" (Three -> Encode 'Open Three
encThree Three
three3) Three
three3
      String -> Encode ('Closed 'Dense) Test -> Test -> Spec
forall t (w :: Wrapped).
(HasCallStack, Show t, Eq t, DecCBOR t) =>
String -> Encode w t -> t -> Spec
encodeSpec String
"test1" (Test -> Encode ('Closed 'Dense) Test
encTestWithGroupForTwo Test
test1) Test
test1
      String -> Encode ('Closed 'Dense) Bigger -> Bigger -> Spec
forall t (w :: Wrapped).
(HasCallStack, Show t, Eq t, DecCBOR t) =>
String -> Encode w t -> t -> Spec
encodeSpec String
"Bigger inlines" (Bigger -> Encode ('Closed 'Dense) Bigger
encBigger Bigger
bigger) Bigger
bigger
    Spec
recordTests
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Sparse tests" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> Trip M M -> M -> Spec
forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
"a0" Trip M M
dualM M
a0
      String -> Trip M M -> M -> Spec
forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
"a1" Trip M M
dualM M
a1
      String -> Trip M M -> M -> Spec
forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
"a2" Trip M M
dualM M
a2
      String -> Trip M M -> M -> Spec
forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
"a3" Trip M M
dualM M
a3
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Virtual Cosntructor tests" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> Trip M M -> M -> Spec
forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
"a0v" Trip M M
dualMvirtual M
a0
      String -> Trip M M -> M -> Spec
forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
"a1v" Trip M M
dualMvirtual M
a1
      String -> Trip M M -> M -> Spec
forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
"a2v" Trip M M
dualMvirtual M
a2
      String -> Trip M M -> M -> Spec
forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
"a3v" Trip M M
dualMvirtual M
a3
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Sum tests" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> Trip N N -> N -> Spec
forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
"N1" Trip N N
dualN (Int -> N
N1 Int
4)
      String -> Trip N N -> N -> Spec
forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
"N2" Trip N N
dualN (BB -> Bool -> N
N2 (Text -> BB
BB Text
"N2") Bool
True)
      String -> Trip N N -> N -> Spec
forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
"N3" Trip N N
dualN (A -> N
N3 (Int -> BB -> C -> A
ACon Int
6 (Text -> BB
BB Text
"N3") (Text -> C
C Text
"Test")))