{-# LANGUAGE AllowAmbiguousTypes       #-}
{-# LANGUAGE BangPatterns              #-}
{-# LANGUAGE CPP                       #-}
{-# LANGUAGE DataKinds                 #-}
{-# LANGUAGE DefaultSignatures         #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE MultiParamTypeClasses     #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ScopedTypeVariables       #-}
{-# LANGUAGE Trustworthy               #-}
{-# LANGUAGE TypeFamilies              #-}
{-# LANGUAGE TypeOperators             #-}
{-# LANGUAGE UndecidableInstances      #-}

-- |Generics-based generation of Flat instances
module Flat.Class
  (
  -- * The Flat class
    Flat(..)
  , getSize
  , module GHC.Generics
  , GFlatEncode,GFlatDecode,GFlatSize
  )
where

import           Data.Bits    (Bits (unsafeShiftL, (.|.)))
import           Data.Word    (Word16)
import           Flat.Decoder (ConsState (..), Get, consBits, consBool,
                               consClose, consOpen, dBool)
import           Flat.Encoder (Encoding, NumBits, eBits16, mempty)
import           GHC.Generics
import           GHC.TypeLits (type (+), type (<=), Nat)
import           Prelude      hiding (mempty)
-- import Data.Proxy
-- External and Internal inlining
#define INL 2
-- Internal inlining
-- #define INL 1
-- No inlining
-- #define INL 0

#if INL == 1
import           GHC.Exts     (inline)
#endif

-- import           Data.Proxy

-- |Calculate the maximum size in bits of the serialisation of the value
getSize :: Flat a => a -> NumBits
getSize :: a -> NumBits
getSize a
a = a -> NumBits -> NumBits
forall a. Flat a => a -> NumBits -> NumBits
size a
a NumBits
0

-- |Class of types that can be encoded/decoded
class Flat a where
    -- |Return the encoding corrresponding to the value
    encode :: a -> Encoding
    default encode :: (Generic a, GFlatEncode (Rep a)) => a -> Encoding
    encode = Rep a Any -> Encoding
forall (f :: * -> *) a. GFlatEncode f => f a -> Encoding
gencode (Rep a Any -> Encoding) -> (a -> Rep a Any) -> a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from

    -- |Decode a value
    decode :: Get a
    default decode :: (Generic a, GFlatDecode (Rep a)) => Get a
    decode = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
to (Rep a Any -> a) -> Get (Rep a Any) -> Get a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Get (Rep a Any)
forall (f :: * -> *) t. GFlatDecode f => Get (f t)
gget

    -- |Add maximum size in bits of the value to the total count
    --
    --  Used to calculated maximum buffer size before encoding
    size :: a -> NumBits -> NumBits
    default size :: (Generic a, GFlatSize (Rep a)) => a -> NumBits -> NumBits
    size !a
x !NumBits
n = NumBits -> Rep a Any -> NumBits
forall (f :: * -> *) a. GFlatSize f => NumBits -> f a -> NumBits
gsize NumBits
n (Rep a Any -> NumBits) -> Rep a Any -> NumBits
forall a b. (a -> b) -> a -> b
$ a -> Rep a Any
forall a x. Generic a => a -> Rep a x
from a
x

#if INL>=2
    -- With these, generated code is optimised for specific data types (e.g.: Tree Bool will fuse the code of Tree and Bool)
    -- This can improve performance very significantly (up to 10X) but also increases compilation times.
    {-# INLINE size #-}
    {-# INLINE decode #-}
    {-# INLINE encode #-}
#elif INL == 1
#elif INL == 0
    {-# NOINLINE size #-}
    {-# NOINLINE decode #-}
    {-# NOINLINE encode #-}
#endif

-- |Generic Encoder
class GFlatEncode f where gencode :: f a -> Encoding

instance {-# OVERLAPPABLE #-} GFlatEncode f => GFlatEncode (M1 i c f) where
      gencode :: M1 i c f a -> Encoding
gencode = f a -> Encoding
forall (f :: * -> *) a. GFlatEncode f => f a -> Encoding
gencode (f a -> Encoding) -> (M1 i c f a -> f a) -> M1 i c f a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 i c f a -> f a
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
      {-# INLINE gencode #-}

  -- Special case, single constructor datatype
instance {-# OVERLAPPING #-} GFlatEncode a => GFlatEncode (D1 i (C1 c a)) where
      gencode :: D1 i (C1 c a) a -> Encoding
gencode = a a -> Encoding
forall (f :: * -> *) a. GFlatEncode f => f a -> Encoding
gencode (a a -> Encoding)
-> (D1 i (C1 c a) a -> a a) -> D1 i (C1 c a) a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 C c a a -> a a
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (M1 C c a a -> a a)
-> (D1 i (C1 c a) a -> M1 C c a a) -> D1 i (C1 c a) a -> a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D1 i (C1 c a) a -> M1 C c a a
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
      {-# INLINE gencode #-}

  -- Type without constructors
instance GFlatEncode V1 where
      gencode :: V1 a -> Encoding
gencode = V1 a -> Encoding
forall a. a
unused
      {-# INLINE gencode #-}

  -- Constructor without arguments
instance GFlatEncode U1 where
      gencode :: U1 a -> Encoding
gencode U1 a
U1 = Encoding
forall a. Monoid a => a
mempty
      {-# INLINE gencode #-}

instance Flat a => GFlatEncode (K1 i a) where
      {-# INLINE gencode #-}
#if INL == 1
      gencode x = inline encode (unK1 x)
#else
      gencode :: K1 i a a -> Encoding
gencode = a -> Encoding
forall a. Flat a => a -> Encoding
encode (a -> Encoding) -> (K1 i a a -> a) -> K1 i a a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 i a a -> a
forall i c k (p :: k). K1 i c p -> c
unK1
#endif

instance (GFlatEncode a, GFlatEncode b) => GFlatEncode (a :*: b) where
      --gencode (!x :*: (!y)) = gencode x <++> gencode y
      gencode :: (:*:) a b a -> Encoding
gencode (a a
x :*: b a
y) = a a -> Encoding
forall (f :: * -> *) a. GFlatEncode f => f a -> Encoding
gencode a a
x Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> b a -> Encoding
forall (f :: * -> *) a. GFlatEncode f => f a -> Encoding
gencode b a
y
      {-# INLINE gencode #-}

instance (NumConstructors (a :+: b) <= 512,GFlatEncodeSum (a :+: b)) => GFlatEncode (a :+: b) where
-- instance (GFlatEncodeSum (a :+: b)) => GFlatEncode (a :+: b) where
      gencode :: (:+:) a b a -> Encoding
gencode = Word16 -> NumBits -> (:+:) a b a -> Encoding
forall (f :: * -> *) a.
GFlatEncodeSum f =>
Word16 -> NumBits -> f a -> Encoding
gencodeSum Word16
0 NumBits
0
      {-# INLINE gencode #-}

-- Constructor Encoding
class GFlatEncodeSum f where
  gencodeSum :: Word16 -> NumBits -> f a -> Encoding

instance (GFlatEncodeSum a, GFlatEncodeSum b) => GFlatEncodeSum (a :+: b) where
  gencodeSum :: Word16 -> NumBits -> (:+:) a b a -> Encoding
gencodeSum !Word16
code !NumBits
numBits (:+:) a b a
s = case (:+:) a b a
s of
                           L1 !a a
x -> Word16 -> NumBits -> a a -> Encoding
forall (f :: * -> *) a.
GFlatEncodeSum f =>
Word16 -> NumBits -> f a -> Encoding
gencodeSum (Word16
code Word16 -> NumBits -> Word16
forall a. Bits a => a -> NumBits -> a
`unsafeShiftL` NumBits
1) (NumBits
numBitsNumBits -> NumBits -> NumBits
forall a. Num a => a -> a -> a
+NumBits
1) a a
x
                           R1 !b a
x -> Word16 -> NumBits -> b a -> Encoding
forall (f :: * -> *) a.
GFlatEncodeSum f =>
Word16 -> NumBits -> f a -> Encoding
gencodeSum ((Word16
code Word16 -> NumBits -> Word16
forall a. Bits a => a -> NumBits -> a
`unsafeShiftL` NumBits
1) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.|. Word16
1) (NumBits
numBitsNumBits -> NumBits -> NumBits
forall a. Num a => a -> a -> a
+NumBits
1) b a
x
  {-# INLINE  gencodeSum #-}

instance GFlatEncode a => GFlatEncodeSum (C1 c a) where
  gencodeSum :: Word16 -> NumBits -> C1 c a a -> Encoding
gencodeSum !Word16
code !NumBits
numBits C1 c a a
x = NumBits -> Word16 -> Encoding
eBits16 NumBits
numBits Word16
code Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> C1 c a a -> Encoding
forall (f :: * -> *) a. GFlatEncode f => f a -> Encoding
gencode C1 c a a
x
  {-# INLINE  gencodeSum #-}

-- |Generic Decoding
class GFlatDecode f where
  gget :: Get (f t)

-- |Metadata (constructor name, etc)
instance GFlatDecode a => GFlatDecode (M1 i c a) where
    gget :: Get (M1 i c a t)
gget = a t -> M1 i c a t
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a t -> M1 i c a t) -> Get (a t) -> Get (M1 i c a t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (a t)
forall (f :: * -> *) t. GFlatDecode f => Get (f t)
gget
    {-# INLINE  gget #-}

-- |Type without constructors
instance GFlatDecode V1 where
    gget :: Get (V1 t)
gget = Get (V1 t)
forall a. a
unused
    {-# INLINE  gget #-}

-- |Constructor without arguments
instance GFlatDecode U1 where
    gget :: Get (U1 t)
gget = U1 t -> Get (U1 t)
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 t
forall k (p :: k). U1 p
U1
    {-# INLINE  gget #-}

-- |Product: constructor with parameters
instance (GFlatDecode a, GFlatDecode b) => GFlatDecode (a :*: b) where
  gget :: Get ((:*:) a b t)
gget = a t -> b t -> (:*:) a b t
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (a t -> b t -> (:*:) a b t)
-> Get (a t) -> Get (b t -> (:*:) a b t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (a t)
forall (f :: * -> *) t. GFlatDecode f => Get (f t)
gget Get (b t -> (:*:) a b t) -> Get (b t) -> Get ((:*:) a b t)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (b t)
forall (f :: * -> *) t. GFlatDecode f => Get (f t)
gget
  {-# INLINE gget #-}

-- |Constants, additional parameters, and rank-1 recursion
instance Flat a => GFlatDecode (K1 i a) where
#if INL == 1
  gget = K1 <$> inline decode
#else
  gget :: Get (K1 i a t)
gget = a -> K1 i a t
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 i a t) -> Get a -> Get (K1 i a t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
forall a. Flat a => Get a
decode
#endif
  {-# INLINE gget #-}


-- Different valid decoding setups
-- #define DEC_BOOLG
-- #define DEC_BOOL

-- #define DEC_BOOLG
-- #define DEC_BOOL
-- #define DEC_BOOL48

-- #define DEC_CONS
-- #define DEC_BOOLC
-- #define DEC_BOOL

-- #define DEC_CONS
-- #define DEC_BOOLC
-- #define DEC_BOOL
-- #define DEC_BOOL48

-- #define DEC_CONS

-- #define DEC_CONS
-- #define DEC_CONS48

#define DEC_CONS
#define DEC_CONS48
#define DEC_BOOLC
#define DEC_BOOL

#ifdef DEC_BOOLG
instance (GFlatDecode a, GFlatDecode b) => GFlatDecode (a :+: b)
#endif

#ifdef DEC_BOOLC
-- Special case for data types with two constructors
instance {-# OVERLAPPING #-} (GFlatDecode a,GFlatDecode b) => GFlatDecode (C1 m1 a :+: C1 m2 b)
#endif

#ifdef DEC_BOOL
  where
      gget :: Get ((:+:) (C1 m1 a) (C1 m2 b) t)
gget = do
        -- error "DECODE2_C2"
        !Bool
tag <- Get Bool
dBool
        !(:+:) (C1 m1 a) (C1 m2 b) t
r <- if Bool
tag then C1 m2 b t -> (:+:) (C1 m1 a) (C1 m2 b) t
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (C1 m2 b t -> (:+:) (C1 m1 a) (C1 m2 b) t)
-> Get (C1 m2 b t) -> Get ((:+:) (C1 m1 a) (C1 m2 b) t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (C1 m2 b t)
forall (f :: * -> *) t. GFlatDecode f => Get (f t)
gget else C1 m1 a t -> (:+:) (C1 m1 a) (C1 m2 b) t
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (C1 m1 a t -> (:+:) (C1 m1 a) (C1 m2 b) t)
-> Get (C1 m1 a t) -> Get ((:+:) (C1 m1 a) (C1 m2 b) t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (C1 m1 a t)
forall (f :: * -> *) t. GFlatDecode f => Get (f t)
gget
        (:+:) (C1 m1 a) (C1 m2 b) t -> Get ((:+:) (C1 m1 a) (C1 m2 b) t)
forall (m :: * -> *) a. Monad m => a -> m a
return (:+:) (C1 m1 a) (C1 m2 b) t
r
      {-# INLINE gget #-}
#endif

#ifdef DEC_CONS
-- | Data types with up to 512 constructors
-- Uses a custom constructor decoding state
-- instance {-# OVERLAPPABLE #-} (GFlatDecodeSum (a :+: b),GFlatDecode a, GFlatDecode b) => GFlatDecode (a :+: b) where
instance {-# OVERLAPPABLE #-} (NumConstructors (a :+: b) <= 512, GFlatDecodeSum (a :+: b)) => GFlatDecode (a :+: b) where
  gget :: Get ((:+:) a b t)
gget = do
    ConsState
cs <- Get ConsState
consOpen
    ConsState -> Get ((:+:) a b t)
forall (f :: * -> *) a. GFlatDecodeSum f => ConsState -> Get (f a)
getSum ConsState
cs
  {-# INLINE gget #-}

-- |Constructor Decoder
class GFlatDecodeSum f where
    getSum :: ConsState -> Get (f a)

#ifdef DEC_CONS48

-- Decode constructors in groups of 2 or 3 bits
-- Significantly reduce instance compilation time and slightly improve execution times
instance {-# OVERLAPPING #-} (GFlatDecodeSum n1,GFlatDecodeSum n2,GFlatDecodeSum n3,GFlatDecodeSum n4) => GFlatDecodeSum ((n1 :+: n2) :+: (n3 :+: n4)) -- where -- getSum = undefined
      where
          getSum :: ConsState -> Get ((:+:) (n1 :+: n2) (n3 :+: n4) a)
getSum ConsState
cs = do
            -- error "DECODE4"
            let (ConsState
cs',Word
tag) = ConsState -> NumBits -> (ConsState, Word)
consBits ConsState
cs NumBits
2
            case Word
tag of
              Word
0 -> (:+:) n1 n2 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 ((:+:) n1 n2 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a)
-> (n1 a -> (:+:) n1 n2 a)
-> n1 a
-> (:+:) (n1 :+: n2) (n3 :+: n4) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n1 a -> (:+:) n1 n2 a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (n1 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a)
-> Get (n1 a) -> Get ((:+:) (n1 :+: n2) (n3 :+: n4) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConsState -> Get (n1 a)
forall (f :: * -> *) a. GFlatDecodeSum f => ConsState -> Get (f a)
getSum ConsState
cs'
              Word
1 -> (:+:) n1 n2 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 ((:+:) n1 n2 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a)
-> (n2 a -> (:+:) n1 n2 a)
-> n2 a
-> (:+:) (n1 :+: n2) (n3 :+: n4) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n2 a -> (:+:) n1 n2 a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (n2 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a)
-> Get (n2 a) -> Get ((:+:) (n1 :+: n2) (n3 :+: n4) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConsState -> Get (n2 a)
forall (f :: * -> *) a. GFlatDecodeSum f => ConsState -> Get (f a)
getSum ConsState
cs'
              Word
2 -> (:+:) n3 n4 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 ((:+:) n3 n4 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a)
-> (n3 a -> (:+:) n3 n4 a)
-> n3 a
-> (:+:) (n1 :+: n2) (n3 :+: n4) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n3 a -> (:+:) n3 n4 a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (n3 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a)
-> Get (n3 a) -> Get ((:+:) (n1 :+: n2) (n3 :+: n4) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConsState -> Get (n3 a)
forall (f :: * -> *) a. GFlatDecodeSum f => ConsState -> Get (f a)
getSum ConsState
cs'
              Word
_ -> (:+:) n3 n4 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 ((:+:) n3 n4 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a)
-> (n4 a -> (:+:) n3 n4 a)
-> n4 a
-> (:+:) (n1 :+: n2) (n3 :+: n4) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n4 a -> (:+:) n3 n4 a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (n4 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a)
-> Get (n4 a) -> Get ((:+:) (n1 :+: n2) (n3 :+: n4) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConsState -> Get (n4 a)
forall (f :: * -> *) a. GFlatDecodeSum f => ConsState -> Get (f a)
getSum ConsState
cs'
          {-# INLINE getSum #-}

instance {-# OVERLAPPING #-} (GFlatDecodeSum n1,GFlatDecodeSum n2,GFlatDecodeSum n3,GFlatDecodeSum n4,GFlatDecodeSum n5,GFlatDecodeSum n6,GFlatDecodeSum n7,GFlatDecodeSum n8) => GFlatDecodeSum (((n1 :+: n2) :+: (n3 :+: n4)) :+: ((n5 :+: n6) :+: (n7 :+: n8))) -- where -- getSum cs = undefined
     where
      getSum :: ConsState
-> Get
     ((:+:)
        ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
getSum ConsState
cs = do
        --error "DECODE8"
        let (ConsState
cs',Word
tag) = ConsState -> NumBits -> (ConsState, Word)
consBits ConsState
cs NumBits
3
        case Word
tag of
          Word
0 -> (:+:) (n1 :+: n2) (n3 :+: n4) a
-> (:+:)
     ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 ((:+:) (n1 :+: n2) (n3 :+: n4) a
 -> (:+:)
      ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
-> (n1 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a)
-> n1 a
-> (:+:)
     ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:+:) n1 n2 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 ((:+:) n1 n2 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a)
-> (n1 a -> (:+:) n1 n2 a)
-> n1 a
-> (:+:) (n1 :+: n2) (n3 :+: n4) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n1 a -> (:+:) n1 n2 a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (n1 a
 -> (:+:)
      ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
-> Get (n1 a)
-> Get
     ((:+:)
        ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConsState -> Get (n1 a)
forall (f :: * -> *) a. GFlatDecodeSum f => ConsState -> Get (f a)
getSum ConsState
cs'
          Word
1 -> (:+:) (n1 :+: n2) (n3 :+: n4) a
-> (:+:)
     ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 ((:+:) (n1 :+: n2) (n3 :+: n4) a
 -> (:+:)
      ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
-> (n2 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a)
-> n2 a
-> (:+:)
     ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:+:) n1 n2 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 ((:+:) n1 n2 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a)
-> (n2 a -> (:+:) n1 n2 a)
-> n2 a
-> (:+:) (n1 :+: n2) (n3 :+: n4) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n2 a -> (:+:) n1 n2 a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (n2 a
 -> (:+:)
      ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
-> Get (n2 a)
-> Get
     ((:+:)
        ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConsState -> Get (n2 a)
forall (f :: * -> *) a. GFlatDecodeSum f => ConsState -> Get (f a)
getSum ConsState
cs'
          Word
2 -> (:+:) (n1 :+: n2) (n3 :+: n4) a
-> (:+:)
     ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 ((:+:) (n1 :+: n2) (n3 :+: n4) a
 -> (:+:)
      ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
-> (n3 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a)
-> n3 a
-> (:+:)
     ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:+:) n3 n4 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 ((:+:) n3 n4 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a)
-> (n3 a -> (:+:) n3 n4 a)
-> n3 a
-> (:+:) (n1 :+: n2) (n3 :+: n4) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n3 a -> (:+:) n3 n4 a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (n3 a
 -> (:+:)
      ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
-> Get (n3 a)
-> Get
     ((:+:)
        ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConsState -> Get (n3 a)
forall (f :: * -> *) a. GFlatDecodeSum f => ConsState -> Get (f a)
getSum ConsState
cs'
          Word
3 -> (:+:) (n1 :+: n2) (n3 :+: n4) a
-> (:+:)
     ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 ((:+:) (n1 :+: n2) (n3 :+: n4) a
 -> (:+:)
      ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
-> (n4 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a)
-> n4 a
-> (:+:)
     ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:+:) n3 n4 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 ((:+:) n3 n4 a -> (:+:) (n1 :+: n2) (n3 :+: n4) a)
-> (n4 a -> (:+:) n3 n4 a)
-> n4 a
-> (:+:) (n1 :+: n2) (n3 :+: n4) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n4 a -> (:+:) n3 n4 a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (n4 a
 -> (:+:)
      ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
-> Get (n4 a)
-> Get
     ((:+:)
        ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConsState -> Get (n4 a)
forall (f :: * -> *) a. GFlatDecodeSum f => ConsState -> Get (f a)
getSum ConsState
cs'
          Word
4 -> (:+:) (n5 :+: n6) (n7 :+: n8) a
-> (:+:)
     ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 ((:+:) (n5 :+: n6) (n7 :+: n8) a
 -> (:+:)
      ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
-> (n5 a -> (:+:) (n5 :+: n6) (n7 :+: n8) a)
-> n5 a
-> (:+:)
     ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:+:) n5 n6 a -> (:+:) (n5 :+: n6) (n7 :+: n8) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 ((:+:) n5 n6 a -> (:+:) (n5 :+: n6) (n7 :+: n8) a)
-> (n5 a -> (:+:) n5 n6 a)
-> n5 a
-> (:+:) (n5 :+: n6) (n7 :+: n8) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n5 a -> (:+:) n5 n6 a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (n5 a
 -> (:+:)
      ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
-> Get (n5 a)
-> Get
     ((:+:)
        ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConsState -> Get (n5 a)
forall (f :: * -> *) a. GFlatDecodeSum f => ConsState -> Get (f a)
getSum ConsState
cs'
          Word
5 -> (:+:) (n5 :+: n6) (n7 :+: n8) a
-> (:+:)
     ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 ((:+:) (n5 :+: n6) (n7 :+: n8) a
 -> (:+:)
      ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
-> (n6 a -> (:+:) (n5 :+: n6) (n7 :+: n8) a)
-> n6 a
-> (:+:)
     ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:+:) n5 n6 a -> (:+:) (n5 :+: n6) (n7 :+: n8) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 ((:+:) n5 n6 a -> (:+:) (n5 :+: n6) (n7 :+: n8) a)
-> (n6 a -> (:+:) n5 n6 a)
-> n6 a
-> (:+:) (n5 :+: n6) (n7 :+: n8) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n6 a -> (:+:) n5 n6 a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (n6 a
 -> (:+:)
      ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
-> Get (n6 a)
-> Get
     ((:+:)
        ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConsState -> Get (n6 a)
forall (f :: * -> *) a. GFlatDecodeSum f => ConsState -> Get (f a)
getSum ConsState
cs'
          Word
6 -> (:+:) (n5 :+: n6) (n7 :+: n8) a
-> (:+:)
     ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 ((:+:) (n5 :+: n6) (n7 :+: n8) a
 -> (:+:)
      ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
-> (n7 a -> (:+:) (n5 :+: n6) (n7 :+: n8) a)
-> n7 a
-> (:+:)
     ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:+:) n7 n8 a -> (:+:) (n5 :+: n6) (n7 :+: n8) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 ((:+:) n7 n8 a -> (:+:) (n5 :+: n6) (n7 :+: n8) a)
-> (n7 a -> (:+:) n7 n8 a)
-> n7 a
-> (:+:) (n5 :+: n6) (n7 :+: n8) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n7 a -> (:+:) n7 n8 a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (n7 a
 -> (:+:)
      ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
-> Get (n7 a)
-> Get
     ((:+:)
        ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConsState -> Get (n7 a)
forall (f :: * -> *) a. GFlatDecodeSum f => ConsState -> Get (f a)
getSum ConsState
cs'
          Word
_ -> (:+:) (n5 :+: n6) (n7 :+: n8) a
-> (:+:)
     ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 ((:+:) (n5 :+: n6) (n7 :+: n8) a
 -> (:+:)
      ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
-> (n8 a -> (:+:) (n5 :+: n6) (n7 :+: n8) a)
-> n8 a
-> (:+:)
     ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:+:) n7 n8 a -> (:+:) (n5 :+: n6) (n7 :+: n8) a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 ((:+:) n7 n8 a -> (:+:) (n5 :+: n6) (n7 :+: n8) a)
-> (n8 a -> (:+:) n7 n8 a)
-> n8 a
-> (:+:) (n5 :+: n6) (n7 :+: n8) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n8 a -> (:+:) n7 n8 a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (n8 a
 -> (:+:)
      ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
-> Get (n8 a)
-> Get
     ((:+:)
        ((n1 :+: n2) :+: (n3 :+: n4)) ((n5 :+: n6) :+: (n7 :+: n8)) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConsState -> Get (n8 a)
forall (f :: * -> *) a. GFlatDecodeSum f => ConsState -> Get (f a)
getSum ConsState
cs'
      {-# INLINE getSum #-}

instance {-# OVERLAPPABLE #-} (GFlatDecodeSum a, GFlatDecodeSum b) => GFlatDecodeSum (a :+: b) where
#else
instance (GFlatDecodeSum a, GFlatDecodeSum b) => GFlatDecodeSum (a :+: b) where
#endif

  getSum :: ConsState -> Get ((:+:) a b a)
getSum ConsState
cs = do
    let (ConsState
cs',Bool
tag) = ConsState -> (ConsState, Bool)
consBool ConsState
cs
    if Bool
tag then b a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (b a -> (:+:) a b a) -> Get (b a) -> Get ((:+:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConsState -> Get (b a)
forall (f :: * -> *) a. GFlatDecodeSum f => ConsState -> Get (f a)
getSum ConsState
cs' else a a -> (:+:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (a a -> (:+:) a b a) -> Get (a a) -> Get ((:+:) a b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConsState -> Get (a a)
forall (f :: * -> *) a. GFlatDecodeSum f => ConsState -> Get (f a)
getSum ConsState
cs'
  {-# INLINE getSum #-}


instance GFlatDecode a => GFlatDecodeSum (C1 c a) where
    getSum :: ConsState -> Get (C1 c a a)
getSum (ConsState Word
_ NumBits
usedBits) = NumBits -> Get ()
consClose NumBits
usedBits Get () -> Get (C1 c a a) -> Get (C1 c a a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get (C1 c a a)
forall (f :: * -> *) t. GFlatDecode f => Get (f t)
gget
    {-# INLINE getSum #-}
#endif

#ifdef DEC_BOOL48
instance {-# OVERLAPPING #-} (GFlatDecode n1,GFlatDecode n2,GFlatDecode n3,GFlatDecode n4) => GFlatDecode ((n1 :+: n2) :+: (n3 :+: n4)) -- where -- gget = undefined
  where
      gget = do
        -- error "DECODE4"
        !tag <- dBEBits8 2
        case tag of
          0 -> L1 <$> L1 <$> gget
          1 -> L1 <$> R1 <$> gget
          2 -> R1 <$> L1 <$> gget
          _ -> R1 <$> R1 <$> gget
      {-# INLINE gget #-}

instance {-# OVERLAPPING #-} (GFlatDecode n1,GFlatDecode n2,GFlatDecode n3,GFlatDecode n4,GFlatDecode n5,GFlatDecode n6,GFlatDecode n7,GFlatDecode n8) => GFlatDecode (((n1 :+: n2) :+: (n3 :+: n4)) :+: ((n5 :+: n6) :+: (n7 :+: n8))) -- where -- gget = undefined
 where
  gget = do
    --error "DECODE8"
    !tag <- dBEBits8 3
    case tag of
      0 -> L1 <$> L1 <$> L1 <$> gget
      1 -> L1 <$> L1 <$> R1 <$> gget
      2 -> L1 <$> R1 <$> L1 <$> gget
      3 -> L1 <$> R1 <$> R1 <$> gget
      4 -> R1 <$> L1 <$> L1 <$> gget
      5 -> R1 <$> L1 <$> R1 <$> gget
      6 -> R1 <$> R1 <$> L1 <$> gget
      _ -> R1 <$> R1 <$> R1 <$> gget
  {-# INLINE gget #-}
#endif

-- |Calculate the number of bits required for the serialisation of a value
-- Implemented as a function that adds the maximum size to a running total
class GFlatSize f where gsize :: NumBits -> f a -> NumBits

-- |Skip metadata
instance GFlatSize f => GFlatSize (M1 i c f) where
    gsize :: NumBits -> M1 i c f a -> NumBits
gsize !NumBits
n = NumBits -> f a -> NumBits
forall (f :: * -> *) a. GFlatSize f => NumBits -> f a -> NumBits
gsize NumBits
n (f a -> NumBits) -> (M1 i c f a -> f a) -> M1 i c f a -> NumBits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M1 i c f a -> f a
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
    {-# INLINE gsize #-}

-- |Type without constructors
instance GFlatSize V1 where
    gsize :: NumBits -> V1 a -> NumBits
gsize !NumBits
n V1 a
_ = NumBits
n
    {-# INLINE gsize #-}

-- |Constructor without arguments
instance GFlatSize U1 where
    gsize :: NumBits -> U1 a -> NumBits
gsize !NumBits
n U1 a
_ = NumBits
n
    {-# INLINE gsize #-}

-- |Skip metadata
instance Flat a => GFlatSize (K1 i a) where
#if INL == 1
  gsize !n x = inline size (unK1 x) n
#else
  gsize :: NumBits -> K1 i a a -> NumBits
gsize !NumBits
n K1 i a a
x = a -> NumBits -> NumBits
forall a. Flat a => a -> NumBits -> NumBits
size (K1 i a a -> a
forall i c k (p :: k). K1 i c p -> c
unK1 K1 i a a
x) NumBits
n
#endif
  {-# INLINE gsize #-}

instance (GFlatSize a, GFlatSize b) => GFlatSize (a :*: b) where
    gsize :: NumBits -> (:*:) a b a -> NumBits
gsize !NumBits
n (a a
x :*: b a
y) =
      let !n' :: NumBits
n' = NumBits -> a a -> NumBits
forall (f :: * -> *) a. GFlatSize f => NumBits -> f a -> NumBits
gsize NumBits
n a a
x
      in NumBits -> b a -> NumBits
forall (f :: * -> *) a. GFlatSize f => NumBits -> f a -> NumBits
gsize NumBits
n' b a
y
      -- gsize (gsize n x) y
    {-# INLINE gsize #-}

-- Alternative 'gsize' implementations
#define SIZ_ADD
-- #define SIZ_NUM

-- #define SIZ_MAX
-- #define SIZ_MAX_VAL
-- #define SIZ_MAX_PROX

#ifdef SIZ_ADD
instance (GFlatSizeSum (a :+: b)) => GFlatSize (a :+: b) where
  gsize :: NumBits -> (:+:) a b a -> NumBits
gsize !NumBits
n = NumBits -> (:+:) a b a -> NumBits
forall (f :: * -> *) a. GFlatSizeSum f => NumBits -> f a -> NumBits
gsizeSum NumBits
n
#endif

#ifdef SIZ_NUM
instance (GFlatSizeSum (a :+: b)) => GFlatSize (a :+: b) where
  gsize !n x = n + gsizeSum 0 x
#endif

#ifdef SIZ_MAX
instance (GFlatSizeNxt (a :+: b),GFlatSizeMax (a:+:b)) => GFlatSize (a :+: b) where
  gsize !n x = gsizeNxt (gsizeMax x + n) x
  {-# INLINE gsize #-}

-- |Calculate the maximum size of a class constructor (that might be one bit more than the size of some of its constructors)
#ifdef SIZ_MAX_VAL
class GFlatSizeMax (f :: * -> *) where gsizeMax :: f a ->  NumBits

instance (GFlatSizeMax f, GFlatSizeMax g) => GFlatSizeMax (f :+: g) where
    gsizeMax _ = 1 + max (gsizeMax (undefined::f a )) (gsizeMax (undefined::g a))
    {-# INLINE gsizeMax #-}

instance (GFlatSize a) => GFlatSizeMax (C1 c a) where
    {-# INLINE gsizeMax #-}
    gsizeMax _ = 0
#endif

#ifdef SIZ_MAX_PROX
-- instance (GFlatSizeNxt (a :+: b),GFlatSizeMax (a:+:b)) => GFlatSize (a :+: b) where
--   gsize !n x = gsizeNxt (gsizeMax x + n) x
--   {-# INLINE gsize #-}


-- -- |Calculate size in bits of constructor
-- class KnownNat n => GFlatSizeMax (n :: Nat) (f :: * -> *) where gsizeMax :: f a -> Proxy n -> NumBits

-- instance (GFlatSizeMax (n + 1) a, GFlatSizeMax (n + 1) b, KnownNat n) => GFlatSizeMax n (a :+: b) where
--     gsizeMax !n x _ = case x of
--                         L1 !l -> gsizeMax n l (Proxy :: Proxy (n+1))
--                         R1 !r -> gsizeMax n r (Proxy :: Proxy (n+1))
--     {-# INLINE gsizeMax #-}

-- instance (GFlatSize a, KnownNat n) => GFlatSizeMax n (C1 c a) where
--     {-# INLINE gsizeMax #-}
--     gsizeMax !n !x _ = gsize (constructorSize + n) x
--       where
--         constructorSize :: NumBits
--         constructorSize = fromInteger (natVal (Proxy :: Proxy n))

-- class KnownNat (ConsSize f) => GFlatSizeMax (f :: * -> *) where
--   gsizeMax :: f a ->  NumBits
--   gsizeMax _ = fromInteger (natVal (Proxy :: Proxy (ConsSize f)))

type family ConsSize (a :: * -> *) :: Nat where
      ConsSize (C1 c a) = 0
      ConsSize (x :+: y) = 1 + Max (ConsSize x) (ConsSize y)

type family Max (n :: Nat) (m :: Nat) :: Nat where
   Max n m  = If (n <=? m) m n

type family If c (t::Nat) (e::Nat) where
    If 'True  t e = t
    If 'False t e = e
#endif

-- |Calculate the size of a value, not taking in account its constructor
class GFlatSizeNxt (f :: * -> *) where gsizeNxt :: NumBits -> f a ->  NumBits

instance (GFlatSizeNxt a, GFlatSizeNxt b) => GFlatSizeNxt (a :+: b) where
    gsizeNxt n x = case x of
                        L1 !l-> gsizeNxt n l
                        R1 !r-> gsizeNxt n r
    {-# INLINE gsizeNxt #-}

instance (GFlatSize a) => GFlatSizeNxt (C1 c a) where
    {-# INLINE gsizeNxt #-}
    gsizeNxt !n !x = gsize n x
#endif

-- |Calculate size in bits of constructor
-- vs proxy implementation: similar compilation time but much better run times (at least for Tree N, -70%)
class GFlatSizeSum (f :: * -> *) where gsizeSum :: NumBits -> f a ->  NumBits

instance (GFlatSizeSum a, GFlatSizeSum b)
         => GFlatSizeSum (a :+: b) where
    gsizeSum :: NumBits -> (:+:) a b a -> NumBits
gsizeSum !NumBits
n (:+:) a b a
x = case (:+:) a b a
x of
                        L1 !a a
l-> NumBits -> a a -> NumBits
forall (f :: * -> *) a. GFlatSizeSum f => NumBits -> f a -> NumBits
gsizeSum (NumBits
nNumBits -> NumBits -> NumBits
forall a. Num a => a -> a -> a
+NumBits
1) a a
l
                        R1 !b a
r-> NumBits -> b a -> NumBits
forall (f :: * -> *) a. GFlatSizeSum f => NumBits -> f a -> NumBits
gsizeSum (NumBits
nNumBits -> NumBits -> NumBits
forall a. Num a => a -> a -> a
+NumBits
1) b a
r
    {-# INLINE gsizeSum #-}

instance (GFlatSize a) => GFlatSizeSum (C1 c a) where
    {-# INLINE gsizeSum #-}
    gsizeSum :: NumBits -> C1 c a a -> NumBits
gsizeSum !NumBits
n !C1 c a a
x = NumBits -> C1 c a a -> NumBits
forall (f :: * -> *) a. GFlatSize f => NumBits -> f a -> NumBits
gsize NumBits
n C1 c a a
x


-- |Calculate number of constructors
type family NumConstructors (a :: * -> *) :: Nat where
  NumConstructors (C1 c a) = 1
  NumConstructors (x :+: y) = NumConstructors x + NumConstructors y

unused :: forall a . a
unused :: a
unused = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Now, now, you could not possibly have meant this.."