Build context for Store instances on type constructors with higher kinds

mgsloan · Aug 16, 2021 · 64c5591 · 64c5591
1 parent 1f1b476
commit 64c5591
Show file tree

Hide file tree

Showing 2 changed files with 7 additions and 1 deletion.
diff --git a/src/Data/Store/Internal.hs b/src/Data/Store/Internal.hs
@@ -876,4 +876,4 @@ instance Store NameFlavour where
 #endif
 
 $(reifyManyWithoutInstances ''Store [''Info] (const True) >>=
-   mapM (\name -> return (deriveGenericInstance [] (ConT name))))
+   mapM deriveGenericInstanceFromName)
diff --git a/src/Data/Store/TH/Internal.hs b/src/Data/Store/TH/Internal.hs
@@ -13,6 +13,7 @@ module Data.Store.TH.Internal
       deriveManyStoreFromStorable
     , deriveTupleStoreInstance
     , deriveGenericInstance
+    , deriveGenericInstanceFromName
     , deriveManyStorePrimVector
     , deriveManyStoreUnboxVector
     , deriveStore
@@ -262,6 +263,11 @@ deriveTupleStoreInstance n =
 deriveGenericInstance :: Cxt -> Type -> Dec
 deriveGenericInstance cs ty = plainInstanceD cs (AppT (ConT ''Store) ty) []
 
+deriveGenericInstanceFromName :: Name -> Q Dec
+deriveGenericInstanceFromName n = do
+    tvs <- map VarT . dtTvs <$> reifyDataType n
+    return $ deriveGenericInstance (map storePred tvs) (appsT (ConT n) tvs)
+
 ------------------------------------------------------------------------
 -- Storable