{-# 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 (..), (:*:) (..))

-- | Use: deriving (ByteSized, Binary) via (ViaGeneric Foo)
newtype ViaGeneric a = ViaGeneric {forall a. ViaGeneric a -> a
unViaGeneric :: a}

-- | Use: deriving (ByteSized, StaticByteSized, Binary) via (ViaStaticGeneric Foo)
newtype ViaStaticGeneric a = ViaStaticGeneric {forall a. ViaStaticGeneric a -> a
unViaStaticGeneric :: a}

-- ByteSized:

class GByteSized f where
  gbyteSize :: f a -> ByteCount

-- Unit
instance GByteSized U1 where
  gbyteSize :: forall a. U1 a -> ByteCount
gbyteSize U1 a
_ = ByteCount
0

-- Product
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

-- Metadata
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

-- Field
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

-- StaticByteSized:

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))

-- Binary:

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)