{-# LANGUAGE CPP                       #-}
{-# LANGUAGE ConstrainedClassMethods   #-}
{-# LANGUAGE DeriveFunctor             #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE LambdaCase                #-}
{-# LANGUAGE MultiWayIf                #-}
{-# LANGUAGE NumDecimals               #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE Rank2Types                #-}
{-# LANGUAGE ScopedTypeVariables       #-}
{-# LANGUAGE TypeApplications          #-}

module Cardano.Binary.ToCBOR
  ( ToCBOR(..)
  , withWordSize
  , module E
  , toCBORMaybe

    -- * Size of expressions
  , Range(..)
  , szEval
  , Size
  , Case(..)
  , caseValue
  , LengthOf(..)
  , SizeOverride(..)
  , isTodo
  , szCases
  , szLazy
  , szGreedy
  , szForce
  , szWithCtx
  , szSimplify
  , apMono
  , szBounds
  )
where

import Prelude hiding ((.))

import Codec.CBOR.Encoding as E
import Codec.CBOR.ByteArray.Sliced as BAS
import Control.Category (Category((.)))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BS.Lazy
import qualified Data.ByteString.Short as SBS
import Data.ByteString.Short.Internal (ShortByteString (SBS))
import qualified Data.Primitive.ByteArray as Prim
import Data.Fixed (E12, Fixed(..), Nano, Pico, resolution)
#if MIN_VERSION_recursion_schemes(5,2,0)
import Data.Fix ( Fix(..) )
#else
import Data.Functor.Foldable (Fix(..))
#endif
import Data.Foldable (toList)
import Data.Functor.Foldable (cata, project)
import Data.Int (Int32, Int64)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Map as M
import Data.Ratio ( Ratio, denominator, numerator )
import qualified Data.Set as S
import Data.Tagged (Tagged(..))
import qualified Data.Text as Text
import Data.Text (Text)
import Data.Text.Lazy.Builder (Builder)
import Data.Time.Calendar.OrdinalDate ( toOrdinalDate )
import Data.Time.Clock (NominalDiffTime, UTCTime(..), diffTimeToPicoseconds)
import Data.Typeable ( Typeable, typeRep, TypeRep, Proxy(..) )
import qualified Data.Vector as Vector
import qualified Data.Vector.Generic as Vector.Generic
import Data.Void (Void, absurd)
import Data.Word ( Word8, Word16, Word32, Word64 )
import Foreign.Storable (sizeOf)
import Formatting (bprint, build, shown, stext)
import qualified Formatting.Buildable as B (Buildable(..))
import Numeric.Natural (Natural)

class Typeable a => ToCBOR a where
  toCBOR :: a -> Encoding

  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
  encodedSizeExpr = forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
todo

  encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size
  encodedListSizeExpr = forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size
defaultEncodedListSizeExpr

-- | A type used to represent the length of a value in 'Size' computations.
newtype LengthOf xs = LengthOf xs

instance Typeable xs => ToCBOR (LengthOf xs) where
  toCBOR :: LengthOf xs -> Encoding
toCBOR = forall a. HasCallStack => [Char] -> a
error [Char]
"The `LengthOf` type cannot be encoded!"

-- | Default size expression for a list type.
defaultEncodedListSizeExpr
  :: forall a
   . ToCBOR a
  => (forall t . ToCBOR t => Proxy t -> Size)
  -> Proxy [a]
  -> Size
defaultEncodedListSizeExpr :: forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size
defaultEncodedListSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy [a]
_ =
  Size
2 forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @(LengthOf [a])) forall a. Num a => a -> a -> a
* forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @a)


--------------------------------------------------------------------------------
-- Size expressions
--------------------------------------------------------------------------------

(.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d)
c -> d
f .: :: forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: a -> b -> c
g = \a
x b
y -> c -> d
f (a -> b -> c
g a
x b
y)

-- | Expressions describing the statically-computed size bounds on
--   a type's possible values.
type Size = Fix SizeF

-- | The base functor for @Size@ expressions.
data SizeF t
  = AddF t t
  -- ^ Sum of two sizes.
  | MulF t t
  -- ^ Product of two sizes.
  | SubF t t
  -- ^ Difference of two sizes.
  | AbsF t
  -- ^ Absolute value of a size.
  | NegF t
  -- ^ Negation of a size.
  | SgnF t
  -- ^ Signum of a size.
  | CasesF [Case t]
  -- ^ Case-selection for sizes. Used for sum types.
  | ValueF Natural
  -- ^ A constant value.
  | ApF Text (Natural -> Natural) t
  -- ^ Application of a monotonic function to a size.
  | forall a. ToCBOR a => TodoF (forall x. ToCBOR x => Proxy x -> Size) (Proxy a)
  -- ^ A suspended size calculation ("thunk"). This is used to delay the
  --   computation of a size until some later point, which is useful for
  --   progressively building more detailed size estimates for a type
  --   from the outside in. For example, `szLazy` can be followed by
  --   applications of `szForce` to reveal more detailed expressions
  --   describing the size bounds on a type.

instance Functor SizeF where
  fmap :: forall a b. (a -> b) -> SizeF a -> SizeF b
fmap a -> b
f = \case
    AddF a
x a
y  -> forall t. t -> t -> SizeF t
AddF (a -> b
f a
x) (a -> b
f a
y)
    MulF a
x a
y  -> forall t. t -> t -> SizeF t
MulF (a -> b
f a
x) (a -> b
f a
y)
    SubF a
x a
y  -> forall t. t -> t -> SizeF t
SubF (a -> b
f a
x) (a -> b
f a
y)
    AbsF   a
x  -> forall t. t -> SizeF t
AbsF (a -> b
f a
x)
    NegF   a
x  -> forall t. t -> SizeF t
NegF (a -> b
f a
x)
    SgnF   a
x  -> forall t. t -> SizeF t
SgnF (a -> b
f a
x)
    CasesF [Case a]
xs -> forall t. [Case t] -> SizeF t
CasesF (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Case a]
xs)
    ValueF Natural
x  -> forall t. Natural -> SizeF t
ValueF Natural
x
    ApF Text
n Natural -> Natural
g a
x -> forall t. Text -> (Natural -> Natural) -> t -> SizeF t
ApF Text
n Natural -> Natural
g (a -> b
f a
x)
    TodoF forall t. ToCBOR t => Proxy t -> Size
g Proxy a
x -> forall t a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> SizeF t
TodoF forall t. ToCBOR t => Proxy t -> Size
g Proxy a
x

instance Num (Fix SizeF) where
  + :: Size -> Size -> Size
(+) = forall (f :: * -> *). f (Fix f) -> Fix f
Fix forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall t. t -> t -> SizeF t
AddF
  * :: Size -> Size -> Size
(*) = forall (f :: * -> *). f (Fix f) -> Fix f
Fix forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall t. t -> t -> SizeF t
MulF
  (-) = forall (f :: * -> *). f (Fix f) -> Fix f
Fix forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall t. t -> t -> SizeF t
SubF
  negate :: Size -> Size
negate = forall (f :: * -> *). f (Fix f) -> Fix f
Fix forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall t. t -> SizeF t
NegF
  abs :: Size -> Size
abs = forall (f :: * -> *). f (Fix f) -> Fix f
Fix forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall t. t -> SizeF t
AbsF
  signum :: Size -> Size
signum = forall (f :: * -> *). f (Fix f) -> Fix f
Fix forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall t. t -> SizeF t
SgnF
  fromInteger :: Integer -> Size
fromInteger = forall (f :: * -> *). f (Fix f) -> Fix f
Fix forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall t. Natural -> SizeF t
ValueF forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Num a => Integer -> a
fromInteger

instance B.Buildable t => B.Buildable (SizeF t) where
  build :: SizeF t -> Builder
build SizeF t
x_
    = let
        showp2 :: (B.Buildable a, B.Buildable b) => a -> Text -> b -> Builder
        showp2 :: forall a b. (Buildable a, Buildable b) => a -> Text -> b -> Builder
showp2 = forall a. Format Builder a -> a
bprint (Format (a -> Text -> b -> Builder) (a -> Text -> b -> Builder)
"(" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Text -> b -> Builder) (Text -> b -> Builder)
" " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall r. Format r (Text -> r)
stext forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (b -> Builder) (b -> Builder)
" " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder Builder
")")
      in
        case SizeF t
x_ of
          AddF t
x t
y -> forall a b. (Buildable a, Buildable b) => a -> Text -> b -> Builder
showp2 t
x Text
"+" t
y
          MulF t
x t
y -> forall a b. (Buildable a, Buildable b) => a -> Text -> b -> Builder
showp2 t
x Text
"*" t
y
          SubF t
x t
y -> forall a b. (Buildable a, Buildable b) => a -> Text -> b -> Builder
showp2 t
x Text
"-" t
y
          NegF t
x   -> forall a. Format Builder a -> a
bprint (Format (t -> Builder) (t -> Builder)
"-" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build) t
x
          AbsF t
x   -> forall a. Format Builder a -> a
bprint (Format (t -> Builder) (t -> Builder)
"|" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder Builder
"|") t
x
          SgnF t
x   -> forall a. Format Builder a -> a
bprint (Format (t -> Builder) (t -> Builder)
"sgn(" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder Builder
")") t
x
          CasesF [Case t]
xs ->
            forall a. Format Builder a -> a
bprint (Format (Builder -> Builder) (Builder -> Builder)
"{ " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder Builder
"}") forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. Format Builder a -> a
bprint (forall a r. Buildable a => Format r (a -> r)
build forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder Builder
" ")) [Case t]
xs
          ValueF Natural
x  -> forall a. Format Builder a -> a
bprint forall a r. Show a => Format r (a -> r)
shown (forall a. Integral a => a -> Integer
toInteger Natural
x)
          ApF Text
n Natural -> Natural
_ t
x -> forall a. Format Builder a -> a
bprint (forall r. Format r (Text -> r)
stext forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (t -> Builder) (t -> Builder)
"(" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder Builder
")") Text
n t
x
          TodoF forall t. ToCBOR t => Proxy t -> Size
_ Proxy a
x -> forall a. Format Builder a -> a
bprint (Format (TypeRep -> Builder) (TypeRep -> Builder)
"(_ :: " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Show a => Format r (a -> r)
shown forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder Builder
")") (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
x)

instance B.Buildable (Fix SizeF) where
  build :: Size -> Builder
build Size
x = forall a. Format Builder a -> a
bprint forall a r. Buildable a => Format r (a -> r)
build (forall t. Recursive t => t -> Base t t
project @(Fix _) Size
x)

-- | Create a case expression from individual cases.
szCases :: [Case Size] -> Size
szCases :: [Case Size] -> Size
szCases = forall (f :: * -> *). f (Fix f) -> Fix f
Fix forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall t. [Case t] -> SizeF t
CasesF

-- | An individual labeled case.
data Case t =
  Case Text t
  deriving (forall a b. a -> Case b -> Case a
forall a b. (a -> b) -> Case a -> Case b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Case b -> Case a
$c<$ :: forall a b. a -> Case b -> Case a
fmap :: forall a b. (a -> b) -> Case a -> Case b
$cfmap :: forall a b. (a -> b) -> Case a -> Case b
Functor)

-- | Discard the label on a case.
caseValue :: Case t -> t
caseValue :: forall t. Case t -> t
caseValue (Case Text
_ t
x) = t
x

instance B.Buildable t => B.Buildable (Case t) where
  build :: Case t -> Builder
build (Case Text
n t
x) = forall a. Format Builder a -> a
bprint (forall r. Format r (Text -> r)
stext forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (t -> Builder) (t -> Builder)
"=" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build) Text
n t
x

-- | A range of values. Should satisfy the invariant @forall x. lo x <= hi x@.
data Range b = Range
  { forall b. Range b -> b
lo :: b
  , forall b. Range b -> b
hi :: b
  }

-- | The @Num@ instance for @Range@ uses interval arithmetic. Note that the
--   @signum@ method is not lawful: if the interval @x@ includes 0 in its
--   interior but is not symmetric about 0, then @abs x * signum x /= x@.
instance (Ord b, Num b) => Num (Range b) where
  Range b
x + :: Range b -> Range b -> Range b
+ Range b
y = Range {lo :: b
lo = forall b. Range b -> b
lo Range b
x forall a. Num a => a -> a -> a
+ forall b. Range b -> b
lo Range b
y, hi :: b
hi = forall b. Range b -> b
hi Range b
x forall a. Num a => a -> a -> a
+ forall b. Range b -> b
hi Range b
y}
  Range b
x * :: Range b -> Range b -> Range b
* Range b
y =
    let products :: [b]
products = [ b
u forall a. Num a => a -> a -> a
* b
v | b
u <- [forall b. Range b -> b
lo Range b
x, forall b. Range b -> b
hi Range b
x], b
v <- [forall b. Range b -> b
lo Range b
y, forall b. Range b -> b
hi Range b
y] ]
    in Range {lo :: b
lo = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [b]
products, hi :: b
hi = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [b]
products}
  Range b
x - :: Range b -> Range b -> Range b
- Range b
y = Range {lo :: b
lo = forall b. Range b -> b
lo Range b
x forall a. Num a => a -> a -> a
- forall b. Range b -> b
hi Range b
y, hi :: b
hi = forall b. Range b -> b
hi Range b
x forall a. Num a => a -> a -> a
- forall b. Range b -> b
lo Range b
y}
  negate :: Range b -> Range b
negate Range b
x = Range {lo :: b
lo = forall a. Num a => a -> a
negate (forall b. Range b -> b
hi Range b
x), hi :: b
hi = forall a. Num a => a -> a
negate (forall b. Range b -> b
lo Range b
x)}
  abs :: Range b -> Range b
abs Range b
x = if
    | forall b. Range b -> b
lo Range b
x forall a. Ord a => a -> a -> Bool
<= b
0 Bool -> Bool -> Bool
&& forall b. Range b -> b
hi Range b
x forall a. Ord a => a -> a -> Bool
>= b
0 -> Range {lo :: b
lo = b
0, hi :: b
hi = forall a. Ord a => a -> a -> a
max (forall b. Range b -> b
hi Range b
x) (forall a. Num a => a -> a
negate forall a b. (a -> b) -> a -> b
$ forall b. Range b -> b
lo Range b
x)}
    | forall b. Range b -> b
lo Range b
x forall a. Ord a => a -> a -> Bool
<= b
0 Bool -> Bool -> Bool
&& forall b. Range b -> b
hi Range b
x forall a. Ord a => a -> a -> Bool
<= b
0 -> Range {lo :: b
lo = forall a. Num a => a -> a
negate (forall b. Range b -> b
hi Range b
x), hi :: b
hi = forall a. Num a => a -> a
negate (forall b. Range b -> b
lo Range b
x)}
    | Bool
otherwise              -> Range b
x
  signum :: Range b -> Range b
signum Range b
x = Range {lo :: b
lo = forall a. Num a => a -> a
signum (forall b. Range b -> b
lo Range b
x), hi :: b
hi = forall a. Num a => a -> a
signum (forall b. Range b -> b
hi Range b
x)}
  fromInteger :: Integer -> Range b
fromInteger Integer
n = Range {lo :: b
lo = forall a. Num a => Integer -> a
fromInteger Integer
n, hi :: b
hi = forall a. Num a => Integer -> a
fromInteger Integer
n}

instance B.Buildable (Range Natural) where
  build :: Range Natural -> Builder
build Range Natural
r = forall a. Format Builder a -> a
bprint (forall a r. Show a => Format r (a -> r)
shown forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Integer -> Builder) (Integer -> Builder)
".." forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Show a => Format r (a -> r)
shown) (forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ forall b. Range b -> b
lo Range Natural
r) (forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ forall b. Range b -> b
hi Range Natural
r)

-- | Fully evaluate a size expression by applying the given function to any
--   suspended computations. @szEval g@ effectively turns each "thunk"
--   of the form @TodoF f x@ into @g x@, then evaluates the result.
szEval
  :: (forall t . ToCBOR t => (Proxy t -> Size) -> Proxy t -> Range Natural)
  -> Size
  -> Range Natural
szEval :: (forall t.
 ToCBOR t =>
 (Proxy t -> Size) -> Proxy t -> Range Natural)
-> Size -> Range Natural
szEval forall t. ToCBOR t => (Proxy t -> Size) -> Proxy t -> Range Natural
doit = forall t a. Recursive t => (Base t a -> a) -> t -> a
cata forall a b. (a -> b) -> a -> b
$ \case
  AddF Range Natural
x Range Natural
y  -> Range Natural
x forall a. Num a => a -> a -> a
+ Range Natural
y
  MulF Range Natural
x Range Natural
y  -> Range Natural
x forall a. Num a => a -> a -> a
* Range Natural
y
  SubF Range Natural
x Range Natural
y  -> Range Natural
x forall a. Num a => a -> a -> a
- Range Natural
y
  NegF   Range Natural
x  -> forall a. Num a => a -> a
negate Range Natural
x
  AbsF   Range Natural
x  -> forall a. Num a => a -> a
abs Range Natural
x
  SgnF   Range Natural
x  -> forall a. Num a => a -> a
signum Range Natural
x
  CasesF [Case (Range Natural)]
xs -> Range
    { lo :: Natural
lo = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (forall a b. (a -> b) -> [a] -> [b]
map (forall b. Range b -> b
lo forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall t. Case t -> t
caseValue) [Case (Range Natural)]
xs)
    , hi :: Natural
hi = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map (forall b. Range b -> b
hi forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall t. Case t -> t
caseValue) [Case (Range Natural)]
xs)
    }
  ValueF Natural
