th-utilities 0.1.1.1 → 0.2.0.0
raw patch · 7 files changed
+398/−121 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- TH.ReifyDataType: DataCon :: Name -> [Name] -> Cxt -> [(Maybe Name, Type)] -> DataCon
- TH.ReifyDataType: DataType :: Name -> [Name] -> Cxt -> [DataCon] -> DataType
- TH.ReifyDataType: [dcCxt] :: DataCon -> Cxt
- TH.ReifyDataType: [dcFields] :: DataCon -> [(Maybe Name, Type)]
- TH.ReifyDataType: [dcName] :: DataCon -> Name
- TH.ReifyDataType: [dcTvs] :: DataCon -> [Name]
- TH.ReifyDataType: [dtCons] :: DataType -> [DataCon]
- TH.ReifyDataType: [dtCxt] :: DataType -> Cxt
- TH.ReifyDataType: [dtName] :: DataType -> Name
- TH.ReifyDataType: [dtTvs] :: DataType -> [Name]
- TH.ReifyDataType: conToDataCons :: Con -> [DataCon]
- TH.ReifyDataType: data DataCon
- TH.ReifyDataType: data DataType
- TH.ReifyDataType: instance Data.Data.Data TH.ReifyDataType.DataCon
- TH.ReifyDataType: instance Data.Data.Data TH.ReifyDataType.DataType
- TH.ReifyDataType: instance GHC.Classes.Eq TH.ReifyDataType.DataCon
- TH.ReifyDataType: instance GHC.Classes.Eq TH.ReifyDataType.DataType
- TH.ReifyDataType: instance GHC.Classes.Ord TH.ReifyDataType.DataCon
- TH.ReifyDataType: instance GHC.Classes.Ord TH.ReifyDataType.DataType
- TH.ReifyDataType: instance GHC.Generics.Generic TH.ReifyDataType.DataCon
- TH.ReifyDataType: instance GHC.Generics.Generic TH.ReifyDataType.DataType
- TH.ReifyDataType: instance GHC.Show.Show TH.ReifyDataType.DataCon
- TH.ReifyDataType: instance GHC.Show.Show TH.ReifyDataType.DataType
- TH.ReifyDataType: reifyDataType :: Name -> Q DataType
- TH.ReifyDataType: reifyDataTypeSubstituted :: Type -> Q DataType
+ TH.ReifySimple: DataCon :: Name -> [Name] -> Cxt -> [(Maybe Name, Type)] -> DataCon
+ TH.ReifySimple: DataFamily :: Name -> [Name] -> [DataInst] -> DataFamily
+ TH.ReifySimple: DataInst :: Name -> Cxt -> [Type] -> [DataCon] -> DataInst
+ TH.ReifySimple: DataType :: Name -> [Name] -> Cxt -> [DataCon] -> DataType
+ TH.ReifySimple: TypeFamily :: Name -> [Name] -> [TypeInst] -> TypeFamily
+ TH.ReifySimple: TypeInst :: Name -> [Type] -> Type -> TypeInst
+ TH.ReifySimple: [dcCxt] :: DataCon -> Cxt
+ TH.ReifySimple: [dcFields] :: DataCon -> [(Maybe Name, Type)]
+ TH.ReifySimple: [dcName] :: DataCon -> Name
+ TH.ReifySimple: [dcTvs] :: DataCon -> [Name]
+ TH.ReifySimple: [dfInsts] :: DataFamily -> [DataInst]
+ TH.ReifySimple: [dfName] :: DataFamily -> Name
+ TH.ReifySimple: [dfTvs] :: DataFamily -> [Name]
+ TH.ReifySimple: [diCons] :: DataInst -> [DataCon]
+ TH.ReifySimple: [diCxt] :: DataInst -> Cxt
+ TH.ReifySimple: [diName] :: DataInst -> Name
+ TH.ReifySimple: [diParams] :: DataInst -> [Type]
+ TH.ReifySimple: [dtCons] :: DataType -> [DataCon]
+ TH.ReifySimple: [dtCxt] :: DataType -> Cxt
+ TH.ReifySimple: [dtName] :: DataType -> Name
+ TH.ReifySimple: [dtTvs] :: DataType -> [Name]
+ TH.ReifySimple: [tfInsts] :: TypeFamily -> [TypeInst]
+ TH.ReifySimple: [tfName] :: TypeFamily -> Name
+ TH.ReifySimple: [tfTvs] :: TypeFamily -> [Name]
+ TH.ReifySimple: [tiName] :: TypeInst -> Name
+ TH.ReifySimple: [tiParams] :: TypeInst -> [Type]
+ TH.ReifySimple: [tiType] :: TypeInst -> Type
+ TH.ReifySimple: conToDataCons :: Con -> [DataCon]
+ TH.ReifySimple: data DataCon
+ TH.ReifySimple: data DataFamily
+ TH.ReifySimple: data DataInst
+ TH.ReifySimple: data DataType
+ TH.ReifySimple: data TypeFamily
+ TH.ReifySimple: data TypeInfo
+ TH.ReifySimple: data TypeInst
+ TH.ReifySimple: infoToDataCon :: Info -> Maybe DataCon
+ TH.ReifySimple: infoToDataFamily :: Info -> Maybe DataFamily
+ TH.ReifySimple: infoToDataType :: Info -> Maybe DataType
+ TH.ReifySimple: infoToType :: Info -> Q (Maybe TypeInfo)
+ TH.ReifySimple: infoToTypeFamily :: Info -> Maybe TypeFamily
+ TH.ReifySimple: infoToTypeNoDataKinds :: Info -> Maybe TypeInfo
+ TH.ReifySimple: instance Data.Data.Data TH.ReifySimple.DataCon
+ TH.ReifySimple: instance Data.Data.Data TH.ReifySimple.DataFamily
+ TH.ReifySimple: instance Data.Data.Data TH.ReifySimple.DataInst
+ TH.ReifySimple: instance Data.Data.Data TH.ReifySimple.DataType
+ TH.ReifySimple: instance Data.Data.Data TH.ReifySimple.TypeFamily
+ TH.ReifySimple: instance Data.Data.Data TH.ReifySimple.TypeInst
+ TH.ReifySimple: instance GHC.Classes.Eq TH.ReifySimple.DataCon
+ TH.ReifySimple: instance GHC.Classes.Eq TH.ReifySimple.DataFamily
+ TH.ReifySimple: instance GHC.Classes.Eq TH.ReifySimple.DataInst
+ TH.ReifySimple: instance GHC.Classes.Eq TH.ReifySimple.DataType
+ TH.ReifySimple: instance GHC.Classes.Eq TH.ReifySimple.TypeFamily
+ TH.ReifySimple: instance GHC.Classes.Eq TH.ReifySimple.TypeInst
+ TH.ReifySimple: instance GHC.Classes.Ord TH.ReifySimple.DataCon
+ TH.ReifySimple: instance GHC.Classes.Ord TH.ReifySimple.DataFamily
+ TH.ReifySimple: instance GHC.Classes.Ord TH.ReifySimple.DataInst
+ TH.ReifySimple: instance GHC.Classes.Ord TH.ReifySimple.DataType
+ TH.ReifySimple: instance GHC.Classes.Ord TH.ReifySimple.TypeFamily
+ TH.ReifySimple: instance GHC.Classes.Ord TH.ReifySimple.TypeInst
+ TH.ReifySimple: instance GHC.Generics.Generic TH.ReifySimple.DataCon
+ TH.ReifySimple: instance GHC.Generics.Generic TH.ReifySimple.DataFamily
+ TH.ReifySimple: instance GHC.Generics.Generic TH.ReifySimple.DataInst
+ TH.ReifySimple: instance GHC.Generics.Generic TH.ReifySimple.DataType
+ TH.ReifySimple: instance GHC.Generics.Generic TH.ReifySimple.TypeFamily
+ TH.ReifySimple: instance GHC.Generics.Generic TH.ReifySimple.TypeInst
+ TH.ReifySimple: instance GHC.Show.Show TH.ReifySimple.DataCon
+ TH.ReifySimple: instance GHC.Show.Show TH.ReifySimple.DataFamily
+ TH.ReifySimple: instance GHC.Show.Show TH.ReifySimple.DataInst
+ TH.ReifySimple: instance GHC.Show.Show TH.ReifySimple.DataType
+ TH.ReifySimple: instance GHC.Show.Show TH.ReifySimple.TypeFamily
+ TH.ReifySimple: instance GHC.Show.Show TH.ReifySimple.TypeInst
+ TH.ReifySimple: reifyDataCon :: Name -> Q DataCon
+ TH.ReifySimple: reifyDataFamily :: Name -> Q DataFamily
+ TH.ReifySimple: reifyDataType :: Name -> Q DataType
+ TH.ReifySimple: reifyDataTypeSubstituted :: Type -> Q DataType
+ TH.ReifySimple: reifyType :: Name -> Q TypeInfo
+ TH.ReifySimple: reifyTypeFamily :: Name -> Q TypeFamily
+ TH.ReifySimple: reifyTypeNoDataKinds :: Name -> Q (Maybe TypeInfo)
+ TH.ReifySimple: typeToDataCon :: Name -> Type -> DataCon
+ TH.Utilities: appsT :: Type -> [Type] -> Type
+ TH.Utilities: everywhereButStrings :: Data a => (forall b. Data b => b -> b) -> a -> a
+ TH.Utilities: everywhereButStringsM :: forall a m. (Data a, Monad m) => GenericM m -> a -> m a
+ TH.Utilities: toSimpleName :: Name -> Name
+ TH.Utilities: typeRepToType :: TypeRep -> Q Type
Files
- ChangeLog.md +9/−0
- src/TH/Derive/Storable.hs +1/−1
- src/TH/ReifyDataType.hs +0/−110
- src/TH/ReifySimple.hs +333/−0
- src/TH/RelativePaths.hs +16/−8
- src/TH/Utilities.hs +37/−0
- th-utilities.cabal +2/−2
ChangeLog.md view
@@ -1,5 +1,14 @@ # ChangeLog +## 0.2.0.0++* Adds TH.ReifySimple, which supports reifying most of the information TH users+ care about.++* Adds some utilities based on SYB, which is often useful for TH.++* Makes relative path stuff less noisyi with GHCi.+ ## 0.1.0.0 * First public release
src/TH/Derive/Storable.hs view
@@ -28,7 +28,7 @@ import Language.Haskell.TH.Syntax import Prelude import TH.Derive.Internal-import TH.ReifyDataType+import TH.ReifySimple import TH.Utilities instance Deriver (Storable a) where
− src/TH/ReifyDataType.hs
@@ -1,110 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE LambdaCase #-}---- | Utilities for reifying simplified datatype info. It omits details--- that aren't usually relevant to generating instances that work with--- the datatype. This makes it easier to use TH to derive instances.-module TH.ReifyDataType- ( DataType(..)- , DataCon(..)- , reifyDataType- , conToDataCons- , reifyDataTypeSubstituted- ) where--import Data.Data (Data, gmapT)-import Data.Generics.Aliases (extT)-import qualified Data.Map as M-import Data.Typeable (Typeable)-import GHC.Generics (Generic)-import Language.Haskell.TH-import Language.Haskell.TH.Instances ()-import TH.Utilities---- | Simplified info about a 'DataD'. Omits deriving, strictness, and--- kind info.-data DataType = DataType- { dtName :: Name- , dtTvs :: [Name]- , dtCxt :: Cxt- , dtCons :: [DataCon]- } deriving (Eq, Show, Ord, Data, Typeable, Generic)---- | Simplified info about a 'Con'. Omits strictness, and kind info.--- This is much nicer than consuming 'Con' directly, because it unifies--- all the constructors into one.-data DataCon = DataCon- { dcName :: Name- , dcTvs :: [Name]- , dcCxt :: Cxt- , dcFields :: [(Maybe Name, Type)]- } deriving (Eq, Show, Ord, Data, Typeable, Generic)---- | Reify the given data or newtype declaration, and yields its--- 'DataType' representation.-reifyDataType :: Name -> Q DataType-reifyDataType queryName = do- info <- reify queryName- case info of-#if MIN_VERSION_template_haskell(2,11,0)- TyConI (DataD preds name vars _kind cons _deriving) -> do-#else- TyConI (DataD preds name vars cons _deriving) -> do-#endif- let tvs = map tyVarBndrName vars- cs = concatMap conToDataCons cons- return (DataType name tvs preds cs)-#if MIN_VERSION_template_haskell(2,11,0)- TyConI (NewtypeD preds name vars _kind con _deriving) -> do-#else- TyConI (NewtypeD preds name vars con _deriving) -> do-#endif- let tvs = map tyVarBndrName vars- cs = conToDataCons con- return (DataType name tvs preds cs)- _ -> fail $ "Expected to reify a datatype, instead got:\n" ++ pprint info---- | Convert a 'Con' to a list of 'DataCon'. The result is a list--- because 'GadtC' and 'RecGadtC' can define multiple constructors.-conToDataCons :: Con -> [DataCon]-conToDataCons = \case- NormalC name slots ->- [DataCon name [] [] (map (\(_, ty) -> (Nothing, ty)) slots)]- RecC name fields ->- [DataCon name [] [] (map (\(n, _, ty) -> (Just n, ty)) fields)]- InfixC (_, ty1) name (_, ty2) ->- [DataCon name [] [] [(Nothing, ty1), (Nothing, ty2)]]- ForallC tvs preds con ->- map (\(DataCon name tvs0 preds0 fields) ->- DataCon name (tvs0 ++ map tyVarBndrName tvs) (preds0 ++ preds) fields) (conToDataCons con)-#if MIN_VERSION_template_haskell(2,11,0)- GadtC ns slots _ ->- map (\n -> DataCon n [] [] (map (\(_, ty) -> (Nothing, ty)) slots)) ns- RecGadtC ns fields _ ->- map (\n -> DataCon n [] [] (map (\(n, _, ty) -> (Just n, ty)) fields)) ns-#endif---- | Like 'reifyDataType', but takes a 'Type' instead of just the 'Name'--- of the datatype. It expects a normal datatype argument (see--- 'typeToNamedCon').-reifyDataTypeSubstituted :: Type -> Q DataType-reifyDataTypeSubstituted ty =- case typeToNamedCon ty of- Nothing -> fail $ "Expected a datatype, but reifyDataTypeSubstituted was applied to " ++ pprint ty- Just (n, args) -> do- dt <- reifyDataType n- let cons' = substituteTvs (M.fromList (zip (dtTvs dt) args)) (dtCons dt)- return (dt { dtCons = cons' })---- TODO: add various handy generics based traversals to TH.Utilities--substituteTvs :: Data a => M.Map Name Type -> a -> a-substituteTvs mp = transformTypes go- where- go (VarT name) | Just ty <- M.lookup name mp = ty- go ty = gmapT (substituteTvs mp) ty--transformTypes :: Data a => (Type -> Type) -> a -> a-transformTypes f = gmapT (transformTypes f) `extT` (id :: String -> String) `extT` f
+ src/TH/ReifySimple.hs view
@@ -0,0 +1,333 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}++-- | Utilities for reifying simplified datatype info. It omits details+-- that aren't usually relevant to generating instances that work with+-- the datatype. This makes it easier to use TH to derive instances.+--+-- The \"Simple\" in the module name refers to the simplicity of the+-- datatypes, not the module itself, which exports quite a few things+-- which are useful in some circumstance or another. I anticipate that+-- the most common uses of this will be the following APIs:+--+-- * Getting info about a @data@ or @newtype@ declaration, via+-- 'DataType', 'reifyDataType', and 'DataCon'. This is useful for+-- writing something which generates declarations based on a datatype,+-- one of the most common uses of Template Haskell.+--+-- * Getting nicely structured info about a named type. See 'TypeInfo'+-- and 'reifyType'. This does not yet support reifying typeclasses,+-- primitive type constructors, or type variables ('TyVarI').+--+-- Currently, this module supports reifying simplified versions of the+-- following 'Info' constructors:+--+-- * 'TyConI' with 'DataD' and 'NewtypeD' (becomes a 'DataType' value)+--+-- * 'FamilyI' becomes a 'DataFamily' or 'TypeFamily' value.+--+-- * 'DataConI' becomes a 'DataCon' value.+--+-- In the future it will hopefully also have support for the remaining+-- 'Info' constructors, 'ClassI', 'ClassOpI', 'PrimTyConI', 'VarI', and+-- 'TyVarI'.+module TH.ReifySimple+ (+ -- * Reifying simplified type info+ TypeInfo, reifyType, infoToType+ , reifyTypeNoDataKinds, infoToTypeNoDataKinds+ -- * Reifying simplified info for specific declaration varieties+ -- ** Datatype info+ , DataType(..), reifyDataType, infoToDataType+ -- ** Data constructor info+ , DataCon(..), reifyDataCon, infoToDataCon, typeToDataCon+ -- ** Data family info+ , DataFamily(..), DataInst(..), reifyDataFamily, infoToDataFamily+ -- ** Type family info+ , TypeFamily(..), TypeInst(..), reifyTypeFamily, infoToTypeFamily+ -- * Other utilities+ , conToDataCons+ , reifyDataTypeSubstituted+ ) where++import Control.Applicative ((<|>))+import Data.Data (Data, gmapT)+import Data.Generics.Aliases (extT)+import qualified Data.Map as M+import Data.Typeable (Typeable)+import GHC.Generics (Generic)+import Language.Haskell.TH+import Language.Haskell.TH.Instances ()+import TH.Utilities++data TypeInfo+ = DataTypeInfo DataType+ | DataFamilyInfo DataFamily+ | TypeFamilyInfo TypeFamily+ | LiftedDataConInfo DataCon++-- | Reifies a 'Name' as a 'TypeInfo', and calls 'fail' if this doesn't+-- work. Use 'reify' with 'infoToType' if you want to handle the failure+-- case more gracefully.+--+-- This does not yet support reifying typeclasses, primitive type+-- constructors, or type variables ('TyVarI').+reifyType :: Name -> Q TypeInfo+reifyType name = do+ info <- reify name+ mres <- infoToType info+ case mres of+ Just res -> return res+ Nothing -> fail $+ "Expected to reify a data type, data family, or type family. Instead got:\n" +++ pprint info++-- | Convert an 'Info' into a 'TypeInfo' if possible, and otherwise+-- yield 'Nothing'. Needs to run in 'Q' so that+infoToType :: Info -> Q (Maybe TypeInfo)+infoToType info =+ case (infoToTypeNoDataKinds info, infoToDataCon info) of+ (Just result, _) -> return (Just result)+ (Nothing, Just dc) -> do+#if MIN_VERSION_template_haskell(2,11,0)+ dataKindsEnabled <- isExtEnabled DataKinds+#else+ reportWarning $+ "For " ++ pprint (dcName dc) +++ ", assuming DataKinds is on, and yielding LiftedDataConInfo."+ let dataKindsEnabled = True+#endif+ return $ if dataKindsEnabled then Just (LiftedDataConInfo dc) else Nothing+ (Nothing, Nothing) -> return Nothing++-- | Reifies type info, but instead of yielding a 'LiftedDataConInfo',+-- will instead yield 'Nothing'.+reifyTypeNoDataKinds :: Name -> Q (Maybe TypeInfo)+reifyTypeNoDataKinds = fmap infoToTypeNoDataKinds . reify++-- | Convert an 'Info into a 'TypeInfo' if possible. If it's a data+-- constructor, instead of yielding 'LiftedDataConInfo', it will instead+-- yield 'Nothing'.+infoToTypeNoDataKinds :: Info -> Maybe TypeInfo+infoToTypeNoDataKinds info =+ (DataTypeInfo <$> infoToDataType info) <|>+ (DataFamilyInfo <$> infoToDataFamily info) <|>+ (TypeFamilyInfo <$> infoToTypeFamily info)++--------------------------------------------------------------------------------+-- Reifying specific declaration varieties++-- | Simplified info about a 'DataD'. Omits deriving, strictness,+-- kind info, and whether it's @data@ or @newtype@.+data DataType = DataType+ { dtName :: Name+ , dtTvs :: [Name]+ , dtCxt :: Cxt+ , dtCons :: [DataCon]+ } deriving (Eq, Show, Ord, Data, Typeable, Generic)++-- | Simplified info about a 'Con'. Omits deriving, strictness, and kind+-- info. This is much nicer than consuming 'Con' directly, because it+-- unifies all the constructors into one.+data DataCon = DataCon+ { dcName :: Name+ , dcTvs :: [Name]+ , dcCxt :: Cxt+ , dcFields :: [(Maybe Name, Type)]+ } deriving (Eq, Show, Ord, Data, Typeable, Generic)++-- | Simplified info about a data family. Omits deriving, strictness, and+-- kind info.+data DataFamily = DataFamily+ { dfName :: Name+ , dfTvs :: [Name]+ , dfInsts :: [DataInst]+ } deriving (Eq, Show, Ord, Data, Typeable, Generic)++-- | Simplified info about a data family instance. Omits deriving,+-- strictness, and kind info.+data DataInst = DataInst+ { diName :: Name+ , diCxt :: Cxt+ , diParams :: [Type]+ , diCons :: [DataCon]+ } deriving (Eq, Show, Ord, Data, Typeable, Generic)++-- | Simplified info about a type family. Omits kind info and injectivity+-- info.+data TypeFamily = TypeFamily+ { tfName :: Name+ , tfTvs :: [Name]+ , tfInsts :: [TypeInst]+ } deriving (Eq, Show, Ord, Data, Typeable, Generic)++-- | Simplified info about a type family instance. Omits nothing.+data TypeInst = TypeInst+ { tiName :: Name+ , tiParams :: [Type]+ , tiType :: Type+ } deriving (Eq, Show, Ord, Data, Typeable, Generic)++-- | Reify the given data or newtype declaration, and yields its+-- 'DataType' representation.+reifyDataType :: Name -> Q DataType+reifyDataType name = do+ info <- reify name+ case infoToDataType info of+ Nothing -> fail $ "Expected to reify a datatype. Instead got:\n" ++ pprint info+ Just x -> return x++-- | Reify the given data constructor.+reifyDataCon :: Name -> Q DataCon+reifyDataCon name = do+ info <- reify name+ case infoToDataCon info of+ Nothing -> fail $ "Expected to reify a constructor. Instead got:\n" ++ pprint info+ Just x -> return x++-- | Reify the given data family, and yield its 'DataFamily'+-- representation.+reifyDataFamily :: Name -> Q DataFamily+reifyDataFamily name = do+ info <- reify name+ case infoToDataFamily info of+ Nothing -> fail $ "Expected to reify a data family. Instead got:\n" ++ pprint info+ Just x -> return x++-- | Reify the given type family instance declaration, and yields its+-- 'TypeInst' representation.+reifyTypeFamily :: Name -> Q TypeFamily+reifyTypeFamily name = do+ info <- reify name+ case infoToTypeFamily info of+ Nothing -> fail $ "Expected to reify a type family. Instead got:\n" ++ pprint info+ Just x -> return x++infoToDataType :: Info -> Maybe DataType+infoToDataType info = case info of+#if MIN_VERSION_template_haskell(2,11,0)+ TyConI (DataD preds name tvs _kind cons _deriving) ->+#else+ TyConI (DataD preds name tvs cons _deriving) ->+#endif+ Just $ DataType name (map tyVarBndrName tvs) preds (concatMap conToDataCons cons)+#if MIN_VERSION_template_haskell(2,11,0)+ TyConI (NewtypeD preds name tvs _kind con _deriving) ->+#else+ TyConI (NewtypeD preds name tvs con _deriving) ->+#endif+ Just $ DataType name (map tyVarBndrName tvs) preds (conToDataCons con)+ _ -> Nothing++infoToDataFamily :: Info -> Maybe DataFamily+infoToDataFamily info = case info of+#if MIN_VERSION_template_haskell(2,11,0)+ FamilyI (DataFamilyD name tvs _kind) insts ->+#else+ FamilyI (FamilyD DataFam name tvs _kind) insts ->+#endif+ Just $ DataFamily name (map tyVarBndrName tvs) (map go insts)+ _ -> Nothing+ where+#if MIN_VERSION_template_haskell(2,11,0)+ go (NewtypeInstD preds name params _kind con _deriving) =+#else+ go (NewtypeInstD preds name params con _deriving) =+#endif+ DataInst name preds params (conToDataCons con)+#if MIN_VERSION_template_haskell(2,11,0)+ go (DataInstD preds name params _kind cons _deriving) =+#else+ go (DataInstD preds name params cons _deriving) =+#endif+ DataInst name preds params (concatMap conToDataCons cons)+ go info' = error $+ "Unexpected instance in FamilyI in infoToDataInsts:\n" ++ pprint info'++infoToTypeFamily :: Info -> Maybe TypeFamily+infoToTypeFamily info = case info of+#if MIN_VERSION_template_haskell(2,11,0)+ FamilyI (ClosedTypeFamilyD (TypeFamilyHead name tvs _result _injectivity) eqns) _ ->+ Just $ TypeFamily name (map tyVarBndrName tvs) $ map (goEqn name) eqns+ FamilyI (OpenTypeFamilyD (TypeFamilyHead name tvs _result _injectivity)) insts ->+ Just $ TypeFamily name (map tyVarBndrName tvs) $ map go insts+#else+ FamilyI (ClosedTypeFamilyD name tvs _kind eqns) [] ->+ Just $ TypeFamily name (map tyVarBndrName tvs) $ map (goEqn name) eqns+ FamilyI (FamilyD TypeFam name tvs _kind) insts ->+ Just $ TypeFamily name (map tyVarBndrName tvs) $ map go insts+#endif+ _ -> Nothing+ where+ goEqn name (TySynEqn params ty) = TypeInst name params ty+ go (TySynInstD name (TySynEqn params ty)) = TypeInst name params ty+ go info' = error $+ "Unexpected instance in FamilyI in infoToTypeInsts:\n" ++ pprint info'++infoToDataCon :: Info -> Maybe DataCon+infoToDataCon info = case info of+#if MIN_VERSION_template_haskell(2,11,0)+ DataConI name ty _parent ->+#else+ DataConI name ty _parent _fixity ->+#endif+ Just (typeToDataCon name ty)+ _ -> Nothing++-- | Creates a 'DataCon' given the 'Name' and 'Type' of a+-- data-constructor. Note that the result the function type is *not* checked to match the provided 'Name'.+typeToDataCon :: Name -> Type -> DataCon+typeToDataCon dcName ty0 = DataCon {..}+ where+ (dcTvs, dcCxt, dcFields) = case ty0 of+ ForallT tvs preds ty -> (map tyVarBndrName tvs, preds, typeToFields ty)+ ty -> ([], [], typeToFields ty)+ -- TODO: Should we sanity check the result type?+ typeToFields = init . map (Nothing, ) . unAppsT++-- | Convert a 'Con' to a list of 'DataCon'. The result is a list+-- because 'GadtC' and 'RecGadtC' can define multiple constructors.+conToDataCons :: Con -> [DataCon]+conToDataCons = \case+ NormalC name slots ->+ [DataCon name [] [] (map (\(_, ty) -> (Nothing, ty)) slots)]+ RecC name fields ->+ [DataCon name [] [] (map (\(n, _, ty) -> (Just n, ty)) fields)]+ InfixC (_, ty1) name (_, ty2) ->+ [DataCon name [] [] [(Nothing, ty1), (Nothing, ty2)]]+ ForallC tvs preds con ->+ map (\(DataCon name tvs0 preds0 fields) ->+ DataCon name (tvs0 ++ map tyVarBndrName tvs) (preds0 ++ preds) fields) (conToDataCons con)+#if MIN_VERSION_template_haskell(2,11,0)+ GadtC ns slots _ ->+ map (\n -> DataCon n [] [] (map (\(_, ty) -> (Nothing, ty)) slots)) ns+ RecGadtC ns fields _ ->+ map (\n -> DataCon n [] [] (map (\(n, _, ty) -> (Just n, ty)) fields)) ns+#endif++-- | Like 'reifyDataType', but takes a 'Type' instead of just the 'Name'+-- of the datatype. It expects a normal datatype argument (see+-- 'typeToNamedCon').+reifyDataTypeSubstituted :: Type -> Q DataType+reifyDataTypeSubstituted ty =+ case typeToNamedCon ty of+ Nothing -> fail $ "Expected a datatype, but reifyDataTypeSubstituted was applied to " ++ pprint ty+ Just (n, args) -> do+ dt <- reifyDataType n+ let cons' = substituteTvs (M.fromList (zip (dtTvs dt) args)) (dtCons dt)+ return (dt { dtCons = cons' })++-- TODO: add various handy generics based traversals to TH.Utilities++substituteTvs :: Data a => M.Map Name Type -> a -> a+substituteTvs mp = transformTypes go+ where+ go (VarT name) | Just ty <- M.lookup name mp = ty+ go ty = gmapT (substituteTvs mp) ty++transformTypes :: Data a => (Type -> Type) -> a -> a+transformTypes f = gmapT (transformTypes f) `extT` (id :: String -> String) `extT` f
src/TH/RelativePaths.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} -- | This module provides Template Haskell utilities for loading files@@ -15,6 +16,7 @@ -- it's in. module TH.RelativePaths where +import Control.Exception (IOException, catch) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import Data.List (find)@@ -24,7 +26,7 @@ import qualified Data.Text.Lazy.IO as LT import Language.Haskell.TH (Q, Loc(loc_filename), location, runIO, reportWarning) import Language.Haskell.TH.Syntax (addDependentFile)-import System.Directory (getDirectoryContents, getCurrentDirectory, setCurrentDirectory)+import System.Directory (getDirectoryContents, getCurrentDirectory, setCurrentDirectory, canonicalizePath) import System.FilePath -- | Reads a file as a strict ByteString. The path is specified relative@@ -90,13 +92,19 @@ pathRelativeToCabalPackage :: FilePath -> Q FilePath pathRelativeToCabalPackage fp = do loc <- location- mcabalFile <- runIO $ findCabalFile (loc_filename loc)- case mcabalFile of- Just cabalFile -> return (takeDirectory cabalFile </> fp)- Nothing -> do- reportWarning "Failed to find cabal file, in order to resolve relative paths in TH. Using current working directory instead."- cwd <- runIO getCurrentDirectory- return (cwd </> fp)+ parent <-+ if loc_filename loc == "<interactive>"+ then runIO getCurrentDirectory+ else do+ mcanonical <- runIO $ fmap Just (canonicalizePath (loc_filename loc))+ `catch` \(_err :: IOException) -> return Nothing+ mcabalFile <- runIO $ maybe (return Nothing) findCabalFile mcanonical+ case mcabalFile of+ Just cabalFile -> return (takeDirectory cabalFile)+ Nothing -> do+ reportWarning "Failed to find cabal file, in order to resolve relative paths in TH. Using current working directory instead."+ runIO getCurrentDirectory+ return (parent </> fp) -- | Given the path to a file or directory, search parent directories -- for a .cabal file.
src/TH/Utilities.hs view
@@ -2,11 +2,15 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} -- | Miscellaneous Template Haskell utilities, added as needed by -- packages in the th-utilities repo and elsewhere. module TH.Utilities where +import Data.Data+import Data.Generics import Data.Proxy import Data.Typeable import Language.Haskell.TH@@ -17,6 +21,10 @@ tyVarBndrName (PlainTV n) = n tyVarBndrName (KindedTV n _) = n +appsT :: Type -> [Type] -> Type+appsT x [] = x+appsT x (y:xs) = appsT (AppT x y) xs+ -- | Breaks a type application like @A b c@ into [A, b, c]. In other -- words, it descends leftwards down 'AppT' constructors, and yields a -- list of the results.@@ -65,6 +73,24 @@ proxyE :: TypeQ -> ExpQ proxyE ty = [| Proxy :: Proxy $(ty) |] +-- | Like the 'everywhere' generic traversal strategy, but skips over+-- strings. This can aid performance of TH traversals quite a bit.+everywhereButStrings :: Data a => (forall b. Data b => b -> b) -> a -> a+everywhereButStrings f =+ (f . gmapT (everywhereButStrings f)) `extT` (id :: String -> String)++-- | Like the 'everywhereM' generic traversal strategy, but skips over+-- strings. This can aid performance of TH traversals quite a bit.+everywhereButStringsM :: forall a m. (Data a, Monad m) => GenericM m -> a -> m a+everywhereButStringsM f x = do+ x' <- gmapM (everywhereButStringsM f) x+ (f `extM` (return :: String -> m String)) x'++-- | Make a 'Name' with a 'NameS' or 'NameQ' flavour, from a 'Name' with+-- any 'NameFlavour'. This may change the meaning of names.+toSimpleName :: Name -> Name+toSimpleName = mkName . pprint+ -- | Construct a plain name ('mkName') based on the given name. This is -- useful for cases where TH doesn't expect a unique name. dequalify :: Name -> Name@@ -101,6 +127,17 @@ fromPlainInstanceD (InstanceD a b c) = Just (a, b, c) #endif fromPlainInstanceD _ = Nothing++-- | Utility to convert "Data.Typeable" 'TypeRep' to a 'Type'. Note that+-- this function is known to not yet work for many cases, but it does+-- work for normal user datatypes. In future versions this function+-- might have better behavior.+typeRepToType :: TypeRep -> Q Type+typeRepToType tr = do+ let (con, args) = splitTyConApp tr+ name = Name (OccName (tyConName con)) (NameG TcClsName (PkgName (tyConPackage con)) (ModName (tyConModule con)))+ resultArgs <- mapM typeRepToType args+ return (appsT (ConT name) resultArgs) -- | Hack to enable putting expressions inside 'lift'-ed TH data. For -- example, you could do
th-utilities.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: th-utilities-version: 0.1.1.1+version: 0.2.0.0 synopsis: Collection of useful functions for use with Template Haskell homepage: https://github.com/fpco/th-utilities#readme bug-reports: https://github.com/fpco/th-utilities/issues@@ -41,7 +41,7 @@ exposed-modules: TH.Derive TH.Derive.Storable- TH.ReifyDataType+ TH.ReifySimple TH.RelativePaths TH.Utilities other-modules: