{-# options_haddock prune #-}

-- | Description: Internal
module Exon.Generic where

import GHC.Generics (C1, D1, K1 (K1), M1 (M1), Meta (MetaData), Rep, S1, from, to)

type family PrepRep (rep :: Type -> Type) :: Maybe Type where
  PrepRep (D1 ('MetaData _ _ _ 'True) (C1 _ (S1 _ (K1 _ w)))) = 'Just w
  PrepRep (D1 ('MetaData _ _ _ 'True) (C1 _ (K1 _ w))) = 'Just w

class RepIsNewtype (rep :: Maybe Type) (wrapped :: Maybe Type) | rep -> wrapped
instance {-# incoherent #-} wrapped ~ 'Nothing => RepIsNewtype rep wrapped
instance wrapped ~ 'Just w => RepIsNewtype ('Just w) wrapped

class IsNewtype w (wrapped :: Maybe Type) | w -> wrapped
instance RepIsNewtype (PrepRep (Rep w)) wrapped => IsNewtype w wrapped

type NewtypeRep :: Symbol -> Symbol -> Symbol -> Meta -> Type -> Type -> Type -> Type
type NewtypeRep n m p c i w =
  D1 ('MetaData n m p 'True) (S1 c (K1 i w))

class UnwrapField (rep :: Type -> Type) (w :: Type) | rep -> w where
  unwrapField :: rep x -> w

-- | Record selector
instance UnwrapField (S1 s (K1 i w)) w where
  unwrapField :: forall x. S1 s (K1 i w) x -> w
unwrapField (M1 (K1 w
w)) = w
w

-- | Plain field
instance UnwrapField (K1 i w) w where
  unwrapField :: forall x. K1 i w x -> w
unwrapField (K1 w
w) = w
w

class Unwrap (a :: Type) (w :: Type) | a -> w where
  unwrap :: a -> w

-- | Constructor ('C1') in a data type ('D1') that's a newtype (@'True@)
instance (
    Generic a,
    Rep a ~ D1 ('MetaData n m p 'True) (C1 c field),
    UnwrapField field w
  ) => Unwrap a w where
    unwrap :: a -> w
unwrap (a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from -> M1 (M1 field Any
field)) = field Any -> w
forall x. field x -> w
forall (rep :: * -> *) w x. UnwrapField rep w => rep x -> w
unwrapField field Any
field

class WrapField (rep :: Type -> Type) (w :: Type) | rep -> w where
  wrapField :: w -> rep x

-- | Record selector
instance WrapField (S1 s (K1 i w)) w where
  wrapField :: forall x. w -> S1 s (K1 i w) x
wrapField = K1 i w x -> M1 S s (K1 i w) x
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 i w x -> M1 S s (K1 i w) x)
-> (w -> K1 i w x) -> w -> M1 S s (K1 i w) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> K1 i w x
forall k i c (p :: k). c -> K1 i c p
K1

-- | Plain field
instance WrapField (K1 i w) w where
  wrapField :: forall x. w -> K1 i w x
wrapField = w -> K1 i w x
forall k i c (p :: k). c -> K1 i c p
K1

class Wrap (a :: Type) (w :: Type) | a -> w where
  wrap :: w -> a

instance (
    Generic a,
    Rep a ~ D1 ('MetaData n m p 'True) (C1 c field),
    WrapField field w
  ) => Wrap a w where
    wrap :: w -> a
wrap w
w = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (M1 C c field Any -> M1 D ('MetaData n m p 'True) (C1 c field) Any
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (field Any -> M1 C c field Any
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (w -> field Any
forall x. w -> field x
forall (rep :: * -> *) w x. WrapField rep w => w -> rep x
wrapField w
w)))

type OverNt (a :: Type) (w :: Type) =
  (Wrap a w, Unwrap a w)