{-# 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TT] -> ShowS
$cshowList :: [TT] -> ShowS
show :: TT -> String
$cshow :: TT -> String
showsPrec :: Int -> TT -> ShowS
$cshowsPrec :: Int -> TT -> ShowS
Show, TT -> TT -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TT -> TT -> Bool
$c/= :: TT -> TT -> Bool
== :: TT -> TT -> Bool
$c== :: TT -> TT -> Bool
Eq)

instance DecCBOR TT where
  decCBOR :: forall s. Decoder s TT
decCBOR = forall s a. Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum Text
"TT" forall a b. (a -> b) -> a -> b
$
    \case
      Word
0 -> (\Int
i -> (Int
2, Int -> TT
A Int
i)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR -- Tag for A is 0
      Word
1 -> do
        -- (,) 3 . B <$> decCBOR <*> decCBOR
        Int
i <- forall a s. DecCBOR a => Decoder s a
decCBOR
        Bool
b <- forall a s. DecCBOR a => Decoder s a
decCBOR
        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 <- forall s a. Decoder s a -> Decoder s [a]
decodeList forall a s. DecCBOR a => Decoder s a
decCBOR
        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 <- forall s a. Decoder s a -> Decoder s (StrictSeq a)
decodeStrictSeq forall a s. DecCBOR a => Decoder s a
decCBOR
        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 -> forall (m :: * -> *) 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 forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
0 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Int
i
  encCBOR (B Int
i Bool
b) = Word -> Encoding
encodeListLen Word
3 forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
1 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Int
i forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Bool
b
  encCBOR (G [Int]
is) = Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR [Int]
is
  encCBOR (H StrictSeq Bool
bs) = Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
encodeWord Word
3 forall a. Semigroup a => a -> a -> a
<> 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Two] -> ShowS
$cshowList :: [Two] -> ShowS
show :: Two -> String
$cshow :: Two -> String
showsPrec :: Int -> Two -> ShowS
$cshowsPrec :: Int -> Two -> ShowS
Show, Two -> Two -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Two -> Two -> Bool
$c/= :: Two -> Two -> Bool
== :: Two -> Two -> Bool
$c== :: Two -> Two -> Bool
Eq)

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

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

instance EncCBOR Two where
  encCBOR :: Two -> Encoding
encCBOR Two
two = forall (w :: Wrapped) t. Encode w t -> Encoding
encode 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 = forall (w :: Wrapped) t s. 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Test] -> ShowS
$cshowList :: [Test] -> ShowS
show :: Test -> String
$cshow :: Test -> String
showsPrec :: Int -> Test -> ShowS
$cshowsPrec :: Int -> Test -> ShowS
Show, Test -> Test -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Test -> Test -> Bool
$c/= :: Test -> Test -> Bool
== :: Test -> Test -> Bool
$c== :: 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 = forall t. t -> Decode ('Closed 'Dense) t
RecD Int -> Two -> Integer -> Test
Test forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed 'Dense) Two
decTwo forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From

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

instance EncCBOR Test where
  encCBOR :: Test -> Encoding
encCBOR = forall (w :: Wrapped) t. Encode w t -> Encoding
encode 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 = forall (w :: Wrapped) t s. 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Three] -> ShowS
$cshowList :: [Three] -> ShowS
show :: Three -> String
$cshow :: Three -> String
showsPrec :: Int -> Three -> ShowS
$cshowsPrec :: Int -> Three -> ShowS
Show, Three -> Three -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Three -> Three -> Bool
$c/= :: Three -> Three -> Bool
== :: Three -> Three -> Bool
$c== :: 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 = forall t. t -> Decode 'Open t
SumD Int -> Three
In forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
decThree Word
1 = forall t. t -> Decode 'Open t
SumD Bool -> Integer -> Three
N forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
decThree Word
2 = forall t. t -> Decode 'Open t
SumD Two -> Three
F forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed 'Dense) Two
decTwo
decThree Word
k = 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) = forall t. t -> Word -> Encode 'Open t
Sum Int -> Three
In Word
0 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
x
encThree (N Bool
b Integer
i) = forall t. t -> Word -> Encode 'Open t
Sum Bool -> Integer -> Three
N Word
1 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Bool
b forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Integer
i
encThree (F Two
t) = forall t. t -> Word -> Encode 'Open t
Sum Two -> Three
F Word
2 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 = forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (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 = 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Big] -> ShowS
$cshowList :: [Big] -> ShowS
show :: Big -> String
$cshow :: Big -> String
showsPrec :: Int -> Big -> ShowS
$cshowsPrec :: Int -> Big -> ShowS
Show, Big -> Big -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Big -> Big -> Bool
$c/= :: Big -> Big -> Bool
== :: Big -> Big -> Bool
$c== :: Big -> Big -> Bool
Eq)

