diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +# 0.11.1.0 + +* Generalise `(***$)` to work on `Profunctor` instead of `ProductProfunctor`. +* `instance Monoid r => ProductProfunctor (Forget r)` +* `instance SumProfunctor (Forget r)` + # 0.11.0.3 * Support GHC 9.2 diff --git a/Data/Profunctor/Product.hs b/Data/Profunctor/Product.hs --- a/Data/Profunctor/Product.hs +++ b/Data/Profunctor/Product.hs @@ -1,43 +1,35 @@ {-# OPTIONS_GHC -Wno-orphans #-} {-# LANGUAGE TemplateHaskell #-} --- | If @p@ is an instance of 'ProductProfunctor' then @p a a'@ --- represents a sort of process for turning @a@s into @a'@s that can --- be "laid out side-by-side" with other values of @p@ to form "wider" --- processes. For example, if I have --- --- @ --- a :: p a a' -- a process for turning as into a's --- b :: p b b' -- a process for turning bs into b's --- c :: p c c' -- a process for turning cs into c's --- @ --- --- then I can combine them using 'p3' to get --- --- @ --- p3 a b c :: p (a, b, c) (a', b', c') --- -- a process for turning (a, b, c)s into (a', b', c')s --- @ --- --- You would typically compose 'ProductProfunctor's using --- 'Profunctors''s 'Profunctor.lmap' and 'Applicative''s 'pure', --- '<$>' / 'fmap' and '<*>'. - -module Data.Profunctor.Product (module Data.Profunctor.Product.Class, - module Data.Profunctor.Product.Newtype, +module Data.Profunctor.Product (-- * @ProductProfunctor@ + ProductProfunctor(..), + (***$), + -- * @SumProfunctor@ + SumProfunctor(..), + list, + -- * @Newtype@ + Newtype(..), + pNewtype, + -- * Deprecated versions + -- | Do not use. Will be removed in a + -- future version. + defaultEmpty, + defaultProfunctorProduct, + defaultPoint, + -- * Re-exports + module Data.Profunctor.Product.Class, module Data.Profunctor.Product) where import Prelude hiding (id) -import Data.Profunctor (Profunctor, dimap, lmap, WrappedArrow, Star(..), Costar) +import Data.Profunctor (Profunctor, lmap, WrappedArrow, Star(Star), Costar, Forget(Forget)) import qualified Data.Profunctor as Profunctor import Data.Profunctor.Composition (Procompose(..)) -import Data.Functor.Contravariant (Contravariant, contramap) import Data.Functor.Contravariant.Divisible (Divisible(..), Decidable, chosen) import Control.Category (id) -import Control.Arrow (Arrow, (***), (<<<), arr, (&&&), ArrowChoice, (+++)) +import Control.Arrow (Arrow, (***), ArrowChoice, (+++)) import Control.Applicative (Applicative, liftA2, pure, (<*>), Alternative, (<|>), (<$>)) -import Data.Monoid (Monoid, mempty, (<>)) +import Data.Monoid (Monoid, mempty) import Data.Tagged import Data.Bifunctor.Biff @@ -98,13 +90,15 @@ -- Still, at least we now have default implementations of the class -- methods, which makes things simpler. --- | '***$' is the generalisation of @Applicative@'s @\<$\>@. +-- | '***$' is the generalisation of 'Functor''s @\<$\>@. -- -- '***$' = 'Profunctor.rmap', just like '<$>' = 'fmap'. -- -- (You probably won't need to use this. @\<$\>@ should be -- sufficient.) -(***$) :: ProductProfunctor p => (b -> c) -> p a b -> p a c +-- +-- /Since 0.11.1.0:/ Generalised to work on arbitrary 'Profunctor's. +(***$) :: Profunctor p => (b -> c) -> p a b -> p a c (***$) = Profunctor.rmap instance ProductProfunctor (->) where @@ -127,6 +121,11 @@ purePP = pure (****) = (<*>) +-- | @since 0.11.1.0 +instance Monoid r => ProductProfunctor (Forget r) where + purePP _ = Forget (const mempty) + Forget f ***! Forget g = Forget $ \(a, a') -> f a <> g a' + instance (ProductProfunctor p, ProductProfunctor q) => ProductProfunctor (Procompose p q) where purePP a = Procompose (purePP a) (purePP ()) Procompose pf qf **** Procompose pa qa = @@ -162,6 +161,10 @@ instance Applicative f => SumProfunctor (Star f) where Star f +++! Star g = Star $ either (fmap Left . f) (fmap Right . g) + +-- | @since 0.11.1.0 +instance SumProfunctor (Forget r) where + Forget f +++! Forget g = Forget $ either f g instance (SumProfunctor p, SumProfunctor q) => SumProfunctor (Procompose p q) where Procompose pa qa +++! Procompose pb qb = Procompose (pa +++! pb) (qa +++! qb) diff --git a/Data/Profunctor/Product/Class.hs b/Data/Profunctor/Product/Class.hs --- a/Data/Profunctor/Product/Class.hs +++ b/Data/Profunctor/Product/Class.hs @@ -36,6 +36,28 @@ -- | -> f b' -> p a b' -- @ -- +-- If @p@ is an instance of 'ProductProfunctor' then @p a a'@ +-- represents a sort of process for turning @a@s into @a'@s that can +-- be "laid out side-by-side" with other values of @p@ to form "wider" +-- processes. For example, if I have +-- +-- @ +-- p :: p a x -- a process for turning as into xs +-- q :: p b y -- a process for turning bs into ys +-- r :: p c z -- a process for turning cs into zs +-- @ +-- +-- then I can combine them using 'p3' to get +-- +-- @ +-- p3 p q r :: p (a, b, c) (x, y, z) +-- -- a process for turning (a, b, c)s into (x, y, z)s +-- @ +-- +-- You would typically compose 'ProductProfunctor's using +-- 'Profunctors''s 'Profunctor.lmap' and 'Applicative''s 'pure', +-- '<$>' / 'fmap' and '<*>'. +-- -- It's easy to make instances of 'ProductProfunctor'. Just make -- instances -- diff --git a/Data/Profunctor/Product/Default.hs b/Data/Profunctor/Product/Default.hs --- a/Data/Profunctor/Product/Default.hs +++ b/Data/Profunctor/Product/Default.hs @@ -43,8 +43,7 @@ -- product type has a different composition function. module Data.Profunctor.Product.Default - ( module Data.Profunctor.Product.Default - , module Data.Profunctor.Product.Default.Class + ( module Data.Profunctor.Product.Default.Class ) where import Control.Applicative (Const (Const)) diff --git a/Data/Profunctor/Product/Examples.hs b/Data/Profunctor/Product/Examples.hs --- a/Data/Profunctor/Product/Examples.hs +++ b/Data/Profunctor/Product/Examples.hs @@ -158,7 +158,7 @@ -- } -- | A challenge from a Clojurist on Hacker News --- (https://news.ycombinator.com/item?id=23939350) +-- () -- -- @ -- > cl_map (uncurry (+)) ([1,2,3], [4,5,6]) @@ -167,7 +167,7 @@ -- > cl_map (+3) [1,2,3] -- [4,5,6] -- --- > let max3 (x, y, z) = x `max` y `max` z +-- > let max3 (x, y, z) = x \`max\` y \`max\` z -- > cl_map max3 ([1,20], [3,4], [5,6]) -- [5,20] -- @ diff --git a/Data/Profunctor/Product/Tuples/TH.hs b/Data/Profunctor/Product/Tuples/TH.hs --- a/Data/Profunctor/Product/Tuples/TH.hs +++ b/Data/Profunctor/Product/Tuples/TH.hs @@ -40,10 +40,12 @@ pTns = fmap concat . mapM pTn productProfunctor :: Name -> Q Pred -productProfunctor p = classP ''ProductProfunctor [pure (VarT p)] +productProfunctor p = [t|ProductProfunctor $(v p)|] + where v = pure . VarT default_ :: Name -> Name -> Name -> Q Pred -default_ p a b = classP ''Default (map (pure . VarT) [p, a, b]) +default_ p a b = [t|Default $(v p) $(v a) $(v b)|] + where v = pure . VarT pTn :: Int -> Q [Dec] pTn n = sequence [sig, fun] diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2013, Karamaan Group LLC; 2014-2018 Purely Agile Limited; 2019-2021 Tom Ellis +Copyright (c) 2013, Karamaan Group LLC; 2014-2018 Purely Agile Limited; 2019-2023 Tom Ellis All rights reserved. diff --git a/product-profunctors.cabal b/product-profunctors.cabal --- a/product-profunctors.cabal +++ b/product-profunctors.cabal @@ -1,6 +1,6 @@ name: product-profunctors -copyright: Copyright (c) 2013, Karamaan Group LLC; 2014-2018 Purely Agile Limited; 2019-2021 Tom Ellis -version: 0.11.0.3 +copyright: Copyright (c) 2013, Karamaan Group LLC; 2014-2018 Purely Agile Limited; 2019-2023 Tom Ellis +version: 0.11.1.0 synopsis: product-profunctors description: Product profunctors and tools for working with them homepage: https://github.com/tomjaguarpaw/product-profunctors @@ -23,13 +23,13 @@ library default-language: Haskell2010 - build-depends: base >= 4.5 && < 5 + build-depends: base >= 4.5 && < 4.17 , profunctors >= 5 && < 5.7 , bifunctors >= 5.4 && < 6.0 , contravariant >= 0.4 && < 1.6 , tagged >= 0.0 && < 1 - , template-haskell - , th-abstraction >= 0.4 + , template-haskell < 2.19 + , th-abstraction >= 0.4 && < 0.5 exposed-modules: Data.Profunctor.Product, Data.Profunctor.Product.Adaptor Data.Profunctor.Product.Default,