{-# LANGUAGE UndecidableInstances #-}
module Binrep.BLen
( BLen(blen)
, blenGenericNonSum, blenGenericSum
, ViaCBLen(..), cblen
) where
import Binrep.CBLen
import GHC.TypeNats
import Binrep.Common.Class.TypeErrors ( ENoSum, ENoEmpty )
import GHC.TypeLits ( TypeError )
import Data.Void
import Data.ByteString qualified as B
import Data.Word
import Data.Int
import Binrep.Util.ByteOrder
import Data.Monoid qualified as Monoid
import GHC.Generics
import Generic.Data.Function.FoldMap
import Generic.Data.Rep.Assert
import Generic.Data.Function.Common
class BLen a where
blen :: a -> Int
instance GenericFoldMap BLen where
type GenericFoldMapM BLen = Monoid.Sum Int
type GenericFoldMapC BLen a = BLen a
genericFoldMapF :: forall a. GenericFoldMapC BLen a => a -> GenericFoldMapM BLen
genericFoldMapF = Int -> Sum Int
forall a. a -> Sum a
Monoid.Sum (Int -> Sum Int) -> (a -> Int) -> a -> Sum Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. BLen a => a -> Int
blen
blenGenericNonSum
:: forall a
. ( Generic a, GFoldMapNonSum BLen (Rep a)
, GAssertNotVoid a, GAssertNotSum a
) => a -> Int
blenGenericNonSum :: forall a.
(Generic a, GFoldMapNonSum BLen (Rep a), GAssertNotVoid a,
GAssertNotSum a) =>
a -> Int
blenGenericNonSum = Sum Int -> Int
forall a. Sum a -> a
Monoid.getSum (Sum Int -> Int) -> (a -> Sum Int) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (tag :: k) a.
(Generic a, GFoldMapNonSum tag (Rep a)) =>
a -> GenericFoldMapM tag
forall (tag :: Type -> Constraint) a.
(Generic a, GFoldMapNonSum tag (Rep a)) =>
a -> GenericFoldMapM tag
genericFoldMapNonSum @BLen
blenGenericSum
:: forall a
. ( Generic a, GFoldMapSum BLen 'SumOnly (Rep a)
, GAssertNotVoid a, GAssertSum a
) => (String -> Int) -> a -> Int
blenGenericSum :: forall a.
(Generic a, GFoldMapSum BLen 'SumOnly (Rep a), GAssertNotVoid a,
GAssertSum a) =>
(String -> Int) -> a -> Int
blenGenericSum String -> Int
f =
Sum Int -> Int
forall a. Sum a -> a
Monoid.getSum (Sum Int -> Int) -> (a -> Sum Int) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (tag :: k) (opts :: SumOpts) a.
(Generic a, GFoldMapSum tag opts (Rep a)) =>
(String -> GenericFoldMapM tag) -> a -> GenericFoldMapM tag
forall (tag :: Type -> Constraint) (opts :: SumOpts) a.
(Generic a, GFoldMapSum tag opts (Rep a)) =>
(String -> GenericFoldMapM tag) -> a -> GenericFoldMapM tag
genericFoldMapSum @BLen @'SumOnly (Int -> Sum Int
forall a. a -> Sum a
Monoid.Sum (Int -> Sum Int) -> (String -> Int) -> String -> Sum Int
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Int
f)
instance TypeError ENoEmpty => BLen Void where blen :: Void -> Int
blen = Void -> Int
forall a. HasCallStack => a
undefined
instance TypeError ENoSum => BLen (Either a b) where blen :: Either a b -> Int
blen = Either a b -> Int
forall a. HasCallStack => a
undefined
instance BLen () where blen :: () -> Int
blen () = Int
0
instance (BLen l, BLen r) => BLen (l, r) where blen :: (l, r) -> Int
blen (l
l, r
r) = l -> Int
forall a. BLen a => a -> Int
blen l
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ r -> Int
forall a. BLen a => a -> Int
blen r
r
instance BLen a => BLen [a] where blen :: [a] -> Int
blen = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> ([a] -> [Int]) -> [a] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Int) -> [a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map a -> Int
forall a. BLen a => a -> Int
blen
instance BLen B.ByteString where blen :: ByteString -> Int
blen = ByteString -> Int
B.length
deriving via ViaCBLen Word8 instance BLen Word8
deriving via ViaCBLen Int8 instance BLen Int8
deriving via ViaCBLen Word16 instance BLen Word16
deriving via ViaCBLen Int16 instance BLen Int16
deriving via ViaCBLen Word32 instance BLen Word32
deriving via ViaCBLen Int32 instance BLen Int32
deriving via ViaCBLen Word64 instance BLen Word64
deriving via ViaCBLen Int64 instance BLen Int64
deriving via ViaCBLen (ByteOrdered end a)
instance KnownNat (CBLen a) => BLen (ByteOrdered end a)
newtype ViaCBLen a = ViaCBLen { forall a. ViaCBLen a -> a
unViaCBLen :: a }
instance KnownNat (CBLen a) => BLen (ViaCBLen a) where blen :: ViaCBLen a -> Int
blen ViaCBLen a
_ = forall a. KnownNat (CBLen a) => Int
forall {k} (a :: k). KnownNat (CBLen a) => Int
cblen @a