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)