module Dahdit.Sizes
  ( ByteCount (..)
  , ElemCount (..)
  , ByteSized (..)
  , StaticByteSized (..)
  , ViaStaticByteSized (..)
  , byteSizeFoldable
  , staticByteSizeFoldable
  , byteSizeViaStatic
  )
where

import Dahdit.Internal (ViaEndianPair (..), ViaFromIntegral (..))
import Dahdit.Nums
  ( DoubleBE
  , DoubleLE
  , FloatBE
  , FloatLE
  , Int16BE
  , Int16LE
  , Int24BE
  , Int24LE
  , Int32BE
  , Int32LE
  , Int64BE
  , Int64LE
  , Word16BE
  , Word16LE
  , Word24BE
  , Word24LE
  , Word32BE
  , Word32LE
  , Word64BE
  , Word64LE
  )
import Dahdit.Proxy (proxyFor, proxyForF)
import Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as BSS
import Data.Coerce (coerce)
import Data.Default (Default)
import Data.Foldable (foldMap')
import Data.Int (Int16, Int32, Int64, Int8)
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Proxy (Proxy (..))
import Data.Semigroup (Sum (..))
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.ShortWord (Int24, Word24)
import Data.Word (Word16, Word32, Word64, Word8)

-- Counts

newtype ByteCount = ByteCount {ByteCount -> Int
unByteCount :: Int}
  deriving stock (Int -> ByteCount -> ShowS
[ByteCount] -> ShowS
ByteCount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ByteCount] -> ShowS
$cshowList :: [ByteCount] -> ShowS
show :: ByteCount -> String
$cshow :: ByteCount -> String
showsPrec :: Int -> ByteCount -> ShowS
$cshowsPrec :: Int -> ByteCount -> ShowS
Show)
  deriving newtype (ByteCount -> ByteCount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ByteCount -> ByteCount -> Bool
$c/= :: ByteCount -> ByteCount -> Bool
== :: ByteCount -> ByteCount -> Bool
$c== :: ByteCount -> ByteCount -> Bool
Eq, Eq ByteCount
ByteCount -> ByteCount -> Bool
ByteCount -> ByteCount -> Ordering
ByteCount -> ByteCount -> ByteCount
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ByteCount -> ByteCount -> ByteCount
$cmin :: ByteCount -> ByteCount -> ByteCount
max :: ByteCount -> ByteCount -> ByteCount
$cmax :: ByteCount -> ByteCount -> ByteCount
>= :: ByteCount -> ByteCount -> Bool
$c>= :: ByteCount -> ByteCount -> Bool
> :: ByteCount -> ByteCount -> Bool
$c> :: ByteCount -> ByteCount -> Bool
<= :: ByteCount -> ByteCount -> Bool
$c<= :: ByteCount -> ByteCount -> Bool
< :: ByteCount -> ByteCount -> Bool
$c< :: ByteCount -> ByteCount -> Bool
compare :: ByteCount -> ByteCount -> Ordering
$ccompare :: ByteCount -> ByteCount -> Ordering
Ord, Integer -> ByteCount
ByteCount -> ByteCount
ByteCount -> ByteCount -> ByteCount
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ByteCount
$cfromInteger :: Integer -> ByteCount
signum :: ByteCount -> ByteCount
$csignum :: ByteCount -> ByteCount
abs :: ByteCount -> ByteCount
$cabs :: ByteCount -> ByteCount
negate :: ByteCount -> ByteCount
$cnegate :: ByteCount -> ByteCount
* :: ByteCount -> ByteCount -> ByteCount
$c* :: ByteCount -> ByteCount -> ByteCount
- :: ByteCount -> ByteCount -> ByteCount
$c- :: ByteCount -> ByteCount -> ByteCount
+ :: ByteCount -> ByteCount -> ByteCount
$c+ :: ByteCount -> ByteCount -> ByteCount
Num, Int -> ByteCount
ByteCount -> Int
ByteCount -> [ByteCount]
ByteCount -> ByteCount
ByteCount -> ByteCount -> [ByteCount]
ByteCount -> ByteCount -> ByteCount -> [ByteCount]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ByteCount -> ByteCount -> ByteCount -> [ByteCount]
$cenumFromThenTo :: ByteCount -> ByteCount -> ByteCount -> [ByteCount]
enumFromTo :: ByteCount -> ByteCount -> [ByteCount]
$cenumFromTo :: ByteCount -> ByteCount -> [ByteCount]
enumFromThen :: ByteCount -> ByteCount -> [ByteCount]
$cenumFromThen :: ByteCount -> ByteCount -> [ByteCount]
enumFrom :: ByteCount -> [ByteCount]
$cenumFrom :: ByteCount -> [ByteCount]
fromEnum :: ByteCount -> Int
$cfromEnum :: ByteCount -> Int
toEnum :: Int -> ByteCount
$ctoEnum :: Int -> ByteCount
pred :: ByteCount -> ByteCount
$cpred :: ByteCount -> ByteCount
succ :: ByteCount -> ByteCount
$csucc :: ByteCount -> ByteCount
Enum, Num ByteCount
Ord ByteCount
ByteCount -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: ByteCount -> Rational
$ctoRational :: ByteCount -> Rational
Real, Enum ByteCount
Real ByteCount
ByteCount -> Integer
ByteCount -> ByteCount -> (ByteCount, ByteCount)
ByteCount -> ByteCount -> ByteCount
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: ByteCount -> Integer
$ctoInteger :: ByteCount -> Integer
divMod :: ByteCount -> ByteCount -> (ByteCount, ByteCount)
$cdivMod :: ByteCount -> ByteCount -> (ByteCount, ByteCount)
quotRem :: ByteCount -> ByteCount -> (ByteCount, ByteCount)
$cquotRem :: ByteCount -> ByteCount -> (ByteCount, ByteCount)
mod :: ByteCount -> ByteCount -> ByteCount
$cmod :: ByteCount -> ByteCount -> ByteCount
div :: ByteCount -> ByteCount -> ByteCount
$cdiv :: ByteCount -> ByteCount -> ByteCount
rem :: ByteCount -> ByteCount -> ByteCount
$crem :: ByteCount -> ByteCount -> ByteCount
quot :: ByteCount -> ByteCount -> ByteCount
$cquot :: ByteCount -> ByteCount -> ByteCount
Integral, ByteCount
forall a. a -> Default a
def :: ByteCount
$cdef :: ByteCount
Default)

