{-# 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 Codec.CBOR.Encoding as E
import Codec.CBOR.ByteArray.Sliced as BAS
import qualified Data.ByteString.Lazy as BS.Lazy
import qualified Data.ByteString.Short as SBS
import qualified Data.ByteString.Short.Internal as 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.Functor.Foldable (cata, project)
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Tagged (Tagged(..))
import qualified Data.Text as Text
import Data.Text.Lazy.Builder (Builder)
import Data.Time.Calendar.OrdinalDate ( toOrdinalDate )
import Data.Time.Clock (NominalDiffTime, UTCTime(..), diffTimeToPicoseconds)
import qualified Data.Vector as Vector
import qualified Data.Vector.Generic as Vector.Generic
import Foreign.Storable (sizeOf)
import Formatting (bprint, build, shown, stext)
import qualified Formatting.Buildable as B (Buildable(..))

import Cardano.Prelude

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

  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
  encodedSizeExpr = (forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
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 t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size
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 = Text -> LengthOf xs -> Encoding
forall a. HasCallStack => Text -> a
panic Text
"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 t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size
defaultEncodedListSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy [a]
_ =
  Size
2 Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy (LengthOf [a]) -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy (LengthOf [a])
forall k (t :: k). Proxy t
Proxy @(LengthOf [a])) Size -> Size -> Size
forall a. Num a => a -> a -> a
* Proxy a -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy a
forall k (t :: k). Proxy t
Proxy @a)


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

(.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d)
c -> d
f .: :: (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 :: (a -> b) -> SizeF a -> SizeF b
fmap a -> b
f = \case
    AddF a
x a
y  -> b -> b -> SizeF b
forall t. t -> t -> SizeF t
AddF (a -> b
f a
x) (a -> b
f a
y)
    MulF a
x a
y  -> b -> b -> SizeF b
forall t. t -> t -> SizeF t
MulF (a -> b
f a
x) (a -> b
f a
y)
    SubF a
x a
y  -> b -> b -> SizeF b
forall t. t -> t -> SizeF t
SubF (a -> b
f a
x) (a -> b
f a
y)
    AbsF   a
x  -> b -> SizeF b
forall t. t -> SizeF t
AbsF (a -> b
f a
x)
    NegF   a
x  -> b -> SizeF b
forall t. t -> SizeF t
NegF (a -> b
f a
x)
    SgnF   a
x  -> b -> SizeF b
forall t. t -> SizeF t
SgnF (a -> b
f a
x)
    CasesF [Case a]
xs -> [Case b] -> SizeF b
forall t. [Case t] -> SizeF t
CasesF ((Case a -> Case b) -> [Case a] -> [Case b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((a -> b) -> Case a -> Case b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Case a]
xs)
    ValueF Natural
x  -> Natural -> SizeF b
forall t. Natural -> SizeF t
ValueF Natural
x
    ApF Text
n Natural -> Natural
g a
x -> Text -> (Natural -> Natural) -> b -> SizeF b
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. ToCBOR t => Proxy t -> Size) -> Proxy a -> SizeF b
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
(+) = SizeF Size -> Size
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SizeF Size -> Size)
-> (Size -> Size -> SizeF Size) -> Size -> Size -> Size
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: Size -> Size -> SizeF Size
forall t. t -> t -> SizeF t
AddF
  * :: Size -> Size -> Size
(*) = SizeF Size -> Size
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SizeF Size -> Size)
-> (Size -> Size -> SizeF Size) -> Size -> Size -> Size
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: Size -> Size -> SizeF Size
forall t. t -> t -> SizeF t
MulF
  (-) = SizeF Size -> Size
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SizeF Size -> Size)
-> (Size -> Size -> SizeF Size) -> Size -> Size -> Size
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: Size -> Size -> SizeF Size
forall t. t -> t -> SizeF t
SubF
  negate :: Size -> Size
negate = SizeF Size -> Size
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SizeF Size -> Size) -> (Size -> SizeF Size) -> Size -> Size
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Size -> SizeF Size
forall t. t -> SizeF t
NegF
  abs :: Size -> Size
abs = SizeF Size -> Size
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SizeF Size -> Size) -> (Size -> SizeF Size) -> Size -> Size
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Size -> SizeF Size
forall t. t -> SizeF t
AbsF
  signum :: Size -> Size
signum = SizeF Size -> Size
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SizeF Size -> Size) -> (Size -> SizeF Size) -> Size -> Size
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Size -> SizeF Size
forall t. t -> SizeF t
SgnF
  fromInteger :: Integer -> Size
