module Arrow where
import Tools(swap,comp,mapFst,mapSnd)

infixr 8 <**
infixr 8 **>
infixr 7 >>>
infixr 7 <<<
infixr 6 |||
infixr 6 +++

class Arrow a where
  arr      :: (b->c) -> a b c
  (>>>)    :: a b c -> a c d -> a b d
  (<<<)    :: a c d -> a b c -> a b d
  first    :: a b c -> a (b,d) (c,d)
  second   :: a b c -> a (d,b) (d,c)
  -- Defaults: 
  f <<< g  =  g >>> f
  f >>> g  =  g <<< f
  second f =  arr swap >>> first  f >>> arr swap
  first f  =  arr swap >>> second f >>> arr swap

(**>),(<**) :: Arrow a => a b c -> a d e -> a (b,d) (c,e)
f **> g = first f >>> second g
f <** g = first f <<< second g

class Arrow a => ArrowChoice a where
  (|||) :: a b d -> a c d -> a (Either b c) d
  (+++) :: a b c -> a b' c' -> a (Either b b') (Either c c')
  -- Defaults: 
  f ||| g = (f +++ g) >>> arr (either id id)
  f +++ g = (f >>> arr Left) ||| (g >>> arr Right)

{-
  left  :: a b c -> a (Either b d) (Either c d)
  right :: a b c -> a (Either d b) (Either d c)
  -- Defaults: 
  f +++ g = left f >>> right g
  left f  = (f >>> arr Left) |||        arr Right
  right g =        arr Left  ||| (g >>> arr Right)
-}

-- --------------------------------------------------------------
-- Instances for (->)

instance Arrow (->) where
  arr      = id
  (>>>)    = comp
  first    = mapFst
  second   = mapSnd

instance ArrowChoice (->) where
  (|||) = either
--  (|||) = \f g-> f `seq` g `seq` either f g