newtype ElemCount = ElemCount {ElemCount -> Int
unElemCount :: Int}
  deriving stock (Int -> ElemCount -> ShowS
[ElemCount] -> ShowS
ElemCount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElemCount] -> ShowS
$cshowList :: [ElemCount] -> ShowS
show :: ElemCount -> String
$cshow :: ElemCount -> String
showsPrec :: Int -> ElemCount -> ShowS
$cshowsPrec :: Int -> ElemCount -> ShowS
Show)
  deriving newtype (ElemCount -> ElemCount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElemCount -> ElemCount -> Bool
$c/= :: ElemCount -> ElemCount -> Bool
== :: ElemCount -> ElemCount -> Bool
$c== :: ElemCount -> ElemCount -> Bool
Eq, Eq ElemCount
ElemCount -> ElemCount -> Bool
ElemCount -> ElemCount -> Ordering
ElemCount -> ElemCount -> ElemCount
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ElemCount -> ElemCount -> ElemCount
$cmin :: ElemCount -> ElemCount -> ElemCount
max :: ElemCount -> ElemCount -> ElemCount
$cmax :: ElemCount -> ElemCount -> ElemCount
>= :: ElemCount -> ElemCount -> Bool
$c>= :: ElemCount -> ElemCount -> Bool
> :: ElemCount -> ElemCount -> Bool
$c> :: ElemCount -> ElemCount -> Bool
<= :: ElemCount -> ElemCount -> Bool
$c<= :: ElemCount -> ElemCount -> Bool
< :: ElemCount -> ElemCount -> Bool
$c< :: ElemCount -> ElemCount -> Bool
compare :: ElemCount -> ElemCount -> Ordering
$ccompare :: ElemCount -> ElemCount -> Ordering
Ord, Integer -> ElemCount
ElemCount -> ElemCount
ElemCount -> ElemCount -> ElemCount
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ElemCount
$cfromInteger :: Integer -> ElemCount
signum :: ElemCount -> ElemCount
$csignum :: ElemCount -> ElemCount
abs :: ElemCount -> ElemCount
$cabs :: ElemCount -> ElemCount
negate :: ElemCount -> ElemCount
$cnegate :: ElemCount -> ElemCount
* :: ElemCount -> ElemCount -> ElemCount
$c* :: ElemCount -> ElemCount -> ElemCount
- :: ElemCount -> ElemCount -> ElemCount
$c- :: ElemCount -> ElemCount -> ElemCount
+ :: ElemCount -> ElemCount -> ElemCount
$c+ :: ElemCount -> ElemCount -> ElemCount
Num, Int -> ElemCount
ElemCount -> Int
ElemCount -> [ElemCount]
ElemCount -> ElemCount
ElemCount -> ElemCount -> [ElemCount]
ElemCount -> ElemCount -> ElemCount -> [ElemCount]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ElemCount -> ElemCount -> ElemCount -> [ElemCount]
$cenumFromThenTo :: ElemCount -> ElemCount -> ElemCount -> [ElemCount]
enumFromTo :: ElemCount -> ElemCount -> [ElemCount]
$cenumFromTo :: ElemCount -> ElemCount -> [ElemCount]
enumFromThen :: ElemCount -> ElemCount -> [ElemCount]
$cenumFromThen :: ElemCount -> ElemCount -> [ElemCount]
enumFrom :: ElemCount -> [ElemCount]
$cenumFrom :: ElemCount -> [ElemCount]
fromEnum :: ElemCount -> Int
$cfromEnum :: ElemCount -> Int
toEnum :: Int -> ElemCount
$ctoEnum :: Int -> ElemCount
pred :: ElemCount -> ElemCount
$cpred :: ElemCount -> ElemCount
succ :: ElemCount -> ElemCount
$csucc :: ElemCount -> ElemCount
Enum, Num ElemCount
Ord ElemCount
ElemCount -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: ElemCount -> Rational
$ctoRational :: ElemCount -> Rational
Real, Enum ElemCount
Real ElemCount
ElemCount -> Integer
ElemCount -> ElemCount -> (ElemCount, ElemCount)
ElemCount -> ElemCount -> ElemCount
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: ElemCount -> Integer
$ctoInteger :: ElemCount -> Integer
divMod :: ElemCount -> ElemCount -> (ElemCount, ElemCount)
$cdivMod :: ElemCount -> ElemCount -> (ElemCount, ElemCount)
quotRem :: ElemCount -> ElemCount -> (ElemCount, ElemCount)
$cquotRem :: ElemCount -> ElemCount -> (ElemCount, ElemCount)
mod :: ElemCount -> ElemCount -> ElemCount
$cmod :: ElemCount -> ElemCount -> ElemCount
div :: ElemCount -> ElemCount -> ElemCount
$cdiv :: ElemCount -> ElemCount -> ElemCount
rem :: ElemCount -> ElemCount -> ElemCount
$crem :: ElemCount -> ElemCount -> ElemCount
quot :: ElemCount -> ElemCount -> ElemCount
$cquot :: ElemCount -> ElemCount -> ElemCount
Integral, ElemCount
forall a. a -> Default a
def :: ElemCount
$cdef :: ElemCount
Default)