x  -> Range {lo :: Natural
lo = Natural
x, hi :: Natural
hi = Natural
x}
  ApF Text
_ Natural -> Natural
f Range Natural
x -> Range {lo :: Natural
lo = Natural -> Natural
f (forall b. Range b -> b
lo Range Natural
x), hi :: Natural
hi = Natural -> Natural
f (forall b. Range b -> b
hi Range Natural
x)}
  TodoF forall t. ToCBOR t => Proxy t -> Size
f Proxy a
x -> forall t. ToCBOR t => (Proxy t -> Size) -> Proxy t -> Range Natural
doit forall t. ToCBOR t => Proxy t -> Size
f Proxy a
x

{-| Evaluate the expression lazily, by immediately creating a thunk
    that will evaluate its contents lazily.

> ghci> putStrLn $ pretty $ szLazy (Proxy @TxAux)
> (_ :: TxAux)
-}
szLazy :: ToCBOR a => (Proxy a -> Size)
szLazy :: forall t. ToCBOR t => Proxy t -> Size
szLazy = forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
todo (forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
szLazy)

{-| Evaluate an expression greedily. There may still be thunks in the
    result, for types that did not provide a custom 'encodedSizeExpr' method
    in their 'ToCBOR' instance.

> ghci> putStrLn $ pretty $ szGreedy (Proxy @TxAux)
> (0 + { TxAux=(2 + ((0 + (((1 + (2 + ((_ :: LengthOf [TxIn]) * (2 + { TxInUtxo=(2 + ((1 + 34) + { minBound=1 maxBound=5 })) })))) + (2 + ((_ :: LengthOf [TxOut]) * (0 + { TxOut=(2 + ((0 + ((2 + ((2 + withWordSize((((1 + 30) + (_ :: Attributes AddrAttributes)) + 1))) + (((1 + 30) + (_ :: Attributes AddrAttributes)) + 1))) + { minBound=1 maxBound=5 })) + { minBound=1 maxBound=9 })) })))) + (_ :: Attributes ()))) + (_ :: Vector TxInWitness))) })

-}
szGreedy :: ToCBOR a => (Proxy a -> Size)
szGreedy :: forall t. ToCBOR t => Proxy t -> Size
szGreedy = forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
szGreedy