fromInteger = SizeF Size -> Size
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SizeF Size -> Size) -> (Integer -> SizeF Size) -> Integer -> Size
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Natural -> SizeF Size
forall t. Natural -> SizeF t
ValueF (Natural -> SizeF Size)
-> (Integer -> Natural) -> Integer -> SizeF Size
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> Natural
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 :: a -> Text -> b -> Builder
showp2 = Format Builder (a -> Text -> b -> Builder)
-> a -> Text -> b -> Builder
forall a. Format Builder a -> a
bprint (Format (a -> Text -> b -> Builder) (a -> Text -> b -> Builder)
"(" Format (a -> Text -> b -> Builder) (a -> Text -> b -> Builder)
-> Format Builder (a -> Text -> b -> Builder)
-> Format 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
. Format (Text -> b -> Builder) (a -> Text -> b -> Builder)
forall a r. Buildable a => Format r (a -> r)
build Format (Text -> b -> Builder) (a -> Text -> b -> Builder)
-> Format Builder (Text -> b -> Builder)
-> Format 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
. Format (Text -> b -> Builder) (Text -> b -> Builder)
" " Format (Text -> b -> Builder) (Text -> b -> Builder)
-> Format Builder (Text -> b -> Builder)
-> Format 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
. Format (b -> Builder) (Text -> b -> Builder)
forall r. Format r (Text -> r)
stext Format (b -> Builder) (Text -> b -> Builder)
-> Format Builder (b -> Builder)
-> Format 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
. Format (b -> Builder) (b -> Builder)
" " Format (b -> Builder) (b -> Builder)
-> Format Builder (b -> Builder) -> Format 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
. Format Builder (b -> Builder)
forall a r. Buildable a => Format r (a -> r)
build Format Builder (b -> Builder)
-> Format Builder Builder -> Format 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
. Format Builder Builder
")")
      in
        case SizeF t
x_ of
          AddF t
x t
y -> t -> Text -> t -> Builder
forall a b. (Buildable a, Buildable b) => a -> Text -> b -> Builder
showp2 t
x Text
"+" t
y
          MulF t
x t
y -> t -> Text -> t -> Builder
forall a b. (Buildable a, Buildable b) => a -> Text -> b -> Builder
showp2 t
x Text
"*" t
y
          SubF t
x t
y -> t -> Text -> t -> Builder
forall a b. (Buildable a, Buildable b) => a -> Text -> b -> Builder
showp2 t
x Text
"-" t
y
          NegF t
x   -> Format Builder (t -> Builder) -> t -> Builder
forall a. Format Builder a -> a
bprint (Format (t -> Builder) (t -> Builder)
"-" Format (t -> Builder) (t -> Builder)
-> Format Builder (t -> Builder) -> Format 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
. Format Builder (t -> Builder)
forall a r. Buildable a => Format r (a -> r)
build) t
x
          AbsF t
x   -> Format Builder (t -> Builder) -> t -> Builder
forall a. Format Builder a -> a
bprint (Format (t -> Builder) (t -> Builder)
"|" Format (t -> Builder) (t -> Builder)
-> Format Builder (t -> Builder) -> Format 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
. Format Builder (t -> Builder)
forall a r. Buildable a => Format r (a -> r)
build Format Builder (t -> Builder)
-> Format Builder Builder -> Format 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
. Format Builder Builder
"|") t
x
          SgnF t
x   -> Format Builder (t -> Builder) -> t -> Builder
forall a. Format Builder a -> a
bprint (Format (t -> Builder) (t -> Builder)
"sgn(" Format (t -> Builder) (t -> Builder)
-> Format Builder (t -> Builder) -> Format 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
. Format Builder (t -> Builder)
forall a r. Buildable a => Format r (a -> r)
build Format Builder (t -> Builder)
-> Format Builder Builder -> Format 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
. Format Builder Builder
")") t
x
          CasesF [Case t]
xs ->
            Format Builder (Builder -> Builder) -> Builder -> Builder