-- ByteSized

class ByteSized a where
  byteSize :: a -> ByteCount

instance ByteSized () where
  byteSize :: () -> ByteCount
byteSize ()
_ = ByteCount
0

instance ByteSized Word8 where
  byteSize :: Word8 -> ByteCount
byteSize Word8
_ = ByteCount
1

instance ByteSized Int8 where
  byteSize :: Int8 -> ByteCount
byteSize Int8
_ = ByteCount
1

instance ByteSized Word16 where
  byteSize :: Word16 -> ByteCount
byteSize Word16
_ = ByteCount
2

instance ByteSized Int16 where
  byteSize :: Int16 -> ByteCount
byteSize Int16
_ = ByteCount
2

instance ByteSized Word24 where
  byteSize :: Word24 -> ByteCount
byteSize Word24
_ = ByteCount
3

instance ByteSized Int24 where
  byteSize :: Int24 -> ByteCount
byteSize Int24
_ = ByteCount
3

instance ByteSized Word32 where
  byteSize :: Word32 -> ByteCount
byteSize Word32
_ = ByteCount
4

instance ByteSized Int32 where
  byteSize :: Int32 -> ByteCount
byteSize Int32
_ = ByteCount
4

instance ByteSized Word64 where
  byteSize :: Word64 -> ByteCount
