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

module Bytezap.Parser.Struct.Generic where

import Bytezap.Parser.Struct
import GHC.Generics
import GHC.Exts
import Data.Kind
import GHC.TypeNats
import Util.TypeNats ( natValInt )
import Bytezap.Common.Generic ( type GTFoldMapCAddition )
import DeFun.Core ( type (~>) )

class GParseBase tag where
    -- | The state token of the parser.
    type GParseBaseSt tag :: ZeroBitType
    type GParseBaseC tag a :: Constraint
    type GParseBaseE tag :: Type

    -- unlike the serializer we stay newtyped because we want our Functor
    gParseBase
        :: GParseBaseC tag a
        => ParserT (GParseBaseSt tag) (GParseBaseE tag) a

    -- | Defunctionalization symbol for a type family turning 'Type's into
    --   'Natural's. (Needed as we can't partially apply type families.)
    type GParseBaseLenTF tag :: Type ~> Natural

class GParse tag gf where
    gParse :: ParserT (GParseBaseSt tag) (GParseBaseE tag) (gf p)

instance GParse tag gf => GParse tag (D1 cd gf) where
    gParse :: forall (p :: k).
ParserT (GParseBaseSt tag) (GParseBaseE tag) (D1 cd gf p)
gParse = gf p -> D1 cd gf p
forall k i (c :: Meta) (f :: k -> Type) (p :: k). f p -> M1 i c f p
M1 (gf p -> D1 cd gf p)
-> ParserT (GParseBaseSt tag) (GParseBaseE tag) (gf p)
-> ParserT (GParseBaseSt tag) (GParseBaseE tag) (D1 cd gf p)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (tag :: k) (gf :: k -> Type) (p :: k).
GParse tag gf =>
ParserT (GParseBaseSt tag) (GParseBaseE tag) (gf p)
forall {k} {k} (tag :: k) (gf :: k -> Type) (p :: k).
GParse tag gf =>
ParserT (GParseBaseSt tag) (GParseBaseE tag) (gf p)
gParse @tag
instance GParse tag gf => GParse tag (C1 cc gf) where
    gParse :: forall (p :: k).
ParserT (GParseBaseSt tag) (GParseBaseE tag) (C1 cc gf p)
gParse = gf p -> C1 cc gf p
forall k i (c :: Meta) (f :: k -> Type) (p :: k). f p -> M1 i c f p
M1 (gf p -> C1 cc gf p)
-> ParserT (GParseBaseSt tag) (GParseBaseE tag) (gf p)
-> ParserT (GParseBaseSt tag) (GParseBaseE tag) (C1 cc gf p)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (tag :: k) (gf :: k -> Type) (p :: k).
GParse tag gf =>
ParserT (GParseBaseSt tag) (GParseBaseE tag) (gf p)
forall {k} {k} (tag :: k) (gf :: k -> Type) (p :: k).
GParse tag gf =>
ParserT (GParseBaseSt tag) (GParseBaseE tag) (gf p)
gParse @tag

instance
  ( GParse tag l
  , GParse tag r
  , GParseBase tag
  , lenL ~ GTFoldMapCAddition (GParseBaseLenTF tag) l
  , KnownNat lenL
  ) => GParse tag (l :*: r) where
    gParse :: forall (p :: k).
ParserT (GParseBaseSt tag) (GParseBaseE tag) ((:*:) l r p)
gParse = Int
-> (l p -> r p -> (:*:) l r p)
-> ParserT (GParseBaseSt tag) (GParseBaseE tag) (l p)
-> ParserT (GParseBaseSt tag) (GParseBaseE tag) (r p)
-> ParserT (GParseBaseSt tag) (GParseBaseE tag) ((:*:) l r p)
forall a b c (st :: ZeroBitType) e.
Int
-> (a -> b -> c)
-> ParserT st e a
-> ParserT st e b
-> ParserT st e c
sequenceParsers Int
len l p -> r p -> (:*:) l r p
forall k (f :: k -> Type) (g :: k -> Type) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (forall (tag :: k) (gf :: k -> Type) (p :: k).
GParse tag gf =>
ParserT (GParseBaseSt tag) (GParseBaseE tag) (gf p)
forall {k} {k} (tag :: k) (gf :: k -> Type) (p :: k).
GParse tag gf =>
ParserT (GParseBaseSt tag) (GParseBaseE tag) (gf p)
gParse @tag) (forall (tag :: k) (gf :: k -> Type) (p :: k).
GParse tag gf =>
ParserT (GParseBaseSt tag) (GParseBaseE tag) (gf p)
forall {k} {k} (tag :: k) (gf :: k -> Type) (p :: k).
GParse tag gf =>
ParserT (GParseBaseSt tag) (GParseBaseE tag) (gf p)
gParse @tag)
      where
        len :: Int
len = forall (n :: Natural). KnownNat n => Int
natValInt @lenL

instance (GParseBase tag, GParseBaseC tag a) => GParse tag (S1 c (Rec0 a)) where
    gParse :: forall (p :: k).
ParserT (GParseBaseSt tag) (GParseBaseE tag) (S1 c (Rec0 a) p)
gParse = (Rec0 a p -> S1 c (Rec0 a) p
forall k i (c :: Meta) (f :: k -> Type) (p :: k). f p -> M1 i c f p
M1 (Rec0 a p -> S1 c (Rec0 a) p)
-> (a -> Rec0 a p) -> a -> S1 c (Rec0 a) p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rec0 a p
forall k i c (p :: k). c -> K1 i c p
K1) (a -> S1 c (Rec0 a) p)
-> ParserT (GParseBaseSt tag) (GParseBaseE tag) a
-> ParserT (GParseBaseSt tag) (GParseBaseE tag) (S1 c (Rec0 a) p)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (tag :: k) a.
(GParseBase tag, GParseBaseC tag a) =>
ParserT (GParseBaseSt tag) (GParseBaseE tag) a
forall {k} (tag :: k) a.
(GParseBase tag, GParseBaseC tag a) =>
ParserT (GParseBaseSt tag) (GParseBaseE tag) a
gParseBase @tag

-- | Wow, look! Nothing!
instance GParse tag U1 where gParse :: forall (p :: k).
ParserT (GParseBaseSt tag) (GParseBaseE tag) (U1 p)
gParse = U1 p -> ParserT (GParseBaseSt tag) (GParseBaseE tag) (U1 p)
forall a (st :: ZeroBitType) e. a -> ParserT st e a
constParse U1 p
forall k (p :: k). U1 p
U1