-- | Is this expression a thunk?
isTodo :: Size -> Bool
isTodo :: Size -> Bool
isTodo (Fix (TodoF forall t. ToCBOR t => Proxy t -> Size
_ Proxy a
_)) = Bool
True
isTodo Size
_                 = Bool
False

-- | Create a "thunk" that will apply @f@ to @pxy@ when forced.
todo
  :: forall a
   . ToCBOR a
  => (forall t . ToCBOR t => Proxy t -> Size)
  -> Proxy a
  -> Size
todo :: forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
todo forall t. ToCBOR t => Proxy t -> Size
f Proxy a
pxy = forall (f :: * -> *). f (Fix f) -> Fix f
Fix (forall t a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> SizeF t
TodoF forall t. ToCBOR t => Proxy t -> Size
f Proxy a
pxy)

-- | Apply a monotonically increasing function to the expression.
--   There are three cases when applying @f@ to a @Size@ expression:
--      * When applied to a value @x@, compute @f x@.
--      * When applied to cases, apply to each case individually.
--      * In all other cases, create a deferred application of @f@.
apMono :: Text -> (Natural -> Natural) -> Size -> Size
apMono :: Text -> (Natural -> Natural) -> Size -> Size
apMono Text
n Natural -> Natural
f = \case
  Fix (ValueF Natural
x ) -> forall (f :: * -> *). f (Fix f) -> Fix f
Fix (forall t. Natural -> SizeF t
ValueF (Natural -> Natural
f Natural
x))
  Fix (CasesF [Case Size]
cs) -> forall (f :: * -> *). f (Fix f) -> Fix f
Fix (forall t. [Case t] -> SizeF t
CasesF (forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> (Natural -> Natural) -> Size -> Size
apMono Text
n Natural -> Natural
f)) [Case Size]
cs))
  Size
