AFA.hs

{-# OPTIONS -fglasgow-exts -farrows #-}

----------------------------------------------------------------------
-- |
-- Module      :  Graphics.UI.Phooey.AFA
-- 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 an arrow
-- and an applicative functor.  (Hence the name \"AFA\".)  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), nothing can be
-- known about the function @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.AFA where

import Control.Arrow hiding (pure)
import Control.Applicative (Applicative, liftA,liftA2)

newtype AFA (~>) src i o = AFA (src i ~> src o)

instance  {-""-}  (Arrow (~>), Applicative src)
          =>      Arrow (AFA (~>) src) where
  arr f              = AFA (arr (liftA f))
  AFA ab >>> AFA bc  = AFA (ab >>> bc)
  first (AFA a)      =
    AFA (arr splitA >>> first a >>> arr mergeA)

instance  {-""-}  (ArrowLoop (~>), Applicative src)
          =>      ArrowLoop (AFA (~>) src) where
  -- loop :: UI (b,d) (c,d) -> UI b c
  loop (AFA k) =
    AFA (loop (arr mergeA >>> k >>> arr splitA))

mergeA :: Applicative m => (m a, m c) -> m (a,c)
mergeA ~(ma,mc) = liftA2 (,) ma mc

splitA :: Applicative m => m (a,b) -> (m a, m b)
splitA m = (liftA fst m, liftA snd m)