forall a. Format Builder a -> a
bprint (Format (Builder -> Builder) (Builder -> Builder)
"{ " Format (Builder -> Builder) (Builder -> Builder)
-> Format Builder (Builder -> Builder)
-> Format 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
. Format Builder (Builder -> Builder)
forall a r. Buildable a => Format r (a -> r)
build Format Builder (Builder -> Builder)
-> Format Builder Builder -> Format 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
. Format Builder Builder
"}") (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ (Case t -> Builder) -> [Case t] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Format Builder (Case t -> Builder) -> Case t -> Builder
forall a. Format Builder a -> a
bprint (Format Builder (Case t -> Builder)
forall a r. Buildable a => Format r (a -> r)
build Format Builder (Case t -> Builder)
-> Format Builder Builder -> Format Builder (Case t -> Builder)
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  -> Format Builder (Integer -> Builder) -> Integer -> Builder
forall a. Format Builder a -> a
bprint Format Builder (Integer -> Builder)
forall a r. Show a => Format r (a -> r)
shown (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
x)
          ApF Text
n Natural -> Natural
_ t
x -> Format Builder (Text -> t -> Builder) -> Text -> t -> Builder
forall a. Format Builder a -> a
bprint (Format (t -> Builder) (Text -> t -> Builder)
forall r. Format r (Text -> r)
stext Format (t -> Builder) (Text -> t -> Builder)
-> Format Builder (t -> Builder)
-> Format Builder (Text -> t -> Builder)
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)
"(" Format (t -> Builder) (t -> Builder)
-> Format Builder (t -> Builder) -> Format 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
. Format Builder (t -> Builder)
forall a r. Buildable a => Format r (a -> r)
build Format Builder (t -> Builder)
-> Format Builder Builder -> Format 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
. Format Builder Builder
")") Text
n t
x
          TodoF forall t. ToCBOR t => Proxy t -> Size
_ Proxy a
x -> Format Builder (TypeRep -> Builder) -> TypeRep -> Builder
forall a. Format Builder a -> a
bprint (Format (TypeRep -> Builder) (TypeRep -> Builder)
"(_ :: " Format (TypeRep -> Builder) (TypeRep -> Builder)
-> Format Builder (TypeRep -> Builder)
-> Format 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
. Format Builder (TypeRep -> Builder)
forall a r. Show a => Format r (a -> r)
shown Format Builder (TypeRep -> Builder)
-> Format Builder Builder -> Format 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
. Format Builder Builder
")") (Proxy a -> TypeRep
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 = Format Builder (SizeF Size -> Builder) -> SizeF Size -> Builder
forall a. Format Builder a -> a
bprint Format Builder (SizeF Size -> Builder)
forall a r. Buildable a => Format r (a -> r)
build (Size -> Base Size Size
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 = SizeF Size -> Size
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SizeF Size -> Size)
-> ([Case Size] -> SizeF Size) -> [Case Size] -> Size
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Case Size] -> SizeF Size
forall t. [Case t] -> SizeF t
CasesF

-- | An individual labeled case.
data Case t =
  Case Text t
  deriving (a -> Case b -> Case a
(a -> b) -> Case a -> Case b
(forall a b. (a -> b) -> Case a -> Case b)
-> (forall a b. a -> Case b -> Case a) -> Functor Case
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
<$ :: a -> Case b -> Case a
$c<$ :: forall a b. a -> Case b -> Case a
fmap :: (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 :: 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) = Format Builder (Text -> t -> Builder) -> Text -> t -> Builder
forall a. Format Builder a -> a
bprint (Format (t -> Builder) (Text -> t -> Builder)
forall r. Format r (Text -> r)
stext Format (t -> Builder) (Text -> t -> Builder)
-> Format Builder (t -> Builder)
-> Format Builder (Text -> t -> Builder)
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)
"=" Format (t -> Builder) (t -> Builder)
-> Format Builder (t -> Builder) -> Format 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
. Format Builder (t -> Builder)
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
  { Range b -> b
lo :: 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 :: forall b. b -> b -> Range b
Range {lo :: b
lo = Range b -> b
forall b. Range b -> b
lo Range b
x b -> b -> b
forall a. Num a => a -> a -> a
+ Range b -> b
forall b. Range b -> b
lo Range b
y, hi :: b
hi = Range b -> b
forall b. Range b -> b
hi Range b
x b -> b -> b
forall a. Num a => a -> a -> a
+ Range b -> b
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 b -> b -> b
forall a. Num a => a -> a -> a
* b
v | b
u <- [Range b -> b
forall b. Range b -> b
lo Range b
x, Range b -> b
forall b. Range b -> b
hi Range b
x], b
v <- [Range b -> b
forall b. Range b -> b
lo Range b
y, Range b -> b
forall b. Range b -> b
hi Range b
y] ]
    in Range :: forall b. b -> b -> Range b
Range {lo :: b
lo = [b] -> b
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [b]
products, hi :: b
hi = [b] -> b
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 :: forall b. b -> b -> Range b
Range {lo :: b
lo = Range b -> b
forall b. Range b -> b
lo Range b
x b -> b -> b
forall a. Num a => a -> a -> a
- Range b -> b
forall b. Range b -> b
hi Range b
y, hi :: b
hi = Range b -> b
forall b. Range b -> b
hi Range b
x b -> b -> b
forall a. Num a => a -> a -> a
- Range b -> b
forall b. Range b -> b
lo Range b
y}
  negate :: Range b -> Range b
negate Range b
x = Range :: forall b. b -> b -> Range b
Range {lo :: b
lo = b -> b
forall a. Num a => a -> a
negate (Range b -> b
forall b. Range b -> b
hi Range b
x), hi :: b
hi = b -> b
forall a. Num a => a -> a
negate (Range b -> b
forall b. Range b -> b
lo Range b
x)}
  abs :: Range b -> Range b
abs Range b
x = if
    | Range b -> b
forall b. Range b -> b
lo Range b
x b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= b
0 Bool -> Bool -> Bool
&& Range b -> b
forall b. Range b -> b
hi Range b
x b -> b -> Bool
forall a. Ord a => a -> a -> Bool
>= b
0 -> Range :: forall b. b -> b -> Range b
Range {lo :: b
lo = b
0, hi :: b
hi = b -> b -> b
forall a. Ord a => a -> a -> a
max (Range b -> b
forall b. Range b -> b
hi Range b
x) (b -> b
forall a. Num a => a -> a
negate (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ Range b -> b
forall b. Range b -> b
lo Range b
x)}
    | Range b -> b
forall b. Range b -> b
lo Range b
x b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= b
0 Bool -> Bool -> Bool
&& Range b -> b
forall b. Range b -> b
hi Range b
x b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= b
0 -> Range :: forall b. b -> b -> Range b
Range {lo :: b
lo = b -> b
forall a. Num a => a -> a
negate (Range b -> b
forall b. Range b -> b
hi Range b
x), hi :: b
hi = b -> b
forall a. Num a => a -> a
negate (Range b -> b
forall b. Range b -> b
lo Range b
x)}
    | Bool
otherwise              -> Range b
x
  signum :: Range b -> Range b
signum Range b
x = Range :: forall b. b -> b -> Range b
Range {lo :: b
lo = b -> b
forall a. Num a => a -> a
signum (Range b -> b
forall b. Range b -> b
lo Range b
x), hi :: b
hi = b -> b
forall a. Num a => a -> a
signum (Range b -> b
forall b. Range b -> b
hi Range b
x)}
  fromInteger :: Integer -> Range b
fromInteger Integer
n = Range :: forall b. b -> b -> Range b
Range {lo :: b
lo = Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
n, hi :: b
hi = Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
n}

instance B.Buildable (Range Natural) where
  build :: Range Natural -> Builder
build Range Natural
r = Format Builder (Integer -> Integer -> Builder)
-> Integer -> Integer -> Builder
forall a. Format Builder a -> a
bprint (Format (Integer -> Builder) (Integer -> Integer -> Builder)
forall a r. Show a => Format r (a -> r)
shown Format (Integer -> Builder) (Integer -> Integer -> Builder)
-> Format Builder (Integer -> Builder)
-> Format Builder (Integer -> Integer -> Builder)
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)
".." Format (Integer -> Builder) (Integer -> Builder)
-> Format Builder (Integer -> Builder)
-> Format 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
. Format Builder (Integer -> Builder)
forall a r. Show a => Format r (a -> r)
shown) (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Natural -> Integer) -> Natural -> Integer
forall a b. (a -> b) -> a -> b
$ Range Natural -> Natural
forall b. Range b -> b
lo Range Natural
r) (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Natural -> Integer) -> Natural -> Integer
forall a b. (a -> b) -> a -> b
$ Range Natural -> Natural
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 = (Base Size (Range Natural) -> Range Natural)
-> Size -> Range Natural
forall t a. Recursive t => (Base t a -> a) -> t -> a
cata ((Base Size (Range Natural) -> Range Natural)
 -> Size -> Range Natural)
-> (Base Size (Range Natural) -> Range Natural)
-> Size
-> Range Natural
forall a b. (a -> b) -> a -> b
$ \case
  AddF x y  -> Range Natural
x Range Natural -> Range Natural -> Range Natural
forall a. Num a => a -> a -> a
+ Range Natural
y
  MulF x y  -> Range Natural
x Range Natural -> Range Natural -> Range Natural
forall a. Num a => a -> a -> a
* Range Natural
y
  SubF x y  -> Range Natural
x Range Natural -> Range Natural -> Range Natural
forall a. Num a => a -> a -> a
- Range Natural
y
  NegF   x  -> Range Natural -> Range Natural
forall a. Num a => a -> a
negate Range Natural
x
  AbsF   x  -> Range Natural -> Range Natural
forall a. Num a => a -> a
abs Range Natural
x
  SgnF   x  -> Range Natural -> Range Natural
forall a. Num a => a -> a
signum Range Natural
x
  CasesF xs -> Range :: forall b. b -> b -> Range b
Range
    { lo :: Natural
lo = [Natural] -> Natural
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ((Case (Range Natural) -> Natural)
-> [Case (Range Natural)] -> [Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Range Natural -> Natural
forall b. Range b -> b
lo (Range Natural -> Natural)
-> (Case (Range Natural) -> Range Natural)
-> Case (Range Natural)
-> Natural
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Case (Range Natural) -> Range Natural
forall t. Case t -> t
caseValue) [Case (Range Natural)]
xs)
    , hi :: Natural
hi = [Natural] -> Natural
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Case (Range Natural) -> Natural)
-> [Case (Range Natural)] -> [Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Range Natural -> Natural
forall b. Range b -> b
hi (Range Natural -> Natural)
-> (Case (Range Natural) -> Range Natural)
-> Case (Range Natural)
-> Natural
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Case (Range Natural) -> Range Natural
forall t. Case t -> t
caseValue) [Case (Range Natural)]
xs)
    }
  ValueF x  -> Range :: forall b. b -> b -> Range b
Range {lo :: Natural
lo = Natural
x, hi :: Natural
hi = Natural
x}
  ApF _ f x -> Range :: forall b. b -> b -> Range b
Range {lo :: Natural
lo = Natural -> Natural
f (Range Natural -> Natural
forall b. Range b -> b
lo Range Natural
x), hi :: Natural
hi = Natural -> Natural
f (Range Natural -> Natural
forall b. Range b -> b
hi Range Natural
x)}
  TodoF f x -> (Proxy a -> Size) -> Proxy a -> Range Natural
forall t. ToCBOR t => (Proxy t -> Size) -> Proxy t -> Range Natural
doit Proxy a -> Size
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 :: Proxy a -> Size
szLazy = (forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
todo ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy t -> Size
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 :: Proxy a -> Size
szGreedy = (forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
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 t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
todo forall t. ToCBOR t => Proxy t -> Size
f Proxy a
pxy = SizeF Size -> Size
forall (f :: * -> *). f (Fix f) -> Fix f
Fix ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> SizeF Size
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 ) -> SizeF Size -> Size
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Natural -> SizeF Size
forall t. Natural -> SizeF t
ValueF (Natural -> Natural
f Natural
x))
  Fix (CasesF [Case Size]
cs) -> SizeF Size -> Size
forall (f :: * -> *). f (Fix f) -> Fix f
Fix ([Case Size] -> SizeF Size
forall t. [Case t] -> SizeF t
CasesF ((Case Size -> Case Size) -> [Case Size] -> [Case Size]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((Size -> Size) -> Case Size -> Case Size
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               -> SizeF Size -> Size
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Text -> (Natural -> Natural) -> Size -> SizeF Size
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) => Map TypeRep SizeOverride -> Proxy a -> Size
szWithCtx :: Map TypeRep SizeOverride -> Proxy a -> Size
szWithCtx Map TypeRep SizeOverride
ctx Proxy a
pxy = case TypeRep -> Map TypeRep SizeOverride -> Maybe SizeOverride
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Proxy a -> TypeRep
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 (Map TypeRep SizeOverride -> Proxy a -> Size
forall a. ToCBOR a => Map TypeRep SizeOverride -> Proxy a -> Size
szWithCtx Map TypeRep SizeOverride
ctx)
    SelectCases    [Text]
names -> (Base Size Size -> Size) -> Size -> Size
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 t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr (Map TypeRep SizeOverride -> Proxy t -> Size
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 (SizeF Size -> Size
forall (f :: * -> *). f (Fix f) -> Fix f
Fix SizeF Size
orig)
    SizeF Size
_         -> SizeF Size -> 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 (Case Size -> Bool) -> [Case Size] -> [Case Size]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Case Text
name Size
_) -> Text
name Text -> [Text] -> Bool
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'        -> SizeF Size -> Size
forall (f :: * -> *). f (Fix f) -> Fix f
Fix ([Case Size] -> SizeF Size
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 = (Base Size (Either Size (Range Natural))
 -> Either Size (Range Natural))
-> Size -> Either Size (Range Natural)
forall t a. Recursive t => (Base t a -> a) -> t -> a
cata ((Base Size (Either Size (Range Natural))
  -> Either Size (Range Natural))
 -> Size -> Either Size (Range Natural))
-> (Base Size (Either Size (Range Natural))
    -> Either Size (Range Natural))
-> Size
-> Either Size (Range Natural)
forall a b. (a -> b) -> a -> b
$ \case
  TodoF f pxy -> Size -> Either Size (Range Natural)
forall a b. a -> Either a b
Left ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
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 x    -> Range Natural -> Either Size (Range Natural)
forall a b. b -> Either a b
Right (Range :: forall b. b -> b -> Range b
Range {lo :: Natural
lo = Natural
x, hi :: Natural
hi = Natural
x})
  CasesF xs   -> case (Case (Either Size (Range Natural)) -> Either Size (Range Natural))
-> [Case (Either Size (Range Natural))]
-> Either Size [Range Natural]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Case (Either Size (Range Natural)) -> Either Size (Range Natural)
forall t. Case t -> t
caseValue [Case (Either Size (Range Natural))]
xs of
    Right [Range Natural]
xs' ->
      Range Natural -> Either Size (Range Natural)
forall a b. b -> Either a b
Right (Range :: forall b. b -> b -> Range b
Range {lo :: Natural
lo = [Natural] -> Natural
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ((Range Natural -> Natural) -> [Range Natural] -> [Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Range Natural -> Natural
forall b. Range b -> b
lo [Range Natural]
xs'), hi :: Natural
hi = [Natural] -> Natural
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Range Natural -> Natural) -> [Range Natural] -> [Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Range Natural -> Natural
forall b. Range b -> b
hi [Range Natural]
xs')})
    Left Size
_ -> Size -> Either Size (Range Natural)
forall a b. a -> Either a b
Left ([Case Size] -> Size
szCases ([Case Size] -> Size) -> [Case Size] -> Size
forall a b. (a -> b) -> a -> b
$ (Case (Either Size (Range Natural)) -> Case Size)
-> [Case (Either Size (Range Natural))] -> [Case Size]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((Either Size (Range Natural) -> Size)
-> Case (Either Size (Range Natural)) -> Case Size
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 x 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 x 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 x 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 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 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 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 _ f (Right x) -> Range Natural -> Either Size (Range Natural)
forall a b. b -> Either a b
Right (Range :: forall b. b -> b -> Range b
Range {lo :: Natural
lo = Natural -> Natural
f (Range Natural -> Natural
forall b. Range b -> b
lo Range Natural
x), hi :: Natural
hi = Natural -> Natural
f (Range Natural -> Natural
forall b. Range b -> b
hi Range Natural
x)})
  ApF n f (Left  x) -> Size -> Either Size (Range Natural)
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) = Range Natural -> Either Size (Range Natural)
forall a b. b -> Either a b
Right (Range Natural -> Range Natural -> Range Natural
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         = Size -> Either Size (Range Natural)
forall a b. a -> Either a b
Left (Size -> Size -> Size
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 -> Range Natural -> Either Size (Range Natural)
forall a b. b -> Either a b
Right (Range Natural -> Range Natural
forall a. Num a => a -> a
f Range Natural
x)
    Left  Size
x -> Size -> Either Size (Range Natural)
forall a b. a -> Either a b
Left (Size -> Size
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 Range Natural -> Natural
forall b. Range b -> b
lo Range Natural
r Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Range Natural -> Natural
forall b. Range b -> b
hi Range Natural
r
      then Natural -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Range Natural -> Natural
forall b. Range b -> b
lo Range Natural
r)
      else [Case Size] -> Size
szCases
        [Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"lo" (Natural -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Size) -> Natural -> Size
forall a b. (a -> b) -> a -> b
$ Range Natural -> Natural
forall b. Range b -> b
lo Range Natural
r), Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"hi" (Natural -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Size) -> Natural -> Size
forall a b. (a -> b) -> a -> b
$ Range Natural -> Natural
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 = (Base Size Size -> Size) -> Size -> Size
forall t a. Recursive t => (Base t a -> a) -> t -> a
cata ((Base Size Size -> Size) -> Size -> Size)
-> (Base Size Size -> Size) -> Size -> Size
forall a b. (a -> b) -> a -> b
$ \case
  AddF x y  -> Size
x Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
y
  MulF x y  -> Size
x Size -> Size -> Size
forall a. Num a => a -> a -> a
* Size
y
  SubF x y  -> Size
x Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
y
  NegF   x  -> Size -> Size
forall a. Num a => a -> a
negate Size
x
  AbsF   x  -> Size -> Size
forall a. Num a => a -> a
abs Size
x
  SgnF   x  -> Size -> Size
forall a. Num a => a -> a
signum Size
x
  CasesF xs -> SizeF Size -> Size
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (SizeF Size -> Size) -> SizeF Size -> Size
forall a b. (a -> b) -> a -> b
$ [Case Size] -> SizeF Size
forall t. [Case t] -> SizeF t
CasesF [Case Size]
xs
  ValueF x  -> SizeF Size -> Size
forall (f :: * -> *). f (Fix f) -> Fix f
Fix (Natural -> SizeF Size
forall t. Natural -> SizeF t
ValueF Natural
x)
  ApF n f x -> Text -> (Natural -> Natural) -> Size -> Size
apMono Text
n Natural -> Natural
f Size
x
  TodoF f x -> Proxy a -> Size
forall t. ToCBOR t => Proxy t -> Size
f Proxy a
x

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

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


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

instance ToCBOR () where
  toCBOR :: () -> Encoding
toCBOR = Encoding -> () -> Encoding
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 :: 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" a
forall a. Bounded a => a
maxBound
  ]
 where
  mkCase :: Text -> a -> Case Size
  mkCase :: Text -> a -> Case Size
mkCase Text
n a
x = Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
n (Integer -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Size) -> Integer -> Size
forall a b. (a -> b) -> a -> b
$ (a -> Integer
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
_ = Proxy Word -> 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
_ = Proxy Word8 -> 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
_ = Proxy Word16 -> 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
_ = Proxy Word32 -> 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
_ = Proxy Word64 -> 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
_ = Proxy Int -> 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 Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Int -> Size
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Float -> Int
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
_ = Proxy Int32 -> 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
_ = Proxy Int64 -> 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 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Ratio a -> a
forall a. Ratio a -> a
numerator Ratio a
r) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Ratio a -> a
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 Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy a -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy a
forall k (t :: k). Proxy t
Proxy @a) Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy a -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy a
forall k (t :: k). Proxy t
Proxy @a)

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

instance ToCBOR Pico where
  toCBOR :: Pico -> Encoding
toCBOR (MkFixed Integer
picoseconds) = Integer -> Encoding
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 = Integer -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Integer -> Encoding)
-> (NominalDiffTime -> Integer) -> NominalDiffTime -> Encoding
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
1e6) (Integer -> Integer)
-> (NominalDiffTime -> Integer) -> NominalDiffTime -> Integer
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 =
      Ratio Integer -> Integer
forall a. Ratio a -> a
numerator (NominalDiffTime -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational NominalDiffTime
t Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* Integer -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational (Proxy E12 -> Integer
forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
resolution (Proxy E12 -> Integer) -> Proxy E12 -> Integer
forall a b. (a -> b) -> a -> b
$ Proxy E12
forall k (t :: k). Proxy t
Proxy @E12))

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

instance ToCBOR Void where
  toCBOR :: Void -> Encoding
toCBOR = Void -> Encoding
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) = a -> Encoding
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 t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (Proxy a
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 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR a
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> b -> Encoding
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 Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy a -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy a
forall k (t :: k). Proxy t
Proxy @a) Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy b -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy b
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 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR a
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> b -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR b
b Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> c -> Encoding
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 Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy a -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy a
forall k (t :: k). Proxy t
Proxy @a) Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy b -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy b
forall k (t :: k). Proxy t
Proxy @b) Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy c -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy c
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 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR a
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> b -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR b
b Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> c -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR c
c Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> d -> Encoding
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 Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy a -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy a
forall k (t :: k). Proxy t
Proxy @a) Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy b -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy b
forall k (t :: k). Proxy t
Proxy @b) Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy c -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy c
forall k (t :: k). Proxy t
Proxy @c) Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy d -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy d
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
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR a
a
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> b -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR b
b
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> c -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR c
c
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> d -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR d
d
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> e -> Encoding
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
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy a -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy a
forall k (t :: k). Proxy t
Proxy @a)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy b -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy b
forall k (t :: k). Proxy t
Proxy @b)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy c -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy c
forall k (t :: k). Proxy t
Proxy @c)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy d -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy d
forall k (t :: k). Proxy t
Proxy @d)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy e -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy e
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
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR a
a
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> b -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR b
b
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> c -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR c
c
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> d -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR d
d
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> e -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR e
e
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> f -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR f
f
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> g -> Encoding
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
    Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy a -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy a
