From 52cc344c6f38290b08507e20ef2ab90e1fb6702b Mon Sep 17 00:00:00 2001 From: Asad Saeeduddin Date: Mon, 19 Aug 2019 23:23:29 -0400 Subject: [PATCH 1/2] Add Choice instance for Joker --- src/Data/Profunctor/Joker.purs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/Data/Profunctor/Joker.purs b/src/Data/Profunctor/Joker.purs index 9cc3a62..aa4e2c9 100644 --- a/src/Data/Profunctor/Joker.purs +++ b/src/Data/Profunctor/Joker.purs @@ -2,8 +2,10 @@ module Data.Profunctor.Joker where import Prelude -import Data.Profunctor (class Profunctor) +import Data.Either (Either(..)) import Data.Newtype (class Newtype) +import Data.Profunctor (class Profunctor) +import Data.Profunctor.Choice (class Choice) -- | Makes a trivial `Profunctor` for a covariant `Functor`. newtype Joker f a b = Joker (f b) @@ -21,5 +23,9 @@ instance functorJoker :: Functor f => Functor (Joker f a) where instance profunctorJoker :: Functor f => Profunctor (Joker f) where dimap f g (Joker a) = Joker (map g a) +instance clownJoker :: Functor f => Choice (Joker f) where + left (Joker f) = Joker $ map Left f + right (Joker f) = Joker $ map Right f + hoistJoker :: forall f g a b. (f ~> g) -> Joker f a b -> Joker g a b hoistJoker f (Joker a) = Joker (f a) From be868fc0c46df3b91cf15e64391d605fd064ee11 Mon Sep 17 00:00:00 2001 From: Asad Saeeduddin Date: Tue, 20 Aug 2019 03:02:35 -0400 Subject: [PATCH 2/2] Add Monad instance for Joker --- src/Data/Profunctor/Joker.purs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/src/Data/Profunctor/Joker.purs b/src/Data/Profunctor/Joker.purs index aa4e2c9..d6663a9 100644 --- a/src/Data/Profunctor/Joker.purs +++ b/src/Data/Profunctor/Joker.purs @@ -3,7 +3,7 @@ module Data.Profunctor.Joker where import Prelude import Data.Either (Either(..)) -import Data.Newtype (class Newtype) +import Data.Newtype (class Newtype, un) import Data.Profunctor (class Profunctor) import Data.Profunctor.Choice (class Choice) @@ -27,5 +27,16 @@ instance clownJoker :: Functor f => Choice (Joker f) where left (Joker f) = Joker $ map Left f right (Joker f) = Joker $ map Right f +instance applyJoker :: Apply f => Apply (Joker f a) where + apply (Joker f) (Joker g) = Joker $ apply f g + +instance applicativeJoker :: Applicative f => Applicative (Joker f a) where + pure = Joker <<< pure + +instance bindJoker :: Bind f => Bind (Joker f a) where + bind (Joker ma) amb = Joker $ ma >>= (amb >>> un Joker) + +instance monadJoker :: Monad m => Monad (Joker m a) + hoistJoker :: forall f g a b. (f ~> g) -> Joker f a b -> Joker g a b hoistJoker f (Joker a) = Joker (f a)