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 - [email protected]
+
+- Update to version 0.4.2.0 with cabal2obs.
+
+-------------------------------------------------------------------
+Mon Nov 14 09:34:01 UTC 2016 - [email protected]
+
+- 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
