module Data.Thrist ( Thrist (..)
, foldThrist
, appendThrist
, mapThrist ) where
import Prelude
import Data.Monoid
import Control.Category
import Control.Arrow
data Thrist :: (* -> * -> *) -> * -> * -> * where
Nil :: Thrist (~>) a a
Cons :: (a ~> b) -> Thrist (~>) b c -> Thrist (~>) a c
foldThrist :: (forall i j k . (i ~> j) -> (j ~> k) -> (i ~> k))
-> c ~> c
-> Thrist (~>) a c
-> a ~> c
foldThrist _ v Nil = v
foldThrist f v (Cons h t) = h `f` (foldThrist f v t)
appendThrist :: forall ((~>) :: * -> * -> *) a b c .
Thrist (~>) a b ->
Thrist (~>) b c ->
Thrist (~>) a c
appendThrist Nil a = a
appendThrist (Cons b r) a = Cons b (appendThrist r a)
mapThrist :: (forall i j . i +> j -> i ~> j) -> Thrist (+>) a b -> Thrist (~>) a b
mapThrist _ Nil = Nil
mapThrist f (Cons a r) = Cons (f a) (mapThrist f r)
instance Monoid (Thrist (~>) a a) where
mempty = Nil
mappend = appendThrist
instance Arrow (Thrist (->)) where
arr f = Cons f Nil
first Nil = Nil
first (t@(Cons _ _)) = Cons ((foldThrist (flip (Prelude..)) Prelude.id t) *** Prelude.id) Nil
instance Category (Thrist (~>)) where
id = Nil
b . a = appendThrist a b