module Sqel.SOP.Enum where

import qualified Data.Map.Strict as Map
import qualified Generics.SOP as SOP
import Generics.SOP (
  I,
  K (K),
  NP (Nil),
  NS,
  SOP (SOP),
  constructorName,
  hcollapse,
  hczipWith,
  injections,
  unK,
  type (-.->),
  )
import Generics.SOP.GGP (GCode, GDatatypeInfoOf, gto)
import qualified Generics.SOP.Type.Metadata as T

import Sqel.SOP.Constraint (IsEnum, IsNullary, ReifySOP)

class EnumTable a where
  enumTable :: Map Text a

instance (
    IsEnum a,
    ReifySOP a (GCode a),
    GDatatypeInfoOf a ~ 'T.ADT mod name ctors strictness,
    T.DemoteConstructorInfos ctors (GCode a)
  ) => EnumTable a where
    enumTable :: Map Text a
enumTable =
      forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse NP (K (Text, a)) (GCode a)
cs)
      where
        cs :: NP (K (Text, a)) (GCode a)
cs =
          forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *) (f'' :: k -> *).
(AllN (Prod h) c xs, HAp h, HAp (Prod h)) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a -> f'' a)
-> Prod h f xs
-> h f' xs
-> h f'' xs
hczipWith (forall {k} (t :: k). Proxy t
Proxy :: Proxy IsNullary) forall {k} (fs :: [*]).
ConstructorInfo fs
-> (-.->) (NP I) (K (NS (NP I) (GCode a))) '[] -> K (Text, a) '[]
f NP ConstructorInfo (GCode a)
ctors forall {k} (xs :: [k]) (f :: k -> *).
SListI xs =>
NP (Injection f xs) xs
injections
        f :: SOP.ConstructorInfo fs -> (NP I -.-> K (NS (NP I) (GCode a))) '[] -> K (Text, a) '[]
        f :: forall {k} (fs :: [*]).
ConstructorInfo fs
-> (-.->) (NP I) (K (NS (NP I) (GCode a))) '[] -> K (Text, a) '[]
f ConstructorInfo fs
ctor (SOP.Fn NP I '[] -> K (NS (NP I) (GCode a)) '[]
inject) =
          forall k a (b :: k). a -> K a b
K (forall a. ToText a => a -> Text
toText (forall (xs :: [*]). ConstructorInfo xs -> ConstructorName
constructorName ConstructorInfo fs
ctor), forall a. (GTo a, Generic a) => SOP I (GCode a) -> a
gto (forall k (f :: k -> *) (xss :: [[k]]). NS (NP f) xss -> SOP f xss
SOP (forall {k} a (b :: k). K a b -> a
unK (NP I '[] -> K (NS (NP I) (GCode a)) '[]
inject forall {k} (a :: k -> *). NP a '[]
Nil))))
        ctors :: NP ConstructorInfo (GCode a)
ctors =
          forall (cs :: [ConstructorInfo]) (xss :: [[*]])
       (proxy :: [ConstructorInfo] -> *).
DemoteConstructorInfos cs xss =>
proxy cs -> NP ConstructorInfo xss
T.demoteConstructorInfos (forall {k} (t :: k). Proxy t
Proxy @ctors)