Skip to content

Commit f8a2322

Browse files
committed
Add cochoice instances for Joker and Star
1 parent 9b3d014 commit f8a2322

File tree

2 files changed

+14
-1
lines changed

2 files changed

+14
-1
lines changed

src/Data/Profunctor/Joker.purs

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,10 +2,13 @@ module Data.Profunctor.Joker where
22

33
import Prelude
44

5-
import Data.Either (Either(..))
5+
import Control.Alternative (empty)
6+
import Control.MonadPlus (class MonadPlus)
7+
import Data.Either (Either(..), either)
68
import Data.Newtype (class Newtype, un)
79
import Data.Profunctor (class Profunctor)
810
import Data.Profunctor.Choice (class Choice)
11+
import Data.Profunctor.Cochoice (class Cochoice)
912

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

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

44+
instance cochoiceJoker :: MonadPlus f => Cochoice (Joker f)
45+
where
46+
unleft (Joker fa) = Joker $ fa >>= either pure (const empty)
47+
unright (Joker fb) = Joker $ fb >>= either (const empty) pure
48+
4149
hoistJoker :: forall f g a b. (f ~> g) -> Joker f a b -> Joker g a b
4250
hoistJoker f (Joker a) = Joker (f a)

src/Data/Profunctor/Star.purs

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@ import Data.Newtype (class Newtype)
1515
import Data.Profunctor (class Profunctor)
1616
import Data.Profunctor.Choice (class Choice)
1717
import Data.Profunctor.Closed (class Closed)
18+
import Data.Profunctor.Cochoice (class Cochoice)
1819
import Data.Profunctor.Strong (class Strong)
1920
import Data.Tuple (Tuple(..))
2021

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

79+
instance cochoiceStar :: MonadPlus f => Cochoice (Star f) where
80+
unleft (Star f) = Star $ \a -> (=<<) (either pure (const empty)) $ f (Left a)
81+
unright (Star f) = Star $ \a -> (=<<) (either (const empty) pure) $ f (Right a)
82+
7883
instance closedStar :: Distributive f => Closed (Star f) where
7984
closed (Star f) = Star \g -> distribute (f <<< g)
8085

0 commit comments

Comments
 (0)