summaryrefslogtreecommitdiff
path: root/src/Data
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data')
-rw-r--r--src/Data/Profunctor/Cayley.hs20
-rw-r--r--src/Data/Profunctor/Mapping.hs4
-rw-r--r--src/Data/Profunctor/Traversing.hs4
3 files changed, 28 insertions, 0 deletions
diff --git a/src/Data/Profunctor/Cayley.hs b/src/Data/Profunctor/Cayley.hs
index 030c51c..24ddd19 100644
--- a/src/Data/Profunctor/Cayley.hs
+++ b/src/Data/Profunctor/Cayley.hs
@@ -19,6 +19,7 @@ import Control.Category
import Control.Comonad
import Data.Profunctor
import Data.Profunctor.Monad
+import Data.Profunctor.Traversing
import Data.Profunctor.Unsafe
import Prelude hiding ((.), id)
@@ -49,10 +50,29 @@ instance (Functor f, Strong p) => Strong (Cayley f p) where
first' = Cayley . fmap first' . runCayley
second' = Cayley . fmap second' . runCayley
+instance (Functor f, Costrong p) => Costrong (Cayley f p) where
+ unfirst (Cayley fp) = Cayley (fmap unfirst fp)
+ unsecond (Cayley fp) = Cayley (fmap unsecond fp)
+
instance (Functor f, Choice p) => Choice (Cayley f p) where
left' = Cayley . fmap left' . runCayley
right' = Cayley . fmap right' . runCayley
+instance (Functor f, Cochoice p) => Cochoice (Cayley f p) where
+ unleft (Cayley fp) = Cayley (fmap unleft fp)
+ {-# INLINE unleft #-}
+ unright (Cayley fp) = Cayley (fmap unright fp)
+ {-# INLINE unright #-}
+
+instance (Functor f, Closed p) => Closed (Cayley f p) where
+ closed = Cayley . fmap closed . runCayley
+
+instance (Functor f, Traversing p) => Traversing (Cayley f p) where
+ traverse' = Cayley . fmap traverse' . runCayley
+
+instance (Functor f, Mapping p) => Mapping (Cayley f p) where
+ map' = Cayley . fmap map' . runCayley
+
instance (Applicative f, Category p) => Category (Cayley f p) where
id = Cayley $ pure id
Cayley fpbc . Cayley fpab = Cayley $ liftA2 (.) fpbc fpab
diff --git a/src/Data/Profunctor/Mapping.hs b/src/Data/Profunctor/Mapping.hs
index ac903bb..7538fee 100644
--- a/src/Data/Profunctor/Mapping.hs
+++ b/src/Data/Profunctor/Mapping.hs
@@ -24,6 +24,7 @@ module Data.Profunctor.Mapping
) where
import Control.Arrow (Kleisli(..))
+import Data.Bifunctor.Tannen
import Data.Distributive
import Data.Functor.Compose
import Data.Functor.Identity
@@ -90,6 +91,9 @@ instance (Applicative m, Distributive m) => Mapping (Star m) where
map' (Star f) = Star (collect f)
roam f = Star #. genMap f .# runStar
+instance (Functor f, Mapping p) => Mapping (Tannen f p) where
+ map' = Tannen . fmap map' . runTannen
+
wanderMapping :: Mapping p => (forall f. Applicative f => (a -> f b) -> s -> f t) -> p a b -> p s t
wanderMapping f = roam ((runIdentity .) #. f .# (Identity .))
diff --git a/src/Data/Profunctor/Traversing.hs b/src/Data/Profunctor/Traversing.hs
index 2bd0c5a..99edff5 100644
--- a/src/Data/Profunctor/Traversing.hs
+++ b/src/Data/Profunctor/Traversing.hs
@@ -20,6 +20,7 @@ module Data.Profunctor.Traversing
import Control.Applicative
import Control.Arrow (Kleisli(..))
+import Data.Bifunctor.Tannen
import Data.Functor.Compose
import Data.Functor.Identity
import Data.Orphans ()
@@ -136,6 +137,9 @@ instance Applicative m => Traversing (Star m) where
traverse' (Star m) = Star (traverse m)
wander f (Star amb) = Star (f amb)
+instance (Functor f, Traversing p) => Traversing (Tannen f p) where
+ traverse' = Tannen . fmap traverse' . runTannen
+
newtype CofreeTraversing p a b = CofreeTraversing { runCofreeTraversing :: forall f. Traversable f => p (f a) (f b) }
instance Profunctor p => Profunctor (CofreeTraversing p) where