Hello community, here is the log from the commit of package ghc-th-lift for openSUSE:Factory checked in at 2018-07-24 17:22:58 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-th-lift (Old) and /work/SRC/openSUSE:Factory/.ghc-th-lift.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-th-lift" Tue Jul 24 17:22:58 2018 rev:5 rq:623873 version:0.7.10 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-th-lift/ghc-th-lift.changes 2018-05-30 12:27:34.125730428 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-th-lift.new/ghc-th-lift.changes 2018-07-24 17:23:02.467350283 +0200 @@ -1,0 +2,13 @@ +Wed Jul 18 14:26:44 UTC 2018 - [email protected] + +- Cosmetic: replace tabs with blanks, strip trailing white space, + and update copyright headers with spec-cleaner. + +------------------------------------------------------------------- +Fri Jul 13 14:31:25 UTC 2018 - [email protected] + +- Update th-lift to version 0.7.10. + Upstream has not updated the file "Changelog" since the last + release. + +------------------------------------------------------------------- @@ -21 +33,0 @@ - Old: ---- th-lift-0.7.8.tar.gz New: ---- th-lift-0.7.10.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-th-lift.spec ++++++ --- /var/tmp/diff_new_pack.8nK79n/_old 2018-07-24 17:23:02.983350942 +0200 +++ /var/tmp/diff_new_pack.8nK79n/_new 2018-07-24 17:23:02.983350942 +0200 @@ -19,7 +19,7 @@ %global pkg_name th-lift %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.7.8 +Version: 0.7.10 Release: 0 Summary: Derive Template Haskell's Lift class for datatypes License: (BSD-3-Clause OR GPL-2.0-only) @@ -29,6 +29,7 @@ BuildRequires: ghc-Cabal-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-template-haskell-devel +BuildRequires: ghc-th-abstraction-devel %description Derive Template Haskell's Lift class for datatypes. ++++++ th-lift-0.7.8.tar.gz -> th-lift-0.7.10.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/th-lift-0.7.8/src/Language/Haskell/TH/Lift.hs new/th-lift-0.7.10/src/Language/Haskell/TH/Lift.hs --- old/th-lift-0.7.8/src/Language/Haskell/TH/Lift.hs 2016-01-18 18:29:12.000000000 +0100 +++ new/th-lift-0.7.10/src/Language/Haskell/TH/Lift.hs 2018-05-14 22:12:56.000000000 +0200 @@ -28,37 +28,62 @@ import GHC.Prim (Char#) #endif /* !(MIN_VERSION_template_haskell(2,11,0)) */ +import Control.Applicative #if MIN_VERSION_template_haskell(2,8,0) import Data.Char (ord) #endif /* !(MIN_VERSION_template_haskell(2,8,0)) */ +#if MIN_VERSION_base(4,8,0) +import Data.Functor.Identity +#endif #if !(MIN_VERSION_template_haskell(2,10,0)) import Data.Ratio (Ratio) #endif /* !(MIN_VERSION_template_haskell(2,10,0)) */ import Language.Haskell.TH +import Language.Haskell.TH.Datatype +import qualified Language.Haskell.TH.Lib as Lib (starK) import Language.Haskell.TH.Syntax import Control.Monad ((<=<), zipWithM) #if MIN_VERSION_template_haskell(2,9,0) import Data.Maybe (catMaybes) #endif /* MIN_VERSION_template_haskell(2,9,0) */ -modName :: String -modName = "Language.Haskell.TH.Lift" - -- | Derive Lift instances for the given datatype. deriveLift :: Name -> Q [Dec] -deriveLift = deriveLift' <=< reify +#if MIN_VERSION_template_haskell(2,9,0) +deriveLift name = do + roles <- reifyDatatypeRoles name + info <- reifyDatatype name + fmap (:[]) $ deriveLiftOne roles info +#else +deriveLift = fmap (:[]) . deriveLiftOne <=< reifyDatatype +#endif -- | Derive Lift instances for many datatypes. deriveLiftMany :: [Name] -> Q [Dec] -deriveLiftMany = deriveLiftMany' <=< mapM reify +#if MIN_VERSION_template_haskell(2,9,0) +deriveLiftMany names = do + roles <- mapM reifyDatatypeRoles names + infos <- mapM reifyDatatype names + mapM (uncurry deriveLiftOne) $ zip roles infos +#else +deriveLiftMany = mapM deriveLiftOne <=< mapM reifyDatatype +#endif -- | Obtain Info values through a custom reification function. This is useful -- when generating instances for datatypes that have not yet been declared. +#if MIN_VERSION_template_haskell(2,9,0) +deriveLift' :: [Role] -> Info -> Q [Dec] +deriveLift' roles = fmap (:[]) . deriveLiftOne roles <=< normalizeInfo + +deriveLiftMany' :: [([Role], Info)] -> Q [Dec] +deriveLiftMany' = mapM (\(rs, i) -> deriveLiftOne rs =<< normalizeInfo i) +#else deriveLift' :: Info -> Q [Dec] -deriveLift' = fmap (:[]) . deriveLiftOne +deriveLift' = fmap (:[]) . deriveLiftOne <=< normalizeInfo deriveLiftMany' :: [Info] -> Q [Dec] -deriveLiftMany' = mapM deriveLiftOne +deriveLiftMany' = mapM (deriveLiftOne <=< normalizeInfo) +#endif -- | Generates a lambda expresson which behaves like 'lift' (without requiring -- a 'Lift' instance). Example: @@ -70,90 +95,92 @@ -- lift = $(makeLift ''Fix) -- @ makeLift :: Name -> Q Exp -makeLift = makeLift' <=< reify +makeLift = makeLiftInternal <=< reifyDatatype -- | Like 'makeLift', but using a custom reification function. makeLift' :: Info -> Q Exp -makeLift' i = withInfo i $ \_ n _ cons -> makeLiftOne n cons +makeLift' = makeLiftInternal <=< normalizeInfo + +makeLiftInternal :: DatatypeInfo -> Q Exp +makeLiftInternal i = withInfo i $ \_ n _ cons -> makeLiftOne n cons -deriveLiftOne :: Info -> Q Dec +#if MIN_VERSION_template_haskell(2,9,0) +deriveLiftOne :: [Role] -> DatatypeInfo -> Q Dec +deriveLiftOne roles i = withInfo i liftInstance +#else +deriveLiftOne :: DatatypeInfo -> Q Dec deriveLiftOne i = withInfo i liftInstance +#endif where - liftInstance dcx n vs cons = do + liftInstance dcx n tys cons = do #if MIN_VERSION_template_haskell(2,9,0) - roles <- qReifyRoles n + -- roles <- reifyDatatypeRoles n -- Compute the set of phantom variables. - let phvars = catMaybes $ - zipWith (\v role -> if role == PhantomR then Just v else Nothing) - vs + let phtys = catMaybes $ + zipWith (\t role -> if role == PhantomR then Just t else Nothing) + tys roles #else /* MIN_VERSION_template_haskell(2,9,0) */ - let phvars = [] + let phtys = [] #endif - instanceD (ctxt dcx phvars vs) - (conT ''Lift `appT` typ n (map fst vs)) + instanceD (ctxt dcx phtys tys) + (conT ''Lift `appT` typ n tys) [funD 'lift [clause [] (normalB (makeLiftOne n cons)) []]] - typ n = foldl appT (conT n) . map varT + typ n = foldl appT (conT n) . map unKind -- Only consider *-kinded type variables, because Lift instances cannot -- meaningfully be given to types of other kinds. Further, filter out type -- variables that are obviously phantom. - ctxt dcx phvars = - fmap (dcx ++) . cxt . concatMap liftPred . filter (`notElem` phvars) + ctxt dcx phtys = + fmap (dcx ++) . cxt . concatMap liftPred . filter (`notElem` phtys) + liftPred ty = + case ty of + SigT t k + | k == Lib.starK -> mkLift t + | otherwise -> [] + _ -> mkLift ty #if MIN_VERSION_template_haskell(2,10,0) - liftPred (v, StarT) = [conT ''Lift `appT` varT v] - liftPred (_, _) = [] -#elif MIN_VERSION_template_haskell(2,8,0) - liftPred (v, StarT) = [classP ''Lift [varT v]] - liftPred (_, _) = [] -#elif MIN_VERSION_template_haskell(2,4,0) - liftPred (v, StarK) = [classP ''Lift [varT v]] - liftPred (_, _) = [] -#else /* !(MIN_VERSION_template_haskell(2,4,0)) */ - liftPred n = conT ''Lift `appT` varT n + mkLift ty = [conT ''Lift `appT` (return ty)] +#else + mkLift ty = [classP ''Lift [return ty]] #endif + unKind (SigT t k) + | k == Lib.starK = return t + unKind t = return t -makeLiftOne :: Name -> [Con] -> Q Exp +makeLiftOne :: Name -> [ConstructorInfo] -> Q Exp makeLiftOne n cons = do e <- newName "e" lam1E (varP e) $ caseE (varE e) $ consMatches n cons -consMatches :: Name -> [Con] -> [Q Match] +consMatches :: Name -> [ConstructorInfo] -> [Q Match] consMatches n [] = [match wildP (normalB e) []] where e = [| errorQExp $(stringE ("Can't lift value of empty datatype " ++ nameBase n)) |] consMatches _ cons = concatMap doCons cons -doCons :: Con -> [Q Match] -doCons (NormalC c sts) = (:[]) $ do - ns <- zipWithM (\_ i -> newName ('x':show (i :: Int))) sts [0..] +doCons :: ConstructorInfo -> [Q Match] +doCons (ConstructorInfo { constructorName = c + , constructorFields = ts + , constructorVariant = variant + }) = (:[]) $ do + ns <- zipWithM (\_ i -> newName ('x':show (i :: Int))) ts [0..] let con = [| conE c |] - args = [ liftVar n t | (n, (_, t)) <- zip ns sts ] - e = foldl (\e1 e2 -> [| appE $e1 $e2 |]) con args - match (conP c (map varP ns)) (normalB e) [] -doCons (RecC c sts) = doCons $ NormalC c [(s, t) | (_, s, t) <- sts] -doCons (InfixC sty1 c sty2) = (:[]) $ do - x0 <- newName "x0" - x1 <- newName "x1" - let con = [| conE c |] - left = liftVar x0 (snd sty1) - right = liftVar x1 (snd sty2) - e = [| infixApp $left $con $right |] - match (infixP (varP x0) c (varP x1)) (normalB e) [] -doCons (ForallC _ _ c) = doCons c -#if MIN_VERSION_template_haskell(2,11,0) --- GADTs can have multiple constructor names, when they are written like: --- --- data T where --- MkT1, MkT2 :: T -doCons (GadtC cs sts _) = map (\c -> do - ns <- zipWithM (\_ i -> newName ('x':show (i :: Int))) sts [0..] - let con = [| conE c |] - args = [ liftVar n t | (n, (_, t)) <- zip ns sts ] - e = foldl (\e1 e2 -> [| appE $e1 $e2 |]) con args - match (conP c (map varP ns)) (normalB e) [] - ) cs -doCons (RecGadtC cs sts _) = - concatMap (\c -> doCons $ NormalC c [(s,t) | (_, s, t) <- sts]) cs + case (variant, ns, ts) of + (InfixConstructor, [x0, x1], [t0, t1]) -> + let e = [| infixApp $(liftVar x0 t0) $con $(liftVar x1 t1) |] + in match (infixP (varP x0) c (varP x1)) (normalB e) [] + (_, _, _) -> + let e = foldl (\e1 e2 -> [| appE $e1 $e2 |]) con $ zipWith liftVar ns ts + in match (conP c (map varP ns)) (normalB e) [] + +#if MIN_VERSION_template_haskell(2,9,0) +-- Reify the roles of a data type. Note that the argument Name may correspond +-- to that of a data family instance constructor, so we need to go through +-- reifyDatatype to determine what the parent data family Name is. +reifyDatatypeRoles :: Name -> Q [Role] +reifyDatatypeRoles n = do + DatatypeInfo { datatypeName = dn } <- reifyDatatype n + qReifyRoles dn #endif liftVar :: Name -> Type -> Q Exp @@ -176,37 +203,16 @@ var = varE varName liftVar varName _ = [| lift $(varE varName) |] -withInfo :: Info -#if MIN_VERSION_template_haskell(2,4,0) - -> (Cxt -> Name -> [(Name, Kind)] -> [Con] -> Q a) -#else /* !(MIN_VERSION_template_haskell(2,4,0)) */ - -> (Cxt -> Name -> [Name] -> [Con] -> Q a) -#endif +withInfo :: DatatypeInfo + -> (Cxt -> Name -> [Type] -> [ConstructorInfo] -> Q a) -> Q a withInfo i f = case i of -#if MIN_VERSION_template_haskell(2,11,0) - TyConI (DataD dcx n vsk _ cons _) -> - f dcx n (map unTyVarBndr vsk) cons - TyConI (NewtypeD dcx n vsk _ con _) -> - f dcx n (map unTyVarBndr vsk) [con] -#else - TyConI (DataD dcx n vsk cons _) -> - f dcx n (map unTyVarBndr vsk) cons - TyConI (NewtypeD dcx n vsk con _) -> - f dcx n (map unTyVarBndr vsk) [con] -#endif - _ -> error (modName ++ ".deriveLift: unhandled: " ++ pprint i) - where -#if MIN_VERSION_template_haskell(2,8,0) - unTyVarBndr (PlainTV v) = (v, StarT) - unTyVarBndr (KindedTV v k) = (v, k) -#elif MIN_VERSION_template_haskell(2,4,0) - unTyVarBndr (PlainTV v) = (v, StarK) - unTyVarBndr (KindedTV v k) = (v, k) -#else /* !(MIN_VERSION_template_haskell(2,4,0)) */ - unTyVarBndr :: Name -> Name - unTyVarBndr v = v -#endif + DatatypeInfo { datatypeContext = dcx + , datatypeName = n + , datatypeVars = vs + , datatypeCons = cons + } -> + f dcx n vs cons -- A type-restricted version of error that ensures makeLift always returns a -- value of type Q Exp, even when used on an empty datatype. @@ -244,8 +250,8 @@ lift (NameL i) = [| case $( lift (I# i) ) of I# i' -> NameL i' |] #endif /* __GLASGOW_HASKELL__ < 710 */ - lift (NameG nameSpace pkgName modnam) - = [| NameG nameSpace pkgName modnam |] + lift (NameG nameSpace' pkgName modnam) + = [| NameG nameSpace' pkgName modnam |] instance Lift NameSpace where lift VarName = [| VarName |] @@ -261,3 +267,11 @@ instance Integral a => Lift (Ratio a) where lift x = return (LitE (RationalL (toRational x))) #endif + +#if MIN_VERSION_base(4,8,0) +instance Lift a => Lift (Identity a) where + lift = appE (conE 'Identity) . lift . runIdentity +#endif + +instance Lift a => Lift (Const a b) where + lift = appE (conE 'Const) . lift . getConst diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/th-lift-0.7.8/t/Foo.hs new/th-lift-0.7.10/t/Foo.hs --- old/th-lift-0.7.8/t/Foo.hs 2015-11-19 15:57:23.000000000 +0100 +++ new/th-lift-0.7.10/t/Foo.hs 2018-05-14 22:12:56.000000000 +0200 @@ -1,9 +1,11 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} module Foo where @@ -41,9 +43,27 @@ newtype Fix f = In { out :: f (Fix f) } deriving instance Show (f (Fix f)) => Show (Fix f) +#if MIN_VERSION_template_haskell(2,7,0) +data family Fam a b c +data instance Fam a Int Char + = FamPrefix1 a Char + | FamPrefix2 a + | FamRec { famField :: a } + | a :%%: a + deriving Show +data instance Fam a Bool Bool = FamInstBool a Bool + deriving Show +#endif + $(deriveLift ''Foo) $(deriveLift ''Rec) $(deriveLift ''Empty) $(deriveLift ''Unboxed) instance Lift (f (Fix f)) => Lift (Fix f) where lift = $(makeLift ''Fix) + +#if MIN_VERSION_template_haskell(2,7,0) +$(deriveLift 'FamPrefix1) +instance (Eq a, Lift a) => Lift (Fam a Bool Bool) where + lift = $(makeLift 'FamInstBool) +#endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/th-lift-0.7.8/t/Test.hs new/th-lift-0.7.10/t/Test.hs --- old/th-lift-0.7.8/t/Test.hs 2015-11-19 15:57:23.000000000 +0100 +++ new/th-lift-0.7.10/t/Test.hs 2018-05-14 22:12:56.000000000 +0200 @@ -16,3 +16,9 @@ #endif 1.0## 1.0# 1# 1##) ) print $( lift (In { out = Nothing }) ) +#if MIN_VERSION_template_haskell(2,7,0) + print $( lift (FamPrefix1 "str1" 'c') ) + print $( lift (FamPrefix2 "str2") ) + print $( lift (FamRec {famField = 'a'}) ) + print $( lift ('a' :%%: 'b') ) +#endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/th-lift-0.7.8/th-lift.cabal new/th-lift-0.7.10/th-lift.cabal --- old/th-lift-0.7.8/th-lift.cabal 2018-02-01 21:45:51.000000000 +0100 +++ new/th-lift-0.7.10/th-lift.cabal 2018-05-14 22:13:07.000000000 +0200 @@ -1,9 +1,9 @@ Name: th-lift -Version: 0.7.8 +Version: 0.7.10 Cabal-Version: >= 1.8 License: BSD3 License-Files: COPYING, BSD3, GPL-2 -Copyright: © 2006 Ian Lynagh, © 2010-2014 Mathieu Boespflug +Copyright: © 2006 Ian Lynagh, © 2010-2018 Mathieu Boespflug Author: Ian Lynagh Maintainer: Mathieu Boespflug <[email protected]> Homepage: http://github.com/mboes/th-lift @@ -24,7 +24,8 @@ Extensions: CPP, TemplateHaskell, MagicHash, TypeSynonymInstances, FlexibleInstances Hs-Source-Dirs: src Build-Depends: base >= 3 && < 5, - ghc-prim + ghc-prim, + th-abstraction >= 0.2.3 ghc-options: -Wall if impl(ghc < 6.12)
