blob: bcc85e4ea7c81107639cd280321a04ab0df93c49 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
|
{-# LANGUAGE PolyKinds, DataKinds, KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-}
module CatPairs where
import Prelude hiding (id, (.))
import Data.Kind (Type)
import Control.Monad ((>=>))
import Control.Category
-- Categories over pairs of types.
-- Taken from Twan van Laarhoven:
-- http://twanvl.nl/blog/haskell/categories-over-pairs-of-types
type family Fst (xy :: (Type, Type)) :: Type
type family Snd (xy :: (Type, Type)) :: Type
type instance Fst '(x,y) = x
type instance Snd '(x,y) = y
-- Ceci n'est pas une pipe
data Pipe i o u m r = Pipe { runPipe :: Either i u -> m (Either o r) }
(>+>) :: Monad m
=> Pipe io1 io2 ur1 m ur2
-> Pipe io2 io3 ur2 m ur3
-> Pipe io1 io3 ur1 m ur3
(>+>) (Pipe f) (Pipe g) = Pipe (f >=> g)
idP :: Monad m => Pipe i i r m r
idP = Pipe return
newtype WrapPipe m iu or = WrapPipe
{ unWrapPipe :: Pipe (Fst iu) (Fst or) (Snd iu) m (Snd or) }
instance Monad m => Category (WrapPipe m) where
id = WrapPipe idP
x . y = WrapPipe (unWrapPipe y >+> unWrapPipe x)
|