x               -> forall (f :: * -> *). f (Fix f) -> Fix f
Fix (forall t. Text -> (Natural -> Natural) -> t -> SizeF t
ApF Text
n Natural -> Natural
f Size
x)

-- | Greedily compute the size bounds for a type, using the given context to
--   override sizes for specific types.
szWithCtx :: (ToCBOR a) => M.Map TypeRep SizeOverride -> Proxy a -> Size
szWithCtx :: forall a. ToCBOR a => Map TypeRep SizeOverride -> Proxy a -> Size
szWithCtx Map TypeRep SizeOverride
ctx Proxy a
pxy = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
pxy) Map TypeRep SizeOverride
ctx of
  Maybe SizeOverride
Nothing       -> Size
normal
  Just SizeOverride
override -> case SizeOverride
override of
    SizeConstant   Size
sz    -> Size
sz
    SizeExpression (forall t. ToCBOR t => Proxy t -> Size) -> Size
f     -> (forall t. ToCBOR t => Proxy t -> Size) -> Size
f (forall a. ToCBOR a => Map TypeRep SizeOverride -> Proxy a -> Size
szWithCtx Map TypeRep SizeOverride
ctx)
    SelectCases    [Text]
names -> forall t a. Recursive t => (Base t a -> a) -> t -> a
cata ([Text] -> SizeF Size -> Size
selectCase [Text]
names) Size
normal
 where
  -- The non-override case
  normal :: Size
normal = forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr (forall a. ToCBOR a => Map TypeRep SizeOverride -> Proxy a -> Size
szWithCtx Map TypeRep SizeOverride
ctx) Proxy a
pxy

  selectCase :: [Text] -> SizeF Size -> Size
  selectCase :: [Text] -> SizeF Size -> Size
selectCase [Text]
names SizeF Size
orig = case SizeF Size
orig of
    CasesF [Case Size]
cs -> [Text] -> [Case Size] -> Size -> Size
matchCase [Text]
names [Case Size]
cs (forall (f :: * -> *). f (Fix f) -> Fix f
Fix SizeF Size
orig)
    SizeF Size
_         -> forall (f :: * -> *). f (Fix f) -> Fix f
Fix SizeF Size
orig

  matchCase :: [Text] -> [Case Size] -> Size -> Size
  matchCase :: [Text] -> [Case Size] -> Size -> Size
matchCase [Text]
names [Case Size]
cs Size
orig =
    case forall a. (a -> Bool) -> [a] -> [a]
filter (\(Case Text
name Size
_) -> Text
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
names) [Case Size]
cs of
      []         -> Size
orig
      [Case Text
_ Size
x] -> Size
x
      [Case Size]
