Last active
May 12, 2019 18:55
-
-
Save mbbx6spp/51bf2b694dc9bbf81b60f2f616453eb3 to your computer and use it in GitHub Desktop.
Doodle to help explain Profunctors and Yoneda embedding application.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE ExplicitForAll #-} | |
{-# LANGUAGE KindSignatures #-} | |
{-# LANGUAGE NoImplicitPrelude #-} | |
{-# LANGUAGE RankNTypes #-} | |
{-# LANGUAGE TypeOperators #-} | |
{-# LANGUAGE TypeSynonymInstances #-} | |
{-# LANGUAGE MultiParamTypeClasses #-} | |
module Profunctors where | |
import Data.Either | |
import Data.Maybe | |
import Data.Functor | |
import Data.Function ((.), ($)) | |
class Iso a b where | |
to :: a -> b | |
from :: b -> a | |
-- law: a = from . to a | |
type Lens s t a b | |
= forall p. Strong (p :: * -> * -> *) => p a b -> p s t | |
type Prism s t a b | |
= forall p. Choice (p :: * -> * -> *) => p a b -> p s t | |
class Profunctor (p :: * -> * -> *) where | |
dimap :: (a -> b) -> (c -> d) -> (p b c -> p a d) | |
-- laws: | |
-- dimap identity identity = identity | |
-- dimap (f' . f) (g . g') = dimap f g · dimap f' g' | |
instance Profunctor (->) where | |
dimap f g h = g . h . f | |
class Profunctor p => Strong (p :: * -> * -> *) where | |
first' :: p a b -> p (a, c) (b, c) | |
class Profunctor p => Choice (p :: * -> * -> *) where | |
left' :: p a b -> p (Either a c) (Either b c) | |
class Profunctor p => Cartesian (p :: * -> * -> *) where | |
first :: p a b -> p (a, c) (b, c) | |
second :: p a b -> p (c, a) (c, b) | |
-- laws: | |
-- dimap runit runit' h = first h | |
-- dimap assoc assoc' (first (first h)) = first h | |
-- where | |
-- runit :: (a, ()) -> a | |
-- runit' :: a -> (a, ()) | |
-- assoc :: (a, (b, c)) -> ((a, b), c) | |
-- assoc' :: ((a, b), c) -> (a, (b, c)) | |
instance Cartesian (->) where | |
first f (a, c) = (f a, c) | |
second f (c, a) = ( c, f a) | |
class Profunctor p => Monoidal p where | |
par :: p a b -> p c d -> p (a, c) (b, d) | |
empty :: p () () | |
-- laws: | |
-- dimap assoc assoc' (par (par h j) k) = par h (par j k) | |
-- dimap runit runit' h = par h empty | |
-- dimap lunit lunit' h = par empty h | |
-- where | |
-- lunit :: ((), a) -> a | |
-- lunit' :: a -> ((), a) | |
-- runit :: (a, ()) -> a | |
-- runit' :: a -> (a, ()) | |
instance Monoidal (->) where | |
par f g (a, c) = (f a, g c) | |
empty = identity | |
-- Natural transformations | |
type f ~> g = forall x. f x -> g x | |
-- Examples of natural transformations | |
-- safeHead :: [a] -> Maybe a | |
safeHead :: [] ~> Maybe | |
safeHead [] = Nothing | |
safeHead (a: _) = Just a | |
-- singletonList :: Maybe a -> [a] | |
singletonList :: Maybe ~> [] | |
singletonList Nothing = [] | |
singletonList (Just a) = [a] | |
-- Reader and the Yoneda Lemma | |
newtype Reader a x | |
= Reader { runReader :: a -> x } | |
instance Functor (Reader a) where | |
fmap f x = Reader (f . runReader x) | |
newtype Yoneda f a = Yoneda { | |
runYoneda :: Functor f => Reader a ~> f | |
} | |
toYoneda :: Functor f => f a -> Yoneda f a | |
toYoneda fa = Yoneda (\x -> fmap (runReader x) fa) | |
fromYoneda :: Functor f => Yoneda f a -> f a | |
fromYoneda yo = runYoneda yo (Reader identity) | |
-- auxilliary functions | |
identity :: a -> a | |
identity a = a | |
flip :: (b -> a -> c) -> a -> b -> c | |
flip f a b = f b a |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment