{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Data.SerDoc.Class
where

import Data.SerDoc.Info

import Data.Kind
import Data.List
import Data.Map ( Map )
import qualified Data.Map.Strict as Map
import Data.Proxy
import Data.Typeable
import Data.Word

-- * Typeclasses

-- | Abstracts over an individual serializer / deserializer, a.k.a., a
-- \"codec\". A codec typically provides a serializer, deserializer, and
-- metadata for each serializable type; however, for various reasons, the
-- 'Codec' typeclass itself only captures the associated types that are involved
-- in serializing and deserializing.
class Codec codec where
  -- | The 'Monad' in which encoding can happen.
  type MonadEncode codec :: Type -> Type

  -- | The 'Monad' in which decoding can happen.
  type MonadDecode codec :: Type -> Type

  -- | Unless explicitly declared otherwise, enum fields will be encoded as
  -- this type.
  type DefEnumEncoding codec :: Type
  type DefEnumEncoding codec = Word16

-- | Serialization and deserialization API for a 'Codec'.
class Codec codec => Serializable codec a where
  -- | Encode / serialize a value.
  encode :: Proxy codec -> a -> MonadEncode codec ()

  -- | Decode / deserialize a value.
  decode :: Proxy codec -> MonadDecode codec a

-- | Serialization metadata for a 'Codec'.
class Codec codec => HasInfo codec a where
  info :: Proxy codec -> Proxy a -> FieldInfo codec

-- * Helpers For Writing Instances

-- | Newtype wrapper for deriving / defining 'HasInfo' and 'Serializable'
-- instances for enum types.
newtype ViaEnum a = ViaEnum { forall a. ViaEnum a -> a
viaEnum :: a }
  deriving newtype (Int -> ViaEnum a -> ShowS
[ViaEnum a] -> ShowS
ViaEnum a -> [Char]
(Int -> ViaEnum a -> ShowS)
-> (ViaEnum a -> [Char])
-> ([ViaEnum a] -> ShowS)
-> Show (ViaEnum a)
forall a. Show a => Int -> ViaEnum a -> ShowS
forall a. Show a => [ViaEnum a] -> ShowS
forall a. Show a => ViaEnum a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ViaEnum a -> ShowS
showsPrec :: Int -> ViaEnum a -> ShowS
$cshow :: forall a. Show a => ViaEnum a -> [Char]
show :: ViaEnum a -> [Char]
$cshowList :: forall a. Show a => [ViaEnum a] -> ShowS
showList :: [ViaEnum a] -> ShowS
Show)

instance ( Enum a
         , Bounded a
         , Typeable a
         , Show a
         , Codec codec
         , HasInfo codec (DefEnumEncoding codec)
         ) => HasInfo codec (ViaEnum a)
  where
    info :: Proxy codec -> Proxy (ViaEnum a) -> FieldInfo codec
info Proxy codec
pCodec Proxy (ViaEnum a)
_ =
      Proxy codec
-> Proxy a -> Proxy (DefEnumEncoding codec) -> FieldInfo codec
forall codec a n.
(Typeable a, Show a, Enum a, Bounded a, Codec codec,
 HasInfo codec n, HasInfo codec (DefEnumEncoding codec)) =>
Proxy codec -> Proxy a -> Proxy n -> FieldInfo codec
enumInfo Proxy codec
pCodec (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(DefEnumEncoding codec))

instance ( Enum a
         , Bounded a
         , Codec codec
         , Integral (DefEnumEncoding codec)
         , Num (DefEnumEncoding codec)
         , Monad (MonadEncode codec)
         , Monad (MonadDecode codec)
         , Serializable codec (DefEnumEncoding codec)
         ) => Serializable codec (ViaEnum a)
  where
    encode :: Proxy codec -> ViaEnum a -> MonadEncode codec ()
encode Proxy codec
pCodec (ViaEnum a
x) = Proxy codec
-> Proxy (DefEnumEncoding codec) -> a -> MonadEncode codec ()
forall codec n a.
(Enum a, Bounded a, Codec codec, Num n, Serializable codec n) =>
Proxy codec -> Proxy n -> a -> MonadEncode codec ()
encodeEnum Proxy codec
pCodec (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(DefEnumEncoding codec)) a
x
    decode :: Proxy codec -> MonadDecode codec (ViaEnum a)
decode Proxy codec
pCodec = a -> ViaEnum a
forall a. a -> ViaEnum a
ViaEnum (a -> ViaEnum a)
-> MonadDecode codec a -> MonadDecode codec (ViaEnum a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy codec -> Proxy (DefEnumEncoding codec) -> MonadDecode codec a
forall codec n a.
(Enum a, Bounded a, Codec codec, Integral n, Serializable codec n,
 Monad (MonadDecode codec)) =>
Proxy codec -> Proxy n -> MonadDecode codec a
decodeEnum Proxy codec
pCodec (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(DefEnumEncoding codec))

enumInfo :: forall codec a n.
            ( Typeable a
            , Show a
            , Enum a
            , Bounded a
            , Codec codec
            , HasInfo codec n
            , HasInfo codec (DefEnumEncoding codec)
            )
         => Proxy codec
         -> Proxy a
         -> Proxy n
         -> FieldInfo codec
enumInfo :: forall codec a n.
(Typeable a, Show a, Enum a, Bounded a, Codec codec,
 HasInfo codec n, HasInfo codec (DefEnumEncoding codec)) =>
Proxy codec -> Proxy a -> Proxy n -> FieldInfo codec
enumInfo Proxy codec
pCodec Proxy a
_ Proxy n
pN =
    [Char] -> FieldSize -> [(Int, [Char])] -> FieldInfo codec
forall codec.
[Char] -> FieldSize -> [(Int, [Char])] -> FieldInfo codec
enumField
      (Proxy a -> [Char]
forall a. Typeable a => Proxy a -> [Char]
getTypeName (Proxy a -> [Char]) -> Proxy a -> [Char]
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
      (FieldInfo codec -> FieldSize
forall codec.
(Codec codec, HasInfo codec (DefEnumEncoding codec)) =>
FieldInfo codec -> FieldSize
fieldSize (FieldInfo codec -> FieldSize) -> FieldInfo codec -> FieldSize
forall a b. (a -> b) -> a -> b
$ Proxy codec -> Proxy n -> FieldInfo codec
forall codec a.
HasInfo codec a =>
Proxy codec -> Proxy a -> FieldInfo codec
info Proxy codec
pCodec Proxy n
pN)
      [ (a -> Int
forall a. Enum a => a -> Int
fromEnum a
val, a -> [Char]
forall a. Show a => a -> [Char]
show a
val) | a
val <- [a
forall a. Bounded a => a
minBound .. a
forall a. Bounded a => a
maxBound :: a] ]

encodeEnum :: forall codec n a.
              ( Enum a
              , Bounded a
              , Codec codec
              , Num n
              , Serializable codec n
              )
           => Proxy codec
           -> Proxy n
           -> a
           -> MonadEncode codec ()
encodeEnum :: forall codec n a.
(Enum a, Bounded a, Codec codec, Num n, Serializable codec n) =>
Proxy codec -> Proxy n -> a -> MonadEncode codec ()
encodeEnum Proxy codec
pCodec Proxy n
_ a
x = do
  let n
i :: n = Int -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> n) -> (a -> Int) -> a -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum (a -> n) -> a -> n
forall a b. (a -> b) -> a -> b
$ a
x
  Proxy codec -> n -> MonadEncode codec ()
forall codec a.
Serializable codec a =>
Proxy codec -> a -> MonadEncode codec ()
encode Proxy codec
pCodec n
i

decodeEnum :: forall codec n a.
               ( Enum a
               , Bounded a
               , Codec codec
               , Integral n
               , Serializable codec n
               , Monad (MonadDecode codec)
               )
            => Proxy codec
            -> Proxy n
            -> (MonadDecode codec) a
decodeEnum :: forall codec n a.
(Enum a, Bounded a, Codec codec, Integral n, Serializable codec n,
 Monad (MonadDecode codec)) =>
Proxy codec -> Proxy n -> MonadDecode codec a
decodeEnum Proxy codec
pCodec Proxy n
_ = do
  (n
i :: n) <- Proxy codec -> MonadDecode codec n
forall codec a.
Serializable codec a =>
Proxy codec -> MonadDecode codec a
decode Proxy codec
pCodec
  a -> MonadDecode codec a
forall a. a -> MonadDecode codec a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> (n -> Int) -> n -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (n -> a) -> n -> a
forall a b. (a -> b) -> a -> b
$ n
i)

getTypeName :: Typeable a => Proxy a -> String
getTypeName :: forall a. Typeable a => Proxy a -> [Char]
getTypeName = TyCon -> [Char]
tyConName (TyCon -> [Char]) -> (Proxy a -> TyCon) -> Proxy a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep -> TyCon
typeRepTyCon (TypeRep -> TyCon) -> (Proxy a -> TypeRep) -> Proxy a -> TyCon
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> TypeRep
forall {k} (proxy :: k -> Type) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep


-- * Helpers For Dealing With 'FieldInfo' And 'Field Size'

fieldType :: forall codec.
             HasInfo codec Word32
          => FieldInfo codec -> String
fieldType :: forall codec. HasInfo codec Word32 => FieldInfo codec -> [Char]
fieldType (AnnField [Char]
_ FieldInfo codec
fi) = FieldInfo codec -> [Char]
forall codec. HasInfo codec Word32 => FieldInfo codec -> [Char]
fieldType FieldInfo codec
fi
fieldType (BasicField BasicFieldInfo
fi) = BasicFieldInfo -> [Char]
basicFieldType BasicFieldInfo
fi
fieldType (EnumField EnumFieldInfo
fi) = EnumFieldInfo -> [Char]
enumFieldType EnumFieldInfo
fi [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldInfo codec -> [Char]
forall codec. HasInfo codec Word32 => FieldInfo codec -> [Char]
fieldType (forall codec a.
HasInfo codec a =>
Proxy codec -> Proxy a -> FieldInfo codec
info @codec @Word32 Proxy codec
forall {k} (t :: k). Proxy t
Proxy Proxy Word32
forall {k} (t :: k). Proxy t
Proxy)
fieldType (CompoundField CompoundFieldInfo codec
fi) = CompoundFieldInfo codec -> [Char]
forall codec. CompoundFieldInfo codec -> [Char]
compoundFieldType CompoundFieldInfo codec
fi
fieldType (ChoiceField ChoiceFieldInfo codec
fi) = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" | " ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (FieldInfo codec -> [Char]) -> [FieldInfo codec] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map FieldInfo codec -> [Char]
forall codec. HasInfo codec Word32 => FieldInfo codec -> [Char]
fieldType (ChoiceFieldInfo codec -> [FieldInfo codec]
forall codec. ChoiceFieldInfo codec -> [FieldInfo codec]
choiceFieldAlternatives ChoiceFieldInfo codec
fi)
fieldType (ListField ListFieldInfo codec
fi) = [Char]
"[" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldInfo codec -> [Char]
forall codec. HasInfo codec Word32 => FieldInfo codec -> [Char]
fieldType (ListFieldInfo codec -> FieldInfo codec
forall codec. ListFieldInfo codec -> FieldInfo codec
listElemInfo ListFieldInfo codec
fi) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"]"
fieldType (AliasField AliasFieldInfo codec
fi) = AliasFieldInfo codec -> [Char]
forall codec. AliasFieldInfo codec -> [Char]
aliasFieldName AliasFieldInfo codec
fi [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" = " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldInfo codec -> [Char]
forall codec. HasInfo codec Word32 => FieldInfo codec -> [Char]
fieldType (AliasFieldInfo codec -> FieldInfo codec
forall codec. AliasFieldInfo codec -> FieldInfo codec
aliasFieldTarget AliasFieldInfo codec
fi)
fieldType (SumField SumFieldInfo codec
fi) = SumFieldInfo codec -> [Char]
forall codec. SumFieldInfo codec -> [Char]
sumFieldType SumFieldInfo codec
fi

shortFieldType :: FieldInfo codec -> String
shortFieldType :: forall codec. FieldInfo codec -> [Char]
shortFieldType (AnnField [Char]
_ FieldInfo codec
fi) = FieldInfo codec -> [Char]
forall codec. FieldInfo codec -> [Char]
shortFieldType FieldInfo codec
fi
shortFieldType (BasicField BasicFieldInfo
fi) = BasicFieldInfo -> [Char]
basicFieldType BasicFieldInfo
fi
shortFieldType (EnumField EnumFieldInfo
fi) = EnumFieldInfo -> [Char]
enumFieldType EnumFieldInfo
fi
shortFieldType (CompoundField CompoundFieldInfo codec
fi) = CompoundFieldInfo codec -> [Char]
forall codec. CompoundFieldInfo codec -> [Char]
compoundFieldType CompoundFieldInfo codec
fi
shortFieldType (ChoiceField ChoiceFieldInfo codec
fi) = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" | " ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (FieldInfo codec -> [Char]) -> [FieldInfo codec] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map FieldInfo codec -> [Char]
forall codec. FieldInfo codec -> [Char]
shortFieldType (ChoiceFieldInfo codec -> [FieldInfo codec]
forall codec. ChoiceFieldInfo codec -> [FieldInfo codec]
choiceFieldAlternatives ChoiceFieldInfo codec
fi)
shortFieldType (ListField ListFieldInfo codec
fi) = [Char]
"[" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ FieldInfo codec -> [Char]
forall codec. FieldInfo codec -> [Char]
shortFieldType (ListFieldInfo codec -> FieldInfo codec
forall codec. ListFieldInfo codec -> FieldInfo codec
listElemInfo ListFieldInfo codec
fi) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"]"
shortFieldType (AliasField AliasFieldInfo codec
fi) = AliasFieldInfo codec -> [Char]
forall codec. AliasFieldInfo codec -> [Char]
aliasFieldName AliasFieldInfo codec
fi
shortFieldType (SumField SumFieldInfo codec
fi) = SumFieldInfo codec -> [Char]
forall codec. SumFieldInfo codec -> [Char]
sumFieldType SumFieldInfo codec
fi

-- | Reduce a 'FieldInfo' to report only the relevant information for a known
-- constructor.
infoOf :: String -> FieldInfo codec -> FieldInfo codec
infoOf :: forall codec. [Char] -> FieldInfo codec -> FieldInfo codec
infoOf [Char]
name (AnnField [Char]
_ FieldInfo codec
fi) = [Char] -> FieldInfo codec -> FieldInfo codec
forall codec. [Char] -> FieldInfo codec -> FieldInfo codec
infoOf [Char]
name FieldInfo codec
fi
infoOf [Char]
name (EnumField EnumFieldInfo
fi) =
  EnumFieldInfo -> FieldInfo codec
forall codec. EnumFieldInfo -> FieldInfo codec
EnumField EnumFieldInfo
fi
    { enumFieldValues =
        [ (i, n)
        | (i, n) <- enumFieldValues fi
        , n == name
        ]
    }
infoOf [Char]
name (SumField SumFieldInfo codec
fi) =
  SumFieldInfo codec -> FieldInfo codec
forall codec. SumFieldInfo codec -> FieldInfo codec
SumField SumFieldInfo codec
fi
    { sumFieldAlternatives =
        [ (n, i)
        | (n, i) <- sumFieldAlternatives fi
        , n == name
        ]
    }
infoOf [Char]
_ FieldInfo codec
fi = FieldInfo codec
fi

formatPath :: [String] -> String
formatPath :: [[Char]] -> [Char]
formatPath = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"." ([[Char]] -> [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse

scopeFieldSize :: String -> FieldSize -> FieldSize
scopeFieldSize :: [Char] -> FieldSize -> FieldSize
scopeFieldSize [Char]
scope (VarSize [Char]
var) = [Char] -> FieldSize
VarSize ([Char]
scope [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
var)
scopeFieldSize [Char]
scope (BinopSize FieldSizeBinop
op FieldSize
a FieldSize
b) = FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
op ([Char] -> FieldSize -> FieldSize
scopeFieldSize [Char]
scope FieldSize
a) ([Char] -> FieldSize -> FieldSize
scopeFieldSize [Char]
scope FieldSize
b)
scopeFieldSize [Char]
scope (RangeSize FieldSize
a FieldSize
b) = FieldSize -> FieldSize -> FieldSize
RangeSize ([Char] -> FieldSize -> FieldSize
scopeFieldSize [Char]
scope FieldSize
a) ([Char] -> FieldSize -> FieldSize
scopeFieldSize [Char]
scope FieldSize
b)
scopeFieldSize [Char]
_ FieldSize
x = FieldSize
x

simplifyFieldSize :: FieldSize -> FieldSize
simplifyFieldSize :: FieldSize -> FieldSize
simplifyFieldSize (RangeSize FieldSize
a FieldSize
b) =
  let a' :: FieldSize
a' = FieldSize -> FieldSize
simplifyFieldSize FieldSize
a
      b' :: FieldSize
b' = FieldSize -> FieldSize
simplifyFieldSize FieldSize
b
  in
    if FieldSize
a' FieldSize -> FieldSize -> Bool
forall a. Eq a => a -> a -> Bool
== FieldSize
b' then
      FieldSize
a'
    else
      case (FieldSize
a', FieldSize
b') of
        (RangeSize FieldSize
aa' FieldSize
ab', RangeSize FieldSize
ba' FieldSize
bb') ->
          FieldSize -> FieldSize
simplifyFieldSize (FieldSize -> FieldSize -> FieldSize
RangeSize (FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
FSMin FieldSize
aa' FieldSize
ba') (FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
FSMax FieldSize
ab' FieldSize
bb'))
        (FieldSize
a'', RangeSize FieldSize
ba' FieldSize
bb') ->
          FieldSize -> FieldSize
simplifyFieldSize (FieldSize -> FieldSize -> FieldSize
RangeSize (FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
FSMin FieldSize
a'' FieldSize
ba') (FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
FSMax FieldSize
a'' FieldSize
bb'))
        (FieldSize, FieldSize)
_ -> FieldSize -> FieldSize -> FieldSize
RangeSize FieldSize
a' FieldSize
b'

simplifyFieldSize (BinopSize FieldSizeBinop
op FieldSize
a FieldSize
b) =
  let a' :: FieldSize
a' = FieldSize -> FieldSize
simplifyFieldSize FieldSize
a
      b' :: FieldSize
b' = FieldSize -> FieldSize
simplifyFieldSize FieldSize
b
  in
    case (FieldSize
a', FieldSizeBinop
op, FieldSize
b') of
      (FieldSize
UnknownSize, FieldSizeBinop
_, FieldSize
_) -> FieldSize
UnknownSize
      (FieldSize
_, FieldSizeBinop
_, FieldSize
UnknownSize) -> FieldSize
UnknownSize

      (FixedSize Int
x, FieldSizeBinop
FSPlus, BinopSize FieldSizeBinop
FSPlus (FixedSize Int
y) FieldSize
z) ->
        FieldSize -> FieldSize
simplifyFieldSize (FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
FSPlus (Int -> FieldSize
FixedSize (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y)) FieldSize
z)
      (BinopSize FieldSizeBinop
FSPlus FieldSize
z (FixedSize Int
y), FieldSizeBinop
FSPlus, FixedSize Int
x) ->
        FieldSize -> FieldSize
simplifyFieldSize (FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
FSPlus (Int -> FieldSize
FixedSize (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y)) FieldSize
z)
      (RangeSize FieldSize
la FieldSize
ra, FieldSizeBinop
_, RangeSize FieldSize
lb FieldSize
rb) ->
        FieldSize -> FieldSize
simplifyFieldSize (FieldSize -> FieldSize -> FieldSize
RangeSize (FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
op FieldSize
la FieldSize
lb) (FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
op FieldSize
ra FieldSize
rb))
      (RangeSize FieldSize
l FieldSize
r, FieldSizeBinop
_, FieldSize
c) ->
        FieldSize -> FieldSize
simplifyFieldSize (FieldSize -> FieldSize -> FieldSize
RangeSize (FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
op FieldSize
l FieldSize
c) (FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
op FieldSize
r FieldSize
c))
      (FieldSize
x, FieldSizeBinop
FSPlus, BinopSize FieldSizeBinop
FSPlus FieldSize
y FieldSize
z) ->
        FieldSize -> FieldSize
simplifyFieldSize (FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
FSPlus (FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
FSPlus FieldSize
x FieldSize
y) FieldSize
z)

      (FixedSize Int
x, FieldSizeBinop
FSMul, BinopSize FieldSizeBinop
FSMul (FixedSize Int
y) FieldSize
z) ->
        FieldSize -> FieldSize
simplifyFieldSize (FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
FSMul (Int -> FieldSize
FixedSize (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y)) FieldSize
z)
      (BinopSize FieldSizeBinop
FSMul FieldSize
z (FixedSize Int
y), FieldSizeBinop
FSMul, FixedSize Int
x) ->
        FieldSize -> FieldSize
simplifyFieldSize (FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
FSMul (Int -> FieldSize
FixedSize (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y)) FieldSize
z)

      (FixedSize Int
x, FieldSizeBinop
FSPlus, FixedSize Int
y) -> Int -> FieldSize
FixedSize (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y)
      (FixedSize Int
x, FieldSizeBinop
FSMul, FixedSize Int
y) -> Int -> FieldSize
FixedSize (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
y)

      (FixedSize Int
x, FieldSizeBinop
FSMax, FixedSize Int
y) -> Int -> FieldSize
FixedSize (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
x Int
y)
      (FixedSize Int
x, FieldSizeBinop
FSMin, FixedSize Int
y) -> Int -> FieldSize
FixedSize (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
x Int
y)

      (FixedSize Int
x, FieldSizeBinop
FSPlus, RangeSize FieldSize
lo FieldSize
hi) ->
        FieldSize -> FieldSize
simplifyFieldSize (FieldSize -> FieldSize -> FieldSize
RangeSize (FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
FSPlus (Int -> FieldSize
FixedSize Int
x) FieldSize
lo) (FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
FSPlus (Int -> FieldSize
FixedSize Int
x) FieldSize
hi))

      (FixedSize Int
0, FieldSizeBinop
FSPlus, FieldSize
y) -> FieldSize
y
      (FieldSize
x, FieldSizeBinop
FSPlus, FixedSize Int
0) -> FieldSize
x
      (FixedSize Int
1, FieldSizeBinop
FSMul, FieldSize
y) -> FieldSize
y
      (FieldSize
x, FieldSizeBinop
FSMul, FixedSize Int
1) -> FieldSize
x
      (FixedSize Int
0, FieldSizeBinop
FSMin, FieldSize
_) -> Int -> FieldSize
FixedSize Int
0
      (FieldSize
_, FieldSizeBinop
FSMin, FixedSize Int
0) -> Int -> FieldSize
FixedSize Int
0
      (FixedSize Int
0, FieldSizeBinop
FSMax, FieldSize
y) -> FieldSize
y
      (FieldSize
x, FieldSizeBinop
FSMax, FixedSize Int
0) -> FieldSize
x

      (FieldSize, FieldSizeBinop, FieldSize)
_ -> FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
op FieldSize
a' FieldSize
b'
simplifyFieldSize FieldSize
x = FieldSize
x

resolveSizeScopes :: forall codec.
                     ( Codec codec
                     , HasInfo codec (DefEnumEncoding codec)
                     )
                  => Proxy codec
                  -> Map String [String]
                  -> FieldSize
                  -> FieldSize
resolveSizeScopes :: forall codec.
(Codec codec, HasInfo codec (DefEnumEncoding codec)) =>
Proxy codec -> Map [Char] [[Char]] -> FieldSize -> FieldSize
resolveSizeScopes Proxy codec
_ Map [Char] [[Char]]
env (VarSize [Char]
name) =
  let name' :: [Char]
name' = [Char] -> ([[Char]] -> [Char]) -> Maybe [[Char]] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
name [[Char]] -> [Char]
formatPath (Maybe [[Char]] -> [Char]) -> Maybe [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> Map [Char] [[Char]] -> Maybe [[Char]]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
name Map [Char] [[Char]]
env
  in [Char] -> FieldSize
VarSize [Char]
name'
resolveSizeScopes Proxy codec
pCodec Map [Char] [[Char]]
env (BinopSize FieldSizeBinop
op FieldSize
a FieldSize
b) =
  FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
op (Proxy codec -> Map [Char] [[Char]] -> FieldSize -> FieldSize
forall codec.
(Codec codec, HasInfo codec (DefEnumEncoding codec)) =>
Proxy codec -> Map [Char] [[Char]] -> FieldSize -> FieldSize
resolveSizeScopes Proxy codec
pCodec Map [Char] [[Char]]
env FieldSize
a) (Proxy codec -> Map [Char] [[Char]] -> FieldSize -> FieldSize
forall codec.
(Codec codec, HasInfo codec (DefEnumEncoding codec)) =>
Proxy codec -> Map [Char] [[Char]] -> FieldSize -> FieldSize
resolveSizeScopes Proxy codec
pCodec Map [Char] [[Char]]
env FieldSize
b)
resolveSizeScopes Proxy codec
pCodec Map [Char] [[Char]]
env (RangeSize FieldSize
a FieldSize
b) =
  FieldSize -> FieldSize -> FieldSize
RangeSize (Proxy codec -> Map [Char] [[Char]] -> FieldSize -> FieldSize
forall codec.
(Codec codec, HasInfo codec (DefEnumEncoding codec)) =>
Proxy codec -> Map [Char] [[Char]] -> FieldSize -> FieldSize
resolveSizeScopes Proxy codec
pCodec Map [Char] [[Char]]
env FieldSize
a) (Proxy codec -> Map [Char] [[Char]] -> FieldSize -> FieldSize
forall codec.
(Codec codec, HasInfo codec (DefEnumEncoding codec)) =>
Proxy codec -> Map [Char] [[Char]] -> FieldSize -> FieldSize
resolveSizeScopes Proxy codec
pCodec Map [Char] [[Char]]
env FieldSize
b)
resolveSizeScopes Proxy codec
pCodec Map [Char] [[Char]]
env FieldSize
EnumSize =
  Proxy codec -> Map [Char] [[Char]] -> FieldSize -> FieldSize
forall codec.
(Codec codec, HasInfo codec (DefEnumEncoding codec)) =>
Proxy codec -> Map [Char] [[Char]] -> FieldSize -> FieldSize
resolveSizeScopes Proxy codec
pCodec Map [Char] [[Char]]
env (FieldInfo codec -> FieldSize
forall codec.
(Codec codec, HasInfo codec (DefEnumEncoding codec)) =>
FieldInfo codec -> FieldSize
fieldSize (FieldInfo codec -> FieldSize) -> FieldInfo codec -> FieldSize
forall a b. (a -> b) -> a -> b
$ Proxy codec -> Proxy (DefEnumEncoding codec) -> FieldInfo codec
forall codec a.
HasInfo codec a =>
Proxy codec -> Proxy a -> FieldInfo codec
info Proxy codec
pCodec (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(DefEnumEncoding codec)))
resolveSizeScopes Proxy codec
_ Map [Char] [[Char]]
_ FieldSize
x = FieldSize
x

fieldSize :: forall codec.
             ( Codec codec
             , HasInfo codec (DefEnumEncoding codec)
             )
          => FieldInfo codec
          -> FieldSize
fieldSize :: forall codec.
(Codec codec, HasInfo codec (DefEnumEncoding codec)) =>
FieldInfo codec -> FieldSize
fieldSize = [[Char]] -> Map [Char] [[Char]] -> FieldInfo codec -> FieldSize
forall codec.
(Codec codec, HasInfo codec (DefEnumEncoding codec)) =>
[[Char]] -> Map [Char] [[Char]] -> FieldInfo codec -> FieldSize
fieldSizeScoped [] Map [Char] [[Char]]
forall a. Monoid a => a
mempty

fieldSizeScoped :: forall codec.
                   ( Codec codec
                   , HasInfo codec (DefEnumEncoding codec)
                   )
                => [String]
                -> Map String [String]
                -> FieldInfo codec
                -> FieldSize
fieldSizeScoped :: forall codec.
(Codec codec, HasInfo codec (DefEnumEncoding codec)) =>
[[Char]] -> Map [Char] [[Char]] -> FieldInfo codec -> FieldSize
fieldSizeScoped [[Char]]
path Map [Char] [[Char]]
env (AnnField [Char]
_ FieldInfo codec
fi) =
  [[Char]] -> Map [Char] [[Char]] -> FieldInfo codec -> FieldSize
forall codec.
(Codec codec, HasInfo codec (DefEnumEncoding codec)) =>
[[Char]] -> Map [Char] [[Char]] -> FieldInfo codec -> FieldSize
fieldSizeScoped [[Char]]
path Map [Char] [[Char]]
env FieldInfo codec
fi
fieldSizeScoped [[Char]]
path Map [Char] [[Char]]
env (AliasField AliasFieldInfo codec
fi) =
  [[Char]] -> Map [Char] [[Char]] -> FieldInfo codec -> FieldSize
forall codec.
(Codec codec, HasInfo codec (DefEnumEncoding codec)) =>
[[Char]] -> Map [Char] [[Char]] -> FieldInfo codec -> FieldSize
fieldSizeScoped [[Char]]
path Map [Char] [[Char]]
env (AliasFieldInfo codec -> FieldInfo codec
forall codec. AliasFieldInfo codec -> FieldInfo codec
aliasFieldTarget AliasFieldInfo codec
fi)
fieldSizeScoped [[Char]]
_ Map [Char] [[Char]]
env (BasicField BasicFieldInfo
fi) =
  Proxy codec -> Map [Char] [[Char]] -> FieldSize -> FieldSize
forall codec.
(Codec codec, HasInfo codec (DefEnumEncoding codec)) =>
Proxy codec -> Map [Char] [[Char]] -> FieldSize -> FieldSize
resolveSizeScopes (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @codec) Map [Char] [[Char]]
env (BasicFieldInfo -> FieldSize
basicFieldSize BasicFieldInfo
fi)
fieldSizeScoped [[Char]]
_ Map [Char] [[Char]]
env (EnumField EnumFieldInfo
fi) =
  Proxy codec -> Map [Char] [[Char]] -> FieldSize -> FieldSize
forall codec.
(Codec codec, HasInfo codec (DefEnumEncoding codec)) =>
Proxy codec -> Map [Char] [[Char]] -> FieldSize -> FieldSize
resolveSizeScopes (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @codec) Map [Char] [[Char]]
env (EnumFieldInfo -> FieldSize
enumFieldSize EnumFieldInfo
fi)
fieldSizeScoped [[Char]]
path Map [Char] [[Char]]
env (CompoundField CompoundFieldInfo codec
fi) =
  let env' :: Map [Char] [[Char]]
env' = (Map [Char] [[Char]] -> SubfieldInfo codec -> Map [Char] [[Char]])
-> Map [Char] [[Char]]
-> [SubfieldInfo codec]
-> Map [Char] [[Char]]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map [Char] [[Char]]
e SubfieldInfo codec
sfi -> [Char] -> [[Char]] -> Map [Char] [[Char]] -> Map [Char] [[Char]]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (SubfieldInfo codec -> [Char]
forall codec. SubfieldInfo codec -> [Char]
subfieldName SubfieldInfo codec
sfi) (SubfieldInfo codec -> [Char]
forall codec. SubfieldInfo codec -> [Char]
subfieldName SubfieldInfo codec
sfi [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
path) Map [Char] [[Char]]
e) Map [Char] [[Char]]
env (CompoundFieldInfo codec -> [SubfieldInfo codec]
forall codec. CompoundFieldInfo codec -> [SubfieldInfo codec]
compoundFieldSubfields CompoundFieldInfo codec
fi)
      qualifiedSubfieldSizes :: SubfieldInfo codec -> FieldSize
qualifiedSubfieldSizes SubfieldInfo codec
sfi =
        let path' :: [[Char]]
path' = SubfieldInfo codec -> [Char]
forall codec. SubfieldInfo codec -> [Char]
subfieldName SubfieldInfo codec
sfi [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
path
            env'' :: Map [Char] [[Char]]
env'' = [Char] -> [[Char]] -> Map [Char] [[Char]] -> Map [Char] [[Char]]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (SubfieldInfo codec -> [Char]
forall codec. SubfieldInfo codec -> [Char]
subfieldName SubfieldInfo codec
sfi) [[Char]]
path' Map [Char] [[Char]]
env'
        in
          [[Char]] -> Map [Char] [[Char]] -> FieldInfo codec -> FieldSize
forall codec.
(Codec codec, HasInfo codec (DefEnumEncoding codec)) =>
[[Char]] -> Map [Char] [[Char]] -> FieldInfo codec -> FieldSize
fieldSizeScoped [[Char]]
path' Map [Char] [[Char]]
env'' (SubfieldInfo codec -> FieldInfo codec
forall codec. SubfieldInfo codec -> FieldInfo codec
subfieldInfo SubfieldInfo codec
sfi)
  in
    case (SubfieldInfo codec -> FieldSize)
-> [SubfieldInfo codec] -> [FieldSize]
forall a b. (a -> b) -> [a] -> [b]
map SubfieldInfo codec -> FieldSize
qualifiedSubfieldSizes (CompoundFieldInfo codec -> [SubfieldInfo codec]
forall codec. CompoundFieldInfo codec -> [SubfieldInfo codec]
compoundFieldSubfields CompoundFieldInfo codec
fi) of
      [] -> Int -> FieldSize
FixedSize Int
0
      (FieldSize
x:[FieldSize]
xs) -> FieldSize -> FieldSize
simplifyFieldSize (FieldSize -> FieldSize) -> FieldSize -> FieldSize
forall a b. (a -> b) -> a -> b
$ (FieldSize -> FieldSize -> FieldSize)
-> FieldSize -> [FieldSize] -> FieldSize
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
FSPlus) FieldSize
x [FieldSize]
xs
fieldSizeScoped [[Char]]
path Map [Char] [[Char]]
env (ListField ListFieldInfo codec
fi) =
  let elemSize :: FieldSize
elemSize = FieldSize -> (Int -> FieldSize) -> Maybe Int -> FieldSize
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FieldSize
UnknownSize Int -> FieldSize
FixedSize (Maybe Int -> FieldSize) -> Maybe Int -> FieldSize
forall a b. (a -> b) -> a -> b
$
                  FieldSize -> Maybe Int
knownSize
                    ([[Char]] -> Map [Char] [[Char]] -> FieldInfo codec -> FieldSize
forall codec.
(Codec codec, HasInfo codec (DefEnumEncoding codec)) =>
[[Char]] -> Map [Char] [[Char]] -> FieldInfo codec -> FieldSize
fieldSizeScoped [[Char]]
path Map [Char] [[Char]]
env (ListFieldInfo codec -> FieldInfo codec
forall codec. ListFieldInfo codec -> FieldInfo codec
listElemInfo ListFieldInfo codec
fi))
  in
    FieldSize -> FieldSize
simplifyFieldSize (FieldSize -> FieldSize) -> FieldSize -> FieldSize
forall a b. (a -> b) -> a -> b
$
      FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
FSMul (ListFieldInfo codec -> FieldSize
forall codec. ListFieldInfo codec -> FieldSize
listSize ListFieldInfo codec
fi) FieldSize
elemSize
fieldSizeScoped [[Char]]
path Map [Char] [[Char]]
env (ChoiceField ChoiceFieldInfo codec
fi) =
  case (FieldInfo codec -> FieldSize) -> [FieldInfo codec] -> [FieldSize]
forall a b. (a -> b) -> [a] -> [b]
map ([[Char]] -> Map [Char] [[Char]] -> FieldInfo codec -> FieldSize
forall codec.
(Codec codec, HasInfo codec (DefEnumEncoding codec)) =>
[[Char]] -> Map [Char] [[Char]] -> FieldInfo codec -> FieldSize
fieldSizeScoped [[Char]]
path Map [Char] [[Char]]
env) (ChoiceFieldInfo codec -> [FieldInfo codec]
forall codec. ChoiceFieldInfo codec -> [FieldInfo codec]
choiceFieldAlternatives ChoiceFieldInfo codec
fi) of
    [] -> Int -> FieldSize
FixedSize Int
0
    (FieldSize
x:[FieldSize]
xs) -> let maxVal :: FieldSize
maxVal = (FieldSize -> FieldSize -> FieldSize)
-> FieldSize -> [FieldSize] -> FieldSize
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
FSMax) FieldSize
x [FieldSize]
xs
                  minVal :: FieldSize
minVal = (FieldSize -> FieldSize -> FieldSize)
-> FieldSize -> [FieldSize] -> FieldSize
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
FSMin) FieldSize
x [FieldSize]
xs
              in FieldSize -> FieldSize
simplifyFieldSize (FieldSize -> FieldSize -> FieldSize
RangeSize FieldSize
minVal FieldSize
maxVal)
fieldSizeScoped [[Char]]
path Map [Char] [[Char]]
env (SumField SumFieldInfo codec
fi) =
  case (([Char], FieldInfo codec) -> FieldSize)
-> [([Char], FieldInfo codec)] -> [FieldSize]
forall a b. (a -> b) -> [a] -> [b]
map ([[Char]] -> Map [Char] [[Char]] -> FieldInfo codec -> FieldSize
forall codec.
(Codec codec, HasInfo codec (DefEnumEncoding codec)) =>
[[Char]] -> Map [Char] [[Char]] -> FieldInfo codec -> FieldSize
fieldSizeScoped [[Char]]
path Map [Char] [[Char]]
env (FieldInfo codec -> FieldSize)
-> (([Char], FieldInfo codec) -> FieldInfo codec)
-> ([Char], FieldInfo codec)
-> FieldSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char], FieldInfo codec) -> FieldInfo codec
forall a b. (a, b) -> b
snd) (SumFieldInfo codec -> [([Char], FieldInfo codec)]
forall codec. SumFieldInfo codec -> [([Char], FieldInfo codec)]
sumFieldAlternatives SumFieldInfo codec
fi) of
    [] -> Int -> FieldSize
FixedSize Int
0
    (FieldSize
x:[FieldSize]
xs) -> let maxVal :: FieldSize
maxVal = (FieldSize -> FieldSize -> FieldSize)
-> FieldSize -> [FieldSize] -> FieldSize
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
FSMax) FieldSize
x [FieldSize]
xs
                  minVal :: FieldSize
minVal = (FieldSize -> FieldSize -> FieldSize)
-> FieldSize -> [FieldSize] -> FieldSize
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (FieldSizeBinop -> FieldSize -> FieldSize -> FieldSize
BinopSize FieldSizeBinop
FSMin) FieldSize
x [FieldSize]
xs
              in FieldSize -> FieldSize
simplifyFieldSize (FieldSize -> FieldSize -> FieldSize
RangeSize FieldSize
minVal FieldSize
maxVal)