kind-generics-th 0.2.2.1 → 0.2.2.2
raw patch · 2 files changed
+46/−39 lines, 2 filesdep ~template-haskelldep ~th-abstractionPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: template-haskell, th-abstraction
API changes (from Hackage documentation)
Files
- kind-generics-th.cabal +4/−4
- src/Generics/Kind/TH.hs +42/−35
kind-generics-th.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: kind-generics-th-version: 0.2.2.1+version: 0.2.2.2 synopsis: Template Haskell support for generating `GenericK` instances description: This package provides Template Haskell functionality to automatically derive @GenericK@ instances (from the@@ -25,8 +25,8 @@ build-depends: base >=4.12 && <5 , ghc-prim >= 0.5.3 , kind-generics >=0.4- , template-haskell >=2.14 && <2.17- , th-abstraction >=0.3.1 && <0.5+ , template-haskell >=2.14 && <2.18+ , th-abstraction >=0.4 && <0.5 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall@@ -37,7 +37,7 @@ build-depends: base >=4.12 && <5 , kind-generics >=0.4 , kind-generics-th- , template-haskell >=2.14 && <2.17+ , template-haskell >=2.14 && <2.18 hs-source-dirs: tests default-language: Haskell2010 ghc-options: -Wall
src/Generics/Kind/TH.hs view
@@ -1,25 +1,27 @@-{-# language ExplicitNamespaces #-}-{-# language MultiWayIf #-}+{-# language CPP #-}+{-# language ExplicitNamespaces #-}+{-# language MultiWayIf #-} {-# language TemplateHaskellQuotes #-}-{-# language CPP #-} -- | Main module of @kind-generics-th@. -- Please refer to the @README@ file for documentation on how to use this package. module Generics.Kind.TH (deriveGenericK) where -import Control.Applicative-import Control.Monad-import qualified Data.Kind as Kind-import Data.List-import Data.Maybe-import Data.Type.Equality (type (~~))-import Generics.Kind-import GHC.Generics as Generics hiding (conIsRecord, conName, datatypeName)-import Language.Haskell.TH as TH-import Language.Haskell.TH.Datatype as THAbs+import Control.Applicative+import Control.Monad+import qualified Data.Kind as Kind+import Data.List+import Data.Maybe+import Data.Type.Equality (type (~~))+import GHC.Generics as Generics hiding (conIsRecord, conName,+ datatypeName)+import Generics.Kind+import Language.Haskell.TH as TH+import Language.Haskell.TH.Datatype as THAbs+import Language.Haskell.TH.Datatype.TyVarBndr #if MIN_VERSION_template_haskell(2,15,0)-import GHC.Classes (IP)+import GHC.Classes (IP) #endif -- | Given the 'Name' of a data type (or, the 'Name' of a constructor belonging@@ -77,8 +79,8 @@ deriveGenericKFor :: [Type] -> [Type] -> Q Dec deriveGenericKFor argsToKeep argsToDrop = do let argNamesToDrop = map varTToName argsToDrop- kind = foldr (\x y -> ArrowT `AppT` x `AppT` y)- (ConT ''Kind.Type) (map typeKind argsToDrop)+ kind = foldr ((\x y -> ArrowT `AppT` x `AppT` y) . typeKind)+ (ConT ''Kind.Type) argsToDrop dataApp = pure $ SigT (foldr (flip AppT) (ConT dataName) argsToKeep) kind instanceD (pure []) (conT ''GenericK `appT` dataApp)@@ -232,6 +234,9 @@ -- homogeneous. To be on the safe side, always -- conservatively assume that the equality it -- heterogeneous, since it is more permissive.+#if MIN_VERSION_template_haskell(2,17,0)+ go ty@MulArrowT{} = kon ty+#endif -- Recursive cases go (AppT ty1 ty2) = do ty1' <- go ty1@@ -252,8 +257,11 @@ -- Desugar (?n :: T) into (IP "n" T) #endif - -- Failure case+ -- Failure cases go ty@ForallT{} = can'tRepresent "rank-n type" ty+#if MIN_VERSION_template_haskell(2,16,0)+ go ty@ForallVisT{} = can'tRepresent "rank-n type" ty+#endif kon :: Type -> Q Type kon ty = promotedT 'Kon `appT` pure ty@@ -287,11 +295,11 @@ fromCon :: Int -- Total number of constructors -> Int -- Constructor index -> ConstructorInfo -> Q Match- fromCon n i (ConstructorInfo{ constructorName = conName- , constructorVars = exTvbs- , constructorContext = conCtxt- , constructorFields = fields- }) = do+ fromCon n i ConstructorInfo{ constructorName = conName+ , constructorVars = exTvbs+ , constructorContext = conCtxt+ , constructorFields = fields+ } = do fNames <- newNameList "f" $ length fields match (conP conName (map varP fNames)) (normalB $ lrE i n $ conE 'M1 `appE`@@ -328,11 +336,11 @@ toCon :: Int -- Total number of constructors -> Int -- Constructor index -> ConstructorInfo -> Q Match- toCon n i (ConstructorInfo{ constructorName = conName- , constructorVars = exTvbs- , constructorContext = conCtxt- , constructorFields = fields- }) = do+ toCon n i ConstructorInfo{ constructorName = conName+ , constructorVars = exTvbs+ , constructorContext = conCtxt+ , constructorFields = fields+ } = do fNames <- newNameList "f" $ length fields match (lrP i n $ conP 'M1 [ do prod <- foldBal (\x y -> infixP x '(:*:) y)@@ -485,7 +493,7 @@ newNameList :: String -> Int -> Q [Name] newNameList prefix n = traverse (newName . (prefix ++) . show) [1..n] -gatherExistentials :: [ConstructorInfo] -> [TyVarBndr]+gatherExistentials :: [ConstructorInfo] -> [TyVarBndrUnit] gatherExistentials = concatMap constructorVars gatherConstraints :: [ConstructorInfo] -> [Pred]@@ -538,14 +546,13 @@ -- | Resolve all of the type synonyms in a 'ConstructorInfo'. resolveConSynonyms :: ConstructorInfo -> Q ConstructorInfo-resolveConSynonyms con@(ConstructorInfo{ constructorVars = vars- , constructorContext = context- , constructorFields = fields- }) = do+resolveConSynonyms con@ConstructorInfo{ constructorVars = vars+ , constructorContext = context+ , constructorFields = fields+ } = do vars' <- traverse (\tvb ->- case tvb of- PlainTV{} -> pure tvb- KindedTV n k -> KindedTV n <$> resolveTypeSynonyms k) vars+ elimTV (\_n -> pure tvb)+ (\n k -> kindedTV n <$> resolveTypeSynonyms k) tvb) vars context' <- traverse resolveTypeSynonyms context fields' <- traverse resolveTypeSynonyms fields pure $ con{ constructorVars = vars'