Hello community,
here is the log from the commit of package ghc-product-profunctors for
openSUSE:Factory checked in at 2017-08-31 20:48:44
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-product-profunctors (Old)
and /work/SRC/openSUSE:Factory/.ghc-product-profunctors.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-product-profunctors"
Thu Aug 31 20:48:44 2017 rev:2 rq:513454 version:0.8.0.3
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-product-profunctors/ghc-product-profunctors.changes
2016-11-15 17:56:56.000000000 +0100
+++
/work/SRC/openSUSE:Factory/.ghc-product-profunctors.new/ghc-product-profunctors.changes
2017-08-31 20:48:45.620325606 +0200
@@ -1,0 +2,5 @@
+Thu Jul 27 14:06:27 UTC 2017 - [email protected]
+
+- Update to version 0.8.0.3.
+
+-------------------------------------------------------------------
Old:
----
1.cabal
product-profunctors-0.7.1.0.tar.gz
New:
----
product-profunctors-0.8.0.3.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-product-profunctors.spec ++++++
--- /var/tmp/diff_new_pack.xm01jw/_old 2017-08-31 20:48:46.580190873 +0200
+++ /var/tmp/diff_new_pack.xm01jw/_new 2017-08-31 20:48:46.588189750 +0200
@@ -1,7 +1,7 @@
#
# spec file for package ghc-product-profunctors
#
-# 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,23 +19,20 @@
%global pkg_name product-profunctors
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.7.1.0
+Version: 0.8.0.3
Release: 0
Summary: Product-profunctors
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
-Source1:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal
BuildRequires: ghc-Cabal-devel
-# Begin cabal-rpm deps:
BuildRequires: ghc-contravariant-devel
BuildRequires: ghc-profunctors-devel
BuildRequires: ghc-rpm-macros
BuildRequires: ghc-tagged-devel
BuildRequires: ghc-template-haskell-devel
BuildRoot: %{_tmppath}/%{name}-%{version}-build
-# End cabal-rpm deps
%description
Product profunctors.
@@ -54,22 +51,15 @@
%prep
%setup -q -n %{pkg_name}-%{version}
-cp -p %{SOURCE1} %{pkg_name}.cabal
-
%build
%ghc_lib_build
-
%install
%ghc_lib_install
-
%check
-%if %{with tests}
-%{cabal} test
-%endif
-
+%cabal_test
%post devel
%ghc_pkg_recache
++++++ product-profunctors-0.7.1.0.tar.gz -> product-profunctors-0.8.0.3.tar.gz
++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/product-profunctors-0.7.1.0/Data/Profunctor/Product/Class.hs
new/product-profunctors-0.8.0.3/Data/Profunctor/Product/Class.hs
--- old/product-profunctors-0.7.1.0/Data/Profunctor/Product/Class.hs
2016-05-28 09:39:24.000000000 +0200
+++ new/product-profunctors-0.8.0.3/Data/Profunctor/Product/Class.hs
2017-02-25 23:59:20.000000000 +0100
@@ -1,12 +1,83 @@
module Data.Profunctor.Product.Class where
-import Data.Profunctor (Profunctor)
+import Data.Profunctor (Profunctor)
+import qualified Data.Profunctor as Profunctor
--- | A 'ProductProfunctor' is a generalization of an 'Applicative'.
--- It has an "input", contravariant type parameter on the left as well
--- as the usual 'Applicative' "output", covariant parameter on teh
--- right.
+-- | 'ProductProfunctor' is a generalization of 'Applicative'.
+--
+-- It has the usual 'Applicative' "output" (covariant) parameter on
+-- the right. Additionally it has an "input" (contravariant) type
+-- parameter on the left.
+--
+-- You will find it easier to see the correspondence between
+-- 'ProductProfunctor' and 'Applicative' if you look at @purePP@,
+-- @(***$)@, and @(****)@, which correspond to @pure@, @(\<$\>)@, and
+-- @(\<*\>)@ respectively.
+--
+-- @
+-- | Correspondence between Applicative and ProductProfunctor
+-- |
+-- | Applicative f ProductProfunctor p
+-- |
+-- | pure purePP
+-- | :: b -> f b :: b -> p a b
+-- |
+-- | (\<$\>) (***$)
+-- | :: (b -> b') :: (b -> b')
+-- | -> f b -> p a b
+-- | -> f b' -> p a b'
+-- |
+-- | (\<*\>) (****)
+-- | :: f (b -> b') :: p a (b -> b')
+-- | -> f b -> p a b
+-- | -> f b' -> p a b'
+-- @
+--
+-- It's easy to make instances of 'ProductProfunctor'. Just make
+-- instances
+--
+-- @
+-- instance Profunctor MyProductProfunctor where
+-- ...
+--
+-- instance Applicative (MyProductProfunctor a) where
+-- ...
+-- @
+--
+-- and then write
+--
+-- @
+-- instance ProductProfunctor MyProductProfunctor where
+-- purePP = pure
+-- (****) = (\<*\>)
+-- @
class Profunctor p => ProductProfunctor p where
- empty :: p () ()
- (***!) :: p a b -> p a' b' -> p (a, a') (b, b')
+ -- | 'purePP' is the generalisation of @Applicative@'s @pure@.
+ --
+ -- Aside from defining 'ProductProfunctor' instances you will
+ -- probably never need to use this; @pure@ should be sufficient (if
+ -- your 'ProductProfunctor' instance also has an @Applicative@
+ -- instance).
+ purePP :: b -> p a b
+ purePP b = Profunctor.dimap (const ()) (const b) empty
+
+ -- | '****' is the generalisation of @Applicative@'s @\<*\>@.
+ --
+ -- Aside from defining 'ProductProfunctor' instances you will you
+ -- will probably never need to use this; @\<*\>@ should be
+ -- sufficient (if your 'ProductProfunctor' instance has also been
+ -- given an @Applicative@ instance).
+ (****) :: p a (b -> c) -> p a b -> p a c
+ (****) f x = Profunctor.dimap dup (uncurry ($)) (f ***! x)
+ where dup y = (y, y)
+ -- | You probably never want to use 'empty' and it may be deprecated
+ -- in a future version.
+ empty :: p () ()
+ empty = purePP ()
+
+ -- | You probably never want to use '***!' and it may be
+ -- deprecated in a future version.
+ (***!) :: p a b -> p a' b' -> p (a, a') (b, b')
+ f ***! g = (,) `Profunctor.rmap` Profunctor.lmap fst f
+ **** Profunctor.lmap snd g
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/product-profunctors-0.7.1.0/Data/Profunctor/Product/Default.hs
new/product-profunctors-0.8.0.3/Data/Profunctor/Product/Default.hs
--- old/product-profunctors-0.7.1.0/Data/Profunctor/Product/Default.hs
2016-05-28 09:39:24.000000000 +0200
+++ new/product-profunctors-0.8.0.3/Data/Profunctor/Product/Default.hs
2017-02-25 23:59:20.000000000 +0100
@@ -17,6 +17,7 @@
import Data.Profunctor.Product.Default.Class
import Data.Profunctor.Product.Tuples.TH (mkDefaultNs, maxTupleSize)
+-- | This will be deprecated in a future version
cdef :: Default (PPOfContravariant u) a a => u a
cdef = unPPOfContravariant def
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/product-profunctors-0.7.1.0/Data/Profunctor/Product/Internal/TH.hs
new/product-profunctors-0.8.0.3/Data/Profunctor/Product/Internal/TH.hs
--- old/product-profunctors-0.7.1.0/Data/Profunctor/Product/Internal/TH.hs
2016-05-28 09:39:24.000000000 +0200
+++ new/product-profunctors-0.8.0.3/Data/Profunctor/Product/Internal/TH.hs
2017-02-25 23:59:20.000000000 +0100
@@ -3,8 +3,8 @@
module Data.Profunctor.Product.Internal.TH where
-import Data.Profunctor (dimap)
-import Data.Profunctor.Product
+import Data.Profunctor (dimap, lmap)
+import Data.Profunctor.Product hiding (constructor, field)
import Data.Profunctor.Product.Default (Default, def)
import qualified Data.Profunctor.Product.Newtype as N
import Language.Haskell.TH (Dec(DataD, SigD, FunD, InstanceD, NewtypeD),
@@ -31,17 +31,27 @@
makeAdaptorAndInstanceE :: Maybe String -> Info -> Either Error (Q [Dec])
makeAdaptorAndInstanceE adaptorNameM info = do
- (tyName, tyVars, conName, conTys) <- dataDecStuffOfInfo info
- let numTyVars = length tyVars
- numConTys = length conTys
+ dataDecStuff <- dataDecStuffOfInfo info
+ let tyName = dTyName dataDecStuff
+ tyVars = dTyVars dataDecStuff
+ conName = dConName dataDecStuff
+ conTys = dConTys dataDecStuff
+
+ numTyVars = length tyVars
+ numConTys = lengthCons conTys
defaultAdaptorName = (mkName . ("p" ++) . nameBase) conName
adaptorNameN = maybe defaultAdaptorName mkName adaptorNameM
adaptorSig' = adaptorSig tyName numTyVars adaptorNameN
- adaptorDefinition' = adaptorDefinition numTyVars conName adaptorNameN
+ adaptorDefinition' =
+ case conTys of ConTys _ ->
+ adaptorDefinition numTyVars conName adaptorNameN
+ FieldTys fieldTys ->
+ adaptorDefinitionFields conName fieldTys adaptorNameN
+
instanceDefinition' = instanceDefinition tyName numTyVars numConTys
adaptorNameN conName
- newtypeInstance' = if length conTys == 1 then
+ newtypeInstance' = if numConTys == 1 then
newtypeInstance conName tyName
else
return []
@@ -63,7 +73,23 @@
return [InstanceD [] (ConT ''N.Newtype `AppT` ConT tyName) body]
#endif
-dataDecStuffOfInfo :: Info -> Either Error (Name, [Name], Name, [Name])
+data ConTysFields = ConTys [Name]
+ -- ^^ The type of each constructor field
+ | FieldTys [(Name, Name)]
+ -- ^^ The fieldname and type of each constructor field
+
+lengthCons :: ConTysFields -> Int
+lengthCons (ConTys l) = length l
+lengthCons (FieldTys l) = length l
+
+data DataDecStuff = DataDecStuff {
+ dTyName :: Name
+ , dTyVars :: [Name]
+ , dConName :: Name
+ , dConTys :: ConTysFields
+ }
+
+dataDecStuffOfInfo :: Info -> Either Error DataDecStuff
#if __GLASGOW_HASKELL__ >= 800
dataDecStuffOfInfo (TyConI (DataD _cxt tyName tyVars _kind constructors
_deriving)) =
#else
@@ -72,7 +98,12 @@
do
(conName, conTys) <- extractConstructorStuff constructors
let tyVars' = map varNameOfBinder tyVars
- return (tyName, tyVars', conName, conTys)
+ return DataDecStuff { dTyName = tyName
+ , dTyVars = tyVars'
+ , dConName = conName
+ , dConTys = conTys
+ }
+
#if __GLASGOW_HASKELL__ >= 800
dataDecStuffOfInfo (TyConI (NewtypeD _cxt tyName tyVars _kind constructor
_deriving)) =
#else
@@ -81,25 +112,31 @@
do
(conName, conTys) <- extractConstructorStuff [constructor]
let tyVars' = map varNameOfBinder tyVars
- return (tyName, tyVars', conName, conTys)
+ return DataDecStuff { dTyName = tyName
+ , dTyVars = tyVars'
+ , dConName = conName
+ , dConTys = conTys
+ }
dataDecStuffOfInfo _ = Left "That doesn't look like a data or newtype
declaration to me"
varNameOfType :: Type -> Either Error Name
varNameOfType (VarT n) = Right n
-varNameOfType x = Left $ "Found a non-variable type" ++ show x
+varNameOfType x = Left $ "Found a non-variable type " ++ show x
varNameOfBinder :: TyVarBndr -> Name
varNameOfBinder (PlainTV n) = n
varNameOfBinder (KindedTV n _) = n
-conStuffOfConstructor :: Con -> Either Error (Name, [Name])
+conStuffOfConstructor :: Con -> Either Error (Name, ConTysFields)
conStuffOfConstructor (NormalC conName st) = do
conTys <- mapM (varNameOfType . snd) st
- return (conName, conTys)
+ return (conName, ConTys conTys)
conStuffOfConstructor (RecC conName vst) = do
- conTys <- mapM (varNameOfType . thrd) vst
- return (conName, conTys)
- where thrd = \(_,_,x) -> x
+ conTys <- mapM nameType vst
+ return (conName, FieldTys conTys)
+ where nameType (n, _, VarT t) = Right (n, t)
+ nameType (_, _, x) = Left ("Found a non-variable type " ++ show
x)
+
conStuffOfConstructor _ = Left "I can't deal with your constructor type"
constructorOfConstructors :: [Con] -> Either Error Con
@@ -108,7 +145,7 @@
constructorOfConstructors _many =
Left "I can't deal with more than one constructor"
-extractConstructorStuff :: [Con] -> Either Error (Name, [Name])
+extractConstructorStuff :: [Con] -> Either Error (Name, ConTysFields)
extractConstructorStuff = conStuffOfConstructor <=< constructorOfConstructors
instanceDefinition :: Name -> Int -> Int -> Name -> Name -> Q Dec
@@ -203,6 +240,33 @@
33 -> 'p33
34 -> 'p34
35 -> 'p35
+ 36 -> 'p36
+ 37 -> 'p37
+ 38 -> 'p38
+ 39 -> 'p39
+ 40 -> 'p40
+ 41 -> 'p41
+ 42 -> 'p42
+ 43 -> 'p43
+ 44 -> 'p44
+ 45 -> 'p45
+ 46 -> 'p46
+ 47 -> 'p47
+ 48 -> 'p48
+ 49 -> 'p49
+ 50 -> 'p50
+ 51 -> 'p51
+ 52 -> 'p52
+ 53 -> 'p53
+ 54 -> 'p54
+ 55 -> 'p55
+ 56 -> 'p56
+ 57 -> 'p57
+ 58 -> 'p58
+ 59 -> 'p59
+ 60 -> 'p60
+ 61 -> 'p61
+ 62 -> 'p62
_ -> error errorMsg
where errorMsg = "Data.Profunctor.Product.TH: "
++ show n
@@ -221,6 +285,26 @@
wheres = [toTuple conName (toTupleN, numConVars),
fromTuple conName (fromTupleN, numConVars)]
+adaptorDefinitionFields :: Name -> [(Name, name)] -> Name -> Dec
+adaptorDefinitionFields conName fieldsTys adaptorName =
+ FunD adaptorName [clause]
+ where fields = map fst fieldsTys
+ -- TODO: vv f should be generated in Q
+ fP = VarP (mkName "f")
+ fE = VarE (mkName "f")
+ clause = Clause [fP] (NormalB body) []
+ body = case fields of
+ [] -> error "Can't handle no fields in constructor"
+ field1:fields' -> let first = (VarE '(***$)) `AppE` (ConE conName)
+ `AppE` (theLmap
field1)
+ app x y = (VarE '(****)) `AppE` x
+ `AppE` (theLmap y)
+ in foldl app first fields'
+
+ theLmap field = appEAll (VarE 'lmap)
+ [ VarE field
+ , VarE field `AppE` fE ]
+
xTuple :: ([Pat] -> Pat) -> ([Exp] -> Exp) -> (Name, Int) -> Dec
xTuple patCon retCon (funN, numTyVars) = FunD funN [clause]
where clause = Clause [pat] body []
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/product-profunctors-0.7.1.0/Data/Profunctor/Product/TH.hs
new/product-profunctors-0.8.0.3/Data/Profunctor/Product/TH.hs
--- old/product-profunctors-0.7.1.0/Data/Profunctor/Product/TH.hs
2016-05-28 09:39:24.000000000 +0200
+++ new/product-profunctors-0.8.0.3/Data/Profunctor/Product/TH.hs
2017-02-25 23:59:20.000000000 +0100
@@ -18,7 +18,7 @@
-- \"adaptor\" with the following splice:
--
-- @
--- $(makeAdaptorAndInstance \"pFoo\" ''Foo)
+-- \$(makeAdaptorAndInstance \"pFoo\" ''Foo)
-- @
--
-- The adaptor for a type @Foo@ is by convention called @pFoo@, but in
@@ -26,7 +26,7 @@
-- the name @pFoo@ yourself you can use
--
-- @
--- $(makeAdaptorAndInstance' ''Foo)
+-- \$(makeAdaptorAndInstance' ''Foo)
-- @
--
-- and it will be named @pFoo@ automatically.
@@ -34,8 +34,9 @@
-- @pFoo@ will have the type
--
-- @
--- pFoo :: ProductProfunctor p =>
--- Foo (p a a') (p b b') (p c c') -> p (Foo a b c) (Foo a' b' c')
+-- pFoo :: ProductProfunctor p
+-- => Foo (p a a') (p b b') (p c c')
+-- -> p (Foo a b c) (Foo a' b' c')
-- @
--
-- and the instance generated will be
@@ -50,8 +51,9 @@
-- (its implementation is given below).
--
-- @
--- pFooApplicative :: Applicative f =>
--- Foo (f a) (f b) (f c) -> f (Foo a b c)
+-- pFooApplicative :: Applicative f
+-- => Foo (f a) (f b) (f c)
+-- -> f (Foo a b c)
-- @
--
-- The product-profunctor \"adaptor\" (in this case @pFoo@) is a
@@ -77,7 +79,7 @@
-- @
-- instance 'N.Newtype' Foo where
-- 'N.constructor' = Foo
--- 'N.field' = \(Foo x) -> x
+-- 'N.field' = \\(Foo x) -> x
-- @
--
-- which allows you to use the polymorphic function 'N.pNewtype'
@@ -85,7 +87,7 @@
--
-- If you prefer not to use Template Haskell then the generated code
-- can be written by hand because it is quite simple. It corresponds
--- very closely to what you would do in the more familiar
+-- very closely to what we would do in the more familiar
-- @Applicative@ case. For an @Applicative@ we would write
--
-- @
@@ -126,7 +128,7 @@
-- | For example
--
-- @
--- $(makeAdaptorAndInstance \"pFoo\" ''Foo)
+-- \$(makeAdaptorAndInstance \"pFoo\" ''Foo)
-- @
--
-- generates the 'Default' instance and the adaptor @pFoo@.
@@ -136,7 +138,7 @@
-- | For example
--
-- @
--- $(makeAdaptorAndInstance ''Foo)
+-- \$(makeAdaptorAndInstance ''Foo)
-- @
--
-- generates the 'Default' instance and the adaptor @pFoo@. The name
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/product-profunctors-0.7.1.0/Data/Profunctor/Product/Tuples/TH.hs
new/product-profunctors-0.8.0.3/Data/Profunctor/Product/Tuples/TH.hs
--- old/product-profunctors-0.7.1.0/Data/Profunctor/Product/Tuples/TH.hs
2016-05-28 09:39:24.000000000 +0200
+++ new/product-profunctors-0.8.0.3/Data/Profunctor/Product/Tuples/TH.hs
2017-02-25 23:59:20.000000000 +0100
@@ -14,6 +14,7 @@
import Data.Profunctor (Profunctor (dimap))
import Data.Profunctor.Product.Class (ProductProfunctor, (***!), empty)
import Data.Profunctor.Product.Default.Class (Default (def))
+import Control.Applicative (pure)
mkTs :: [Int] -> Q [Dec]
mkTs = mapM mkT
@@ -37,12 +38,18 @@
pTns :: [Int] -> Q [Dec]
pTns = fmap concat . mapM pTn
+productProfunctor :: Name -> Q Pred
+productProfunctor p = classP ''ProductProfunctor [pure (VarT p)]
+
+default_ :: Name -> Name -> Name -> Q Pred
+default_ p a b = classP ''Default (map (pure . VarT) [p, a, b])
+
pTn :: Int -> Q [Dec]
pTn n = sequence [sig, fun]
where
p = mkName "p"
sig = sigD (pT n) (forallT (map PlainTV $ p : take n as ++ take n bs)
- (pure [ConT ''ProductProfunctor `AppT` VarT p])
+ (sequence [productProfunctor p])
(arrowT `appT` mkLeftTy `appT` mkRightTy)
)
mkLeftTy = foldl appT (conT tN)
@@ -115,7 +122,7 @@
pN n = sequence [sig, fun]
where
sig = sigD nm (forallT (map PlainTV $ p : as ++ bs)
- (pure [ConT ''ProductProfunctor `AppT` VarT p])
+ (sequence [productProfunctor p])
(arrowT `appT` mkLeftTy `appT` mkRightTy)
)
mkLeftTy = case n of
@@ -146,11 +153,11 @@
mkDefaultNs = mapM mkDefaultN
mkDefaultN :: Int -> Q Dec
-mkDefaultN n = instanceD (pure (ConT ''ProductProfunctor `AppT` VarT p :
mkDefs))
+mkDefaultN n = instanceD (sequence (productProfunctor p : mkDefs))
(conT ''Default `appT` varT p `appT` mkTupT as `appT`
mkTupT bs)
[mkFun]
where
- mkDefs = zipWith (\a b -> ConT ''Default `AppT` VarT p `AppT` VarT a
`AppT` VarT b) as bs
+ mkDefs = zipWith (\a b -> default_ p a b) as bs
mkTupT = foldl appT (tupleT n) . map varT
mkFun = funD 'def [clause [] bdy []]
bdy = normalB $ case n of
@@ -161,4 +168,4 @@
bs = take n [ mkName $ 'b':show i | i <- [0::Int ..] ]
maxTupleSize :: Int
-maxTupleSize = 35
+maxTupleSize = 62
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/product-profunctors-0.7.1.0/Data/Profunctor/Product/Tuples.hs
new/product-profunctors-0.8.0.3/Data/Profunctor/Product/Tuples.hs
--- old/product-profunctors-0.7.1.0/Data/Profunctor/Product/Tuples.hs
2016-05-28 09:39:24.000000000 +0200
+++ new/product-profunctors-0.8.0.3/Data/Profunctor/Product/Tuples.hs
2017-02-25 23:59:20.000000000 +0100
@@ -1,6 +1,10 @@
{-# LANGUAGE TemplateHaskell #-}
+
+-- | This is old cruft. You should never use this and it will likely
+-- be deprecated in a future version.
+
module Data.Profunctor.Product.Tuples where
import Data.Profunctor.Product.Tuples.TH
-mkTs [0..35]
+mkTs [0..maxTupleSize]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/product-profunctors-0.7.1.0/Data/Profunctor/Product.hs
new/product-profunctors-0.8.0.3/Data/Profunctor/Product.hs
--- old/product-profunctors-0.7.1.0/Data/Profunctor/Product.hs 2016-05-28
09:39:24.000000000 +0200
+++ new/product-profunctors-0.8.0.3/Data/Profunctor/Product.hs 2017-02-25
23:59:20.000000000 +0100
@@ -9,7 +9,7 @@
import Data.Functor.Contravariant (Contravariant, contramap)
import Control.Category (id)
import Control.Arrow (Arrow, (***), (<<<), arr, (&&&))
-import Control.Applicative (Applicative, liftA2, pure)
+import Control.Applicative (Applicative, liftA2, pure, (<*>))
import Data.Monoid (Monoid, mempty, (<>))
import Data.Profunctor.Product.Newtype
@@ -63,65 +63,24 @@
-- Still, at least we now have default implementations of the class
-- methods, which makes things simpler.
--- This appears to be just 'Data.Functor.Contravariant.Divisible'
-class Contravariant f => ProductContravariant f where
- point :: f ()
- (***<) :: f a -> f b -> f (a, b)
-
--- | This is exactly the same as @Applicative@'s @\<*\>@, but for a
--- 'ProductProfunctor'.
-(****) :: ProductProfunctor p => p a (b -> c) -> p a b -> p a c
-(****) f x = Profunctor.dimap dup (uncurry ($)) (f ***! x)
- where dup y = (y, y)
-
--- | This is exactly 'Profunctor.rmap', given a name which highlights
--- the similarity to @Applicative@'s @\<$\>@.
+-- | '***$' is the generalisation of @Applicative@'s @\<$\>@.
+--
+-- '***$' = 'Profunctor.rmap', just like '<$>' = 'fmap'.
+--
+-- You will probably never need to use this; @\<$\>@ should be
+-- sufficient (if your 'ProductProfunctor' instance has also been given
+-- a @Functor@ instance).
(***$) :: ProductProfunctor p => (b -> c) -> p a b -> p a c
(***$) = Profunctor.rmap
-defaultEmpty :: Applicative (p ()) => p () ()
-defaultEmpty = pure ()
-
-defaultProfunctorProduct :: (Applicative (p (a, a')), Profunctor p)
- => p a b -> p a' b' -> p (a, a') (b, b')
-defaultProfunctorProduct p p' = liftA2 (,) (lmap fst p) (lmap snd p')
-
-defaultPoint :: Monoid (p ()) => p ()
-defaultPoint = mempty
-
-defaultContravariantProduct :: (Contravariant f, Monoid (f (a, b)))
- => f a -> f b -> f (a, b)
-defaultContravariantProduct p p' = contramap fst p <> contramap snd p'
-
-newtype PPOfContravariant f a b = PPOfContravariant (f a)
-
-unPPOfContravariant :: PPOfContravariant c a a -> c a
-unPPOfContravariant (PPOfContravariant pp) = pp
-
-instance Contravariant f => Profunctor (PPOfContravariant f) where
- dimap f _ (PPOfContravariant p) = PPOfContravariant (contramap f p)
-
-instance ProductContravariant f => ProductProfunctor (PPOfContravariant f)
where
- empty = PPOfContravariant point
- PPOfContravariant f ***! PPOfContravariant f' = PPOfContravariant (f ***< f')
-
instance ProductProfunctor (->) where
- empty = id
- (***!) = (***)
+ purePP = pure
+ (****) = (<*>)
instance Arrow arr => ProductProfunctor (WrappedArrow arr) where
- empty = id
+ empty = id
(***!) = (***)
-data AndArrow arr z a b = AndArrow { runAndArrow :: arr z b }
-
-instance Arrow arr => Profunctor (AndArrow arr z) where
- dimap _ f (AndArrow g) = AndArrow (arr f <<< g)
-
-instance Arrow arr => ProductProfunctor (AndArrow arr z) where
- empty = AndArrow (arr (const ()))
- (AndArrow f) ***! (AndArrow f') = AndArrow (f &&& f')
-
-- { Sum
class Profunctor p => SumProfunctor p where
@@ -132,6 +91,10 @@
instance SumProfunctor (->) where
f +++! g = either (Left . f) (Right . g)
+-- | A generalisation of @map :: (a -> b) -> [a] -> [b]@. It is also,
+-- in spirit, a generalisation of @traverse :: (a -> f b) -> [a] -> f
+-- [b]@, but the types need to be shuffled around a bit to make that
+-- work.
list :: (ProductProfunctor p, SumProfunctor p) => p a b -> p [a] [b]
list p = Profunctor.dimap fromList toList (empty +++! (p ***! list p))
where toList :: Either () (a, [a]) -> [a]
@@ -148,3 +111,57 @@
pTns [0..maxTupleSize]
pNs [0..maxTupleSize]
+
+-- { Deprecated stuff
+
+-- | You probably never want to use 'defaultEmpty' and it may be
+-- deprecated in a later version.
+defaultEmpty :: Applicative (p ()) => p () ()
+defaultEmpty = pure ()
+
+-- | You probably never want to use 'defaultProfunctorProduct' and it
+-- may be deprecated in a later version.
+defaultProfunctorProduct :: (Applicative (p (a, a')), Profunctor p)
+ => p a b -> p a' b' -> p (a, a') (b, b')
+defaultProfunctorProduct p p' = liftA2 (,) (lmap fst p) (lmap snd p')
+
+-- | You probably never want to use 'defaultPoint' and it may be
+-- deprecated in a later version.
+defaultPoint :: Monoid (p ()) => p ()
+defaultPoint = mempty
+
+{-# DEPRECATED ProductContravariant "Use Data.Functor.Contravariant.Divisible
instead" #-}
+class Contravariant f => ProductContravariant f where
+ point :: f ()
+ (***<) :: f a -> f b -> f (a, b)
+
+{-# DEPRECATED AndArrow "If you really need this, file an issue. It will go
soon." #-}
+data AndArrow arr z a b = AndArrow { runAndArrow :: arr z b }
+
+instance Arrow arr => Profunctor (AndArrow arr z) where
+ dimap _ f (AndArrow g) = AndArrow (arr f <<< g)
+
+instance Arrow arr => ProductProfunctor (AndArrow arr z) where
+ empty = AndArrow (arr (const ()))
+ (AndArrow f) ***! (AndArrow f') = AndArrow (f &&& f')
+
+{-# DEPRECATED defaultContravariantProduct "defaultContravariantProduct will
be removed" #-}
+defaultContravariantProduct :: (Contravariant f, Monoid (f (a, b)))
+ => f a -> f b -> f (a, b)
+defaultContravariantProduct p p' = contramap fst p <> contramap snd p'
+
+{-# DEPRECATED PPOfContravariant "PPOfContravariant will be removed" #-}
+newtype PPOfContravariant f a b = PPOfContravariant (f a)
+
+{-# DEPRECATED unPPOfContravariant "unPPOfContravariant will be removed" #-}
+unPPOfContravariant :: PPOfContravariant c a a -> c a
+unPPOfContravariant (PPOfContravariant pp) = pp
+
+instance Contravariant f => Profunctor (PPOfContravariant f) where
+ dimap f _ (PPOfContravariant p) = PPOfContravariant (contramap f p)
+
+instance ProductContravariant f => ProductProfunctor (PPOfContravariant f)
where
+ empty = PPOfContravariant point
+ PPOfContravariant f ***! PPOfContravariant f' = PPOfContravariant (f ***< f')
+
+-- }
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/product-profunctors-0.7.1.0/LICENSE
new/product-profunctors-0.8.0.3/LICENSE
--- old/product-profunctors-0.7.1.0/LICENSE 2016-05-28 09:39:24.000000000
+0200
+++ new/product-profunctors-0.8.0.3/LICENSE 2017-02-25 23:59:20.000000000
+0100
@@ -1,4 +1,4 @@
-Copyright (c) 2013, Karamaan Group LLC
+Copyright (c) 2013, Karamaan Group LLC; 2014-2017 Purely Agile Limited
All rights reserved.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/product-profunctors-0.7.1.0/product-profunctors.cabal
new/product-profunctors-0.8.0.3/product-profunctors.cabal
--- old/product-profunctors-0.7.1.0/product-profunctors.cabal 2016-05-28
09:39:24.000000000 +0200
+++ new/product-profunctors-0.8.0.3/product-profunctors.cabal 2017-02-25
23:59:20.000000000 +0100
@@ -1,21 +1,24 @@
name: product-profunctors
-version: 0.7.1.0
+copyright: Copyright (c) 2013, Karamaan Group LLC; 2014-2017 Purely Agile
Limited
+version: 0.8.0.3
synopsis: product-profunctors
description: Product profunctors
homepage: https://github.com/tomjaguarpaw/product-profunctors
license: BSD3
-license-File: LICENSE
+license-file: LICENSE
author: Purely Agile
maintainer: Purely Agile
category: Control, Category
build-type: Simple
-cabal-version: >= 1.8
+cabal-version: >= 1.18
+tested-with: GHC==8.0.1, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3
source-repository head
- Type: git
- Location: https://github.com/tomjaguarpaw/product-profunctors
+ type: git
+ location: https://github.com/tomjaguarpaw/product-profunctors
library
+ default-language: Haskell2010
build-depends: base >= 4.5 && < 5
, profunctors >= 4.0 && < 5.3
, contravariant >= 0.4 && < 1.5
@@ -37,6 +40,7 @@
build-depends: transformers >= 0.2 && < 0.6
test-suite test
+ default-language: Haskell2010
type: exitcode-stdio-1.0
main-is: Main.hs
other-modules: CheckTypes,
