{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Main
( main
) where
import Prelude hiding ((.), id)
import Control.Arrow (Kleisli (..))
import Control.Category (Category, (.), id)
import Data.Profunctor (Profunctor, rmap)
-- From Control.Categorical.Functor.
class (Category r, Category t) => GFunctor f r t | f r -> t, f t -> r where
gfmap :: r a b -> t (f a) (f b)
--------------------------------------------------------------------------------
data Coyoneda p f a where
Coyoneda :: p a b -> f a -> Coyoneda p f b
instance Profunctor p => Functor (Coyoneda p f) where
fmap f (Coyoneda g a) = Coyoneda (rmap f g) a
instance Category p => GFunctor (Coyoneda p f) p (->) where
gfmap f (Coyoneda g a) = Coyoneda (f . g) a
liftCoyoneda :: Category p => f a -> Coyoneda p f a
liftCoyoneda = Coyoneda id
lowerCoyoneda :: GFunctor f p (->) => Coyoneda p f a -> f a
lowerCoyoneda (Coyoneda f a) = gfmap f a
sequenceCoyoneda :: (Applicative m, Traversable f) => Coyoneda (Kleisli m) f a -> m (f a)
sequenceCoyoneda (Coyoneda f a) = traverse (runKleisli f) a
--------------------------------------------------------------------------------
prompt :: String -> IO String
prompt m = putStr m *> putStr "> " *> getLine
main :: IO ()
main = example1 *> example2
example1 :: IO ()
example1 =
let foo = liftCoyoneda ["A"] in
let bar = gfmap (Kleisli prompt) foo in
let baz = gfmap (Kleisli prompt) bar in
print =<< sequenceCoyoneda baz
example2 :: IO ()
example2 =
let foo = ["A"] in
let bar = traverse prompt foo in
let baz = traverse prompt =<< bar in
print =<< baz
