{-# 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
class Codec codec where
type MonadEncode codec :: Type -> Type
type MonadDecode codec :: Type -> Type
type DefEnumEncoding codec :: Type
type DefEnumEncoding codec = Word16
class Codec codec => Serializable codec a where
encode :: Proxy codec -> a -> MonadEncode codec ()
decode :: Proxy codec -> MonadDecode codec a
class Codec codec => HasInfo codec a where
info :: Proxy codec -> Proxy a -> FieldInfo codec
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
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
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)