data Bigger = Bigger Test Two Big
  deriving (Int -> Bigger -> ShowS
[Bigger] -> ShowS
Bigger -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bigger] -> ShowS
$cshowList :: [Bigger] -> ShowS
show :: Bigger -> String
$cshow :: Bigger -> String
showsPrec :: Int -> Bigger -> ShowS
$cshowsPrec :: Int -> Bigger -> ShowS
Show, Bigger -> Bigger -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bigger -> Bigger -> Bool
$c/= :: Bigger -> Bigger -> Bool
== :: Bigger -> Bigger -> Bool
$c== :: 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 (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 =
  forall t. t -> Decode ('Closed 'Dense) t
RecD Test -> Two -> Big -> Bigger
Bigger
    forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall t. t -> Decode ('Closed 'Dense) t
RecD Int -> Two -> Integer -> Test
Test forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall t. t -> Decode ('Closed 'Dense) t
RecD Int -> Bool -> Two
Two forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From) forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From)
    forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall t. t -> Decode ('Closed 'Dense) t
RecD Int -> Bool -> Two
Two forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From)
    forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall t. t -> Decode ('Closed 'Dense) t
RecD Int -> Bool -> Integer -> Big
Big forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! 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)) =
  forall t. t -> Encode ('Closed 'Dense) t
Rec Test -> Two -> Big -> Bigger
Bigger
    forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (forall t. t -> Encode ('Closed 'Dense) t
Rec Int -> Two -> Integer -> Test
Test forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
a forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (forall t. t -> Encode ('Closed 'Dense) t
Rec Int -> Bool -> Two
Two forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
b forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Bool
c) forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Integer
d)
    forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (forall t. t -> Encode ('Closed 'Dense) t
Rec Int -> Bool -> Two
Two forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
e forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Bool
f)
    forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (forall t. t -> Encode ('Closed 'Dense) t
Rec Int -> Bool -> Integer -> Big
Big forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
g forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Bool
h forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Integer
i)

instance EncCBOR Bigger where
  encCBOR :: Bigger -> Encoding
encCBOR = forall (w :: Wrapped) t. Encode w t -> Encoding
encode 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 = forall (w :: Wrapped) t s. 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [M] -> ShowS
$cshowList :: [M] -> ShowS
show :: M -> String
$cshow :: M -> String
showsPrec :: Int -> M -> ShowS
$cshowsPrec :: Int -> M -> ShowS
Show, M -> M -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: M -> M -> Bool
$c/= :: M -> M -> Bool
== :: M -> M -> Bool
$c== :: 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) = forall t. t -> Word -> Encode 'Open t
Sum Int -> [Bool] -> Text -> M
M Word
0 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t (w :: Wrapped). t -> Encode w t
OmitC Int
0 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t (w :: Wrapped). t -> Encode w t
OmitC [] forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Text
t
encM (M Int
0 [Bool]
bs Text
t) = forall t. t -> Word -> Encode 'Open t
Sum Int -> [Bool] -> Text -> M
M Word
1 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t (w :: Wrapped). t -> Encode w t
OmitC Int
0 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To [Bool]
bs forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Text
t
encM (M Int
n [] Text
t) = forall t. t -> Word -> Encode 'Open t
Sum Int -> [Bool] -> Text -> M
M Word
2 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
n forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t (w :: Wrapped). t -> Encode w t
OmitC [] forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Text
t
encM (M Int
n [Bool]
bs Text
t) = forall t. t -> Word -> Encode 'Open t
Sum Int -> [Bool] -> Text -> M
M Word
3 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
n forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To [Bool]
bs forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> 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 = forall t. t -> Decode 'Open t
SumD Int -> [Bool] -> Text -> M
M forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). t -> Decode w t
Emit Int
0 forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). t -> Decode w t
Emit [] forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
decM Word
1 = forall t. t -> Decode 'Open t
SumD Int -> [Bool] -> Text -> M
M forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). t -> Decode w t
Emit Int
0 forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
decM Word
2 = forall t. t -> Decode 'Open t
SumD Int -> [Bool] -> Text -> M
M forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). t -> Decode w t
Emit [] forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
decM Word
3 = forall t. t -> Decode 'Open t
SumD Int -> [Bool] -> Text -> M
M forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
decM Word
n = forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