cs'        -> forall (f :: * -> *). f (Fix f) -> Fix f
Fix (forall t. [Case t] -> SizeF t
CasesF [Case Size]
cs')

-- | Override mechanisms to be used with 'szWithCtx'.
data SizeOverride
  = SizeConstant Size
  -- ^ Replace with a fixed @Size@.
  | SizeExpression ((forall a. ToCBOR a => Proxy a -> Size) -> Size)
  -- ^ Recursively compute the size.
  | SelectCases [Text]
  -- ^ Select only a specific case from a @CasesF@.

-- | Simplify the given @Size@, resulting in either the simplified @Size@ or,
--   if it was fully simplified, an explicit upper and lower bound.
szSimplify :: Size -> Either Size (Range Natural)
szSimplify :: Size -> Either Size (Range Natural)
szSimplify = forall t a. Recursive t => (Base t a -> a) -> t -> a
cata forall a b. (a -> b) -> a -> b
$ \case
  TodoF forall t. ToCBOR t => Proxy t -> Size
f Proxy a
pxy -> forall a b. a -> Either a b
Left (forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
todo forall t. ToCBOR t => Proxy t -> Size
f Proxy a
pxy)
  ValueF Natural
x    -> forall a b. b -> Either a b
Right (Range {lo :: Natural
lo = Natural
x, hi :: Natural
hi = Natural
x})
  CasesF [Case (Either Size (Range Natural))]
xs   -> case forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall t. Case t -> t
caseValue [Case (Either Size (Range Natural))]
xs of
    Right [Range Natural]
xs' ->
      forall a b. b -> Either a b
Right (Range {lo :: Natural
lo = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (forall a b. (a -> b) -> [a] -> [b]
map forall b. Range b -> b
lo [Range Natural]
xs'), hi :: Natural
hi = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map forall b. Range b -> b
hi [Range Natural]
xs')})
    Left Size
_ -> forall a b. a -> Either a b
Left ([Case Size] -> Size
szCases forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either Size (Range Natural) -> Size
toSize) [Case (Either Size (Range Natural))]
xs)
  AddF Either Size (Range Natural)
x Either Size (Range Natural)
y          -> (forall a. Num a => a -> a -> a)
-> Either Size (Range Natural)
-> Either Size (Range Natural)
-> Either Size (Range Natural)
binOp forall a. Num a => a -> a -> a
(+) Either Size (Range Natural)
x Either Size (Range Natural)
y
  MulF Either Size (Range Natural)
x Either Size (Range Natural)
y          -> (forall a. Num a => a -> a -> a)
-> Either Size (Range Natural)
-> Either Size (Range Natural)
-> Either Size (Range Natural)
binOp forall a. Num a => a -> a -> a
(*) Either Size (Range Natural)
x Either Size (Range Natural)
y
  SubF Either Size (Range Natural)
x Either Size (Range Natural)
y          -> (forall a. Num a => a -> a -> a)
-> Either Size (Range Natural)
-> Either Size (Range Natural)
-> Either Size (Range Natural)
binOp (-) Either Size (Range Natural)
x Either Size (Range Natural)
y
  NegF Either Size (Range Natural)
x            -> (forall a. Num a => a -> a)
-> Either Size (Range Natural) -> Either Size (Range Natural)
unOp forall a. Num a => a -> a
negate Either Size (Range Natural)
x
  AbsF Either Size (Range Natural)
x            -> (forall a. Num a => a -> a)
-> Either Size (Range Natural) -> Either Size (Range Natural)
unOp forall a. Num a => a -> a
abs Either Size (Range Natural)
x
  SgnF Either Size (Range Natural)
x            -> (forall a. Num a => a -> a)
-> Either Size (Range Natural) -> Either Size (Range Natural)
unOp forall a. Num a => a -> a
signum Either Size (Range Natural)
x
  ApF Text
_ Natural -> Natural
f (Right Range Natural
x) -> forall a b. b -> Either a b
Right (Range {lo :: Natural
lo = Natural -> Natural
f (forall b. Range b -> b
lo Range Natural
x), hi :: Natural
hi = Natural -> Natural
f (forall b. Range b -> b
hi Range Natural
x)})
  ApF Text
n Natural -> Natural
f (Left  Size
x) -> forall a b. a -> Either a b
Left (Text -> (Natural -> Natural) -> Size -> Size
apMono Text
n Natural -> Natural
f Size
x)
 where
  binOp
    :: (forall a . Num a => a -> a -> a)
    -> Either Size (Range Natural)
    -> Either Size (Range Natural)
    -> Either Size (Range Natural)
  binOp :: (forall a. Num a => a -> a -> a)
-> Either Size (Range Natural)
-> Either Size (Range Natural)
-> Either Size (Range Natural)
binOp forall a. Num a => a -> a -> a
op (Right Range Natural
x) (Right Range Natural
y) = forall a b. b -> Either a b
Right (forall a. Num a => a -> a -> a
op Range Natural
x Range Natural
y)
  binOp forall a. Num a => a -> a -> a
op Either Size (Range Natural)
x         Either Size (Range Natural)
y         = forall a b. a -> Either a b
Left (forall a. Num a => a -> a -> a
op (Either Size (Range Natural) -> Size
toSize Either Size (Range Natural)
x) (Either Size (Range Natural) -> Size
toSize Either Size (Range Natural)
y))

  unOp
    :: (forall a . Num a => a -> a)
    -> Either Size (Range Natural)
    -> Either Size (Range Natural)
  unOp :: (forall a. Num a => a -> a)
-> Either Size (Range Natural) -> Either Size (Range Natural)
unOp forall a. Num a => a -> a
f = \case
    Right Range Natural
x -> forall a b. b -> Either a b
Right (forall a. Num a => a -> a
f Range Natural
x)
    Left  Size
x -> forall a b. a -> Either a b
Left (forall a. Num a => a -> a
f Size
x)

  toSize :: Either Size (Range Natural) -> Size
  toSize :: Either Size (Range Natural) -> Size
toSize = \case
    Left  Size
x -> Size
x
    Right Range Natural
r -> if forall b. Range b -> b
lo Range Natural
r forall a. Eq a => a -> a -> Bool
== forall b. Range b -> b
hi Range Natural
r
      then forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall b. Range b -> b
lo Range Natural
r)
      else [Case Size] -> Size
szCases
        [forall t. Text -> t -> Case t
Case Text
"lo" (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall b. Range b -> b
lo Range Natural
r), forall t. Text -> t -> Case t
Case Text
"hi" (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall b. Range b -> b
hi Range Natural
r)]

-- | Force any thunks in the given @Size@ expression.
--
-- > ghci> putStrLn $ pretty $ szForce $ szLazy (Proxy @TxAux)
-- > (0 + { TxAux=(2 + ((0 + (_ :: Tx)) + (_ :: Vector TxInWitness))) })
szForce :: Size -> Size
szForce :: Size -> Size
szForce = forall t a. Recursive t => (Base t a -> a) -> t -> a
cata forall a b. (a -> b) -> a -> b
$ \case
  AddF Size
x Size
y  -> Size
x forall a. Num a => a -> a -> a
+ Size
y
  MulF Size
x Size
y  -> Size
x forall a. Num a => a -> a -> a
* Size
y
  SubF Size
x Size
y  -> Size
x forall a. Num a => a -> a -> a
- Size
y
  NegF   Size
x  -> forall a. Num a => a -> a
negate Size
x
  AbsF   Size
x  -> forall a. Num a => a -> a
abs Size
x
  SgnF   Size
x  -> forall a. Num a => a -> a
signum Size
x
  CasesF [Case Size]
xs -> forall (f :: * -> *). f (Fix f) -> Fix f
Fix forall a b. (a -> b) -> a -> b
$ forall t. [Case t] -> SizeF t
CasesF [Case Size]
xs
  ValueF Natural
x  -> forall (f :: * -> *). f (Fix f) -> Fix f
Fix (forall t. Natural -> SizeF t
ValueF Natural
x)
  ApF Text
n Natural -> Natural
f Size
x -> Text -> (Natural -> Natural) -> Size -> Size
apMono Text
n Natural -> Natural
f Size
x
  TodoF forall t. ToCBOR t => Proxy t -> Size
f Proxy a
x -> forall t. ToCBOR t => Proxy t -> Size
f Proxy a
x

szBounds :: ToCBOR a => a -> Either Size (Range Natural)
szBounds :: forall a. ToCBOR a => a -> Either Size (Range Natural)
szBounds = Size -> Either Size (Range Natural)
szSimplify forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall t. ToCBOR t => Proxy t -> Size
szGreedy forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Compute encoded size of an integer
withWordSize :: (Integral s, Integral a) => s -> a
withWordSize :: forall s a. (Integral s, Integral a) => s -> a
withWordSize s
x =
  let s :: Integer
s = forall a b. (Integral a, Num b) => a -> b
fromIntegral s
x :: Integer
  in
    if
      | Integer
s forall a. Ord a => a -> a -> Bool
<= Integer
0x17 Bool -> Bool -> Bool
&& Integer
s forall a. Ord a => a -> a -> Bool
>= (-Integer
0x18)              -> a
1
      | Integer
s forall a. Ord a => a -> a -> Bool
<= Integer
0xff Bool -> Bool -> Bool
&& Integer
s forall a. Ord a => a -> a -> Bool
>= (-Integer
0x100)             -> a
2
      | Integer
s forall a. Ord a => a -> a -> Bool
<= Integer
0xffff Bool -> Bool -> Bool
&& Integer
s forall a. Ord a => a -> a -> Bool
>= (-Integer
0x10000)         -> a
3
      | Integer
s forall a. Ord a => a -> a -> Bool
<= Integer
0xffffffff Bool -> Bool -> Bool
&& Integer
s forall a. Ord a => a -> a -> Bool
>= (-Integer
0x100000000) -> a
5
      | Bool
otherwise                              -> a
9


--------------------------------------------------------------------------------
-- Primitive types
--------------------------------------------------------------------------------

instance ToCBOR () where
  toCBOR :: () -> Encoding
toCBOR = forall a b. a -> b -> a
const Encoding
E.encodeNull
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy () -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ Proxy ()
_ = Size
1

instance ToCBOR Bool where
  toCBOR :: Bool -> Encoding
toCBOR = Bool -> Encoding
E.encodeBool
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Bool -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ Proxy Bool
_ = Size
1


--------------------------------------------------------------------------------
-- Numeric data
--------------------------------------------------------------------------------

instance ToCBOR Integer where
  toCBOR :: Integer -> Encoding
toCBOR = Integer -> Encoding
E.encodeInteger

encodedSizeRange :: forall a . (Integral a, Bounded a) => Proxy a -> Size
encodedSizeRange :: forall a. (Integral a, Bounded a) => Proxy a -> Size
encodedSizeRange Proxy a
_ = [Case Size] -> Size
szCases
  [ Text -> a -> Case Size
mkCase Text
"minBound" a
0 -- min, in absolute value
  , Text -> a -> Case Size
mkCase Text
"maxBound" forall a. Bounded a => a
maxBound
  ]
 where
  mkCase :: Text -> a -> Case Size
  mkCase :: Text -> a -> Case Size
mkCase Text
n a
x = forall t. Text -> t -> Case t
Case Text
n (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (forall s a. (Integral s, Integral a) => s -> a
withWordSize :: a -> Integer) a
x)

instance ToCBOR Word where
  toCBOR :: Word -> Encoding
toCBOR = Word -> Encoding
E.encodeWord
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Word -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ = forall a. (Integral a, Bounded a) => Proxy a -> Size
encodedSizeRange

instance ToCBOR Word8 where
  toCBOR :: Word8 -> Encoding
toCBOR = Word8 -> Encoding
E.encodeWord8
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Word8 -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ = forall a. (Integral a, Bounded a) => Proxy a -> Size
encodedSizeRange

instance ToCBOR Word16 where
  toCBOR :: Word16 -> Encoding
toCBOR = Word16 -> Encoding
E.encodeWord16
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Word16 -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ = forall a. (Integral a, Bounded a) => Proxy a -> Size
encodedSizeRange

instance ToCBOR Word32 where
  toCBOR :: Word32 -> Encoding
toCBOR = Word32 -> Encoding
E.encodeWord32
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Word32 -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ = forall a. (Integral a, Bounded a) => Proxy a -> Size
encodedSizeRange

instance ToCBOR Word64 where
  toCBOR :: Word64 -> Encoding
toCBOR = Word64 -> Encoding
E.encodeWord64
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Word64 -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ = forall a. (Integral a, Bounded a) => Proxy a -> Size
encodedSizeRange

instance ToCBOR Int where
  toCBOR :: Int -> Encoding
toCBOR = Int -> Encoding
E.encodeInt
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Int -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ = forall a. (Integral a, Bounded a) => Proxy a -> Size
encodedSizeRange

instance ToCBOR Float where
  toCBOR :: Float -> Encoding
toCBOR = Float -> Encoding
E.encodeFloat
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Float -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ Proxy Float
_ = Size
1 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Storable a => a -> Int
sizeOf (Float
0 :: Float))

instance ToCBOR Int32 where
  toCBOR :: Int32 -> Encoding
toCBOR = Int32 -> Encoding
E.encodeInt32
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Int32 -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ = forall a. (Integral a, Bounded a) => Proxy a -> Size
encodedSizeRange

instance ToCBOR Int64 where
  toCBOR :: Int64 -> Encoding
toCBOR = Int64 -> Encoding
E.encodeInt64
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Int64 -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_ = forall a. (Integral a, Bounded a) => Proxy a -> Size
encodedSizeRange

instance ToCBOR a => ToCBOR (Ratio a) where
  toCBOR :: Ratio a -> Encoding
toCBOR Ratio a
r = Word -> Encoding
E.encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR (forall a. Ratio a -> a
numerator Ratio a
r) forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR (forall a. Ratio a -> a
denominator Ratio a
r)
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy (Ratio a) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy (Ratio a)
_ = Size
1 forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @a) forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @a)

