Hello community, here is the log from the commit of package ghc-one-liner for openSUSE:Factory checked in at 2017-07-06 00:03:29 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-one-liner (Old) and /work/SRC/openSUSE:Factory/.ghc-one-liner.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-one-liner" Thu Jul 6 00:03:29 2017 rev:4 rq:508034 version:0.9.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-one-liner/ghc-one-liner.changes 2017-06-22 10:38:25.458276128 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-one-liner.new/ghc-one-liner.changes 2017-07-06 00:03:30.317404974 +0200 @@ -1,0 +2,5 @@ +Sun Jun 25 18:41:38 UTC 2017 - [email protected] + +- Update to version 0.9.1. + +------------------------------------------------------------------- Old: ---- one-liner-0.9.tar.gz New: ---- one-liner-0.9.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-one-liner.spec ++++++ --- /var/tmp/diff_new_pack.v1D12T/_old 2017-07-06 00:03:31.101294541 +0200 +++ /var/tmp/diff_new_pack.v1D12T/_new 2017-07-06 00:03:31.105293978 +0200 @@ -19,7 +19,7 @@ %global pkg_name one-liner %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.9 +Version: 0.9.1 Release: 0 Summary: Constraint-based generics License: BSD-3-Clause ++++++ one-liner-0.9.tar.gz -> one-liner-0.9.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/one-liner-0.9/one-liner.cabal new/one-liner-0.9.1/one-liner.cabal --- old/one-liner-0.9/one-liner.cabal 2017-05-11 19:22:02.000000000 +0200 +++ new/one-liner-0.9.1/one-liner.cabal 2017-06-19 22:07:08.000000000 +0200 @@ -1,5 +1,5 @@ Name: one-liner -Version: 0.9 +Version: 0.9.1 Synopsis: Constraint-based generics Description: Write short and concise generic instances of type classes. one-liner is particularly useful for writing default diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/one-liner-0.9/src/Generics/OneLiner/Internal.hs new/one-liner-0.9.1/src/Generics/OneLiner/Internal.hs --- old/one-liner-0.9/src/Generics/OneLiner/Internal.hs 2017-05-11 19:22:02.000000000 +0200 +++ new/one-liner-0.9.1/src/Generics/OneLiner/Internal.hs 2017-06-19 22:07:08.000000000 +0200 @@ -59,9 +59,9 @@ type ADTNonEmpty' = ADT_ Identity Proxy NonEmptyProfunctor type ADTRecord' = ADT_ Identity Proxy RecordProfunctor -type ADT1' = ADT_ Identity Identity ADTProfunctor -type ADTNonEmpty1' = ADT_ Proxy Identity NonEmptyProfunctor -type ADTRecord1' = ADT_ Proxy Identity RecordProfunctor +type ADT1' t = (ADT_ Identity Identity ADTProfunctor t, ADT_ Proxy Identity ADTProfunctor t) +type ADTNonEmpty1' t = (ADT_ Identity Identity NonEmptyProfunctor t, ADT_ Proxy Identity NonEmptyProfunctor t) +type ADTRecord1' t = (ADT_ Identity Identity RecordProfunctor t, ADT_ Proxy Identity RecordProfunctor t) type ADTProfunctor = GenericEmptyProfunctor ': NonEmptyProfunctor type NonEmptyProfunctor = GenericSumProfunctor ': RecordProfunctor @@ -90,24 +90,25 @@ generic' proxy0 for f = generic_ proxy0 (Proxy :: Proxy Identity) for (Identity f) (Proxy :: Proxy AnyType) Proxy Proxy {-# INLINE generic' #-} -nonEmpty1' :: forall t c1 p ks a b proxy0 for. (ADT_ Proxy Identity ks t, Constraints' t AnyType c1, Satisfies p ks) +generic1' :: forall t c1 p ks a b proxy0 for. (ADT_ Proxy Identity ks t, Constraints' t AnyType c1, Satisfies p ks) => proxy0 ks -> for c1 -> (forall s d e. c1 s => p d e -> p (s d) (s e)) -> p a b -> p (t a) (t b) -nonEmpty1' proxy0 for f p = generic_ proxy0 (Proxy :: Proxy Proxy) (Proxy :: Proxy AnyType) Proxy for (Identity f) (Identity p) -{-# INLINE nonEmpty1' #-} +generic1' proxy0 for f p = generic_ proxy0 (Proxy :: Proxy Proxy) (Proxy :: Proxy AnyType) Proxy for (Identity f) (Identity p) +{-# INLINE generic1' #-} -generic1' :: forall t c1 p ks a b proxy0 for. (ADT_ Identity Identity ks t, Constraints' t AnyType c1, Satisfies p ks, ks |- GenericEmptyProfunctor) +generic01' :: forall t c0 c1 p ks a b proxy0 for for1. (ADT_ Identity Identity ks t, Constraints' t c0 c1, Satisfies p ks) => proxy0 ks - -> for c1 + -> for c0 + -> (forall s. c0 s => p s s) + -> for1 c1 -> (forall s d e. c1 s => p d e -> p (s d) (s e)) -> p a b -> p (t a) (t b) -generic1' proxy0 for f p = (proxy0 |- (Proxy :: Proxy GenericEmptyProfunctor)) - (generic_ proxy0 (Proxy :: Proxy Identity) (Proxy :: Proxy AnyType) (Identity identity) for (Identity f) (Identity p)) -{-# INLINE generic1' #-} +generic01' proxy0 for0 k for1 f p = generic_ proxy0 (Proxy :: Proxy Identity) for0 (Identity k) for1 (Identity f) (Identity p) +{-# INLINE generic01' #-} class ADT_ (nullary :: * -> *) (unary :: * -> *) (ks :: [(* -> * -> *) -> Constraint]) (t :: * -> *) where generic_ :: (Constraints' t c c1, Satisfies p ks) @@ -142,6 +143,10 @@ generic_ proxy0 _ _ f _ _ _ = (proxy0 |- (Proxy :: Proxy Profunctor)) (dimap unK1 K1 (runIdentity f)) {-# INLINE generic_ #-} +instance ks |- GenericEmptyProfunctor => ADT_ Proxy unary ks (K1 i v) where + generic_ proxy0 _ _ _ _ _ _ = (proxy0 |- (Proxy :: Proxy GenericEmptyProfunctor)) (dimap unK1 K1 identity) + {-# INLINE generic_ #-} + instance (ks |- Profunctor, ADT_ nullary unary ks f) => ADT_ nullary unary ks (M1 i c f) where generic_ proxy0 proxy1 for f for1 f1 p1 = (proxy0 |- (Proxy :: Proxy Profunctor)) (dimap unM1 M1 (generic_ proxy0 proxy1 for f for1 f1 p1)) @@ -178,16 +183,16 @@ snd1 (_ :*: r) = r {-# INLINE snd1 #-} -class GenericUnitProfunctor p where +class Profunctor p => GenericUnitProfunctor p where unit :: p (U1 a) (U1 a') -class GenericProductProfunctor p where +class Profunctor p => GenericProductProfunctor p where mult :: p (f a) (f' a') -> p (g a) (g' a') -> p ((f :*: g) a) ((f' :*: g') a') -class GenericSumProfunctor p where +class Profunctor p => GenericSumProfunctor p where plus :: p (f a) (f' a') -> p (g a) (g' a') -> p ((f :+: g) a) ((f' :+: g') a') -class GenericEmptyProfunctor p where +class Profunctor p => GenericEmptyProfunctor p where identity :: p a a zero :: p (V1 a) (V1 a') @@ -247,14 +252,14 @@ identity = Star pure {-# INLINE identity #-} -instance GenericUnitProfunctor (Costar f) where +instance Functor f => GenericUnitProfunctor (Costar f) where unit = Costar $ const U1 {-# INLINE unit #-} instance Functor f => GenericProductProfunctor (Costar f) where mult (Costar f) (Costar g) = Costar $ \lr -> f (fst1 <$> lr) :*: g (snd1 <$> lr) {-# INLINE mult #-} -instance (Applicative g, Profunctor p, GenericUnitProfunctor p) => GenericUnitProfunctor (Biff p f g) where +instance (Functor f, Applicative g, Profunctor p, GenericUnitProfunctor p) => GenericUnitProfunctor (Biff p f g) where unit = Biff $ dimap (const U1) pure unit {-# INLINE unit #-} instance (Functor f, Applicative g, Profunctor p, GenericProductProfunctor p) => GenericProductProfunctor (Biff p f g) where @@ -350,9 +355,14 @@ record1 :: forall c p t a b. (ADTRecord1 t, Constraints1 t c, GenericRecordProfunctor p) => (forall d e s. c s => p d e -> p (s d) (s e)) -> p a b -> p (t a) (t b) -record1 f p = dimap from1 to1 $ nonEmpty1' (Proxy :: Proxy RecordProfunctor) (Proxy :: Proxy c) f p +record1 f p = dimap from1 to1 $ generic1' (Proxy :: Proxy RecordProfunctor) (Proxy :: Proxy c) f p {-# INLINE record1 #-} +record01 :: forall c0 c1 p t a b. (ADTRecord1 t, Constraints01 t c0 c1, GenericRecordProfunctor p) + => (forall s. c0 s => p s s) -> (forall d e s. c1 s => p d e -> p (s d) (s e)) -> p a b -> p (t a) (t b) +record01 k f p = dimap from1 to1 $ generic01' (Proxy :: Proxy RecordProfunctor) (Proxy :: Proxy c0) k (Proxy :: Proxy c1) f p +{-# INLINE record01 #-} + nonEmpty :: forall c p t. (ADTNonEmpty t, Constraints t c, GenericNonEmptyProfunctor p) => (forall s. c s => p s s) -> p t t nonEmpty f = dimap from to $ generic' (Proxy :: Proxy NonEmptyProfunctor) (Proxy :: Proxy c) f @@ -360,9 +370,14 @@ nonEmpty1 :: forall c p t a b. (ADTNonEmpty1 t, Constraints1 t c, GenericNonEmptyProfunctor p) => (forall d e s. c s => p d e -> p (s d) (s e)) -> p a b -> p (t a) (t b) -nonEmpty1 f p = dimap from1 to1 $ nonEmpty1' (Proxy :: Proxy NonEmptyProfunctor) (Proxy :: Proxy c) f p +nonEmpty1 f p = dimap from1 to1 $ generic1' (Proxy :: Proxy NonEmptyProfunctor) (Proxy :: Proxy c) f p {-# INLINE nonEmpty1 #-} +nonEmpty01 :: forall c0 c1 p t a b. (ADTNonEmpty1 t, Constraints01 t c0 c1, GenericNonEmptyProfunctor p) + => (forall s. c0 s => p s s) -> (forall d e s. c1 s => p d e -> p (s d) (s e)) -> p a b -> p (t a) (t b) +nonEmpty01 k f p = dimap from1 to1 $ generic01' (Proxy :: Proxy NonEmptyProfunctor) (Proxy :: Proxy c0) k (Proxy :: Proxy c1) f p +{-# INLINE nonEmpty01 #-} + generic :: forall c p t. (ADT t, Constraints t c, GenericProfunctor p) => (forall s. c s => p s s) -> p t t generic f = dimap from to $ generic' (Proxy :: Proxy ADTProfunctor) (Proxy :: Proxy c) f @@ -373,6 +388,11 @@ generic1 f p = dimap from1 to1 $ generic1' (Proxy :: Proxy ADTProfunctor) (Proxy :: Proxy c) f p {-# INLINE generic1 #-} +generic01 :: forall c0 c1 p t a b. (ADT1 t, Constraints01 t c0 c1, GenericProfunctor p) + => (forall s. c0 s => p s s) -> (forall d e s. c1 s => p d e -> p (s d) (s e)) -> p a b -> p (t a) (t b) +generic01 k f p = dimap from1 to1 $ generic01' (Proxy :: Proxy ADTProfunctor) (Proxy :: Proxy c0) k (Proxy :: Proxy c1) f p +{-# INLINE generic01 #-} + -- | `Constraints` is a constraint type synonym, containing the constraint -- requirements for an instance for `t` of class `c`. -- It requires an instance of class `c` for each component of `t`. @@ -380,6 +400,8 @@ type Constraints1 t c = Constraints' (Rep1 t) AnyType c +type Constraints01 t c0 c1 = Constraints' (Rep1 t) c0 c1 + -- | `ADTRecord` is a constraint type synonym. An instance is an `ADT` with *exactly* one constructor. type ADTRecord t = (Generic t, ADTRecord' (Rep t), Constraints t AnyType) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/one-liner-0.9/src/Generics/OneLiner.hs new/one-liner-0.9.1/src/Generics/OneLiner.hs --- old/one-liner-0.9/src/Generics/OneLiner.hs 2017-05-11 19:22:02.000000000 +0200 +++ new/one-liner-0.9.1/src/Generics/OneLiner.hs 2017-06-19 22:07:08.000000000 +0200 @@ -8,8 +8,10 @@ -- Portability : non-portable -- -- All functions without postfix are for instances of `Generic`, and functions --- with postfix `1` are for instances of `Generic1` (with kind @* -> *@) which +-- with postfix @1@ are for instances of `Generic1` (with kind @* -> *@) which -- get an extra argument to specify how to deal with the parameter. +-- Functions with postfix @01@ are also for `Generic1` but they get yet another +-- argument that, like the `Generic` functions, allows handling of constant leaves. -- The function `createA_` does not require any such instance, but must be given -- a constructor explicitly. ----------------------------------------------------------------------------- @@ -34,6 +36,7 @@ -- * Combining values mzipWith, zipWithA, mzipWith1, zipWithA1, + Zip(..), -- * Consuming values consume, consume1, -- * Functions for records @@ -45,6 +48,7 @@ -- using different `profunctor`s. record, nonEmpty, generic, record1, nonEmpty1, generic1, + record01, nonEmpty01, generic01, -- ** Classes GenericRecordProfunctor, GenericNonEmptyProfunctor, @@ -55,7 +59,7 @@ GenericEmptyProfunctor(..), -- * Types ADT, ADTNonEmpty, ADTRecord, Constraints, - ADT1, ADTNonEmpty1, ADTRecord1, Constraints1, + ADT1, ADTNonEmpty1, ADTRecord1, Constraints1, Constraints01, FunConstraints, FunResult, AnyType ) where @@ -219,6 +223,8 @@ -- | Combine two values by combining each component of the structures with the given function, under an applicative effect. -- Returns `empty` if the constructors don't match. +-- +-- `zipWithA` is `generic` specialized to `Zip` zipWithA :: forall c t f. (ADT t, Constraints t c, Alternative f) => (forall s. c s => s -> s -> f s) -> t -> t -> f t zipWithA f = runZip $ generic @c $ Zip f @@ -236,6 +242,7 @@ mzipWith1 f = dimap inm2 outm2 $ zipWithA1 @c $ dimap outm2 inm2 f {-# INLINE mzipWith1 #-} +-- | `zipWithA1` is `generic1` specialized to `Zip` zipWithA1 :: forall c t f a b. (ADT1 t, Constraints1 t c, Alternative f) => (forall d e s. c s => (d -> d -> f e) -> s d -> s d -> f (s e)) -> (a -> a -> f b) -> t a -> t a -> f (t b)
