{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-} -- thanks to type manipulation

{- TODO
* in some low-level Haskell code (probably bytestring or other GHC lib) I've
  seen a pattern of binding in a certain way in order to hint a value's
  stickiness (whether it will change) to GHC. Probably whether to put it on LHS
  or RHS.
  * yeah, I think see https://wiki.haskell.org/Let_vs._Where
  * and Data.ByteString.Builder.Internal for a purposeful eta expansion
-}

{- | Generics for bytezap's struct serializer.

We can't use my generic-data-functions library, because we're doing more than
just basic monoidal composition. But I still want the same pluggable generics,
where the user provides the class to use for base cases. So I do that. However,
unlike g-d-f, the class info can't be provided via the user-selected monoid,
because you don't select that. Instead, we take a simple "index" type. It's
pretty much the same idea, surprisingly. This way, we can provide a few sensible
"versions" like in g-f-d, while primarily designing for DIY.
-}

module Bytezap.Struct.Generic where

import Bytezap.Struct
import GHC.Generics
import GHC.Exts

-- TODO fill in kind of a (some generic thing)
type family UnwrapGenericS1 a where
    UnwrapGenericS1 (S1 c (Rec0 a)) = a

-- | Class for holding info on class to use for poking base cases.
--
-- The type is just used to map to class info. It is never instantiated.
-- By packing @KnownSizeOf@ into here, we don't need to enforce a type-level
-- solution! Now it's up to you how you want to track your constant lengths.
--
-- We stay unboxed here because the internals are unboxed, just for convenience.
-- Maybe this is bad, let me know.
class GPokeBase idx where
    -- | The state token of our poker.
    type GPokeBaseSt idx

    -- | The type class that provides base case poking.
    --
    -- The type class should provide a function that looks like 'gPokeBase'.
    type GPokeBaseC idx a :: Constraint

    gPokeBase :: GPokeBaseC idx a => a -> Poke# (GPokeBaseSt idx)

    -- | The type class that provides poked length (known at compile time).
    type KnownSizeOf' idx a :: Constraint

    -- | Get the poked length of the given type. Unboxed because I felt like it.
    --
    -- I think we have to pass a proxy, because of forall limitations on
    -- instance signatures. This would be much better with explicit type
    -- variables (GHC 9.10 or 9.12).
    sizeOf' :: forall a. KnownSizeOf' idx a => Proxy# a -> Int#

class GPoke idx f where gPoke :: f p -> Poke# (GPokeBaseSt idx)

instance GPoke idx f => GPoke idx (D1 c f) where gPoke :: forall (p :: k). D1 c f p -> Poke# (GPokeBaseSt idx)
gPoke = forall (idx :: k) (f :: k -> Type) (p :: k).
GPoke idx f =>
f p -> Poke# (GPokeBaseSt idx)
forall {k} {k} (idx :: k) (f :: k -> Type) (p :: k).
GPoke idx f =>
f p -> Poke# (GPokeBaseSt idx)
gPoke @idx (f p -> Poke# (GPokeBaseSt idx))
-> (D1 c f p -> f p) -> D1 c f p -> Poke# (GPokeBaseSt idx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. D1 c f p -> f p
forall k i (c :: Meta) (f :: k -> Type) (p :: k). M1 i c f p -> f p
unM1
instance GPoke idx f => GPoke idx (C1 c f) where gPoke :: forall (p :: k). C1 c f p -> Poke# (GPokeBaseSt idx)
gPoke = forall (idx :: k) (f :: k -> Type) (p :: k).
GPoke idx f =>
f p -> Poke# (GPokeBaseSt idx)
forall {k} {k} (idx :: k) (f :: k -> Type) (p :: k).
GPoke idx f =>
f p -> Poke# (GPokeBaseSt idx)
gPoke @idx (f p -> Poke# (GPokeBaseSt idx))
-> (C1 c f p -> f p) -> C1 c f p -> Poke# (GPokeBaseSt idx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. C1 c f p -> f p
forall k i (c :: Meta) (f :: k -> Type) (p :: k). M1 i c f p -> f p
unM1

instance (GPoke idx l, GPoke idx r, GPokeBase idx, KnownSizeOf' idx (UnwrapGenericS1 l))
  => GPoke idx (l :*: r) where
    -- TODO moved os and s0 to RHS because base is const and those aren't?
    -- will this change anything?? idk!!!!
    gPoke :: forall (p :: k). (:*:) l r p -> Poke# (GPokeBaseSt idx)
gPoke (l p
l :*: r p
r) Addr#
base# = \Int#
os# State# (GPokeBaseSt idx)
s0 ->
        case forall (idx :: k) (f :: k -> Type) (p :: k).
GPoke idx f =>
f p -> Poke# (GPokeBaseSt idx)
forall {k} {k} (idx :: k) (f :: k -> Type) (p :: k).
GPoke idx f =>
f p -> Poke# (GPokeBaseSt idx)
gPoke @idx l p
l Addr#
base# Int#
os# State# (GPokeBaseSt idx)
s0 of
          State# (GPokeBaseSt idx)
s1 -> forall (idx :: k) (f :: k -> Type) (p :: k).
GPoke idx f =>
f p -> Poke# (GPokeBaseSt idx)
forall {k} {k} (idx :: k) (f :: k -> Type) (p :: k).
GPoke idx f =>
f p -> Poke# (GPokeBaseSt idx)
gPoke @idx r p
r Addr#
base# (Int#
os# Int# -> Int# -> Int#
+# forall (idx :: k) a.
(GPokeBase idx, KnownSizeOf' idx a) =>
Proxy# a -> Int#
forall {k} (idx :: k) a.
(GPokeBase idx, KnownSizeOf' idx a) =>
Proxy# a -> Int#
sizeOf' @idx @(UnwrapGenericS1 l) Proxy# (UnwrapGenericS1 l)
forall {k} (a :: k). Proxy# a
proxy#) State# (GPokeBaseSt idx)
s1

instance (GPokeBase idx, GPokeBaseC idx a) => GPoke idx (S1 c (Rec0 a)) where
    gPoke :: forall (p :: k). S1 c (Rec0 a) p -> Poke# (GPokeBaseSt idx)
gPoke = forall (idx :: k) a.
(GPokeBase idx, GPokeBaseC idx a) =>
a -> Poke# (GPokeBaseSt idx)
forall {k} (idx :: k) a.
(GPokeBase idx, GPokeBaseC idx a) =>
a -> Poke# (GPokeBaseSt idx)
gPokeBase @idx (a -> Poke# (GPokeBaseSt idx))
-> (S1 c (Rec0 a) p -> a)
-> S1 c (Rec0 a) p
-> Poke# (GPokeBaseSt idx)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K1 R a p -> a
forall k i c (p :: k). K1 i c p -> c
unK1 (K1 R a p -> a)
-> (S1 c (Rec0 a) p -> K1 R a p) -> S1 c (Rec0 a) p -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S1 c (Rec0 a) p -> K1 R a p
forall k i (c :: Meta) (f :: k -> Type) (p :: k). M1 i c f p -> f p
unM1

-- | Wow, look! Nothing!
instance GPoke idx U1 where gPoke :: forall (p :: k). U1 p -> Poke# (GPokeBaseSt idx)
gPoke U1 p
U1 Addr#
_base# = \Int#
_os# State# (GPokeBaseSt idx)
s0 -> State# (GPokeBaseSt idx)
s0