byteSize Word64
_ = ByteCount
8

instance ByteSized Int64 where
  byteSize :: Int64 -> ByteCount
byteSize Int64
_ = ByteCount
8

instance ByteSized Float where
  byteSize :: Float -> ByteCount
byteSize Float
_ = ByteCount
4

instance ByteSized Double where
  byteSize :: Double -> ByteCount
byteSize Double
_ = ByteCount
8

instance ByteSized Bool where
  byteSize :: Bool -> ByteCount
byteSize Bool
_ = ByteCount
1

instance ByteSized Char where
  byteSize :: Char -> ByteCount
byteSize Char
_ = ByteCount
1

instance ByteSized Int where
  byteSize :: Int -> ByteCount
byteSize Int
_ = ByteCount
8

instance ByteSized Word16LE where
  byteSize :: Word16LE -> ByteCount
byteSize Word16LE
_ = ByteCount
2

instance ByteSized Int16LE where
  byteSize :: Int16LE -> ByteCount
byteSize Int16LE
_ = ByteCount
2

instance ByteSized Word24LE where
  byteSize :: Word24LE -> ByteCount
byteSize Word24LE
_ = ByteCount
3

instance ByteSized Int24LE where
  byteSize :: Int24LE -> ByteCount
byteSize Int24LE
_ = ByteCount
3

instance ByteSized Word32LE where
  byteSize :: Word32LE -> ByteCount
byteSize Word32LE
_ = ByteCount
4

instance ByteSized Int32LE where
  byteSize :: Int32LE -> ByteCount
byteSize Int32LE
_ = ByteCount
4

instance ByteSized Word64LE where
  byteSize :: Word64LE -> ByteCount
byteSize Word64LE
_ = ByteCount
8

instance ByteSized Int64LE where
  byteSize :: Int64LE -> ByteCount
byteSize Int64LE
_ = ByteCount
8

instance ByteSized FloatLE where
  byteSize :: FloatLE -> ByteCount
byteSize FloatLE
_ = ByteCount
4

instance ByteSized DoubleLE where
  byteSize :: DoubleLE -> ByteCount
byteSize DoubleLE
_ = ByteCount
8

instance StaticByteSized x => ByteSized (ViaFromIntegral x y) where
  byteSize :: ViaFromIntegral x y -> ByteCount
byteSize = forall a. StaticByteSized a => a -> ByteCount
byteSizeViaStatic

instance StaticByteSized le => ByteSized (ViaEndianPair le be) where
  byteSize :: ViaEndianPair le be -> ByteCount
byteSize = forall a. StaticByteSized a => a -> ByteCount
byteSizeViaStatic

deriving via (ViaEndianPair Word16LE Word16BE) instance ByteSized Word16BE

deriving via (ViaEndianPair Int16LE Int16BE) instance ByteSized Int16BE

deriving via (ViaEndianPair Word24LE Word24BE) instance ByteSized Word24BE

deriving via (ViaEndianPair Int24LE Int24BE) instance ByteSized Int24BE

deriving via (ViaEndianPair Word32LE Word32BE) instance ByteSized Word32BE

deriving via (ViaEndianPair Int32LE Int32BE) instance ByteSized Int32BE

deriving via (ViaEndianPair Word64LE Word64BE) instance ByteSized Word64BE

deriving via (ViaEndianPair Int64LE Int64BE) instance ByteSized Int64BE