forall k (t :: k). Proxy t
Proxy @a)
    Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy b -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy b
forall k (t :: k). Proxy t
Proxy @b)
    Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy c -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy c
forall k (t :: k). Proxy t
Proxy @c)
    Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy d -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy d
forall k (t :: k). Proxy t
Proxy @d)
    Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy e -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy e
forall k (t :: k). Proxy t
Proxy @e)
    Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy f -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy f
forall k (t :: k). Proxy t
Proxy @f)
    Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy g -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy g
forall k (t :: k). Proxy t
Proxy @g)

instance ToCBOR 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 = Proxy (LengthOf ByteString) -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy (LengthOf ByteString)
forall k (t :: k). Proxy t
Proxy @(LengthOf ByteString))
    in Text -> (Natural -> Natural) -> Size -> Size
apMono Text
"withWordSize@Int" (forall a. (Integral Int, Integral a) => Int -> a
forall s a. (Integral s, Integral a) => s -> a
withWordSize @Int (Int -> Natural) -> (Natural -> Int) -> Natural -> Natural
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Size
len Size -> Size -> Size
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 = Proxy (LengthOf Text) -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy (LengthOf Text)
forall k (t :: k). Proxy t
Proxy @(LengthOf Text))
        Size -> Size -> Size
forall a. Num a => a -> a -> a
* [Case Size] -> Size
szCases [Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"minChar" Size
1, Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"maxChar" Size
4]
    in Size
