Hello community, here is the log from the commit of package ghc-contravariant for openSUSE:Factory checked in at 2016-01-28 17:23:42 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-contravariant (Old) and /work/SRC/openSUSE:Factory/.ghc-contravariant.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-contravariant" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-contravariant/ghc-contravariant.changes 2015-09-17 09:19:15.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-contravariant.new/ghc-contravariant.changes 2016-01-28 17:24:36.000000000 +0100 @@ -1,0 +2,7 @@ +Fri Jan 22 08:35:07 UTC 2016 - mimi...@gmail.com + +- update to 1.4 +* Improved the performance of Deciding at the cost of downgrading it to Trustworthy. +* Support for transformers 0.5 + +------------------------------------------------------------------- Old: ---- contravariant-1.3.3.tar.gz New: ---- contravariant-1.4.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-contravariant.spec ++++++ --- /var/tmp/diff_new_pack.0aGwI2/_old 2016-01-28 17:24:37.000000000 +0100 +++ /var/tmp/diff_new_pack.0aGwI2/_new 2016-01-28 17:24:37.000000000 +0100 @@ -19,7 +19,7 @@ %global pkg_name contravariant Name: ghc-contravariant -Version: 1.3.3 +Version: 1.4 Release: 0 Summary: Contravariant functors License: BSD-3-Clause @@ -34,6 +34,7 @@ # Begin cabal-rpm deps: BuildRequires: ghc-StateVar-devel BuildRequires: ghc-semigroups-devel +BuildRequires: ghc-tagged-devel BuildRequires: ghc-transformers-compat-devel BuildRequires: ghc-transformers-devel BuildRequires: ghc-void-devel ++++++ contravariant-1.3.3.tar.gz -> contravariant-1.4.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/contravariant-1.3.3/CHANGELOG.markdown new/contravariant-1.4/CHANGELOG.markdown --- old/contravariant-1.3.3/CHANGELOG.markdown 2015-09-04 12:33:20.000000000 +0200 +++ new/contravariant-1.4/CHANGELOG.markdown 2016-01-16 22:55:58.000000000 +0100 @@ -1,3 +1,9 @@ +1.4 +--- +* Improved the performance of `Deciding` at the cost of downgrading it to `Trustworthy`. +* Support for GHC 8 +* Support for `transformers` 0.5 + 1.3.3 ----- * Add `instance Monoid m => Divisible (Const m)` diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/contravariant-1.3.3/contravariant.cabal new/contravariant-1.4/contravariant.cabal --- old/contravariant-1.3.3/contravariant.cabal 2015-09-04 12:33:20.000000000 +0200 +++ new/contravariant-1.4/contravariant.cabal 2016-01-16 22:55:58.000000000 +0100 @@ -1,6 +1,6 @@ name: contravariant category: Control, Data -version: 1.3.3 +version: 1.4 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE @@ -38,6 +38,11 @@ default: True manual: True +flag safe + description: Get Safe guarantees rather than merely Trustworthy, but with worse constant factors. + default: False + manual: True + flag StateVar description: You can disable the use of the `StateVar` package using `-f-StateVar`. @@ -50,7 +55,7 @@ hs-source-dirs: src build-depends: base < 5, - transformers >= 0.2 && < 0.5, + transformers >= 0.2 && < 0.6, transformers-compat >= 0.3 && < 1, void >= 0.6 && < 1 @@ -66,6 +71,9 @@ if impl(ghc >= 7.2 && < 7.6) build-depends: ghc-prim + if flag(safe) + cpp-options: -DSAFE + exposed-modules: Data.Functor.Contravariant Data.Functor.Contravariant.Compose diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/contravariant-1.3.3/src/Data/Functor/Contravariant/Divisible.hs new/contravariant-1.4/src/Data/Functor/Contravariant/Divisible.hs --- old/contravariant-1.3.3/src/Data/Functor/Contravariant/Divisible.hs 2015-09-04 12:33:20.000000000 +0200 +++ new/contravariant-1.4/src/Data/Functor/Contravariant/Divisible.hs 2016-01-16 22:55:58.000000000 +0100 @@ -1,4 +1,7 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} + ----------------------------------------------------------------------------- -- | -- Module : Data.Functor.Contravariant.Divisible @@ -20,18 +23,48 @@ ) where import Control.Applicative +import Control.Applicative.Backwards +import Control.Arrow +import Control.Monad.Trans.Error +import Control.Monad.Trans.Except +import Control.Monad.Trans.Identity +import Control.Monad.Trans.List +import Control.Monad.Trans.Maybe +import qualified Control.Monad.Trans.RWS.Lazy as Lazy +import qualified Control.Monad.Trans.RWS.Strict as Strict +import Control.Monad.Trans.Reader +import qualified Control.Monad.Trans.State.Lazy as Lazy +import qualified Control.Monad.Trans.State.Strict as Strict +import qualified Control.Monad.Trans.Writer.Lazy as Lazy +import qualified Control.Monad.Trans.Writer.Strict as Strict + +import Data.Either +import Data.Functor.Compose +import Data.Functor.Constant import Data.Functor.Contravariant +import Data.Functor.Product +import Data.Functor.Reverse +import Data.Void -#if __GLASGOW_HASKELL__ < 710 -import Data.Monoid +#if MIN_VERSION_base(4,8,0) +import Data.Monoid (Alt(..)) +#else +import Data.Monoid (Monoid(..)) #endif -import Data.Void +#if MIN_VERSION_base(4,7,0) || defined(MIN_VERSION_tagged) +import Data.Proxy +#endif #if MIN_VERSION_StateVar import Data.StateVar #endif +#if __GLASGOW_HASKELL__ >= 702 +#define GHC_GENERICS +import GHC.Generics +#endif + -------------------------------------------------------------------------------- -- * Contravariant Applicative -------------------------------------------------------------------------------- @@ -53,7 +86,7 @@ -- @ -- delta a = (a,a) -- @ --- +-- -- @'divide' 'delta'@ should be associative with 'conquer' as a unit -- -- @ @@ -94,7 +127,7 @@ -- | Redundant, but provided for symmetry. -- -- @ --- 'conquered' = 'conquer +-- 'conquered' = 'conquer' -- @ conquered :: Divisible f => f () conquered = conquer @@ -108,7 +141,7 @@ -- @ liftD :: Divisible f => (a -> b) -> f b -> f a liftD f = divide ((,) () . f) conquer - + instance Monoid r => Divisible (Op r) where divide f (Op g) (Op h) = Op $ \a -> case f a of (b, c) -> g b `mappend` h c @@ -135,6 +168,118 @@ divide _ (Const a) (Const b) = Const (mappend a b) conquer = Const mempty +#if MIN_VERSION_base(4,8,0) +instance Divisible f => Divisible (Alt f) where + divide f (Alt l) (Alt r) = Alt $ divide f l r + conquer = Alt conquer +#endif + +#ifdef GHC_GENERICS +instance Divisible U1 where + divide _ U1 U1 = U1 + conquer = U1 + +instance Divisible f => Divisible (Rec1 f) where + divide f (Rec1 l) (Rec1 r) = Rec1 $ divide f l r + conquer = Rec1 conquer + +instance Divisible f => Divisible (M1 i c f) where + divide f (M1 l) (M1 r) = M1 $ divide f l r + conquer = M1 conquer + +instance (Divisible f, Divisible g) => Divisible (f :*: g) where + divide f (l1 :*: r1) (l2 :*: r2) = divide f l1 l2 :*: divide f r1 r2 + conquer = conquer :*: conquer + +instance (Applicative f, Divisible g) => Divisible (f :.: g) where + divide f (Comp1 l) (Comp1 r) = Comp1 (divide f <$> l <*> r) + conquer = Comp1 $ pure conquer +#endif + +instance Divisible f => Divisible (Backwards f) where + divide f (Backwards l) (Backwards r) = Backwards $ divide f l r + conquer = Backwards conquer + +instance Divisible m => Divisible (ErrorT e m) where + divide f (ErrorT l) (ErrorT r) = ErrorT $ divide (funzip . fmap f) l r + conquer = ErrorT conquer + +instance Divisible m => Divisible (ExceptT e m) where + divide f (ExceptT l) (ExceptT r) = ExceptT $ divide (funzip . fmap f) l r + conquer = ExceptT conquer + +instance Divisible f => Divisible (IdentityT f) where + divide f (IdentityT l) (IdentityT r) = IdentityT $ divide f l r + conquer = IdentityT conquer + +instance Divisible m => Divisible (ListT m) where + divide f (ListT l) (ListT r) = ListT $ divide (funzip . map f) l r + conquer = ListT conquer + +instance Divisible m => Divisible (MaybeT m) where + divide f (MaybeT l) (MaybeT r) = MaybeT $ divide (funzip . fmap f) l r + conquer = MaybeT conquer + +instance Divisible m => Divisible (ReaderT r m) where + divide abc (ReaderT rmb) (ReaderT rmc) = ReaderT $ \r -> divide abc (rmb r) (rmc r) + conquer = ReaderT $ \_ -> conquer + +instance Divisible m => Divisible (Lazy.RWST r w s m) where + divide abc (Lazy.RWST rsmb) (Lazy.RWST rsmc) = Lazy.RWST $ \r s -> + divide (\ ~(a, s', w) -> case abc a of + ~(b, c) -> ((b, s', w), (c, s', w))) + (rsmb r s) (rsmc r s) + conquer = Lazy.RWST $ \_ _ -> conquer + +instance Divisible m => Divisible (Strict.RWST r w s m) where + divide abc (Strict.RWST rsmb) (Strict.RWST rsmc) = Strict.RWST $ \r s -> + divide (\(a, s', w) -> case abc a of + (b, c) -> ((b, s', w), (c, s', w))) + (rsmb r s) (rsmc r s) + conquer = Strict.RWST $ \_ _ -> conquer + +instance Divisible m => Divisible (Lazy.StateT s m) where + divide f (Lazy.StateT l) (Lazy.StateT r) = Lazy.StateT $ \s -> + divide (lazyFanout f) (l s) (r s) + conquer = Lazy.StateT $ \_ -> conquer + +instance Divisible m => Divisible (Strict.StateT s m) where + divide f (Strict.StateT l) (Strict.StateT r) = Strict.StateT $ \s -> + divide (strictFanout f) (l s) (r s) + conquer = Strict.StateT $ \_ -> conquer + +instance Divisible m => Divisible (Lazy.WriterT w m) where + divide f (Lazy.WriterT l) (Lazy.WriterT r) = Lazy.WriterT $ + divide (lazyFanout f) l r + conquer = Lazy.WriterT conquer + +instance Divisible m => Divisible (Strict.WriterT w m) where + divide f (Strict.WriterT l) (Strict.WriterT r) = Strict.WriterT $ + divide (strictFanout f) l r + conquer = Strict.WriterT conquer + +instance (Applicative f, Divisible g) => Divisible (Compose f g) where + divide f (Compose l) (Compose r) = Compose (divide f <$> l <*> r) + conquer = Compose $ pure conquer + +instance Monoid m => Divisible (Constant m) where + divide _ (Constant l) (Constant r) = Constant $ mappend l r + conquer = Constant mempty + +instance (Divisible f, Divisible g) => Divisible (Product f g) where + divide f (Pair l1 r1) (Pair l2 r2) = Pair (divide f l1 l2) (divide f r1 r2) + conquer = Pair conquer conquer + +instance Divisible f => Divisible (Reverse f) where + divide f (Reverse l) (Reverse r) = Reverse $ divide f l r + conquer = Reverse conquer + +#if MIN_VERSION_base(4,7,0) || defined(MIN_VERSION_tagged) +instance Divisible Proxy where + divide _ Proxy Proxy = Proxy + conquer = Proxy +#endif + #if MIN_VERSION_StateVar instance Divisible SettableStateVar where divide k (SettableStateVar l) (SettableStateVar r) = SettableStateVar $ \ a -> case k a of @@ -142,13 +287,24 @@ conquer = SettableStateVar $ \_ -> return () #endif +lazyFanout :: (a -> (b, c)) -> (a, s) -> ((b, s), (c, s)) +lazyFanout f ~(a, s) = case f a of + ~(b, c) -> ((b, s), (c, s)) + +strictFanout :: (a -> (b, c)) -> (a, s) -> ((b, s), (c, s)) +strictFanout f (a, s) = case f a of + (b, c) -> ((b, s), (c, s)) + +funzip :: Functor f => f (a, b) -> (f a, f b) +funzip = fmap fst &&& fmap snd + -------------------------------------------------------------------------------- -- * Contravariant Alternative -------------------------------------------------------------------------------- -- | -- --- A 'Divisible' contravariant functor is a monoid object in the category of presheaves +-- A 'Divisible' contravariant functor is a monoid object in the category of presheaves -- from Hask to Hask, equipped with Day convolution mapping the cartesian product of the -- source to the Cartesian product of the target. -- @@ -210,6 +366,123 @@ lose f = Op $ absurd . f choose f (Op g) (Op h) = Op $ either g h . f +#if MIN_VERSION_base(4,8,0) +instance Decidable f => Decidable (Alt f) where + lose = Alt . lose + choose f (Alt l) (Alt r) = Alt $ choose f l r +#endif + +#ifdef GHC_GENERICS +instance Decidable U1 where + lose _ = U1 + choose _ U1 U1 = U1 + +instance Decidable f => Decidable (Rec1 f) where + lose = Rec1 . lose + choose f (Rec1 l) (Rec1 r) = Rec1 $ choose f l r + +instance Decidable f => Decidable (M1 i c f) where + lose = M1 . lose + choose f (M1 l) (M1 r) = M1 $ choose f l r + +instance (Decidable f, Decidable g) => Decidable (f :*: g) where + lose f = lose f :*: lose f + choose f (l1 :*: r1) (l2 :*: r2) = choose f l1 l2 :*: choose f r1 r2 + +instance (Applicative f, Decidable g) => Decidable (f :.: g) where + lose = Comp1 . pure . lose + choose f (Comp1 l) (Comp1 r) = Comp1 (choose f <$> l <*> r) +#endif + +instance Decidable f => Decidable (Backwards f) where + lose = Backwards . lose + choose f (Backwards l) (Backwards r) = Backwards $ choose f l r + +instance Decidable f => Decidable (IdentityT f) where + lose = IdentityT . lose + choose f (IdentityT l) (IdentityT r) = IdentityT $ choose f l r + +instance Decidable m => Decidable (ReaderT r m) where + lose f = ReaderT $ \_ -> lose f + choose abc (ReaderT rmb) (ReaderT rmc) = ReaderT $ \r -> choose abc (rmb r) (rmc r) + +instance Decidable m => Decidable (Lazy.RWST r w s m) where + lose f = Lazy.RWST $ \_ _ -> contramap (\ ~(a, _, _) -> a) (lose f) + choose abc (Lazy.RWST rsmb) (Lazy.RWST rsmc) = Lazy.RWST $ \r s -> + choose (\ ~(a, s', w) -> either (Left . betuple3 s' w) + (Right . betuple3 s' w) + (abc a)) + (rsmb r s) (rsmc r s) + +instance Decidable m => Decidable (Strict.RWST r w s m) where + lose f = Strict.RWST $ \_ _ -> contramap (\(a, _, _) -> a) (lose f) + choose abc (Strict.RWST rsmb) (Strict.RWST rsmc) = Strict.RWST $ \r s -> + choose (\(a, s', w) -> either (Left . betuple3 s' w) + (Right . betuple3 s' w) + (abc a)) + (rsmb r s) (rsmc r s) + +instance Divisible m => Decidable (ListT m) where + lose _ = ListT conquer + choose f (ListT l) (ListT r) = ListT $ divide ((lefts &&& rights) . map f) l r + +instance Divisible m => Decidable (MaybeT m) where + lose _ = MaybeT conquer + choose f (MaybeT l) (MaybeT r) = MaybeT $ + divide ( maybe (Nothing, Nothing) + (either (\b -> (Just b, Nothing)) + (\c -> (Nothing, Just c))) + . fmap f) l r + +instance Decidable m => Decidable (Lazy.StateT s m) where + lose f = Lazy.StateT $ \_ -> contramap lazyFst (lose f) + choose f (Lazy.StateT l) (Lazy.StateT r) = Lazy.StateT $ \s -> + choose (\ ~(a, s') -> either (Left . betuple s') (Right . betuple s') (f a)) + (l s) (r s) + +instance Decidable m => Decidable (Strict.StateT s m) where + lose f = Strict.StateT $ \_ -> contramap fst (lose f) + choose f (Strict.StateT l) (Strict.StateT r) = Strict.StateT $ \s -> + choose (\(a, s') -> either (Left . betuple s') (Right . betuple s') (f a)) + (l s) (r s) + +instance Decidable m => Decidable (Lazy.WriterT w m) where + lose f = Lazy.WriterT $ contramap lazyFst (lose f) + choose f (Lazy.WriterT l) (Lazy.WriterT r) = Lazy.WriterT $ + choose (\ ~(a, s') -> either (Left . betuple s') (Right . betuple s') (f a)) l r + +instance Decidable m => Decidable (Strict.WriterT w m) where + lose f = Strict.WriterT $ contramap fst (lose f) + choose f (Strict.WriterT l) (Strict.WriterT r) = Strict.WriterT $ + choose (\(a, s') -> either (Left . betuple s') (Right . betuple s') (f a)) l r + +instance (Applicative f, Decidable g) => Decidable (Compose f g) where + lose = Compose . pure . lose + choose f (Compose l) (Compose r) = Compose (choose f <$> l <*> r) + +instance (Decidable f, Decidable g) => Decidable (Product f g) where + lose f = Pair (lose f) (lose f) + choose f (Pair l1 r1) (Pair l2 r2) = Pair (choose f l1 l2) (choose f r1 r2) + +instance Decidable f => Decidable (Reverse f) where + lose = Reverse . lose + choose f (Reverse l) (Reverse r) = Reverse $ choose f l r + +betuple :: s -> a -> (a, s) +betuple s a = (a, s) + +betuple3 :: s -> w -> a -> (a, s, w) +betuple3 s w a = (a, s, w) + +lazyFst :: (a, b) -> a +lazyFst ~(a, _) = a + +#if MIN_VERSION_base(4,7,0) || defined(MIN_VERSION_tagged) +instance Decidable Proxy where + lose _ = Proxy + choose _ Proxy Proxy = Proxy +#endif + #if MIN_VERSION_StateVar instance Decidable SettableVar where lose k = SettableStateVar (absurd . k) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/contravariant-1.3.3/src/Data/Functor/Contravariant/Generic.hs new/contravariant-1.4/src/Data/Functor/Contravariant/Generic.hs --- old/contravariant-1.3.3/src/Data/Functor/Contravariant/Generic.hs 2015-09-04 12:33:20.000000000 +0200 +++ new/contravariant-1.4/src/Data/Functor/Contravariant/Generic.hs 2016-01-16 22:55:58.000000000 +0100 @@ -1,5 +1,9 @@ {-# LANGUAGE CPP #-} +#ifdef SAFE {-# LANGUAGE BangPatterns #-} +#elif __GLASGOW_HASKELL__ >= 704 +{-# LANGUAGE Trustworthy #-} +#endif {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleInstances #-} @@ -32,6 +36,9 @@ import Data.Functor.Contravariant import Data.Functor.Contravariant.Divisible import GHC.Generics +#ifndef SAFE +import Unsafe.Coerce +#endif -- | This provides machinery for deconstructing an arbitrary 'Generic' instance using a 'Decidable' 'Contravariant' functor. -- @@ -84,13 +91,13 @@ gdeciding _ _ = conquer instance GDeciding q V1 where - gdeciding _ _ = lose (\ !_ -> error "impossible") + gdeciding _ _ = glose instance (GDeciding q f, GDeciding q g) => GDeciding q (f :*: g) where - gdeciding p q = divide (\(a :*: b) -> (a, b)) (gdeciding p q) (gdeciding p q) + gdeciding p q = gdivide (gdeciding p q) (gdeciding p q) instance (GDeciding q f, GDeciding q g) => GDeciding q (f :+: g) where - gdeciding p q = choose (\ xs -> case xs of L1 a -> Left a; R1 a -> Right a) (gdeciding p q) (gdeciding p q) + gdeciding p q = gchoose (gdeciding p q) (gdeciding p q) #ifndef HLINT instance q p => GDeciding q (K1 i p) where @@ -109,18 +116,44 @@ gdeciding1 _ _ _ = conquer instance GDeciding1 q V1 where - gdeciding1 _ _ _ = lose (\ !_ -> error "impossible") + gdeciding1 _ _ _ = glose instance (GDeciding1 q f, GDeciding1 q g) => GDeciding1 q (f :*: g) where - gdeciding1 p q r = divide (\(a :*: b) -> (a, b)) (gdeciding1 p q r) (gdeciding1 p q r) + gdeciding1 p q r = gdivide (gdeciding1 p q r) (gdeciding1 p q r) instance (GDeciding1 q f, GDeciding1 q g) => GDeciding1 q (f :+: g) where - gdeciding1 p q r = choose (\ xs -> case xs of L1 a -> Left a; R1 a -> Right a) (gdeciding1 p q r) (gdeciding1 p q r) + gdeciding1 p q r = gchoose (gdeciding1 p q r) (gdeciding1 p q r) + + + +glose :: Decidable f => f (V1 a) +#ifdef SAFE +glose = lose (\ !_ -> error "impossible") +#else +glose = lose unsafeCoerce +#endif +{-# INLINE glose #-} + +gdivide :: Divisible f => f (g a) -> f (h a) -> f ((g:*:h) a) +#ifdef SAFE +gdivide = divide (\(f:*:g) -> (f,g)) +#else +gdivide = divide unsafeCoerce +#endif +{-# INLINE gdivide #-} + +gchoose :: Decidable f => f (g a) -> f (h a) -> f ((g:+:h) a) +#ifdef SAFE +gchoose = choose (\xs -> case xs of L1 a -> Left a; R1 b -> Right b) +#else +gchoose = choose unsafeCoerce +#endif +{-# INLINE gchoose #-} #ifndef HLINT instance q p => GDeciding1 q (K1 i p) where -#endif gdeciding1 _ q _ = contramap unK1 q +#endif instance GDeciding1 q f => GDeciding1 q (M1 i c f) where gdeciding1 p q r = contramap unM1 (gdeciding1 p q r)