diff --git a/src/Data/Profunctor/Joker.purs b/src/Data/Profunctor/Joker.purs index 9cc3a62..d6663a9 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.Either (Either(..)) +import Data.Newtype (class Newtype, un) import Data.Profunctor (class Profunctor) -import Data.Newtype (class Newtype) +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,20 @@ 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 + +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)