Hello community, here is the log from the commit of package ghc-fclabels for openSUSE:Factory checked in at 2016-02-23 16:57:39 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-fclabels (Old) and /work/SRC/openSUSE:Factory/.ghc-fclabels.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-fclabels" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-fclabels/ghc-fclabels.changes 2016-01-28 17:24:39.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-fclabels.new/ghc-fclabels.changes 2016-02-23 16:59:31.000000000 +0100 @@ -1,0 +2,5 @@ +Thu Feb 18 09:12:56 UTC 2016 - mimi...@gmail.com + +- update 2.0.3 + +------------------------------------------------------------------- Old: ---- fclabels-2.0.2.4.tar.gz New: ---- fclabels-2.0.3.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-fclabels.spec ++++++ --- /var/tmp/diff_new_pack.BwZIPW/_old 2016-02-23 16:59:31.000000000 +0100 +++ /var/tmp/diff_new_pack.BwZIPW/_new 2016-02-23 16:59:31.000000000 +0100 @@ -21,7 +21,7 @@ %bcond_without tests Name: ghc-fclabels -Version: 2.0.2.4 +Version: 2.0.3 Release: 0 Summary: First class accessor labels implemented as lenses License: BSD-3-Clause ++++++ fclabels-2.0.2.4.tar.gz -> fclabels-2.0.3.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fclabels-2.0.2.4/CHANGELOG new/fclabels-2.0.3/CHANGELOG --- old/fclabels-2.0.2.4/CHANGELOG 2016-01-18 14:18:19.000000000 +0100 +++ new/fclabels-2.0.3/CHANGELOG 2016-02-17 14:58:34.000000000 +0100 @@ -1,5 +1,9 @@ CHANGELOG +2.0.3 + + - Support GHC 8. + 2.0.2.3 to 2.0.2.4 - Allow transformers 0.5.*. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fclabels-2.0.2.4/README.md new/fclabels-2.0.3/README.md --- old/fclabels-2.0.2.4/README.md 1970-01-01 01:00:00.000000000 +0100 +++ new/fclabels-2.0.3/README.md 2016-02-17 14:58:34.000000000 +0100 @@ -0,0 +1,42 @@ +# fclabels: first class accessor labels + +This package provides first class labels that can act as bidirectional record +fields. The labels can be derived automatically using Template Haskell which +means you don't have to write any boilerplate yourself. The labels are +implemented as _lenses_ and are fully composable. Lenses can be used to _get_, +_set_ and _modify_ parts of a data type in a consistent way. + +See `Data.Label` for an introductory explanation. + +### Total and partial lenses + +Internally lenses do not use Haskell functions directly, but are implemented +as categories. Categories allow the lenses to be run in custom computational +contexts. This approach allows us to make partial lenses that point to fields +of multi-constructor datatypes in an elegant way. + +See `Data.Label.Partial` for the use of partial labels. + +### Monomorphic and polymorphic lenses + +We have both polymorphic and monomorphic lenses. Polymorphic lenses allow +updates that change the type. The types of polymorphic lenses are slightly more +verbose than their monomorphic counterparts, but their usage is similar. +Because monomorphic lenses are built by restricting the types of polymorphic +lenses they are essentially the same and can be freely composed with eachother. + +See `Data.Label.Mono` and `Data.Label.Poly` for the difference between +polymorphic and monomorphic lenses. + +### Using fclabels + +To simplify working with labels we supply both a set of labels for Haskell's +base types, like lists, tuples, Maybe and Either, and we supply a set of +combinators for working with labels for values in the Reader and State monad. + +See `Data.Label.Base` and `Data.Label.Monadic` for more information. + +On Hackage: http://hackage.haskell.org/package/fclabels + +Introduction: http://fvisser.nl/post/2013/okt/1/fclabels-2.0.html + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fclabels-2.0.2.4/bench/Benchmark.hs new/fclabels-2.0.3/bench/Benchmark.hs --- old/fclabels-2.0.2.4/bench/Benchmark.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/fclabels-2.0.3/bench/Benchmark.hs 2016-02-17 14:58:34.000000000 +0100 @@ -0,0 +1,58 @@ +{-# LANGUAGE TemplateHaskell #-} + +import Data.Label +import Prelude hiding ((.), id) +import Control.Category +import Criterion.Main + +data Person = Person + { _name :: String + , _age :: Int + , _place :: Place + , _birthplace :: Maybe Place + } deriving (Show, Eq) + +data Place = Place + { _city + , _country + , _continent :: String + } deriving (Show, Eq) + +mkLabels [''Person, ''Place] + +jan :: Person +jan = Person "Jan" 71 (Place "Utrecht" "The Netherlands" "Europe") Nothing + +getAge :: Int +getAge = get age jan + +moveToAmsterdam :: Person -> Person +moveToAmsterdam = set (city . place) "Amsterdam" + +moveToAmsterdam' :: Person -> Person +moveToAmsterdam' person = person{_place = (_place person){_city = "Amsterdam"}} + +ageByOneYear :: Person -> Person +ageByOneYear = modify age (+1) + +ageByOneYear' :: Person -> Person +ageByOneYear' person = person{_age = (+1) $ _age person} + +moveAndAge :: Person -> Person +moveAndAge = ageByOneYear . moveToAmsterdam . ageByOneYear . ageByOneYear . ageByOneYear + +moveAndAge' :: Person -> Person +moveAndAge' = ageByOneYear' . moveToAmsterdam' . ageByOneYear' . ageByOneYear' . ageByOneYear' + +main :: IO () +main = + defaultMain + [ bench "warmup" $ whnf show "Hello World" + , bench "ageByOneYear" $ whnf ageByOneYear jan + , bench "ageByOneYear'" $ whnf ageByOneYear' jan + , bench "moveToAmsterdam" $ whnf moveToAmsterdam jan + , bench "moveToAmsterdam'" $ whnf moveToAmsterdam' jan + , bench "moveAndAge" $ whnf moveAndAge jan + , bench "moveAndAge'" $ whnf moveAndAge' jan + ] + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fclabels-2.0.2.4/fclabels.cabal new/fclabels-2.0.3/fclabels.cabal --- old/fclabels-2.0.2.4/fclabels.cabal 2016-01-18 14:18:19.000000000 +0100 +++ new/fclabels-2.0.3/fclabels.cabal 2016-02-17 14:58:34.000000000 +0100 @@ -1,5 +1,5 @@ Name: fclabels -Version: 2.0.2.4 +Version: 2.0.3 Author: Sebastiaan Visser, Erik Hesselink, Chris Eidhof, Sjoerd Visscher with lots of help and feedback from others. Synopsis: First class accessor labels implemented as lenses. @@ -47,9 +47,9 @@ See "Data.Label.Base" and "Data.Label.Monadic" for more information. . - * /Changelog from 2.0.2.1 to 2.0.2.2/ + * /Changelog from 2.0.2.4 to 2.0.3/ . - > - Restored support for GHC 7.4. + > - Support GHC 8. Maintainer: Sebastiaan Visser <c...@fvisser.nl> Homepage: https://github.com/sebastiaanvisser/fclabels @@ -59,7 +59,14 @@ Category: Data, Lenses Cabal-Version: >= 1.8 Build-Type: Simple -Extra-Source-Files: CHANGELOG +Tested-With: + GHC==7.6.3, + GHC==7.8.4, + GHC==7.10.3, + GHC==8.0.1 +Extra-Source-Files: + README.md + CHANGELOG Library HS-Source-Dirs: src @@ -78,8 +85,8 @@ GHC-Options: -Wall Build-Depends: - base < 5 - , template-haskell >= 2.2 && < 2.11 + base >= 4.6 && < 4.10 + , template-haskell >= 2.2 && < 2.12 , mtl >= 1.0 && < 2.3 , transformers >= 0.2 && < 0.6 @@ -91,11 +98,21 @@ Type: exitcode-stdio-1.0 HS-Source-Dirs: test Main-Is: TestSuite.hs - Ghc-Options: -Wall -fhpc -threaded + Ghc-Options: -Wall -threaded Build-Depends: base < 5 , fclabels - , template-haskell >= 2.2 && < 2.11 + , template-haskell >= 2.2 && < 2.12 , mtl >= 1.0 && < 2.3 - , transformers >= 0.2 && < 0.5 + , transformers >= 0.2 && < 0.6 , HUnit >= 1.2 && < 1.4 + +Benchmark benchmark + Type: exitcode-stdio-1.0 + HS-Source-Dirs: bench + Main-Is: Benchmark.hs + Ghc-Options: -Wall -threaded + Build-Depends: + base < 5 + , fclabels + , criterion < 1.2 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fclabels-2.0.2.4/src/Data/Label/Derive.hs new/fclabels-2.0.3/src/Data/Label/Derive.hs --- old/fclabels-2.0.2.4/src/Data/Label/Derive.hs 2016-01-18 14:18:19.000000000 +0100 +++ new/fclabels-2.0.3/src/Data/Label/Derive.hs 2016-02-17 14:58:34.000000000 +0100 @@ -202,10 +202,18 @@ delabelize :: Dec -> Dec delabelize dec = case dec of +#if MIN_VERSION_template_haskell(2,11,0) + DataD ctx nm vars mk cs ns -> DataD ctx nm vars mk (con <$> cs) ns + NewtypeD ctx nm vars mk c ns -> NewtypeD ctx nm vars mk (con c) ns +#else DataD ctx nm vars cs ns -> DataD ctx nm vars (con <$> cs) ns NewtypeD ctx nm vars c ns -> NewtypeD ctx nm vars (con c) ns +#endif rest -> rest where con (RecC n vst) = NormalC n (map (\(_, s, t) -> (s, t)) vst) +#if MIN_VERSION_template_haskell(2,11,0) + con (RecGadtC ns vst ty) = GadtC ns (map (\(_, s, t) -> (s, t)) vst) ty +#endif con c = c ------------------------------------------------------------------------------- @@ -272,17 +280,22 @@ -- constructors and the type variables. let (name, cons, vars) = case dec of +#if MIN_VERSION_template_haskell(2,11,0) + DataD _ n vs _ cs _ -> (n, cs, vs) + NewtypeD _ n vs _ c _ -> (n, [c], vs) +#else DataD _ n vs cs _ -> (n, cs, vs) NewtypeD _ n vs c _ -> (n, [c], vs) +#endif _ -> fclError "Can only derive labels for datatypes and newtypes." -- We are only interested in lenses of record constructors. - fields = groupFields mk cons + fields = groupFields mk vars cons forM fields $ generateLabel failing concrete name vars cons -groupFields :: (String -> String) -> [Con] -> [Field ([Context], Subst)] -groupFields mk +groupFields :: (String -> String) -> [TyVarBndr] -> [Con] -> [Field ([Context], Subst)] +groupFields mk vs = map (rename mk) . concatMap (\fs -> let vals = concat (toList <$> fs) cons = fst <$> vals @@ -291,14 +304,14 @@ ) . groupBy eq . sortBy (comparing name) - . concatMap constructorFields + . concatMap (constructorFields vs) where name (Field n _ _ _) = n eq f g = False `fromMaybe` ((==) <$> name f <*> name g) rename f (Field n a b c) = Field (mkName . f . nameBase <$> n) a b c -constructorFields :: Con -> [Field (Context, Subst)] -constructorFields con = +constructorFields :: [TyVarBndr] -> Con -> [Field (Context, Subst)] +constructorFields vs con = case con of @@ -311,14 +324,13 @@ where one (i, f@(n, _, ty)) = Field (Just n) mono ty (Context i c con, []) where fsTys = map (typeVariables . trd) (delete f fs) mono = any (\x -> any (elem x) fsTys) (typeVariables ty) - trd (_, _, x) = x InfixC a c b -> one <$> [(0, a), (1, b)] where one (i, (_, ty)) = Field Nothing mono ty (Context i c con, []) where fsTys = map (typeVariables . snd) [a, b] mono = any (\x -> any (elem x) fsTys) (typeVariables ty) - ForallC x y v -> setEqs <$> constructorFields v + ForallC x y v -> setEqs <$> constructorFields vs v #if MIN_VERSION_template_haskell(2,10,0) where eqs = [ (a, b) | AppT (AppT EqualityT a) b <- y ] #else @@ -326,6 +338,23 @@ #endif setEqs (Field a b c d) = Field a b c (first upd . second (eqs ++) $ d) upd (Context a b c) = Context a b (ForallC x y c) +#if MIN_VERSION_template_haskell(2,11,0) + GadtC cs fs resTy -> concatMap (\c -> one c <$> zip [0..] fs) cs + where one c (i, f@(_, ty)) = Field Nothing mono ty (Context i c con, mkSubst vs resTy) + where fsTys = map (typeVariables . snd) (delete f fs) + mono = any (\x -> any (elem x) fsTys) (typeVariables ty) + RecGadtC cs fs resTy -> concatMap (\c -> one c <$> zip [0..] fs) cs + where one c (i, f@(n, _, ty)) = Field (Just n) mono ty (Context i c con, mkSubst vs resTy) + where fsTys = map (typeVariables . trd) (delete f fs) + mono = any (\x -> any (elem x) fsTys) (typeVariables ty) + +mkSubst :: [TyVarBndr] -> Type -> Subst +mkSubst vars t = go (reverse vars) t + where + go [] _ = [] + go (v:vs) (AppT t1 t2) = (typeFromBinder v, t2) : go vs t1 + go _ _ = fclError "Non-AppT with type variables in mkSubst. Please report this as a bug for fclabels." +#endif prune :: [Context] -> [Con] -> [Con] prune contexts allCons = @@ -338,13 +367,23 @@ unifiableCon a b = and (zipWith unifiable (indices a) (indices b)) where indices con = case con of - NormalC {} -> [] - RecC {} -> [] - InfixC {} -> [] -#if MIN_VERSION_template_haskell(2,10,0) - ForallC _ x _ -> [ c | AppT (AppT EqualityT _) c <- x ] + NormalC {} -> [] + RecC {} -> [] + InfixC {} -> [] +#if MIN_VERSION_template_haskell(2,11,0) + ForallC _ _ ty -> indices ty +#elif MIN_VERSION_template_haskell(2,10,0) + ForallC _ x _ -> [ c | AppT (AppT EqualityT _) c <- x ] #else - ForallC _ x _ -> [ c | EqualP _ c <- x ] + ForallC _ x _ -> [ c | EqualP _ c <- x ] +#endif +#if MIN_VERSION_template_haskell(2,11,0) + GadtC _ _ ty -> conIndices ty + RecGadtC _ _ ty -> conIndices ty + where + conIndices (AppT (ConT _) ty) = [ty] + conIndices (AppT rest ty) = conIndices rest ++ [ty] + conIndices _ = fclError "Non-AppT in conIndices. Please report this as a bug for fclabels." #endif unifiable :: Type -> Type -> Bool @@ -442,21 +481,26 @@ nm = maybe (tupE []) (litE . StringL . nameBase) (guard failing >> mn) wild = if total then [] else [match wildP (normalB [| Left $(nm) |]) []] rght = if total then id else appE [| Right |] - mkCase (Context i _ c) = match pat (normalB (rght var)) [] - where (pat, var) = case1 i c + mkCase (Context i _ c) = map (\(pat, var) -> match pat (normalB (rght var)) []) (case1 i c) lamE [varP pt] - (caseE (varE pt) (map mkCase cons ++ wild)) + (caseE (varE pt) (concatMap mkCase cons ++ wild)) where + case1 :: Int -> Con -> [(Q Pat, Q Exp)] case1 i con = case con of - NormalC c fs -> let s = take (length fs) in (conP c (s pats), var) - RecC c fs -> let s = take (length fs) in (conP c (s pats), var) - InfixC _ c _ -> (infixP (pats !! 0) c (pats !! 1), var) - ForallC _ _ c -> case1 i c + NormalC c fs -> [one fs c] + RecC c fs -> [one fs c] + InfixC _ c _ -> [(infixP (pats !! 0) c (pats !! 1), var)] + ForallC _ _ c -> case1 i c +#if MIN_VERSION_template_haskell(2,11,0) + GadtC cs fs _ -> map (one fs) cs + RecGadtC cs fs _ -> map (one fs) cs +#endif where fresh = mkName <$> delete "f" freshNames pats1 = varP <$> fresh pats = replicate i wildP ++ [pats1 !! i] ++ repeat wildP var = varE (fresh !! i) + one fs c = let s = take (length fs) in (conP c (s pats), var) setter :: Bool -> Bool -> Field ([Context], Subst) -> Q Exp setter failing total (Field mn _ _ (cons, _)) = @@ -465,19 +509,23 @@ nm = maybe (tupE []) (litE . StringL . nameBase) (guard failing >> mn) wild = if total then [] else [match wildP (normalB [| Left $(nm) |]) []] rght = if total then id else appE [| Right |] - mkCase (Context i _ c) = match pat (normalB (rght var)) [] - where (pat, var) = case1 i c + mkCase (Context i _ c) = map (\(pat, var) -> match pat (normalB (rght var)) []) (case1 i c) lamE [tupP [varP md, varP pt]] - (caseE (varE pt) (map mkCase cons ++ wild)) + (caseE (varE pt) (concatMap mkCase cons ++ wild)) where case1 i con = case con of - NormalC c fs -> let s = take (length fs) in (conP c (s pats), apps (conE c) (s vars)) - RecC c fs -> let s = take (length fs) in (conP c (s pats), apps (conE c) (s vars)) - InfixC _ c _ -> ( infixP (pats !! 0) c (pats !! 1) - , infixE (Just (vars !! 0)) (conE c) (Just (vars !! 1)) - ) - ForallC _ _ c -> case1 i c + NormalC c fs -> [one fs c] + RecC c fs -> [one fs c] + InfixC _ c _ -> [( infixP (pats !! 0) c (pats !! 1) + , infixE (Just (vars !! 0)) (conE c) (Just (vars !! 1)) + ) + ] + ForallC _ _ c -> case1 i c +#if MIN_VERSION_template_haskell(2,11,0) + GadtC cs fs _ -> map (one fs) cs + RecGadtC cs fs _ -> map (one fs) cs +#endif where fresh = mkName <$> delete "f" (delete "v" freshNames) pats1 = varP <$> fresh pats = take i pats1 ++ [wildP] ++ drop (i + 1) pats1 @@ -485,6 +533,7 @@ v = varE (mkName "v") vars = take i vars1 ++ [v] ++ drop (i + 1) vars1 apps f as = foldl appE f as + one fs c = let s = take (length fs) in (conP c (s pats), apps (conE c) (s vars)) freshNames :: [String] freshNames = map pure ['a'..'z'] ++ map (('a':) . show) [0 :: Integer ..] @@ -630,3 +679,6 @@ = do tysl <- sequence tys return (foldl AppT (ConT cla) tysl) #endif + +trd :: (a, b, c) -> c +trd (_, _, x) = x diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/fclabels-2.0.2.4/test/TestSuite.hs new/fclabels-2.0.3/test/TestSuite.hs --- old/fclabels-2.0.2.4/test/TestSuite.hs 2016-01-18 14:18:19.000000000 +0100 +++ new/fclabels-2.0.3/test/TestSuite.hs 2016-02-17 14:58:34.000000000 +0100 @@ -7,13 +7,23 @@ , TemplateHaskell , TypeOperators , RankNTypes - , FlexibleContexts #-} + , FlexibleContexts + , CPP #-} + +-- Needed for the Either String orphan instances. +#if MIN_VERSION_transformers(0,5,0) && MIN_VERSION_base(4,9,0) +{-# OPTIONS_GHC -Wno-orphans -Wno-warnings-deprecations #-} +#endif module Main where import Control.Arrow import Control.Applicative import Control.Category +#if MIN_VERSION_transformers(0,5,0) && MIN_VERSION_base(4,9,0) +import Control.Monad (MonadPlus (..)) +import Control.Monad.Trans.Error (Error (noMsg)) +#endif import Prelude hiding ((.), id) import Test.HUnit import Data.Label @@ -119,6 +129,38 @@ _Ga = lGa; _Gb = lGb; _Gc = lGc; _Gd = lGd; _Ge = lGe; _Gf = lGf; _Gg = lGg; _Gh = lGh; +data Gadt2 a b where + C7, C8 :: { gi :: b, gj :: a } -> Gadt2 a b + +mkLabel ''Gadt2 + +_Gi :: (ArrowApply cat, ArrowChoice cat, ArrowZero cat) => Poly.Lens cat (Gadt2 a b -> Gadt2 a c) (b -> c) +_Gj :: (ArrowApply cat, ArrowChoice cat, ArrowZero cat) => Poly.Lens cat (Gadt2 a b -> Gadt2 c b) (a -> c) + +_Gi = lGi; _Gj = lGj; + +------------------------------------------------------------------------------- + +-- These instance are needed for the `Failing.Lens String` instance, +-- since that needs a `MonadZero` constraint on `Kleisli (Either String)`, +-- which in turn needs a `MonadPlus (Either String)` constraint. +-- These instances used to exist in transformers but were removed in +-- 0.5.0.0 accidentally, and added in 0.5.2.0. We can probably remove +-- this ifdef after GHC 8 rc3 is released, which will include +-- transformers-0.5.2.0. + +#if MIN_VERSION_transformers(0,5,0) && !MIN_VERSION_transformers(0,5,2) && MIN_VERSION_base(4,9,0) +instance (Error e) => Alternative (Either e) where + empty = Left noMsg + Left _ <|> n = n + m <|> _ = m + +instance Error e => MonadPlus (Either e) where + mzero = Left noMsg + Left _ `mplus` n = n + m `mplus` _ = m +#endif + ------------------------------------------------------------------------------- embed_fB :: Record :~> Newtype Bool
