Skip to content

Commit

Permalink
Add cochoice instances for Joker and Star
Browse files Browse the repository at this point in the history
  • Loading branch information
masaeedu committed Oct 8, 2019
1 parent 9b3d014 commit 46ba93b
Show file tree
Hide file tree
Showing 2 changed files with 14 additions and 1 deletion.
10 changes: 9 additions & 1 deletion src/Data/Profunctor/Joker.purs
Original file line number Diff line number Diff line change
Expand Up @@ -2,10 +2,13 @@ module Data.Profunctor.Joker where

import Prelude

import Data.Either (Either(..))
import Control.Alternative (empty)
import Control.MonadPlus (class MonadZero)
import Data.Either (Either(..), either)
import Data.Newtype (class Newtype, un)
import Data.Profunctor (class Profunctor)
import Data.Profunctor.Choice (class Choice)
import Data.Profunctor.Cochoice (class Cochoice)

-- | Makes a trivial `Profunctor` for a covariant `Functor`.
newtype Joker f a b = Joker (f b)
Expand Down Expand Up @@ -38,5 +41,10 @@ instance bindJoker :: Bind f => Bind (Joker f a) where

instance monadJoker :: Monad m => Monad (Joker m a)

instance cochoiceJoker :: MonadZero f => Cochoice (Joker f)
where
unleft (Joker fa) = Joker $ fa >>= either pure (const empty)
unright (Joker fb) = Joker $ fb >>= either (const empty) pure

hoistJoker :: forall f g a b. (f ~> g) -> Joker f a b -> Joker g a b
hoistJoker f (Joker a) = Joker (f a)
5 changes: 5 additions & 0 deletions src/Data/Profunctor/Star.purs
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,7 @@ import Data.Newtype (class Newtype)
import Data.Profunctor (class Profunctor)
import Data.Profunctor.Choice (class Choice)
import Data.Profunctor.Closed (class Closed)
import Data.Profunctor.Cochoice (class Cochoice)
import Data.Profunctor.Strong (class Strong)
import Data.Tuple (Tuple(..))

Expand Down Expand Up @@ -75,6 +76,10 @@ instance choiceStar :: Applicative f => Choice (Star f) where
left (Star f) = Star $ either (map Left <<< f) (pure <<< Right)
right (Star f) = Star $ either (pure <<< Left) (map Right <<< f)

instance cochoiceStar :: MonadZero f => Cochoice (Star f) where
unleft (Star f) = Star $ \a -> (=<<) (either pure (const empty)) $ f (Left a)
unright (Star f) = Star $ \a -> (=<<) (either (const empty) pure) $ f (Right a)

instance closedStar :: Distributive f => Closed (Star f) where
closed (Star f) = Star \g -> distribute (f <<< g)

Expand Down

0 comments on commit 46ba93b

Please sign in to comment.