From 4f3b99144cd97507881cd1a4b4028f6f513c709c Mon Sep 17 00:00:00 2001 From: Ellie Hermaszewska Date: Thu, 19 Sep 2024 20:51:09 +0800 Subject: [PATCH] Do not put inferred kind variables in generated TH splices Fixes https://github.com/lamdu/hypertypes/issues/23 --- src/Hyper/TH/Internal/Utils.hs | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/src/Hyper/TH/Internal/Utils.hs b/src/Hyper/TH/Internal/Utils.hs index 64b55b5..61e7208 100644 --- a/src/Hyper/TH/Internal/Utils.hs +++ b/src/Hyper/TH/Internal/Utils.hs @@ -84,20 +84,19 @@ makeTypeInfo name = parts :: D.DatatypeInfo -> Q (Type, Name) parts info = - case D.datatypeVars info of + case D.datatypeInstTypes info of [] -> fail "expected type constructor which requires arguments" xs -> - elimTV - (pure . (,) res) - ( \var c -> - case c of - ConT aHyper | aHyper == ''AHyperType -> pure (res, var) - _ -> fail "expected last argument to be a AHyperType variable" - ) - (last xs) + case last xs of + SigT (VarT var) (ConT aHyper) + | aHyper == ''AHyperType -> pure (res, var) + _ -> fail "expected last argument to be a AHyperType variable" where + unkind = \case + SigT a _k -> a + a -> a res = - foldl AppT (ConT (D.datatypeName info)) (init xs <&> VarT . D.tvName) + foldl AppT (ConT (D.datatypeName info)) (init xs <&> unkind) childrenTypes :: TypeInfo -> TypeContents childrenTypes info = evalState (childrenTypesH info) mempty