{-# LANGUAGE UndecidableInstances #-}
module Dahdit.Generic
( ViaGeneric (..)
, ViaStaticGeneric (..)
)
where
import Control.Applicative (liftA2)
import Dahdit.Binary (Binary (..))
import Dahdit.Free (Get, Put)
import Dahdit.Funs (putStaticHint)
import Dahdit.Sizes (ByteCount, ByteSized (..), StaticByteSized (..))
import Data.Kind (Type)
import Data.Proxy (Proxy (..))
import GHC.Generics (Generic (..), K1 (..), M1 (..), U1 (..), (:*:) (..))
newtype ViaGeneric a = ViaGeneric {forall a. ViaGeneric a -> a
unViaGeneric :: a}
newtype ViaStaticGeneric a = ViaStaticGeneric {forall a. ViaStaticGeneric a -> a
unViaStaticGeneric :: a}
class GByteSized f where
gbyteSize :: f a -> ByteCount
instance GByteSized U1 where
gbyteSize :: forall a. U1 a -> ByteCount
gbyteSize U1 a
_ = ByteCount
0
instance (GByteSized a, GByteSized b) => GByteSized (a :*: b) where
gbyteSize :: forall a. (:*:) a b a -> ByteCount
gbyteSize (a a
x :*: b a
y) = forall (f :: * -> *) a. GByteSized f => f a -> ByteCount
gbyteSize a a
x forall a. Num a => a -> a -> a
+ forall (f :: * -> *) a. GByteSized f => f a -> ByteCount
gbyteSize b a
y
instance GByteSized a => GByteSized (M1 i c a) where
gbyteSize :: forall a. M1 i c a a -> ByteCount
gbyteSize = forall (f :: * -> *) a. GByteSized f => f a -> ByteCount
gbyteSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
instance ByteSized a => GByteSized (K1 i a) where
gbyteSize :: forall a. K1 i a a -> ByteCount
gbyteSize = forall a. ByteSized a => a -> ByteCount
byteSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). K1 i c p -> c
unK1
instance (Generic t, GByteSized (Rep t)) => ByteSized (ViaGeneric t) where
byteSize :: ViaGeneric t -> ByteCount
byteSize = forall (f :: * -> *) a. GByteSized f => f a -> ByteCount
gbyteSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ViaGeneric a -> a
unViaGeneric
instance (Generic t, GByteSized (Rep t)) => ByteSized (ViaStaticGeneric t) where
byteSize :: ViaStaticGeneric t -> ByteCount
byteSize = forall (f :: * -> *) a. GByteSized f => f a -> ByteCount
gbyteSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ViaStaticGeneric a -> a
unViaStaticGeneric
class GByteSized f => GStaticByteSized (f :: Type -> Type) where
gstaticByteSize :: Proxy f -> ByteCount
instance GStaticByteSized U1 where
gstaticByteSize :: Proxy U1 -> ByteCount
gstaticByteSize Proxy U1
_ = ByteCount
0
instance (GStaticByteSized a, GStaticByteSized b) => GStaticByteSized (a :*: b) where
gstaticByteSize :: Proxy (a :*: b) -> ByteCount
gstaticByteSize Proxy (a :*: b)
_ = forall (f :: * -> *). GStaticByteSized f => Proxy f -> ByteCount
gstaticByteSize (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) forall a. Num a => a -> a -> a
+ forall (f :: * -> *). GStaticByteSized f => Proxy f -> ByteCount
gstaticByteSize (forall {k} (t :: k). Proxy t
Proxy :: Proxy b)
instance GStaticByteSized a => GStaticByteSized (M1 i c a) where
gstaticByteSize :: Proxy (M1 i c a) -> ByteCount
gstaticByteSize Proxy (M1 i c a)
_ = forall (f :: * -> *). GStaticByteSized f => Proxy f -> ByteCount
gstaticByteSize (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
instance StaticByteSized a => GStaticByteSized (K1 i a) where
gstaticByteSize :: Proxy (K1 i a) -> ByteCount
gstaticByteSize Proxy (K1 i a)
_ = forall a. StaticByteSized a => Proxy a -> ByteCount
staticByteSize (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
instance (Generic t, GStaticByteSized (Rep t)) => StaticByteSized (ViaStaticGeneric t) where
staticByteSize :: Proxy (ViaStaticGeneric t) -> ByteCount
staticByteSize Proxy (ViaStaticGeneric t)
_ = forall (f :: * -> *). GStaticByteSized f => Proxy f -> ByteCount
gstaticByteSize (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Rep t))
class GByteSized f => GBinary (f :: Type -> Type) where
gget :: Get (f a)
gput :: f a -> Put
instance GBinary U1 where
gget :: forall a. Get (U1 a)
gget = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall k (p :: k). U1 p
U1
gput :: forall a. U1 a -> Put
gput U1 a
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
instance (GBinary a, GBinary b) => GBinary (a :*: b) where
gget :: forall a. Get ((:*:) a b a)
gget = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) forall (f :: * -> *) a. GBinary f => Get (f a)
gget forall (f :: * -> *) a. GBinary f => Get (f a)
gget
gput :: forall a. (:*:) a b a -> Put
gput (a a
x :*: b a
y) = forall (f :: * -> *) a. GBinary f => f a -> Put
gput a a
x forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. GBinary f => f a -> Put
gput b a
y
instance GBinary a => GBinary (M1 i c a) where
gget :: forall a. Get (M1 i c a a)
gget = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) a. GBinary f => Get (f a)
gget
gput :: forall a. M1 i c a a -> Put
gput = forall (f :: * -> *) a. GBinary f => f a -> Put
gput forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
instance Binary a => GBinary (K1 i a) where
gget :: forall a. Get (K1 i a a)
gget = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k i c (p :: k). c -> K1 i c p
K1 forall a. Binary a => Get a
get
gput :: forall a. K1 i a a -> Put
gput = forall a. Binary a => a -> Put
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k i c (p :: k). K1 i c p -> c
unK1
instance (Generic t, GBinary (Rep t)) => Binary (ViaGeneric t) where
get :: Get (ViaGeneric t)
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> ViaGeneric a
ViaGeneric forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => Rep a x -> a
to) forall (f :: * -> *) a. GBinary f => Get (f a)
gget
put :: ViaGeneric t -> Put
put = forall (f :: * -> *) a. GBinary f => f a -> Put
gput forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ViaGeneric a -> a
unViaGeneric
instance (Generic t, GStaticByteSized (Rep t), GBinary (Rep t)) => Binary (ViaStaticGeneric t) where
get :: Get (ViaStaticGeneric t)
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> ViaStaticGeneric a
ViaStaticGeneric forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => Rep a x -> a
to) forall (f :: * -> *) a. GBinary f => Get (f a)
gget
put :: ViaStaticGeneric t -> Put
put = forall a. StaticByteSized a => (a -> Put) -> a -> Put
putStaticHint (forall (f :: * -> *) a. GBinary f => f a -> Put
gput forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a x. Generic a => a -> Rep a x
from forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ViaStaticGeneric a -> a
unViaStaticGeneric)