Hello community, here is the log from the commit of package ghc-th-expand-syns for openSUSE:Factory checked in at 2017-01-31 12:45:06 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-th-expand-syns (Old) and /work/SRC/openSUSE:Factory/.ghc-th-expand-syns.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-th-expand-syns" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-th-expand-syns/ghc-th-expand-syns.changes 2017-01-18 21:33:02.502963383 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-th-expand-syns.new/ghc-th-expand-syns.changes 2017-02-03 17:40:15.047048392 +0100 @@ -1,0 +2,10 @@ +Wed Jan 18 08:59:52 UTC 2017 - psimons@suse.com + +- Update to version 0.4.2.0 with cabal2obs. + +------------------------------------------------------------------- +Mon Nov 14 09:34:01 UTC 2016 - psimons@suse.com + +- Update to version 0.4.1.0 with cabal2obs. + +------------------------------------------------------------------- Old: ---- th-expand-syns-0.4.0.0.tar.gz New: ---- th-expand-syns-0.4.2.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-th-expand-syns.spec ++++++ --- /var/tmp/diff_new_pack.fjB5TR/_old 2017-02-03 17:40:16.358862717 +0100 +++ /var/tmp/diff_new_pack.fjB5TR/_new 2017-02-03 17:40:16.358862717 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-th-expand-syns # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,21 +19,19 @@ %global pkg_name th-expand-syns %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.4.0.0 +Version: 0.4.2.0 Release: 0 Summary: Expands type synonyms in Template Haskell ASTs License: BSD-3-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel -# Begin cabal-rpm deps: BuildRequires: ghc-containers-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-syb-devel BuildRequires: ghc-template-haskell-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build -# End cabal-rpm deps %description Expands type synonyms in Template Haskell ASTs. @@ -52,20 +50,14 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %check -%if %{with tests} -%{cabal} test -%endif - +%cabal_test %post devel %ghc_pkg_recache ++++++ th-expand-syns-0.4.0.0.tar.gz -> th-expand-syns-0.4.2.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/th-expand-syns-0.4.0.0/Language/Haskell/TH/ExpandSyns.hs new/th-expand-syns-0.4.2.0/Language/Haskell/TH/ExpandSyns.hs --- old/th-expand-syns-0.4.0.0/Language/Haskell/TH/ExpandSyns.hs 2016-03-28 19:54:43.000000000 +0200 +++ new/th-expand-syns-0.4.2.0/Language/Haskell/TH/ExpandSyns.hs 2017-01-12 01:09:39.000000000 +0100 @@ -3,6 +3,10 @@ {-# LANGUAGE NoMonomorphismRestriction #-} module Language.Haskell.TH.ExpandSyns(-- * Expand synonyms expandSyns + ,expandSynsWith + ,SynonymExpansionSettings + ,noWarnTypeFamilies + -- * Misc utilities ,substInType ,substInCon @@ -12,6 +16,8 @@ import qualified Data.Set as Set import Data.Generics import Control.Monad +import Data.Monoid +import Prelude -- For ghci #ifndef MIN_VERSION_template_haskell @@ -65,28 +71,32 @@ (<*>) :: (Monad m) => m (a -> b) -> m a -> m b (<*>) = ap -type SynInfo = ([Name],Type) -nameIsSyn :: Name -> Q (Maybe SynInfo) -nameIsSyn n = do - i <- reify n - case i of - TyConI d -> decIsSyn d - ClassI {} -> return Nothing - PrimTyConI {} -> return Nothing -#if MIN_VERSION_template_haskell(2,11,0) - FamilyI (OpenTypeFamilyD (TypeFamilyHead name _ _ _)) _ -> maybeWarnTypeFamily TypeFam name >> return Nothing - FamilyI (ClosedTypeFamilyD (TypeFamilyHead name _ _ _) _) _ -> maybeWarnTypeFamily TypeFam name >> return Nothing - FamilyI (DataFamilyD _ _ _) _ -> return Nothing -#elif MIN_VERSION_template_haskell(2,7,0) - FamilyI (FamilyD flavour name _ _) _ -> maybeWarnTypeFamily flavour name >> return Nothing -#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 + +data SynonymExpansionSettings = + SynonymExpansionSettings { + sesWarnTypeFamilies :: Bool + } + +-- | Default settings ('mempty'): +-- +-- * Warn if type families are encountered. +-- +-- (The 'mappend' is currently rather useless; the monoid instance is intended for additional settings in the future). +instance Monoid SynonymExpansionSettings where + mempty = + SynonymExpansionSettings { + sesWarnTypeFamilies = True + } + + mappend (SynonymExpansionSettings w1) (SynonymExpansionSettings w2) = + SynonymExpansionSettings (w1 && w2) + +-- | Suppresses the warning that type families are unsupported. +noWarnTypeFamilies :: SynonymExpansionSettings +noWarnTypeFamilies = mempty { sesWarnTypeFamilies = False } warn :: String -> Q () warn msg = @@ -98,47 +108,114 @@ (packagename ++": "++"WARNING: "++msg) -#if MIN_VERSION_template_haskell(2,4,0) -maybeWarnTypeFamily :: FamFlavour -> Name -> Q () -maybeWarnTypeFamily flavour name = - 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) - DataFam -> return () - -- Nothing to expand for data families, so no warning + +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 +#if MIN_VERSION_template_haskell(2,7,0) + FamilyI d _ -> decIsSyn settings d -- Called for warnings +#endif + 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)) + +#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 + +#if MIN_VERSION_template_haskell(2,9,0) + go (ClosedTypeFamilyD name _ _ _) = maybeWarnTypeFamily settings name >> no +#endif + + go (FamilyD TypeFam name _ _) = maybeWarnTypeFamily settings name >> no +#endif + + go (FunD {}) = no + go (ValD {}) = no + go (DataD {}) = no + go (NewtypeD {}) = no + go (ClassD {}) = no + go (InstanceD {}) = no + go (SigD {}) = no + go (ForeignD {}) = no + +#if MIN_VERSION_template_haskell(2,8,0) + go (InfixD {}) = no +#endif + +#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 :: Dec -> Q (Maybe SynInfo) -decIsSyn (ClassD {}) = return Nothing -decIsSyn (DataD {}) = return Nothing -decIsSyn (NewtypeD {}) = return Nothing -decIsSyn (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) -decIsSyn (OpenTypeFamilyD (TypeFamilyHead name _ _ _)) = maybeWarnTypeFamily TypeFam name >> return Nothing -decIsSyn (ClosedTypeFamilyD (TypeFamilyHead name _ _ _) _) = maybeWarnTypeFamily TypeFam name >> return Nothing -decIsSyn (DataFamilyD _ _ _) = return Nothing + go (DataFamilyD {}) = no #elif MIN_VERSION_template_haskell(2,4,0) -decIsSyn (FamilyD flavour name _ _) = maybeWarnTypeFamily flavour name >> return Nothing + go (FamilyD DataFam _ _ _) = no #endif -decIsSyn 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 --- | Expands all type synonyms in the given type. Type families currently won't be expanded (but will be passed through). +#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. expandSyns :: Type -> Q Type -expandSyns = \t -> +expandSyns = expandSynsWith mempty + + +-- | Expands all type synonyms in the given type. Type families currently won't be expanded (but will be passed through). +expandSynsWith :: SynonymExpansionSettings -> Type -> Q Type +expandSynsWith settings = expandSyns' + + where + expandSyns' t = do (acc,t') <- go [] t return (foldl AppT t' acc) - - where -- Must only be called on an `x' requiring no expansion passThrough acc x = return (acc, x) @@ -158,8 +235,8 @@ go acc x@(VarT _) = passThrough acc x go [] (ForallT ns cxt t) = do - cxt' <- mapM (bindPred expandSyns) cxt - t' <- expandSyns t + cxt' <- mapM (bindPred expandSyns') cxt + t' <- expandSyns' t return ([], ForallT ns cxt' t') go acc x@(ForallT _ _ _) = @@ -169,17 +246,17 @@ go acc (AppT t1 t2) = do - r <- expandSyns t2 + r <- expandSyns' t2 go (r:acc) t1 go acc x@(ConT n) = do - i <- nameIsSyn n + i <- nameIsSyn settings n case i of Nothing -> return (acc, x) Just (vars,body) -> if length acc < length vars - then fail (packagename++": expandSyns: Underapplied type synonym: "++show(n,acc)) + then fail (packagename++": expandSynsWith: Underapplied type synonym: "++show(n,acc)) else let substs = zip vars acc @@ -220,13 +297,13 @@ #if MIN_VERSION_template_haskell(2,11,0) go acc (InfixT t1 nm t2) = do - t1' <- expandSyns t1 - t2' <- expandSyns t2 + t1' <- expandSyns' t1 + t2' <- expandSyns' t2 return (acc,InfixT t1' nm t2') go acc (UInfixT t1 nm t2) = do - t1' <- expandSyns t1 - t2' <- expandSyns t2 + t1' <- expandSyns' t1 + t2' <- expandSyns' t2 return (acc,UInfixT t1' nm t2') go acc (ParensT t) = do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/th-expand-syns-0.4.0.0/changelog.markdown new/th-expand-syns-0.4.2.0/changelog.markdown --- old/th-expand-syns-0.4.0.0/changelog.markdown 2016-03-28 19:54:43.000000000 +0200 +++ new/th-expand-syns-0.4.2.0/changelog.markdown 2017-01-13 00:08:26.000000000 +0100 @@ -1,13 +1,21 @@ +## 0.4.2.0 + +* Eliminated warnings about unrecognized results of 'reify'. + +## 0.4.1.0 + +* Added a setting for suppressing warnings about type families. + ## 0.4.0.0 * 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) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/th-expand-syns-0.4.0.0/testing/Main.hs new/th-expand-syns-0.4.2.0/testing/Main.hs --- old/th-expand-syns-0.4.0.0/testing/Main.hs 2016-03-28 19:54:43.000000000 +0200 +++ new/th-expand-syns-0.4.2.0/testing/Main.hs 2017-01-12 13:37:16.000000000 +0100 @@ -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,17 +53,25 @@ 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 |]) + + $(do + reportWarning "No warning about type families should appear after this line." -- TODO: Automate this test with a custom Quasi instance? + _ <- expandSynsWith noWarnTypeFamilies =<< [t| (DF1 Int', TF1 Int', AT1 Int') |] + [| return () |]) + + + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/th-expand-syns-0.4.0.0/testing/Util.hs new/th-expand-syns-0.4.2.0/testing/Util.hs --- old/th-expand-syns-0.4.0.0/testing/Util.hs 2016-03-28 19:54:43.000000000 +0200 +++ new/th-expand-syns-0.4.2.0/testing/Util.hs 2017-01-13 00:03:48.000000000 +0100 @@ -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 + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/th-expand-syns-0.4.0.0/th-expand-syns.cabal new/th-expand-syns-0.4.2.0/th-expand-syns.cabal --- old/th-expand-syns-0.4.0.0/th-expand-syns.cabal 2016-03-28 19:54:43.000000000 +0200 +++ new/th-expand-syns-0.4.2.0/th-expand-syns.cabal 2017-01-13 00:08:43.000000000 +0100 @@ -1,5 +1,5 @@ name: th-expand-syns -version: 0.4.0.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