instance ToCBOR Nano where
  toCBOR :: Nano -> Encoding
toCBOR (MkFixed Integer
nanoseconds) = forall a. ToCBOR a => a -> Encoding
toCBOR Integer
nanoseconds

instance ToCBOR Pico where
  toCBOR :: Pico -> Encoding
toCBOR (MkFixed Integer
picoseconds) = forall a. ToCBOR a => a -> Encoding
toCBOR Integer
picoseconds

-- | For backwards compatibility we round pico precision to micro
instance ToCBOR NominalDiffTime where
  toCBOR :: NominalDiffTime -> Encoding
toCBOR = forall a. ToCBOR a => a -> Encoding
toCBOR forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall a. Integral a => a -> a -> a
`div` Integer
1e6) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NominalDiffTime -> Integer
toPicoseconds
   where
    toPicoseconds :: NominalDiffTime -> Integer
    toPicoseconds :: NominalDiffTime -> Integer
toPicoseconds NominalDiffTime
t =
      forall a. Ratio a -> a
numerator (forall a. Real a => a -> Ratio Integer
toRational NominalDiffTime
t forall a. Num a => a -> a -> a
* forall a. Real a => a -> Ratio Integer
toRational (forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
resolution forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @E12))

instance ToCBOR Natural where
  toCBOR :: Natural -> Encoding
toCBOR = forall a. ToCBOR a => a -> Encoding
toCBOR forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Integral a => a -> Integer
toInteger

instance ToCBOR Void where
  toCBOR :: Void -> Encoding
toCBOR = forall a. Void -> a
absurd


--------------------------------------------------------------------------------
-- Tagged
--------------------------------------------------------------------------------

instance (Typeable s, ToCBOR a) => ToCBOR (Tagged s a) where
  toCBOR :: Tagged s a -> Encoding
toCBOR (Tagged a
a) = forall a. ToCBOR a => a -> Encoding
toCBOR a
a
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Tagged s a) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy (Tagged s a)
_ = forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @a)


--------------------------------------------------------------------------------
-- Containers
--------------------------------------------------------------------------------

instance (ToCBOR a, ToCBOR b) => ToCBOR (a,b) where
  toCBOR :: (a, b) -> Encoding
toCBOR (a
a, b
b) = Word -> Encoding
E.encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR a
a forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR b
b

  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy (a, b) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy (a, b)
_ = Size
1 forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @a) forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @b)

instance (ToCBOR a, ToCBOR b, ToCBOR c) => ToCBOR (a,b,c) where
  toCBOR :: (a, b, c) -> Encoding
toCBOR (a
a, b
b, c
c) = Word -> Encoding
E.encodeListLen Word
3 forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR a
a forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR b
b forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR c
c

  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy (a, b, c) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy (a, b, c)
_ =
    Size
1 forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @a) forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @b) forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @c)

instance (ToCBOR a, ToCBOR b, ToCBOR c, ToCBOR d) => ToCBOR (a,b,c,d) where
  toCBOR :: (a, b, c, d) -> Encoding
toCBOR (a
a, b
b, c
c, d
d) =
    Word -> Encoding
E.encodeListLen Word
4 forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR a
a forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR b
b forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR c
c forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR d
d

  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (a, b, c, d) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy (a, b, c, d)
_ =
    Size
1 forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @a) forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @b) forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @c) forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @d)

instance
  (ToCBOR a, ToCBOR b, ToCBOR c, ToCBOR d, ToCBOR e)
  => ToCBOR (a, b, c, d, e)
 where
  toCBOR :: (a, b, c, d, e) -> Encoding