bsLength Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Text -> (Natural -> Natural) -> Size -> Size
apMono Text
"withWordSize" Natural -> Natural
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.SBS ByteArray#
ba) =
    SlicedByteArray -> Encoding
E.encodeByteArray (SlicedByteArray -> Encoding) -> SlicedByteArray -> Encoding
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 = Proxy (LengthOf ShortByteString) -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy (LengthOf ShortByteString)
forall k (t :: k). Proxy t
Proxy @(LengthOf SBS.ShortByteString))
    in Text -> (Natural -> Natural) -> Size -> Size
apMono Text
"withWordSize@Int" (forall a. (Integral Int, Integral a) => Int -> a
forall s a. (Integral s, Integral a) => s -> a
withWordSize @Int (Int -> Natural) -> (Natural -> Int) -> Natural -> Natural
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Size
len Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
len

instance ToCBOR BS.Lazy.ByteString where
  toCBOR :: ByteString -> Encoding
toCBOR = ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ByteString -> Encoding)
-> (ByteString -> ByteString) -> ByteString -> Encoding
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 = Proxy (LengthOf ByteString) -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy (LengthOf ByteString)
forall k (t :: k). Proxy t
Proxy @(LengthOf BS.Lazy.ByteString))
    in Text -> (Natural -> Natural) -> Size -> Size
