mirror of
https://github.com/hablapps/DontFearTheProfunctorOptics.git
synced 2024-09-11 09:05:26 +03:00
Adds profunctor encodings and minimal changes
This commit is contained in:
parent
2f38957db2
commit
0f2a35923a
@ -101,3 +101,100 @@ newtype Traversal' s t a b = Traversal' { extract :: s -> FunList a b t }
|
||||
|
||||
firstNSecond' :: Traversal' (a, a, c) (b, b, c) a b
|
||||
firstNSecond' = Traversal' (\(a1, a2, c) -> More a1 (More a2 (Done (,,c))))
|
||||
|
||||
---------------------------------------------------
|
||||
-- Part II: Profunctors as Generalized Functions --
|
||||
---------------------------------------------------
|
||||
|
||||
-- Functor
|
||||
|
||||
-- class Functor f where
|
||||
-- fmap :: (a -> b) -> f a -> f b
|
||||
|
||||
-- instance Functor ((->) r) where
|
||||
-- fmap f g = g . f
|
||||
|
||||
-- Contravariant
|
||||
|
||||
class Contravariant f where
|
||||
cmap :: (b -> a) -> f a -> f b
|
||||
|
||||
newtype CReader r a = CReader (a -> r)
|
||||
|
||||
instance Contravariant (CReader r) where
|
||||
cmap f (CReader g) = CReader (g . f)
|
||||
|
||||
-- Profunctor
|
||||
|
||||
class Profunctor p where
|
||||
dimap :: (a' -> a) -> (b -> b') -> p a b -> p a' b'
|
||||
|
||||
lmap :: (a' -> a) -> p a b -> p a' b
|
||||
lmap f = dimap f id
|
||||
rmap :: (b -> b') -> p a b -> p a b'
|
||||
rmap f = dimap id f
|
||||
|
||||
instance Profunctor (->) where
|
||||
dimap f g h = g . h . f
|
||||
|
||||
-- Cartesian
|
||||
|
||||
class Profunctor p => Cartesian p where
|
||||
first :: p a b -> p (a, c) (b, c)
|
||||
second :: p a b -> p (c, a) (c, b)
|
||||
|
||||
instance Cartesian (->) where
|
||||
first f (a, c) = (f a, c)
|
||||
second f (c, a) = (c, f a)
|
||||
|
||||
-- Cocartesian
|
||||
|
||||
class Profunctor p => Cocartesian p where
|
||||
left :: p a b -> p (Either a c) (Either b c)
|
||||
right :: p a b -> p (Either c a) (Either c b)
|
||||
|
||||
instance Cocartesian (->) where
|
||||
left f = either (Left . f) Right
|
||||
right f = either Left (Right . f)
|
||||
|
||||
-- Monoidal
|
||||
|
||||
class Profunctor p => Monoidal p where
|
||||
par :: p a b -> p c d -> p (a, c) (b, d)
|
||||
empty :: p () ()
|
||||
|
||||
instance Monoidal (->) where
|
||||
par f g (a, c) = (f a, g c)
|
||||
empty = id
|
||||
|
||||
-- Beyond Functions
|
||||
|
||||
newtype UpStar f a b = UpStar { runUpStar :: a -> f b }
|
||||
|
||||
instance Functor f => Profunctor (UpStar f) where
|
||||
dimap f g (UpStar h) = UpStar (fmap g . h . f)
|
||||
|
||||
instance Functor f => Cartesian (UpStar f) where
|
||||
first (UpStar f) = UpStar (\(a, c) -> fmap (,c) (f a))
|
||||
second (UpStar f) = UpStar (\(c, a) -> fmap (c,) (f a))
|
||||
|
||||
instance Applicative f => Cocartesian (UpStar f) where
|
||||
left (UpStar f) = UpStar (either (fmap Left . f) (fmap Right . pure))
|
||||
right (UpStar f) = UpStar (either (fmap Left . pure) (fmap Right . f))
|
||||
|
||||
instance Applicative f => Monoidal (UpStar f) where
|
||||
par (UpStar f) (UpStar g) = UpStar (\(a, b) -> (,) <$> f a <*> g b)
|
||||
empty = UpStar pure
|
||||
|
||||
newtype Tagged a b = Tagged { unTagged :: b }
|
||||
|
||||
instance Profunctor Tagged where
|
||||
dimap _ g (Tagged b) = Tagged (g b)
|
||||
|
||||
instance Cocartesian Tagged where
|
||||
left (Tagged b) = Tagged (Left b)
|
||||
right (Tagged b) = Tagged (Right b)
|
||||
|
||||
instance Monoidal Tagged where
|
||||
par (Tagged b) (Tagged d) = Tagged (b, d)
|
||||
empty = Tagged ()
|
||||
|
@ -205,8 +205,8 @@ instance Cocartesian (->) where
|
||||
Indeed, this typeclass is very similar to `Cartesian`, but the resulting box
|
||||
deals with sum types (`Either`) instead of product types. What does it mean from
|
||||
our diagram perspective? It means that inputs are exclusive and only one of them
|
||||
will be active in a particular time. The input itself determines which part of
|
||||
the component is active. The new component is shown in the next picture:
|
||||
will be active in a particular time. The input itself determines which path
|
||||
should be active. The corresponding diagram is shown in the next picture:
|
||||
|
||||
![cocartesian](diagram/cocartesian.svg)
|
||||
|
||||
@ -250,15 +250,14 @@ instance Monoidal (->) where
|
||||
empty = id
|
||||
```
|
||||
|
||||
Now, we'll focus on `par`. It receives a pair of components, `p a b` and `p c
|
||||
d`, and it builds a new component `p (a, c) (b, d)`. Given this signature, it's
|
||||
easy to figure out what is going on inside the resulting component. It's shown
|
||||
in the next diagram:
|
||||
Now, we'll focus on `par`. It receives a pair of boxes, `p a b` and `p c d`, and
|
||||
it builds a new box typed `p (a, c) (b, d)`. Given this signature, it's easy to
|
||||
figure out what's going on in the shadows. It's shown in the next diagram:
|
||||
|
||||
![monoidal](diagram/monoidal.svg)
|
||||
|
||||
The resulting component make both arguments (`h` and `j`) coexist, by connecting
|
||||
them in parallel (therefore the name `par`).
|
||||
The resulting box make both arguments (`h` and `j`) coexist, by connecting them
|
||||
in parallel (therefore the name `par`).
|
||||
|
||||
### Beyond Functions
|
||||
|
||||
@ -334,4 +333,4 @@ We've chosen `DownStar` and `Tagged` because we'll use them in the final part.
|
||||
However, you should know that there're other awesome instances for profunctors
|
||||
[out
|
||||
there](https://ocharles.org.uk/blog/guest-posts/2013-12-22-24-days-of-hackage-profunctors.html).
|
||||
As you see, profunctors arise everywhere!
|
||||
As you see, profunctors also arise everywhere!
|
||||
|
Loading…
Reference in New Issue
Block a user