{-# OPTIONS #-}

----------------------------------------------------------------------
-- |
-- Module      :  Graphics.UI.Phooey.AmA
-- Copyright   :  (c) Conal Elliott 2006
-- License     :  LGPL
-- 
-- Maintainer  :  conal@conal.net
-- Stability   :  provisional
-- Portability :  portable
--
-- This module captures a pattern that for building an arrow from a monad
-- and an arrow.  (Hence the name "AmA".)  Motivation follows.
--
-- The UI monad makes for simple examples, but an awkwardness remains,
-- namely explicit Source types.  The reason for Source types is that
-- in a monadic bind, @m >>= f@ (as hidden in @do@ notation), the
-- function nothing can be known about @f@ until it is applied to a value
-- generated by @m@.  In other words, the monadic interface prevents us
-- from accessing the static aspects of @f@ and separating them from the
-- dynamic aspects.  This difficulty is the main motivation for
-- generalizing monads to arrows.
----------------------------------------------------------------------

module Graphics.UI.Phooey.AmA where

import Control.Arrow
import Control.Monad (liftM,liftM2)

-- newtype AmA (~>) src i o = AmA (src i ~> src o)

-- Workaround for haddock limitation
-- newtype AmA arr src i o = AmA (src i `arr` src o)
newtype AmA arr src i o = AmA (arr (src i) (src o))

instance  {-""-}  (Arrow arr, Monad src)
          =>      Arrow (AmA arr src) where
  pure f             = AmA (pure (liftM f))
  AmA ab >>> AmA bc  = AmA (ab >>> bc)
  first (AmA a)      =
    AmA (pure splitM >>> first a >>> pure mergeM)

instance  {-""-}  (ArrowLoop arr, Monad src)
          =>      ArrowLoop (AmA arr src) where
  -- loop :: UI (b,d) (c,d) -> UI b c
  loop (AmA k) =
    AmA (loop (pure mergeM >>> k >>> pure splitM))

mergeM :: Monad m => (m a, m c) -> m (a,c)
mergeM ~(ma,mc) = liftM2 (,) ma mc

splitM :: Monad m => m (a,b) -> (m a, m b)
splitM m = (liftM fst m, liftM snd m)