From d604debc2f9f3ebb21e53a849af68683aca8d611 Mon Sep 17 00:00:00 2001 From: Ollie Charles Date: Wed, 20 Sep 2017 12:57:11 +0100 Subject: [PATCH 1/8] Provide an intuitive explanation of Contravariant --- src/Data/Functor/Contravariant.hs | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/src/Data/Functor/Contravariant.hs b/src/Data/Functor/Contravariant.hs index 18feac6..42f256f 100644 --- a/src/Data/Functor/Contravariant.hs +++ b/src/Data/Functor/Contravariant.hs @@ -118,7 +118,32 @@ import GHC.Generics import Prelude hiding ((.),id) --- | Any instance should be subject to the following laws: +-- | The class of contravariant functors. +-- +-- Whereas in Haskell, one can think of a 'Functor' as containing or producing +-- values, a contravariant functor is a functor that can be thought of as +-- /consuming/ values. +-- +-- As an example, consider the type of predicate functions @a -> Bool@. One +-- such predicate might be @negative x = x < 0@, which +-- classisifies integers as to whether they are negative. However, given this +-- predicate, we can re-use it in other situations, providing we have a way to +-- map values /to/ integers. For instance, we can use the @negative@ predicate +-- on a persons bank balance to work out if they are currently overdrawn: +-- +-- @ +-- newtype Predicate a = Predicate (a -> Bool) +-- +-- instance Contravariant Predicate where +-- contramap f (Predicate p) = Predicate (p . f) +-- | `- First, map the input... +-- `----- then apply the predicate. +-- +-- overdrawn :: Predicate Person +-- overdrawn = contramap personBankBalance negative +-- @ +-- +-- Any instance should be subject to the following laws: -- -- > contramap id = id -- > contramap f . contramap g = contramap (g . f) From cff1bca19e510ccb9cc19962e53e8f1bc0430874 Mon Sep 17 00:00:00 2001 From: Ollie Charles Date: Wed, 20 Sep 2017 13:10:22 +0100 Subject: [PATCH 2/8] Explain Divisible --- src/Data/Functor/Contravariant/Divisible.hs | 112 +++++++++++++++----- 1 file changed, 84 insertions(+), 28 deletions(-) diff --git a/src/Data/Functor/Contravariant/Divisible.hs b/src/Data/Functor/Contravariant/Divisible.hs index 432aec5..081e560 100644 --- a/src/Data/Functor/Contravariant/Divisible.hs +++ b/src/Data/Functor/Contravariant/Divisible.hs @@ -20,6 +20,11 @@ module Data.Functor.Contravariant.Divisible Divisible(..), divided, conquered, liftD -- * Contravariant Alternative , Decidable(..), chosen, lost + -- * Mathematical definitions + -- $math + + -- ** A note on 'conquer' + -- $conquer ) where import Control.Applicative @@ -73,48 +78,54 @@ import GHC.Generics -- -- A 'Divisible' contravariant functor is the contravariant analogue of 'Applicative'. -- --- In denser jargon, 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. --- --- By way of contrast, an 'Applicative' functor can be viewed as a monoid object in the --- category of copresheaves from Hask to Hask, equipped with Day convolution mapping the --- Cartesian product of the source to the Cartesian product of the target. +-- Continuing the intuition that 'Contravariant' functors consume input, a 'Divisible' +-- contravariant functor also has the ability to composed "beside" another contravariant +-- functor. -- --- Given the canonical diagonal morphism: +-- Serializers provide a good example of 'Divisible' contravariant functors. To begin +-- let's start with the type of serializers for specific types: -- -- @ --- delta a = (a,a) +-- newtype Serializer a = Serializer { runSerializer :: a -> ByteString } -- @ -- --- @'divide' 'delta'@ should be associative with 'conquer' as a unit +-- This is a contravariant functor: -- -- @ --- 'divide' 'delta' m 'conquer' = m --- 'divide' 'delta' 'conquer' m = m --- 'divide' 'delta' ('divide' 'delta' m n) o = 'divide' 'delta' m ('divide' 'delta' n o) +-- instance Contravariant Serializer where +-- contramap f s = Serializer . runSerializer s . f -- @ -- --- With more general arguments you'll need to reassociate and project using the monoidal --- structure of the source category. (Here fst and snd are used in lieu of the more restricted --- lambda and rho, but this construction works with just a monoidal category.) +-- That is, given a serializer for @a@ (@s :: Serializer a@), and a way to turn +-- @b@s into @a@s (a mapping @f :: b -> a@), we have a serializer for @b@: +-- @contramap f s :: Serializer b@. +-- +-- Divisible gives us a way to combine two serializers that focus on different +-- parts of a structure. If we postulate the existance of two primitive +-- serializers - @string :: Serializer String@ and @int :: Serializer Int@, we +-- would like to be able to combine these into a serializer for pairs of +-- @String@s and @Int@s. How can we do this? Simply run both serializer and +-- combine their output! -- -- @ --- 'divide' f m 'conquer' = 'contramap' ('fst' . f) m --- 'divide' f 'conquer' m = 'contramap' ('snd' . f) m --- 'divide' f ('divide' g m n) o = 'divide' f' m ('divide' 'id' n o) where --- f' a = case f a of (bc,d) -> case g bc of (b,c) -> (a,(b,c)) +-- combine :: Serializer a -> Serializer b -> Serializer (a, b) +-- combine serializeA serializeB = Serializer $ \(a, b) -> +-- let aBytes = runSerializer serializeA a +-- bBytes = runSerializer serializeB b +-- in aBytes <> bBytes +-- +-- serializeStringAndInt :: Serializer (String, Int) +-- serializeStringAndInt = combine string int -- @ +-- +-- 'divide' is a generalization by also taking a 'contramap' like function to +-- split any @a@ into a pair. This conveniently allows you to target fields of +-- a record, for instance, by extracting the values under two fields and +-- combining them into a tuple. class Contravariant f => Divisible f where divide :: (a -> (b, c)) -> f b -> f c -> f a - -- | The underlying theory would suggest that this should be: - -- - -- @ - -- conquer :: (a -> ()) -> f a - -- @ - -- - -- However, as we are working over a Cartesian category (Hask) and the Cartesian product, such an input - -- morphism is uniquely determined to be @'const' 'mempty'@, so we elide it. + + -- | Conquer acts as an identity for combining @Divisible@ functors. conquer :: f a -- | @@ -490,3 +501,48 @@ instance Decidable SettableStateVar where Left b -> l b Right c -> r c #endif + +-- $math +-- +-- In denser jargon, 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. +-- +-- By way of contrast, an 'Applicative' functor can be viewed as a monoid object in the +-- category of copresheaves from Hask to Hask, equipped with Day convolution mapping the +-- Cartesian product of the source to the Cartesian product of the target. +-- +-- Given the canonical diagonal morphism: +-- +-- @ +-- delta a = (a,a) +-- @ +-- +-- @'divide' 'delta'@ should be associative with 'conquer' as a unit +-- +-- @ +-- 'divide' 'delta' m 'conquer' = m +-- 'divide' 'delta' 'conquer' m = m +-- 'divide' 'delta' ('divide' 'delta' m n) o = 'divide' 'delta' m ('divide' 'delta' n o) +-- @ +-- +-- With more general arguments you'll need to reassociate and project using the monoidal +-- structure of the source category. (Here fst and snd are used in lieu of the more restricted +-- lambda and rho, but this construction works with just a monoidal category.) +-- +-- @ +-- 'divide' f m 'conquer' = 'contramap' ('fst' . f) m +-- 'divide' f 'conquer' m = 'contramap' ('snd' . f) m +-- 'divide' f ('divide' g m n) o = 'divide' f' m ('divide' 'id' n o) where +-- f' a = case f a of (bc,d) -> case g bc of (b,c) -> (a,(b,c)) +-- @ + +-- $conquer +-- The underlying theory would suggest that this should be: +-- +-- @ +-- conquer :: (a -> ()) -> f a +-- @ +-- +-- However, as we are working over a Cartesian category (Hask) and the Cartesian product, such an input +-- morphism is uniquely determined to be @'const' 'mempty'@, so we elide it. From ee30aad030caeb69ac60221d25224157a0669907 Mon Sep 17 00:00:00 2001 From: Oliver Charles Date: Thu, 21 Sep 2017 10:15:16 +0100 Subject: [PATCH 3/8] Fix typos in Contravariant --- src/Data/Functor/Contravariant.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Data/Functor/Contravariant.hs b/src/Data/Functor/Contravariant.hs index 42f256f..b72b049 100644 --- a/src/Data/Functor/Contravariant.hs +++ b/src/Data/Functor/Contravariant.hs @@ -118,7 +118,7 @@ import GHC.Generics import Prelude hiding ((.),id) --- | The class of contravariant functors. +-- | The of contravariant functors. -- -- Whereas in Haskell, one can think of a 'Functor' as containing or producing -- values, a contravariant functor is a functor that can be thought of as @@ -126,13 +126,13 @@ import Prelude hiding ((.),id) -- -- As an example, consider the type of predicate functions @a -> Bool@. One -- such predicate might be @negative x = x < 0@, which --- classisifies integers as to whether they are negative. However, given this +-- classifies integers as to whether they are negative. However, given this -- predicate, we can re-use it in other situations, providing we have a way to -- map values /to/ integers. For instance, we can use the @negative@ predicate --- on a persons bank balance to work out if they are currently overdrawn: +-- on a person's bank balance to work out if they are currently overdrawn: -- -- @ --- newtype Predicate a = Predicate (a -> Bool) +-- newtype Predicate a = Predicate { getPredicate :: a -> Bool } -- -- instance Contravariant Predicate where -- contramap f (Predicate p) = Predicate (p . f) From 9e5341f6142ef1b344bf233b28f52b7426129ba3 Mon Sep 17 00:00:00 2001 From: Oliver Charles Date: Thu, 21 Sep 2017 10:16:29 +0100 Subject: [PATCH 4/8] Fix typos in Divisible --- src/Data/Functor/Contravariant/Divisible.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Functor/Contravariant/Divisible.hs b/src/Data/Functor/Contravariant/Divisible.hs index 081e560..cb19b26 100644 --- a/src/Data/Functor/Contravariant/Divisible.hs +++ b/src/Data/Functor/Contravariant/Divisible.hs @@ -79,7 +79,7 @@ import GHC.Generics -- A 'Divisible' contravariant functor is the contravariant analogue of 'Applicative'. -- -- Continuing the intuition that 'Contravariant' functors consume input, a 'Divisible' --- contravariant functor also has the ability to composed "beside" another contravariant +-- contravariant functor also has the ability to be composed "beside" another contravariant -- functor. -- -- Serializers provide a good example of 'Divisible' contravariant functors. To begin From 14847e09c12894653a33e567dfe2abc533ef4ea9 Mon Sep 17 00:00:00 2001 From: Oliver Charles Date: Thu, 21 Sep 2017 10:17:36 +0100 Subject: [PATCH 5/8] Accidental typo --- src/Data/Functor/Contravariant.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Functor/Contravariant.hs b/src/Data/Functor/Contravariant.hs index b72b049..ec14245 100644 --- a/src/Data/Functor/Contravariant.hs +++ b/src/Data/Functor/Contravariant.hs @@ -118,7 +118,7 @@ import GHC.Generics import Prelude hiding ((.),id) --- | The of contravariant functors. +-- | The class of contravariant functors. -- -- Whereas in Haskell, one can think of a 'Functor' as containing or producing -- values, a contravariant functor is a functor that can be thought of as From 5b7f819022945a8c9bd0d03c2ce884141f8e3bb2 Mon Sep 17 00:00:00 2001 From: Ollie Charles Date: Thu, 21 Sep 2017 12:58:02 +0100 Subject: [PATCH 6/8] Explain Decidable --- src/Data/Functor/Contravariant/Divisible.hs | 85 +++++++++++++++++---- 1 file changed, 69 insertions(+), 16 deletions(-) diff --git a/src/Data/Functor/Contravariant/Divisible.hs b/src/Data/Functor/Contravariant/Divisible.hs index cb19b26..99c492a 100644 --- a/src/Data/Functor/Contravariant/Divisible.hs +++ b/src/Data/Functor/Contravariant/Divisible.hs @@ -21,10 +21,14 @@ module Data.Functor.Contravariant.Divisible -- * Contravariant Alternative , Decidable(..), chosen, lost -- * Mathematical definitions - -- $math + -- ** Divisible + -- $divisible - -- ** A note on 'conquer' + -- *** A note on 'conquer' -- $conquer + + -- ** Decidable + -- $decidable ) where import Control.Applicative @@ -313,26 +317,58 @@ funzip = fmap fst &&& fmap snd -- * Contravariant Alternative -------------------------------------------------------------------------------- --- | +-- | A 'Decidable' contravariant functor is the contravariant analogue of 'Alternative'. -- --- 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. +-- Noting the superclass constraint that @f@ must also be 'Divisible', a @Decidable@ +-- functor has the ability to "fan out" input, under the intuition that contravariant +-- functors consume input. +-- +-- In the dicussion for @Divisible@, an example was demonstrated with @Serializer@s, +-- that turn @a@s into @ByteString@s. @Divisible@ allowed us to serialize the /product/ +-- of multiple values by concatenation. By making our @Serializer@ also @Decidable@- +-- we now have the ability to serialize the /sum/ of multiple values - for example +-- different constructors in an ADT. +-- +-- Consider serializing arbitrary identifiers that can be either @String@s or @Int@s: -- -- @ --- 'choose' 'Left' m ('lose' f) = m --- 'choose' 'Right' ('lose' f) m = m --- 'choose' f ('choose' g m n) o = 'divide' f' m ('divide' 'id' n o) where --- f' bcd = 'either' ('either' 'id' ('Right' . 'Left') . g) ('Right' . 'Right') . f +-- data Identifier = StringId String | IntId Int -- @ -- --- In addition, we expect the same kind of distributive law as is satisfied by the usual --- covariant 'Alternative', w.r.t 'Applicative', which should be fully formulated and --- added here at some point! - +-- We know we have serializers for @String@s and @Int@s, but how do we combine them +-- into a @Serializer@ for @Identifier@? Essentially, our @Serializer@ needs to +-- scrutinise the incoming value and choose how to serialize it: +-- +-- @ +-- identifier :: Serializer Identifier +-- identifier = Serializer $ \identifier -> +-- case identifier of +-- StringId s -> runSerializer string s +-- IntId i -> runSerializer int i +-- @ +-- +-- It is exactly this notion of choice that @Decidable@ encodes. Hence if we add +-- an instance of @Decidable@ for @Serializer@... +-- +-- @ +-- instance Decidable Serializer where +-- lose f = Serializer $ \a -> absurd (f a) +-- choose split l r = Serializer $ \a -> +-- either (runSerializer l) (runSerializer r) (split a) +-- @ +-- +-- Then our @identifier@ @Serializer@ is +-- +-- @ +-- identifier :: Serializer Identifier +-- identifier = choose toEither string int where +-- toEither (StringId s) = Left s +-- toEither (IntId i) = Right i +-- @ class Divisible f => Decidable f where - -- | The only way to win is not to play. + -- | Acts as identity to 'choose'. lose :: (a -> Void) -> f a + choose :: (a -> Either b c) -> f b -> f c -> f a -- | @@ -502,7 +538,7 @@ instance Decidable SettableStateVar where Right c -> r c #endif --- $math +-- $divisible -- -- In denser jargon, a 'Divisible' contravariant functor is a monoid object in the category -- of presheaves from Hask to Hask, equipped with Day convolution mapping the Cartesian @@ -546,3 +582,20 @@ instance Decidable SettableStateVar where -- -- However, as we are working over a Cartesian category (Hask) and the Cartesian product, such an input -- morphism is uniquely determined to be @'const' 'mempty'@, so we elide it. + +-- $decidable +-- +-- 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. +-- +-- @ +-- 'choose' 'Left' m ('lose' f) = m +-- 'choose' 'Right' ('lose' f) m = m +-- 'choose' f ('choose' g m n) o = 'divide' f' m ('divide' 'id' n o) where +-- f' bcd = 'either' ('either' 'id' ('Right' . 'Left') . g) ('Right' . 'Right') . f +-- @ +-- +-- In addition, we expect the same kind of distributive law as is satisfied by the usual +-- covariant 'Alternative', w.r.t 'Applicative', which should be fully formulated and +-- added here at some point! From 5bdb02d754f1ffe32d3be3810a4dd0632bcf0883 Mon Sep 17 00:00:00 2001 From: Ollie Charles Date: Thu, 21 Sep 2017 13:02:56 +0100 Subject: [PATCH 7/8] Rewrite Divisible documentation to actually show Divisible --- src/Data/Functor/Contravariant/Divisible.hs | 33 ++++++++++++++++----- 1 file changed, 26 insertions(+), 7 deletions(-) diff --git a/src/Data/Functor/Contravariant/Divisible.hs b/src/Data/Functor/Contravariant/Divisible.hs index 99c492a..8e9ab8b 100644 --- a/src/Data/Functor/Contravariant/Divisible.hs +++ b/src/Data/Functor/Contravariant/Divisible.hs @@ -112,20 +112,39 @@ import GHC.Generics -- combine their output! -- -- @ --- combine :: Serializer a -> Serializer b -> Serializer (a, b) --- combine serializeA serializeB = Serializer $ \(a, b) -> --- let aBytes = runSerializer serializeA a --- bBytes = runSerializer serializeB b --- in aBytes <> bBytes +-- data StringAndInt = StringAndInt String Int -- --- serializeStringAndInt :: Serializer (String, Int) --- serializeStringAndInt = combine string int +-- stringAndInt :: Serializer StringAndInt +-- stringAndInt = Serializer $ \(StringAndInt s i) -> +-- let sBytes = runSerializer string s +-- iBytes = runSerializer int i +-- in sBytes <> iBytes -- @ -- -- 'divide' is a generalization by also taking a 'contramap' like function to -- split any @a@ into a pair. This conveniently allows you to target fields of -- a record, for instance, by extracting the values under two fields and -- combining them into a tuple. +-- +-- To complete the example, here is how to write @stringAndInt@ using a +-- @Divisible@ instance: +-- +-- @ +-- instance Divisible Serializer where +-- conquer = Serializer (const mempty) +-- +-- divide toBC b c = Serializer $ \a -> +-- case toBC a of +-- (a, b) -> +-- let sBytes = runSerializer serializeA a +-- iBytes = runSerializer serializeB b +-- in sBytes <> iBytes +-- +-- stringAndInt :: Serializer (String, Int) +-- stringAndInt = +-- divide (\(StringAndInt s i) -> (s, i)) string int +-- @ +-- class Contravariant f => Divisible f where divide :: (a -> (b, c)) -> f b -> f c -> f a From 901b1da17119c4dc7ff646f1908921bb5492b11b Mon Sep 17 00:00:00 2001 From: Oliver Charles Date: Thu, 21 Sep 2017 13:56:15 +0100 Subject: [PATCH 8/8] Correct type error in stringAndInt example --- src/Data/Functor/Contravariant/Divisible.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Functor/Contravariant/Divisible.hs b/src/Data/Functor/Contravariant/Divisible.hs index 8e9ab8b..03347ca 100644 --- a/src/Data/Functor/Contravariant/Divisible.hs +++ b/src/Data/Functor/Contravariant/Divisible.hs @@ -140,7 +140,7 @@ import GHC.Generics -- iBytes = runSerializer serializeB b -- in sBytes <> iBytes -- --- stringAndInt :: Serializer (String, Int) +-- stringAndInt :: Serializer StringAndInt -- stringAndInt = -- divide (\(StringAndInt s i) -> (s, i)) string int -- @