Arrow.hs

{-# OPTIONS -fglasgow-exts -farrows #-}
----------------------------------------------------------------------
-- |
-- Module      :  Examples.Arrow
-- Copyright   :  (c) Conal Elliott 2006
-- License     :  LGPL
-- 
-- Maintainer  :  conal@conal.net
-- Stability   :  experimental
-- Portability :  portable
-- 
-- Phooey examples.  Run them with 'runUI'
----------------------------------------------------------------------

module Examples.Arrow where

import Control.Arrow
import Graphics.UI.Phooey.Arrow

-- Simple shopping list

sl0 :: IWidget Int
sl0 = islider (0,10)

ui1 :: UI () ()
ui1 =  title "Shopping List" $
       proc () -> do
         a  <- title "apples"   $ sl0 3 -< ()
         b  <- title "bananas"  $ sl0 7 -< ()
         title "total"  showDisplay     -< a+b


lo,hi :: UI () Int
lo = title "lo" (sl0 3)
hi = title "hi" (sl0 8)

-- Dynamic bounds
ui2 = proc () -> do
        l <- lo -< ()
        h <- hi -< ()
        v <- title "val" $ isliderDyn 5 -< (l,h)
        title "factorial" showDisplay   -< fact v

bounds :: UI () (Int,Int)
bounds = lo &&& hi

bounds' = proc () -> do 
            l <- lo -< ()
            h <- hi -< ()
            returnA -< (l,h)
          

val :: UI () Int
val = title "val" $ (lo &&& hi) >>> isliderDyn 5

val' = bounds >>> title "val" (isliderDyn 5)

ui2' = val' >>> pure fact >>> title "factorial" showDisplay

ui2'' = (fact ^<< val') >>> title "factorial" showDisplay


fact n = product [1 .. n]


-- In the two examples above, visual layout is implicitly chosen to be
-- top-down, following the order in which the components are declared in
-- the arrow expressions.  This choice may be overridden, as in the
-- following examples.

uiB1  = fromBottom  ui1
uiL1  = fromLeft    ui1
uiR1  = fromRight   ui1

ui3 =  fromBottom $
       proc () -> do
	    (a,b) <- fromRight fruit   -< (0,10)
	    title "total" showDisplay  -< a+b
  where       
   fruit =  title "apples"   (isliderDyn 3) &&&
	    title "bananas"  (isliderDyn 7)


-- Recursive examples.  These ones just hang.  Investigate.


uir1 = proc () -> do
         rec  lo   <-  title "lo"   (isliderDyn 3)  -< (0,hi)
              hi   <-  title "hi"   (isliderDyn 8)  -< (lo,10)
              val  <-  title "val"  (isliderDyn 5)  -< (lo,hi)
              title "factorial" showDisplay         -< fact val
         returnA -< ()

uir2 = proc () -> do
         rec  val <- title "val" (isliderDyn 6)  -< (val-5,val+5)
         title "squared" showDisplay             -< val*val

uir3 = proc () -> do
         s  <- title "message" (stringEntry "")  -< ()
         title "reversed" stringDisplay   -< reverse s


-- -- Simpler example for testing
-- uia = proc () -> do
--         n <- sl0 5 -< ()
--         showDisplay           -< fact n

-- uia' = fromLeft uia

-- uib :: UI () ()
-- uib =  title "Shopping List" $
--        proc () -> do
--          a  <- title "apples"   (sl0 3) -< ()
--          b  <- title "bananas"  (sl0 7) -< ()
--          title "sum"      showDisplay              -< a+b
--          title "product"  showDisplay              -< a*b