apMono Text
"withWordSize@Int" (forall a. (Integral Int, Integral a) => Int -> a
forall s a. (Integral s, Integral a) => s -> a
withWordSize @Int (Int -> Natural) -> (Natural -> Int) -> Natural -> Natural
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Size
len Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
len

instance ToCBOR a => ToCBOR [a] where
  toCBOR :: [a] -> Encoding
toCBOR [a]
xs = Encoding
E.encodeListLenIndef Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (a -> Encoding -> Encoding) -> Encoding -> [a] -> Encoding
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x Encoding
r -> a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR a
x Encoding -> Encoding -> Encoding
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 t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size
encodedListSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (Proxy [a]
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 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
E.encodeWord Word
0 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR a
x
  toCBOR (Right b
x) = Word -> Encoding
E.encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
E.encodeWord Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> b -> Encoding
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
    [Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"Left" (Size
2 Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy a -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy a
forall k (t :: k). Proxy t
Proxy @a)), Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"Right" (Size
2 Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy b -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy b
forall k (t :: k). Proxy t
Proxy @b))]

instance ToCBOR a => ToCBOR (NonEmpty a) where
  toCBOR :: NonEmpty a -> Encoding
toCBOR = [a] -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ([a] -> Encoding) -> (NonEmpty a -> [a]) -> NonEmpty a -> Encoding
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NonEmpty a -> [a]
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)
_ = Proxy [a] -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy [a]
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 = (a -> Encoding) -> Maybe a -> Encoding
forall a. (a -> Encoding) -> Maybe a -> Encoding
toCBORMaybe a -> Encoding
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 [Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"Nothing" Size
1, Text -> Size -> Case Size
forall t. Text -> t -> Case t
Case Text
"Just" (Size
1 Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy a -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy a
forall k (t :: k). Proxy t
Proxy @a))]

