th-expand-syns 0.4.1.0 → 0.4.2.0
raw patch · 5 files changed
+121/−66 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Language/Haskell/TH/ExpandSyns.hs +78/−42
- changelog.markdown +7/−3
- testing/Main.hs +12/−13
- testing/Util.hs +13/−7
- th-expand-syns.cabal +11/−1
Language/Haskell/TH/ExpandSyns.hs view
@@ -98,71 +98,107 @@ noWarnTypeFamilies :: SynonymExpansionSettings noWarnTypeFamilies = mempty { sesWarnTypeFamilies = False } +warn :: String -> Q ()+warn msg =+#if MIN_VERSION_template_haskell(2,8,0)+ reportWarning+#else+ report False+#endif+ (packagename ++": "++"WARNING: "++msg) +++ type SynInfo = ([Name],Type) nameIsSyn :: SynonymExpansionSettings -> Name -> Q (Maybe SynInfo) nameIsSyn settings n = do i <- reify n case i of+ ClassI {} -> no+ ClassOpI {} -> no TyConI d -> decIsSyn settings d- ClassI {} -> return Nothing- PrimTyConI {} -> return Nothing-#if MIN_VERSION_template_haskell(2,11,0)- FamilyI (OpenTypeFamilyD (TypeFamilyHead name _ _ _)) _ -> maybeWarnTypeFamily settings TypeFam name >> return Nothing- FamilyI (ClosedTypeFamilyD (TypeFamilyHead name _ _ _) _) _ -> maybeWarnTypeFamily settings TypeFam name >> return Nothing- FamilyI (DataFamilyD _ _ _) _ -> return Nothing-#elif MIN_VERSION_template_haskell(2,7,0)- FamilyI (FamilyD flavour name _ _) _ -> maybeWarnTypeFamily settings flavour name >> return Nothing+#if MIN_VERSION_template_haskell(2,7,0)+ FamilyI d _ -> decIsSyn settings d -- Called for warnings #endif- _ -> do- warn ("Don't know how to interpret the result of reify "++show n++" (= "++show i++").\n"++- "I will assume that "++show n++" is not a type synonym.")- return Nothing+ PrimTyConI {} -> no+ DataConI {} -> no+ VarI {} -> no+ TyVarI {} -> no + where+ no = return Nothing +decIsSyn :: SynonymExpansionSettings -> Dec -> Q (Maybe SynInfo)+decIsSyn settings = go+ where+ go (TySynD _ vars t) = return (Just (tyVarBndrGetName <$> vars,t)) -warn :: String -> Q ()-warn msg =-#if MIN_VERSION_template_haskell(2,8,0)- reportWarning+#if MIN_VERSION_template_haskell(2,11,0)+ go (OpenTypeFamilyD (TypeFamilyHead name _ _ _)) = maybeWarnTypeFamily settings name >> no+ go (ClosedTypeFamilyD (TypeFamilyHead name _ _ _) _) = maybeWarnTypeFamily settings name >> no #else- report False++#if MIN_VERSION_template_haskell(2,9,0)+ go (ClosedTypeFamilyD name _ _ _) = maybeWarnTypeFamily settings name >> no #endif- (packagename ++": "++"WARNING: "++msg) + go (FamilyD TypeFam name _ _) = maybeWarnTypeFamily settings name >> no+#endif -#if MIN_VERSION_template_haskell(2,4,0)-maybeWarnTypeFamily :: SynonymExpansionSettings -> FamFlavour -> Name -> Q ()-maybeWarnTypeFamily settings flavour name =- when (sesWarnTypeFamilies settings) $+ go (FunD {}) = no+ go (ValD {}) = no+ go (DataD {}) = no+ go (NewtypeD {}) = no+ go (ClassD {}) = no+ go (InstanceD {}) = no+ go (SigD {}) = no+ go (ForeignD {}) = no - case flavour of- TypeFam ->- warn ("Type synonym families (and associated type synonyms) are currently not supported (they won't be expanded). Name of unsupported family: "++show name)+#if MIN_VERSION_template_haskell(2,8,0)+ go (InfixD {}) = no+#endif - DataFam -> return ()- -- Nothing to expand for data families, so no warning+#if MIN_VERSION_template_haskell(2,4,0)+ go (PragmaD {}) = no #endif --- | Handles only declaration constructs that can be returned by 'reify'ing a type name.-decIsSyn :: SynonymExpansionSettings -> Dec -> Q (Maybe SynInfo)-decIsSyn settings = go- where- go (ClassD {}) = return Nothing- go (DataD {}) = return Nothing- go (NewtypeD {}) = return Nothing- go (TySynD _ vars t) = return (Just (tyVarBndrGetName <$> vars,t))+ -- Nothing to expand for data families, so no warning #if MIN_VERSION_template_haskell(2,11,0)- go (OpenTypeFamilyD (TypeFamilyHead name _ _ _)) = maybeWarnTypeFamily settings TypeFam name >> return Nothing- go (ClosedTypeFamilyD (TypeFamilyHead name _ _ _) _) = maybeWarnTypeFamily settings TypeFam name >> return Nothing- go (DataFamilyD _ _ _) = return Nothing+ go (DataFamilyD {}) = no #elif MIN_VERSION_template_haskell(2,4,0)- go (FamilyD flavour name _ _) = maybeWarnTypeFamily settings flavour name >> return Nothing+ go (FamilyD DataFam _ _ _) = no #endif- go x = do- warn ("Unrecognized declaration construct: "++ show x++". I will assume that it's not a type synonym declaration.")- return Nothing++#if MIN_VERSION_template_haskell(2,4,0)+ go (DataInstD {}) = no+ go (NewtypeInstD {}) = no+ go (TySynInstD {}) = no+#endif++#if MIN_VERSION_template_haskell(2,9,0)+ go (RoleAnnotD {}) = no+#endif++#if MIN_VERSION_template_haskell(2,10,0)+ go (StandaloneDerivD {}) = no+ go (DefaultSigD {}) = no+#endif++ no = return Nothing++#if MIN_VERSION_template_haskell(2,4,0)+maybeWarnTypeFamily :: SynonymExpansionSettings -> Name -> Q ()+maybeWarnTypeFamily settings name =+ when (sesWarnTypeFamilies settings) $+ warn ("Type synonym families (and associated type synonyms) are currently not supported (they won't be expanded). Name of unsupported family: "++show name)+#endif+++++ -- | Calls 'expandSynsWith' with the default settings.
changelog.markdown view
@@ -1,3 +1,7 @@+## 0.4.2.0++* Eliminated warnings about unrecognized results of 'reify'.+ ## 0.4.1.0 * Added a setting for suppressing warnings about type families.@@ -6,12 +10,12 @@ * Fixed build with GHC 8 / template-haskell-2.11 (Thanks to Christiaan Baaij) - Note: `substInCon` doesn't support GADT constructor with GHC 8 in this version+ Note: `substInCon` doesn't support GADT constructors with GHC 8 in this version ## 0.3.0.6 -* Fixed build with current (commit 029a296a770addbd096bbfd6de0936327ee620d4) GHC 7.10 (Thanks to David Fox)+* Fixed build with current (commit 029a296a770addbd096bbfd6de0936327ee620d4) GHC 7.10 (Thanks to David Fox) ## 0.3.0.5 -* Fixed build with GHC 7.10.1-rc2 / template-haskell-2.10 (Thanks to Gabor Greif)+* Fixed build with GHC 7.10.1-rc2 / template-haskell-2.10 (Thanks to Gabor Greif)
testing/Main.hs view
@@ -9,22 +9,21 @@ import Language.Haskell.TH import Language.Haskell.TH.Syntax import Util-import Types -+import Types main = do putStrLn "Basic test..."- $(mkTest [t| forall a. Show a => a -> ForAll [] -> (Int,ApplyToInteger []) |] + $(mkTest [t| forall a. Show a => a -> ForAll [] -> (Int,ApplyToInteger []) |] --- GHC 7.8 always seems to consider the body of 'ForallT' to have a 'PlainTV', --- whereas it always has a 'KindedTV' with GHC 7.10 (in both cases, it doesn't appear +-- GHC 7.8 always seems to consider the body of 'ForallT' to have a 'PlainTV',+-- whereas it always has a 'KindedTV' with GHC 7.10 (in both cases, it doesn't appear -- to matter whether the definition of 'ForAll' is actually written with a kind signature). #if MIN_VERSION_template_haskell(2,10,0) [t| forall a. Show a => a -> (forall (x :: *). [] x) -> (Int,[] Integer) |] #else [t| forall a. Show a => a -> (forall x. [] x) -> (Int,[] Integer) |] #endif- + ) putStrLn "Variable capture avoidance test..."@@ -38,15 +37,15 @@ #endif expectedExpansion =- forallT - [y_0] + forallT+ [y_0] (cxt []) (conT ''Either `appT` varT' "y" `appT` varT' "y_0" --> conT ''Int) -- the naive (and wrong) result would be: -- forall y. (forall y. Either y y -> Int) in- mkTest (forallT'' ["y"] (conT' "E" `appT` varT' "y")) + mkTest (forallT'' ["y"] (conT' "E" `appT` varT' "y")) (forallT'' ["y"] expectedExpansion)) putStrLn "Testing that it doesn't crash on type families (expanding them is not supported yet)"@@ -54,18 +53,18 @@ t = [t| (DF1 Int, TF1 Int, AT1 Int) |] in mkTest t t)- - putStrLn "Testing that the args of type family applications are handled" ++ putStrLn "Testing that the args of type family applications are handled" $(mkTest [t| (DF1 Int', TF1 Int', AT1 Int') |] [t| (DF1 Int, TF1 Int, AT1 Int) |]) putStrLn "Higher-kinded synonym"- $(mkTest + $(mkTest [t| Either' (ListOf Int') (ListOf Char) |] [t| Either [Int] [Char] |]) putStrLn "Nested"- $(mkTest + $(mkTest [t| Int'' |] [t| Int |])
testing/Util.hs view
@@ -1,24 +1,30 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} module Util where-import Language.Haskell.TH-import Language.Haskell.TH.ExpandSyns+import Language.Haskell.TH+import Language.Haskell.TH.ExpandSyns mkTest :: Q Type -> Q Type -> Q Exp mkTest input expected = do- input' <- input + input' <- input runIO . putStrLn $ ("info: input = "++show input')- expected' <- expected + expected' <- expected runIO . putStrLn $ ("info: expected = "++show expected') actual <- expandSyns input' runIO . putStrLn $ ("info: actual = "++show actual)- if (pprint expected'==pprint actual) then [| putStrLn "Ok" |] else [| error "expected /= actual" |] + if (pprint expected'==pprint actual) then [| putStrLn "Ok" |] else [| error "expected /= actual" |] -forallT' xs = forallT ((PlainTV . mkName) `fmap` xs) -forallT'' xs = forallT' xs (cxt []) +forallT' xs = forallT ((PlainTV . mkName) `fmap` xs)+forallT'' xs = forallT' xs (cxt []) varT' = varT . mkName conT' = conT . mkName x --> y = (arrowT `appT` x) `appT` y infixr 5 -->++#if !MIN_VERSION_template_haskell(2,8,0)+reportWarning = report False+#endif+
th-expand-syns.cabal view
@@ -1,5 +1,5 @@ name: th-expand-syns-version: 0.4.1.0+version: 0.4.2.0 synopsis: Expands type synonyms in Template Haskell ASTs description: Expands type synonyms in Template Haskell ASTs category: Template Haskell@@ -10,6 +10,16 @@ cabal-version: >= 1.8 build-type: Simple extra-source-files: changelog.markdown+homepage: https://github.com/DanielSchuessler/th-expand-syns+tested-with:+ GHC == 7.0.4+ GHC == 7.2.2+ GHC == 7.4.2+ GHC == 7.6.3+ GHC == 7.8.4+ GHC == 7.10.3+ GHC == 8.0.1+ GHC == 8.1 source-repository head type: git