module Data.Thrist ( Thrist (..)
                   , foldThrist
                   , appendThrist
                   , mapThrist ) where

import Prelude
import Data.Monoid
import Control.Category
-- import Data.Char
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)

{- Simple demo:
-- MOVE THIS TO TESTS
t1 :: Thrist (->) Char Char
t1 = ord `Cons` ((\i -> i+32) `Cons` (chr `Cons` Nil))

t2 :: Char -> Char
t2 = foldThrist (flip (.)) id t1
-}

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