dualMvirtual :: Trip M M
dualMvirtual :: Trip M M
dualMvirtual = forall a b. (a -> Encoding) -> (forall s. Decoder s b) -> Trip a b
mkTrip (forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. M -> Encode 'Open M
encM) (forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (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) = forall t. t -> Encode ('Closed 'Sparse) t
Keyed Int -> [Bool] -> Text -> M
M forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit (forall a. Eq a => a -> a -> Bool
== Int
0) (forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
0 (forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Int
n)) forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
1 (forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To [Bool]
xs)) forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
2 (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 = forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field Int -> M -> M
update0 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 = forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field [Bool] -> M -> M
update1 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 = forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field Text -> M -> M
update2 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 = 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 = 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 = forall a b. (a -> Encoding) -> (forall s. Decoder s b) -> Trip a b
mkTrip (forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. M -> Encode ('Closed 'Sparse) M
baz) (forall (w :: Wrapped) t s. 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 = forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
name forall a b. (a -> b) -> a -> b
$ 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 = forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
name (forall a b. (a -> Encoding) -> (forall s. Decoder s b) -> Trip a b
mkTrip (forall a b. a -> b -> a
const (forall (w :: Wrapped) t. Encode w t -> Encoding
encode Encode w t
enc)) forall a s. DecCBOR a => Decoder s a
decCBOR)

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

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

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

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

dualBB :: Trip BB BB
dualBB :: Trip BB BB
dualBB = forall a b. (a -> Encoding) -> (forall s. Decoder s b) -> Trip a b
mkTrip (\(BB Text
t) -> forall a. EncCBOR a => a -> Encoding
encCBOR Text
t) (Text -> BB
BB forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [A] -> ShowS
$cshowList :: [A] -> ShowS
show :: A -> String
$cshow :: A -> String
showsPrec :: Int -> A -> ShowS
$cshowsPrec :: Int -> A -> ShowS
Show, A -> A -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: A -> A -> Bool
$c/= :: A -> A -> Bool
== :: A -> A -> Bool
$c== :: A -> A -> Bool
Eq)

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

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

instance EncCBOR A where
  encCBOR :: A -> Encoding
encCBOR A
x = 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 = forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode Decode ('Closed 'Dense) A
decodeA

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

recordTests :: Spec
recordTests :: Spec
recordTests =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Record tests" forall a b. (a -> b) -> a -> b
$ do
    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"))
    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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [N] -> ShowS
$cshowList :: [N] -> ShowS
show :: N -> String
$cshow :: N -> String
showsPrec :: Int -> N -> ShowS
$cshowsPrec :: Int -> N -> ShowS
Show, N -> N -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: N -> N -> Bool
$c/= :: N -> N -> Bool
== :: N -> N -> Bool
$c== :: N -> N -> Bool
Eq)

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

decodeN :: Decode ('Closed 'Dense) N
decodeN :: Decode ('Closed 'Dense) N
decodeN = 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 = forall t. t -> Decode 'Open t
SumD Int -> N
N1 forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    decodeNx Word
1 = forall t. t -> Decode 'Open t
SumD BB -> Bool -> N
N2 forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (forall a b. Trip a b -> forall s. Decoder s b
tripDecoder Trip BB BB
dualBB) forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    decodeNx Word
2 = forall t. t -> Decode 'Open t
SumD A -> N
N3 forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    decodeNx Word
k = forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
k

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

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

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

spec :: Spec
spec :: Spec
spec =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Coders" forall a b. (a -> b) -> a -> b
$ do
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Simple Coders" forall a b. (a -> b) -> a -> b
$ do
      forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"encode Bigger is compact" (forall (t :: * -> *) a. Foldable t => t a -> Int
length FlatTerm
biggerItems forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Int
10)
      Spec
ttSpec
      forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Encode TT" forall a b. (a -> b) -> a -> b
$ do
        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
        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
        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
      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
      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
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Sparse tests" forall a b. (a -> b) -> a -> b
$ do
      forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
"a0" Trip M M
dualM M
a0
      forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
"a1" Trip M M
dualM M
a1
      forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
"a2" Trip M M
dualM M
a2
      forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
"a3" Trip M M
dualM M
a3
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Virtual Cosntructor tests" forall a b. (a -> b) -> a -> b
$ do
      forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
"a0v" Trip M M
dualMvirtual M
a0
      forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
"a1v" Trip M M
dualMvirtual M
a1
      forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
"a2v" Trip M M
dualMvirtual M
a2
      forall t.
(HasCallStack, Show t, Eq t, Typeable t) =>
String -> Trip t t -> t -> Spec
roundTripSpec String
"a3v" Trip M M
dualMvirtual M
a3
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Sum tests" forall a b. (a -> b) -> a -> b
$ do
      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)
      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)
      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")))