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

import Dahdit.LiftedPrim (LiftedPrim, LiftedPrimArray, sizeofLiftedPrimArray)
import Dahdit.Nums
  ( FloatBE
  , FloatLE
  , Int16BE
  , Int16LE
  , Int24BE
  , Int24LE
  , Int32BE
  , Int32LE
  , Word16BE
  , Word16LE
  , Word24BE
  , Word24LE
  , Word32BE
  , Word32LE
  )
import Dahdit.Proxy (proxyFor, proxyForF)
import Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as BSS
import Data.Default (Default)
import Data.Foldable (foldMap')
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Primitive (Prim)
import Data.Primitive.PrimArray (PrimArray, sizeofPrimArray)
import Data.Proxy (Proxy (..))
import Data.Semigroup (Sum (..))
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Word (Word16, Word32, Word64, Word8)

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

newtype ByteCount = ByteCount {ByteCount -> Word64
unByteCount :: Word64}
  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 -> a -> Bounded a
maxBound :: ByteCount
$cmaxBound :: ByteCount
minBound :: ByteCount
$cminBound :: ByteCount
Bounded, ByteCount
forall a. a -> Default a
def :: ByteCount
$cdef :: ByteCount
Default)

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 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 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 FloatLE where
  byteSize :: FloatLE -> ByteCount
byteSize FloatLE
_ = ByteCount
4

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

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

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

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

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

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

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

instance ByteSized ShortByteString where
  byteSize :: ShortByteString -> ByteCount
byteSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Int
BSS.length

instance StaticByteSized a => ByteSized (Seq a) where
  byteSize :: Seq a -> ByteCount
byteSize Seq a
ss =
    let !elen :: ByteCount
elen = forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
        !alen :: ByteCount
alen = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Seq a -> Int
Seq.length Seq a
ss)
    in  ByteCount
elen forall a. Num a => a -> a -> a
* ByteCount
alen

instance (StaticByteSized a, Prim a) => ByteSized (PrimArray a) where
  byteSize :: PrimArray a -> ByteCount
byteSize PrimArray a
pa =
    let !elen :: ByteCount
elen = forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
        !alen :: ByteCount
alen = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray a
pa)
    in  ByteCount
elen forall a. Num a => a -> a -> a
* ByteCount
alen

instance (StaticByteSized a, LiftedPrim a) => ByteSized (LiftedPrimArray a) where
  byteSize :: LiftedPrimArray a -> ByteCount
byteSize LiftedPrimArray a
lpa =
    let !elen :: ByteCount
elen = forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
        !alen :: ByteCount
alen = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. LiftedPrim a => LiftedPrimArray a -> Int
sizeofLiftedPrimArray LiftedPrimArray a
lpa)
    in  ByteCount
elen forall a. Num a => a -> a -> a
* ByteCount
alen

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

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

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 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 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 FloatLE where
  staticByteSize :: Proxy FloatLE -> ByteCount
staticByteSize Proxy FloatLE
_ = ByteCount
4

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

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

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

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

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

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

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

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
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length f a
fa)