toCBOR (a
a, b
b, c
c, d
d, e
e) =
    Word -> Encoding
E.encodeListLen Word
5
      forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR a
a
      forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR b
b
      forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR c
c
      forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR d
d
      forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR e
e

  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (a, b, c, d, e) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy (a, b, c, d, e)
_ =
    Size
1
      forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @a)
      forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @b)
      forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @c)
      forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @d)
      forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @e)

instance
  (ToCBOR a, ToCBOR b, ToCBOR c, ToCBOR d, ToCBOR e, ToCBOR f, ToCBOR g)
  => ToCBOR (a, b, c, d, e, f, g)
  where
  toCBOR :: (a, b, c, d, e, f, g) -> Encoding
toCBOR (a
a, b
b, c
c, d
d, e
e, f
f, g
g) =
    Word -> Encoding
E.encodeListLen Word
7
      forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR a
a
      forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR b
b
      forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR c
c
      forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR d
d
      forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR e
e
      forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR f
f
      forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR g
g

  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (a, b, c, d, e, f, g) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy (a, b, c, d, e, f, g)
_ =
    Size
1
    forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @a)
    forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @b)
    forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @c)
    forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @d)
    forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @e)
    forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @f)
    forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @g)

instance ToCBOR BS.ByteString where
  toCBOR :: ByteString -> Encoding
toCBOR = ByteString -> Encoding
E.encodeBytes
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy ByteString -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy ByteString
_ =
    let len :: Size
len = forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @(LengthOf BS.ByteString))
    in Text -> (Natural -> Natural) -> Size -> Size
apMono Text
"withWordSize@Int" (forall s a. (Integral s, Integral a) => s -> a
withWordSize @Int forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Size
len forall a. Num a => a -> a -> a
+ Size
len

instance ToCBOR Text.Text where
  toCBOR :: Text -> Encoding
toCBOR = Text -> Encoding
E.encodeString
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Text -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy Text
_ =
    let
      bsLength :: Size
bsLength = forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @(LengthOf Text))
        forall a. Num a => a -> a -> a
* [Case Size] -> Size
szCases [forall t. Text -> t -> Case t
Case Text
"minChar" Size
1, forall t. Text -> t -> Case t
Case Text
"maxChar" Size
4]
    in Size
bsLength forall a. Num a => a -> a -> a
+ Text -> (Natural -> Natural) -> Size -> Size
apMono Text
"withWordSize" forall s a. (Integral s, Integral a) => s -> a
withWordSize Size
bsLength

instance ToCBOR SBS.ShortByteString where
  toCBOR :: ShortByteString -> Encoding
toCBOR sbs :: ShortByteString
sbs@(SBS ByteArray#
ba) =
    SlicedByteArray -> Encoding
E.encodeByteArray forall a b. (a -> b) -> a -> b
$ ByteArray -> Int -> Int -> SlicedByteArray
BAS.SBA (ByteArray# -> ByteArray
Prim.ByteArray ByteArray#
ba) Int
0 (ShortByteString -> Int
SBS.length ShortByteString
sbs)

  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy ShortByteString -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy ShortByteString
_ =
    let len :: Size
len = forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @(LengthOf SBS.ShortByteString))
    in Text -> (Natural -> Natural) -> Size -> Size
apMono Text
"withWordSize@Int" (forall s a. (Integral s, Integral a) => s -> a
withWordSize @Int forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Size
len forall a. Num a => a -> a -> a
+ Size
len

instance ToCBOR BS.Lazy.ByteString where
  toCBOR :: ByteString -> Encoding
toCBOR = forall a. ToCBOR a => a -> Encoding
toCBOR forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
BS.Lazy.toStrict
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy ByteString -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy ByteString
_ =
    let len :: Size
len = forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @(LengthOf BS.Lazy.ByteString))
    in Text -> (Natural -> Natural) -> Size -> Size
apMono Text
"withWordSize@Int" (forall s a. (Integral s, Integral a) => s -> a
withWordSize @Int forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) Size
len forall a. Num a => a -> a -> a
+ Size
len

instance ToCBOR a => ToCBOR [a] where
  toCBOR :: [a] -> Encoding
toCBOR [a]
xs = Encoding
E.encodeListLenIndef forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x Encoding
r -> forall a. ToCBOR a => a -> Encoding
toCBOR a
x forall a. Semigroup a => a -> a -> a
<> Encoding
r) Encoding
E.encodeBreak [a]
xs
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy [a]
_ = forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size
encodedListSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @[a])

instance (ToCBOR a, ToCBOR b) => ToCBOR (Either a b) where
  toCBOR :: Either a b -> Encoding
toCBOR (Left  a
x) = Word -> Encoding
E.encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
E.encodeWord Word
0 forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR a
x
  toCBOR (Right b
x) = Word -> Encoding
E.encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
E.encodeWord Word
1 forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR b
x

  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Either a b) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy (Either a b)
_ = [Case Size] -> Size
szCases
    [forall t. Text -> t -> Case t
Case Text
"Left" (Size
2 forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @a)), forall t. Text -> t -> Case t
Case Text
"Right" (Size
2 forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @b))]

instance ToCBOR a => ToCBOR (NonEmpty a) where
  toCBOR :: NonEmpty a -> Encoding
toCBOR = forall a. ToCBOR a => a -> Encoding
toCBOR forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (NonEmpty a) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy (NonEmpty a)
_ = forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @[a]) -- MN TODO make 0 count impossible

instance ToCBOR a => ToCBOR (Maybe a) where
  toCBOR :: Maybe a -> Encoding
toCBOR = forall a. (a -> Encoding) -> Maybe a -> Encoding
toCBORMaybe forall a. ToCBOR a => a -> Encoding
toCBOR

  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy (Maybe a) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy (Maybe a)
_ =
    [Case Size] -> Size
szCases [forall t. Text -> t -> Case t
Case Text
"Nothing" Size
1, forall t. Text -> t -> Case t
Case Text
"Just" (Size
1 forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @a))]

toCBORMaybe :: (a -> Encoding) -> Maybe a -> Encoding
toCBORMaybe :: forall a. (a -> Encoding) -> Maybe a -> Encoding
toCBORMaybe a -> Encoding
encodeA = \case
  Maybe a
Nothing -> Word -> Encoding
E.encodeListLen Word
0
  Just a
x  -> Word -> Encoding
E.encodeListLen Word
1 forall a. Semigroup a => a -> a -> a
<> a -> Encoding
encodeA a
x

encodeContainerSkel
  :: (Word -> E.Encoding)
  -> (container -> Int)
  -> (accumFunc -> E.Encoding -> container -> E.Encoding)
  -> accumFunc
  -> container
  -> E.Encoding
encodeContainerSkel :: forall container accumFunc.
(Word -> Encoding)
-> (container -> Int)
-> (accumFunc -> Encoding -> container -> Encoding)
-> accumFunc
-> container
-> Encoding
encodeContainerSkel Word -> Encoding
encodeLen container -> Int
size accumFunc -> Encoding -> container -> Encoding
foldFunction accumFunc
f container
c =
  Word -> Encoding