deriving via (ViaEndianPair FloatLE FloatBE) instance ByteSized FloatBE

deriving via (ViaEndianPair DoubleLE DoubleBE) instance ByteSized DoubleBE

instance ByteSized ShortByteString where
  byteSize :: ShortByteString -> ByteCount
byteSize = coerce :: forall a b. Coercible a b => a -> b
coerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Int
BSS.length

instance ByteSized a => ByteSized [a] where
  byteSize :: [a] -> ByteCount
byteSize = forall (f :: * -> *) a.
(Foldable f, ByteSized a) =>
f a -> ByteCount
byteSizeFoldable

instance ByteSized a => ByteSized (Seq a) where
  byteSize :: Seq a -> ByteCount
byteSize = forall (f :: * -> *) a.
(Foldable f, ByteSized a) =>
f a -> ByteCount
byteSizeFoldable

instance ByteSized a => ByteSized (Maybe a) where
  byteSize :: Maybe a -> ByteCount
byteSize = \case
    Maybe a
Nothing -> ByteCount
1
    Just a
a -> ByteCount
1 forall a. Num a => a -> a -> a
+ forall a. ByteSized a => a -> ByteCount
byteSize a
a

instance (ByteSized b, ByteSized a) => ByteSized (Either b a) where
  byteSize :: Either b a -> ByteCount
byteSize = \case
    Left b
b -> ByteCount
1 forall a. Num a => a -> a -> a
+ forall a. ByteSized a => a -> ByteCount
byteSize b
b
    Right a
a -> ByteCount
1 forall a. Num a => a -> a -> a
+ forall a. ByteSized a => a -> ByteCount
byteSize a
a

instance (ByteSized a, ByteSized b) => ByteSized (a, b) where
  byteSize :: (a, b) -> ByteCount
byteSize (a
a, b
b) = forall a. ByteSized a => a -> ByteCount
byteSize a
a forall a. Num a => a -> a -> a
+ forall a. ByteSized a => a -> ByteCount
byteSize b
b

instance (ByteSized a, ByteSized b, ByteSized c) => ByteSized (a, b, c) where
  byteSize :: (a, b, c) -> ByteCount
byteSize (a
a, b
b, c
c) = forall a. ByteSized a => a -> ByteCount
byteSize a
a forall a. Num a => a -> a -> a
+ forall a. ByteSized a => a -> ByteCount
byteSize b
b forall a. Num a => a -> a -> a
+ forall a. ByteSized a => a -> ByteCount
byteSize c
c

instance (ByteSized a, ByteSized b, ByteSized c, ByteSized d) => ByteSized (a, b, c, d) where
  byteSize :: (a, b, c, d) -> ByteCount
byteSize (a
a, b
b, c
c, d
d) = forall a. ByteSized a => a -> ByteCount
byteSize a
a forall a. Num a => a -> a -> a
+ forall a. ByteSized a => a -> ByteCount
byteSize b
b forall a. Num a => a -> a -> a
+ forall a. ByteSized a => a -> ByteCount
byteSize c
c forall a. Num a => a -> a -> a
+ forall a. ByteSized a => a -> ByteCount
byteSize d
d

instance (ByteSized a, ByteSized b, ByteSized c, ByteSized d, ByteSized e) => ByteSized (a, b, c, d, e) where
  byteSize :: (a, b, c, d, e) -> ByteCount
byteSize (a
a, b
b, c
c, d
d, e
e) = forall a. ByteSized a => a -> ByteCount
byteSize a
a forall a. Num a => a -> a -> a
+ forall a. ByteSized a => a -> ByteCount
byteSize b
b forall a. Num a => a -> a -> a
+ forall a. ByteSized a => a -> ByteCount
byteSize c
c forall a. Num a => a -> a -> a
+ forall a. ByteSized a => a -> ByteCount
byteSize d
d forall a. Num a => a -> a -> a
+ forall a. ByteSized a => a -> ByteCount
byteSize e
e

instance ByteSized a => ByteSized (Set a) where
  byteSize :: Set a -> ByteCount
byteSize = forall a. ByteSized a => a -> ByteCount
byteSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toAscList

