{-# options_haddock prune #-}

-- |Description: Internal
module Exon.Generic where

import Generics.SOP (All2, I (I), NP (Nil, (:*)), NS (S, Z), SOP (SOP), Top)
import Generics.SOP.GGP (GCode, GDatatypeInfoOf, GFrom, GTo, gfrom, gto)
import Generics.SOP.Type.Metadata (DatatypeInfo (Newtype))

type ReifySOP (a :: Type) (ass :: [[Type]]) =
  (Generic a, GTo a, GCode a ~ ass, All2 Top ass)

type ConstructSOP (a :: Type) (ass :: [[Type]]) =
  (Generic a, GFrom a, GCode a ~ ass, All2 Top ass)

type ReifyNt (a :: Type) (b :: Type) =
  ReifySOP a '[ '[b] ]

type GenNt (a :: Type) (b :: Type) =
  ConstructSOP a '[ '[b] ]

type OverNt (a :: Type) (b :: Type) =
  (ReifyNt a b, GenNt a b)

unwrap ::
  GenNt a b =>
  a ->
  b
unwrap :: forall a b. GenNt a b => a -> b
unwrap a
a =
  case a -> SOP I (GCode a)
forall a. (GFrom a, Generic a) => a -> SOP I (GCode a)
gfrom a
a of
    SOP (Z (I x
b :* NP I xs
Nil)) -> b
x
b
    SOP (S NS (NP I) xs
n) -> case NS (NP I) xs
n of

wrap ::
  ReifyNt a b =>
  b ->
  a
wrap :: forall a b. ReifyNt a b => b -> a
wrap b
b =
  SOP I (GCode a) -> a
forall a. (GTo a, Generic a) => SOP I (GCode a) -> a
gto (NS (NP I) '[ '[b]] -> SOP I '[ '[b]]
forall k (f :: k -> *) (xss :: [[k]]). NS (NP f) xss -> SOP f xss
SOP (NP I '[b] -> NS (NP I) '[ '[b]]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]). a x -> NS a (x : xs)
Z (b -> I b
forall a. a -> I a
I b
b I b -> NP I '[] -> NP I '[b]
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP I '[]
forall {k} (a :: k -> *). NP a '[]
Nil)))

class GDatatypeInfoIsNewtype (dss :: [[Type]]) (info :: DatatypeInfo) (wrapped :: Maybe Type) | dss info -> wrapped
instance {-# incoherent #-} wrapped ~ 'Nothing => GDatatypeInfoIsNewtype dss info wrapped
instance wrapped ~ 'Just d => GDatatypeInfoIsNewtype '[ '[d]] ('Newtype m n c) wrapped

class IsNewtype d (wrapped :: Maybe Type) | d -> wrapped
instance GDatatypeInfoIsNewtype (GCode d) (GDatatypeInfoOf d) wrapped => IsNewtype d wrapped