{-# LANGUAGE DefaultSignatures #-}
module Clean.Arrow where

import Clean.Category
import Clean.Monad
import Clean.Core

class Split ar => Arrow ar where
  arr :: (a -> b) -> ar a b
instance Arrow (->) where arr = id

class Profunctor p where
  promap :: (a -> b) -> p b c -> p a c
  default promap :: Arrow p => (a -> b) -> p b c -> p a c
  promap f = (arr f >>>) 
infixr 4 $>>
($>>) = promap

a ||| b = (a >>> arr Left) <|> (b >>> arr Right)

newtype Kleisli m a b = Kleisli { runKleisli :: a -> m b }
instance Monad m => Category (Kleisli m) where
  id = Kleisli pure
  Kleisli f . Kleisli g = Kleisli (\a -> g a >>= f)
instance Monad m => Choice (Kleisli m) where
  Kleisli f <|> Kleisli g = Kleisli (f <|> g)
instance (Monad m,Applicative m) => Split (Kleisli m) where
  Kleisli f <#> Kleisli g = Kleisli (\(a,c) -> (,)<$>f a<*>g c)
instance (Monad m,Applicative m) => Arrow (Kleisli m) where
  arr a = Kleisli (pure . a)