toCBORMaybe :: (a -> Encoding) -> Maybe a -> Encoding
toCBORMaybe :: (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 Encoding -> Encoding -> Encoding
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 :: (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 (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (container -> Int
size container
c)) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> accumFunc -> Encoding -> container -> Encoding
foldFunction accumFunc
f Encoding
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 :: (m -> Int)
-> ((k -> v -> Encoding -> Encoding) -> Encoding -> m -> Encoding)
-> m
-> Encoding
encodeMapSkel m -> Int
size (k -> v -> Encoding -> Encoding) -> Encoding -> m -> Encoding
foldrWithKey = (Word -> Encoding)
-> (m -> Int)
-> ((k -> v -> Encoding -> Encoding) -> Encoding -> m -> Encoding)
-> (k -> v -> Encoding -> Encoding)
-> m
-> Encoding
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 -> k -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR k
k Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> v -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR v
v Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
b)
{-# INLINE encodeMapSkel #-}

instance (Ord k, ToCBOR k, ToCBOR v) => ToCBOR (Map k v) where
  toCBOR :: Map k v -> Encoding
toCBOR = (Map k v -> Int)
-> ((k -> v -> Encoding -> Encoding)
    -> Encoding -> Map k v -> Encoding)
-> Map k v
-> Encoding
forall k v m.
(ToCBOR k, ToCBOR v) =>
(m -> Int)
-> ((k -> v -> Encoding -> Encoding) -> Encoding -> m -> Encoding)
-> m
-> Encoding
encodeMapSkel Map k v -> Int
forall k a. Map k a -> Int
M.size (k -> v -> Encoding -> Encoding) -> Encoding -> Map k v -> Encoding
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 :: (s -> Int)
-> ((a -> Encoding -> Encoding) -> Encoding -> s -> Encoding)
-> s
-> Encoding
encodeSetSkel s -> Int
size (a -> Encoding -> Encoding) -> Encoding -> s -> Encoding
foldFunction = Encoding -> Encoding -> Encoding
forall a. Monoid a => a -> a -> a
mappend Encoding
encodeSetTag (Encoding -> Encoding) -> (s -> Encoding) -> s -> Encoding
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Word -> Encoding)
-> (s -> Int)
-> ((a -> Encoding -> Encoding) -> Encoding -> s -> Encoding)
-> (a -> Encoding -> Encoding)
-> s
-> Encoding
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 -> a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR a
a Encoding -> Encoding -> Encoding
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 (Set a) where
  toCBOR :: Set a -> Encoding
toCBOR = (Set a -> Int)
-> ((a -> Encoding -> Encoding) -> Encoding -> Set a -> Encoding)
-> Set a
-> Encoding
forall a s.
ToCBOR a =>
(s -> Int)
-> ((a -> Encoding -> Encoding) -> Encoding -> s -> Encoding)
-> s
-> Encoding
encodeSetSkel Set a -> Int
forall a. Set a -> Int
S.size (a -> Encoding -> Encoding) -> Encoding -> Set a -> Encoding
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 :: v a -> Encoding
encodeVector = (Word -> Encoding)
-> (v a -> Int)
-> ((a -> Encoding -> Encoding) -> Encoding -> v a -> Encoding)
-> (a -> Encoding -> Encoding)
-> v a
-> Encoding
forall container accumFunc.
(Word -> Encoding)
-> (container -> Int)
-> (accumFunc -> Encoding -> container -> Encoding)
-> accumFunc
-> container
-> Encoding
encodeContainerSkel
  Word -> Encoding
E.encodeListLen
  v a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
Vector.Generic.length
  (a -> Encoding -> Encoding) -> Encoding -> v a -> Encoding
forall (v :: * -> *) a b.
Vector v a =>
(a -> b -> b) -> b -> v a -> b
Vector.Generic.foldr
  (\a
a Encoding
b -> a -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR a
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
b)
{-# INLINE encodeVector #-}


instance (ToCBOR a) => ToCBOR (Vector.Vector a) where
  toCBOR :: Vector a -> Encoding
toCBOR = Vector a -> Encoding
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 Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Proxy (LengthOf (Vector a)) -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy (LengthOf (Vector a))
forall k (t :: k). Proxy t
Proxy @(LengthOf (Vector.Vector a))) Size -> Size -> Size
forall a. Num a => a -> a -> a
* Proxy a -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Proxy a
forall k (t :: k). Proxy t
Proxy @a)


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

instance ToCBOR UTCTime where
  toCBOR :: UTCTime -> Encoding
toCBOR (UTCTime Day
day DiffTime
timeOfDay) = [Encoding] -> Encoding
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