encodeLen (forall a b. (Integral a, Num b) => a -> b
fromIntegral (container -> Int
size container
c)) forall a. Semigroup a => a -> a -> a
<> accumFunc -> Encoding -> container -> Encoding
foldFunction accumFunc
f forall a. Monoid a => a
mempty container
c
{-# INLINE encodeContainerSkel #-}

encodeMapSkel
  :: (ToCBOR k, ToCBOR v)
  => (m -> Int)
  -> ((k -> v -> E.Encoding -> E.Encoding) -> E.Encoding -> m -> E.Encoding)
  -> m
  -> E.Encoding
encodeMapSkel :: forall k v m.
(ToCBOR k, ToCBOR v) =>
(m -> Int)
-> ((k -> v -> Encoding -> Encoding) -> Encoding -> m -> Encoding)
-> m
-> Encoding
encodeMapSkel m -> Int
size (k -> v -> Encoding -> Encoding) -> Encoding -> m -> Encoding
foldrWithKey = forall container accumFunc.
(Word -> Encoding)
-> (container -> Int)
-> (accumFunc -> Encoding -> container -> Encoding)
-> accumFunc
-> container
-> Encoding
encodeContainerSkel
  Word -> Encoding
E.encodeMapLen
  m -> Int
size
  (k -> v -> Encoding -> Encoding) -> Encoding -> m -> Encoding
foldrWithKey
  (\k
k v
v Encoding
b -> forall a. ToCBOR a => a -> Encoding
toCBOR k
k forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR v
v forall a. Semigroup a => a -> a -> a
<> Encoding
b)
{-# INLINE encodeMapSkel #-}

instance (Ord k, ToCBOR k, ToCBOR v) => ToCBOR (M.Map k v) where
  toCBOR :: Map k v -> Encoding
toCBOR = forall k v m.
(ToCBOR k, ToCBOR v) =>
(m -> Int)
-> ((k -> v -> Encoding -> Encoding) -> Encoding -> m -> Encoding)
-> m
-> Encoding
encodeMapSkel forall k a. Map k a -> Int
M.size forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey

encodeSetSkel
  :: ToCBOR a
  => (s -> Int)
  -> ((a -> E.Encoding -> E.Encoding) -> E.Encoding -> s -> E.Encoding)
  -> s
  -> E.Encoding
encodeSetSkel :: forall a s.
ToCBOR a =>
(s -> Int)
-> ((a -> Encoding -> Encoding) -> Encoding -> s -> Encoding)
-> s
-> Encoding
encodeSetSkel s -> Int
size (a -> Encoding -> Encoding) -> Encoding -> s -> Encoding
foldFunction = forall a. Monoid a => a -> a -> a
mappend Encoding
encodeSetTag forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall container accumFunc.
(Word -> Encoding)
-> (container -> Int)
-> (accumFunc -> Encoding -> container -> Encoding)
-> accumFunc
-> container
-> Encoding
encodeContainerSkel
  Word -> Encoding
E.encodeListLen
  s -> Int
size
  (a -> Encoding -> Encoding) -> Encoding -> s -> Encoding
foldFunction
  (\a
a Encoding
b -> forall a. ToCBOR a => a -> Encoding
toCBOR a
a forall a. Semigroup a => a -> a -> a
<> Encoding
b)
{-# INLINE encodeSetSkel #-}

-- We stitch a `258` in from of a (Hash)Set, so that tools which
-- programmatically check for canonicity can recognise it from a normal
-- array. Why 258? This will be formalised pretty soon, but IANA allocated
-- 256...18446744073709551615 to "First come, first served":
-- https://www.iana.org/assignments/cbor-tags/cbor-tags.xhtml Currently `258` is
-- the first unassigned tag and as it requires 2 bytes to be encoded, it sounds
-- like the best fit.
setTag :: Word
setTag :: Word
setTag = Word
258

encodeSetTag :: E.Encoding
encodeSetTag :: Encoding
encodeSetTag = Word -> Encoding
E.encodeTag Word
setTag

instance (Ord a, ToCBOR a) => ToCBOR (S.Set a) where
  toCBOR :: Set a -> Encoding
toCBOR = forall a s.
ToCBOR a =>
(s -> Int)
-> ((a -> Encoding -> Encoding) -> Encoding -> s -> Encoding)
-> s
-> Encoding
encodeSetSkel forall a. Set a -> Int
S.size forall a b. (a -> b -> b) -> b -> Set a -> b
S.foldr

-- | Generic encoder for vectors. Its intended use is to allow easy
-- definition of 'Serialise' instances for custom vector
encodeVector :: (ToCBOR a, Vector.Generic.Vector v a) => v a -> E.Encoding
encodeVector :: forall a (v :: * -> *). (ToCBOR a, Vector v a) => v a -> Encoding
encodeVector = forall container accumFunc.
(Word -> Encoding)
-> (container -> Int)
-> (accumFunc -> Encoding -> container -> Encoding)
-> accumFunc
-> container
-> Encoding
encodeContainerSkel
  Word -> Encoding
E.encodeListLen
  forall (v :: * -> *) a. Vector v a => v a -> Int
Vector.Generic.length
  forall (v :: * -> *) a b.
Vector v a =>
(a -> b -> b) -> b -> v a -> b
Vector.Generic.foldr
  (\a
a Encoding
b -> forall a. ToCBOR a => a -> Encoding
toCBOR a
a forall a. Semigroup a => a -> a -> a
<> Encoding
b)
{-# INLINE encodeVector #-}


instance (ToCBOR a) => ToCBOR (Vector.Vector a) where
  toCBOR :: Vector a -> Encoding
toCBOR = forall a (v :: * -> *). (ToCBOR a, Vector v a) => v a -> Encoding
encodeVector
  {-# INLINE toCBOR #-}
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy (Vector a) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy (Vector a)
_ =
    Size
2 forall a. Num a => a -> a -> a
+ forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @(LengthOf (Vector.Vector a))) forall a. Num a => a -> a -> a
* forall t. ToCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy @a)


--------------------------------------------------------------------------------
-- Time
--------------------------------------------------------------------------------

instance ToCBOR UTCTime where
  toCBOR :: UTCTime -> Encoding
toCBOR (UTCTime Day
day DiffTime
timeOfDay) = forall a. Monoid a => [a] -> a
mconcat [
      Word -> Encoding
encodeListLen Word
3
    , Integer -> Encoding
encodeInteger Integer
year
    , Int -> Encoding
encodeInt Int
dayOfYear
    , Integer -> Encoding
encodeInteger Integer
timeOfDayPico
    ]
    where
      (Integer
year, Int
dayOfYear) = Day -> (Integer, Int)
toOrdinalDate Day
day
      timeOfDayPico :: Integer
timeOfDayPico = DiffTime -> Integer
diffTimeToPicoseconds DiffTime
timeOfDay