instance (ByteSized k, ByteSized v) => ByteSized (Map k v) where
  byteSize :: Map k v -> ByteCount
byteSize = forall a. ByteSized a => a -> ByteCount
byteSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toAscList

instance ByteSized IntSet where
  byteSize :: IntSet -> ByteCount
byteSize = forall a. ByteSized a => a -> ByteCount
byteSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Int]
IntSet.toAscList

instance ByteSized v => ByteSized (IntMap v) where
  byteSize :: IntMap v -> ByteCount
byteSize = forall a. ByteSized a => a -> ByteCount
byteSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [(Int, a)]
IntMap.toAscList

-- StaticByteSized

class ByteSized a => StaticByteSized a where
  staticByteSize :: Proxy a -> ByteCount

instance StaticByteSized () where
  staticByteSize :: Proxy () -> ByteCount
staticByteSize Proxy ()
_ = ByteCount
0

instance StaticByteSized Word8 where
  staticByteSize :: Proxy Word8 -> ByteCount
staticByteSize Proxy Word8
_ = ByteCount
1

instance StaticByteSized Int8 where
  staticByteSize :: Proxy Int8 -> ByteCount
staticByteSize Proxy Int8
_ = ByteCount
1

instance StaticByteSized Word16 where
  staticByteSize :: Proxy Word16 -> ByteCount
staticByteSize Proxy Word16
_ = ByteCount
2

instance StaticByteSized Int16 where
  staticByteSize :: Proxy Int16 -> ByteCount
staticByteSize Proxy Int16
_ = ByteCount
2

instance StaticByteSized Word24 where
  staticByteSize :: Proxy Word24 -> ByteCount
staticByteSize Proxy Word24
_ = ByteCount
3

instance StaticByteSized Int24 where
  staticByteSize :: Proxy Int24 -> ByteCount
staticByteSize Proxy Int24
_ = ByteCount
3

instance StaticByteSized Word32 where
  staticByteSize :: Proxy Word32 -> ByteCount
staticByteSize Proxy Word32
_ = ByteCount
4

instance StaticByteSized Int32 where
  staticByteSize :: Proxy Int32 -> ByteCount
staticByteSize Proxy Int32
_ = ByteCount
4

instance StaticByteSized Word64 where
  staticByteSize :: Proxy Word64 -> ByteCount
staticByteSize Proxy Word64
_ = ByteCount
8

instance StaticByteSized Int64 where
  staticByteSize :: Proxy Int64 -> ByteCount
staticByteSize Proxy Int64
_ = ByteCount
8

instance StaticByteSized Float where
  staticByteSize :: Proxy Float -> ByteCount
staticByteSize Proxy Float
_ = ByteCount
4

instance StaticByteSized Double where
  staticByteSize :: Proxy Double -> ByteCount
staticByteSize Proxy Double
_ = ByteCount
8

instance StaticByteSized Bool where
  staticByteSize :: Proxy Bool -> ByteCount
staticByteSize Proxy Bool
_ = ByteCount
1

instance StaticByteSized Char where
  staticByteSize :: Proxy Char -> ByteCount
staticByteSize Proxy Char
_ = ByteCount
1

instance StaticByteSized Int where
  staticByteSize :: Proxy Int -> ByteCount
staticByteSize Proxy Int
_ = ByteCount
8

instance StaticByteSized Word16LE where
  staticByteSize :: Proxy Word16LE -> ByteCount
staticByteSize Proxy Word16LE
_ = ByteCount
2

instance StaticByteSized Int16LE where
  staticByteSize :: Proxy Int16LE -> ByteCount
staticByteSize Proxy Int16LE
_ = ByteCount
2

instance StaticByteSized Word24LE where
  staticByteSize :: Proxy Word24LE -> ByteCount
staticByteSize Proxy Word24LE
_ = ByteCount
3

instance StaticByteSized Int24LE where
  staticByteSize :: Proxy Int24LE -> ByteCount
staticByteSize Proxy Int24LE
_ = ByteCount
3

instance StaticByteSized Word32LE where
  staticByteSize :: Proxy Word32LE -> ByteCount
