content: {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
  {-# LANGUAGE Arrows, CPP, TypeOperators #-}
  
  -- Test infix type notation and arrow notation
  
  module Test where
  
  import Prelude hiding (id,(.))
  import Control.Category
  import Control.Arrow
  
  -- For readability, I use infix notation for arrow types.  I'd prefer the
  -- following, but GHC doesn't allow operators like "-=>" as type
  -- variables.
  -- 
  -- comp1 :: Arrow (-=>) => b-=>c -> c-=>d -> b-=>d
  
  
  comp1 :: Arrow to => b `to` c -> c `to` d -> b `to` d
  comp1 f g = proc x -> do
              b <- f -< x
              g -< b
  
  -- arrowp produces
  -- comp1 f g = (f >>> g)
  
  comp :: Arrow to => (b `to` c, c `to` d) `to` (b `to` d)
  comp = arr (uncurry (>>>))
  
  -- app :: Arrow to => (b c, b) `to` c
  
  type R = Float
  type I = Int
  
  z1,z2 :: Arrow to => I `to` (R `to` R)
  z1 = undefined 
  z2 = z1
  
  z3 :: Arrow to => (I,I) `to` (R `to` R,R `to` R)
  z3 = z1 *** z2
  
  z4 :: Arrow to => (I,I) `to` (R `to` R)
  z4 = z3 >>> comp
  
  comp4,comp5 :: Arrow to =>
    b `to` (c `to` d) -> e `to` (d `to` f) -> (b,e) `to` (c `to` f)
  
  comp4 g f = proc (b,e) -> do
              g' <- g -< b
              f' <- f -< e
              returnA -< (g' >>> f')
  
  comp5 g f = (g *** f) >>> comp
  
  lam,lam2 :: Arrow to => (e,b) `to` c -> e `to` (b `to` c)
  
  lam f = arr $ \ e -> arr (pair e) >>> f
  
  pair a b = (a,b)
  
  -- I got the definition lam above by starting with
  
  lam2 f = proc e ->
           returnA -< (proc b -> do
                       c <- f -< (e,b)
                       returnA -< c)
  
  -- I desugared with  the arrows preprocessor, removed extra parens and
  -- renamed "arr" to "pure", to get
  -- 
  --  lam f = pure (\ e -> pure (\ b -> (e, b)) >>> f)
  
  -- Note that lam is arrow curry
  
  -- curry :: ((e,b) -> c) -> (e -> b -> c)
  
  -- All equivalent:
  
  curry1 f e b = f (e,b)
  
  curry2 f = \ e -> \ b -> f (e,b)
  
  curry3 f = \ e -> f . (\ b -> (e,b))
  
  curry4 f = \ e -> f . (pair e)
  
  
  
  comp6 :: Arrow to => b `to` (c `to` d) -> e `to` (d `to` f)
                    -> b `to` (e `to` (c `to` f))
  comp6 g f = lam $ comp5 g f 
  
  -- What about uncurrying?
  
  -- uncurryA :: Arrow to => b `to` (c `to` d)
  --                     -> (b,c) `to` d
  -- uncurryA f = proc (b,c) -> do
  --              f' <- f -< b
  --              returnA -< f' c
  
  -- Why "lam" instead of "curryA" (good name also): so I can use Arrows
  -- lambda notation, similar to
  
  compF g f = \ b e -> g b . f e
  
  -- But I haven't figured out how to.
  
  -- comp7 :: Arrow to => b `to` (c `to` d) -> e `to` (d `to` f)
  --                   -> b `to` (e `to` (c `to` f))
  -- comp7 g f = proc b -> proc e -> do
  --             g' <- g -< b
  --             f' <- f -< e
  --             returnA -< (g' >>> f')
  
  -- Try "(| lam \ b -> ... |)" in the FOP arrows chapter
  -- cmd ::= form exp cmd1 ... cmdn.  Parens if nec
  
  -- (| lam (\ b -> undefined) |)
  
  -- Oh!  The arrow syntax allows bindings with *infix* operators.  And I
  -- don't know how to finish comp7.
  
  -- Uncurried forms:
  
  comp8 :: Arrow to => (b,c) `to` d -> (e,d) `to` k -> (b,c,e) `to` k
  comp8 g f = proc (b,c,e) -> do
              d <- g -< (b,c)
              f -< (e,d)
  
  -- This looks like straightforward `to` translation.  With insertions of
  -- curry & uncurry operators, it'd probably be easy to handle curried
  -- definitions as well.
  
  -- Simpler example, for experimentation
  
  comp9 :: Arrow to => (c,d) `to` e -> b `to` d -> (b,c) `to` e
  comp9 g f = proc (b,c) -> do
              d <- f -< b
              g -< (c,d)
   
  -- Desugared:
  
  comp9' :: Arrow to => (c,d) `to` e -> b `to` d -> (b,c) `to` e
  comp9' g f = first f >>> arr (\ (d,c) -> (c,d)) >>> g
  
  
  