staticByteSize Proxy Word32LE
_ = ByteCount
4

instance StaticByteSized Int32LE where
  staticByteSize :: Proxy Int32LE -> ByteCount
staticByteSize Proxy Int32LE
_ = ByteCount
4

instance StaticByteSized Word64LE where
  staticByteSize :: Proxy Word64LE -> ByteCount
staticByteSize Proxy Word64LE
_ = ByteCount
8

instance StaticByteSized Int64LE where
  staticByteSize :: Proxy Int64LE -> ByteCount
staticByteSize Proxy Int64LE
_ = ByteCount
8

instance StaticByteSized FloatLE where
  staticByteSize :: Proxy FloatLE -> ByteCount
staticByteSize Proxy FloatLE
_ = ByteCount
4

instance StaticByteSized DoubleLE where
  staticByteSize :: Proxy DoubleLE -> ByteCount
staticByteSize Proxy DoubleLE
_ = ByteCount
8

instance StaticByteSized x => StaticByteSized (ViaFromIntegral x y) where
  staticByteSize :: Proxy (ViaFromIntegral x y) -> ByteCount
staticByteSize Proxy (ViaFromIntegral x y)
_ = forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall {k} (t :: k). Proxy t
Proxy :: Proxy x)

instance StaticByteSized le => StaticByteSized (ViaEndianPair le be) where
  staticByteSize :: Proxy (ViaEndianPair le be) -> ByteCount
staticByteSize Proxy (ViaEndianPair le be)
_ = forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall {k} (t :: k). Proxy t
Proxy :: Proxy le)

deriving via (ViaEndianPair Word16LE Word16BE) instance StaticByteSized Word16BE

deriving via (ViaEndianPair Int16LE Int16BE) instance StaticByteSized Int16BE

deriving via (ViaEndianPair Word24LE Word24BE) instance StaticByteSized Word24BE

deriving via (ViaEndianPair Int24LE Int24BE) instance StaticByteSized Int24BE

deriving via (ViaEndianPair Word32LE Word32BE) instance StaticByteSized Word32BE

deriving via (ViaEndianPair Int32LE Int32BE) instance StaticByteSized Int32BE

deriving via (ViaEndianPair Word64LE Word64BE) instance StaticByteSized Word64BE

deriving via (ViaEndianPair Int64LE Int64BE) instance StaticByteSized Int64BE

deriving via (ViaEndianPair FloatLE FloatBE) instance StaticByteSized FloatBE

deriving via (ViaEndianPair DoubleLE DoubleBE) instance StaticByteSized DoubleBE

-- Via

newtype ViaStaticByteSized a = ViaStaticByteSized {forall a. ViaStaticByteSized a -> a
unViaStaticByteSized :: a}

instance StaticByteSized a => ByteSized (ViaStaticByteSized a) where
  byteSize :: ViaStaticByteSized a -> ByteCount
byteSize ViaStaticByteSized a
_ = forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

byteSizeFoldable :: (Foldable f, ByteSized a) => f a -> ByteCount
byteSizeFoldable :: forall (f :: * -> *) a.
(Foldable f, ByteSized a) =>
f a -> ByteCount
byteSizeFoldable = forall a. Sum a -> a
getSum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' (forall a. a -> Sum a
Sum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ByteSized a => a -> ByteCount
byteSize)

staticByteSizeFoldable :: (Foldable f, StaticByteSized a) => f a -> ByteCount
staticByteSizeFoldable :: forall (f :: * -> *) a.
(Foldable f, StaticByteSized a) =>
f a -> ByteCount
staticByteSizeFoldable f a
fa = forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall (f :: * -> *) a. f a -> Proxy a
proxyForF f a
fa) forall a. Num a => a -> a -> a
* coerce :: forall a b. Coercible a b => a -> b
coerce (forall (t :: * -> *) a. Foldable t => t a -> Int
length f a
fa)

byteSizeViaStatic :: StaticByteSized a => a -> ByteCount
byteSizeViaStatic :: forall a. StaticByteSized a => a -> ByteCount
byteSizeViaStatic = forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Proxy a
proxyFor