phooey 0.2.1 → 0.3

raw patch · 12 files changed

+128/−94 lines, 12 files

Files

• CHANGES +14/−1
• Makefile +5/−11
• README +1/−1
• phooey.cabal +4/−4
• src/Examples.hs +1/−3
• src/Graphics/UI/Phooey/AFA.hs +51/−0
• src/Graphics/UI/Phooey/AmA.hs +0/−54
• src/Graphics/UI/Phooey/ArrowUI.hs +6/−10
• src/Graphics/UI/Phooey/CallBackT.hs +1/−1
• src/Graphics/UI/Phooey/LayoutT.hs +1/−1
• src/Graphics/UI/Phooey/MonadUI.hs +17/−8
• src/MonadExamples.hs +27/−0

@@ -1,9 +1,22 @@+Version 0.3:+* Finished renaming "CallbackT" to "CallBackT" (thanks to Michal Palka for+  catching the inconsistency).+* Renamed AmA.hs to AFA.hs.  AFA is more general in that it works with+  applicative functors instead of monads.+* ArrowUI.title now defined in terms of ArrowMonad.title.+* Added src/MonadExamples.hs+* Changed type of MonadUI.runUI.  Now takes a UI (Source ()) instead of UI+  ().  The new type is more convenient for use.+* Relaxed type of LayoutT.runL, to accommodate the new MonadUI.runUI type.+* Makefile tweaks to fit cabal-make changes.+ Version 0.2.1: * Changed all files to *nix-style line endings.  Changes in version 0.2: -* Finally fixed a long-standing stretching bug.  When widgets are abutted horizontally, they now all stretch together.+* Finally fixed a long-standing stretching bug.  When widgets are abutted+  horizontally, they now all stretch together.  Changes in version 0.1: 

@@ -1,14 +1,8 @@-# See README for Cabal-based building.  Other fancy stuff (like haddock) here.--user = conal-package = phooey+# For special configuration, especially for docs.  Otherwise see README. -configure_args=--disable-use-packages --haddock-args="\-  --read-interface=http://haskell.org/ghc/docs/latest/html/libraries/base,c:/ghc/ghc-6.6/doc/html/libraries/base/base.haddock \-  --read-interface=http://haskell.org/ghc/docs/latest/html/libraries/mtl,c:/ghc/ghc-6.6/doc/html/libraries/mtl/mtl.haddock \-  --read-interface=http://wxhaskell.sourceforge.net/doc,c:/Haskell/wxhaskell/out/doc/wxhaskell.haddock \-  $(source_args)\-  $(comments_args)\-  "+haddock-interfaces=\+  http://haskell.org/ghc/docs/latest/html/libraries/base,c:/ghc/ghc-6.6/doc/html/libraries/base/base.haddock \+  http://haskell.org/ghc/docs/latest/html/libraries/mtl,c:/ghc/ghc-6.6/doc/html/libraries/mtl/mtl.haddock \+  http://wxhaskell.sourceforge.net/doc,c:/Haskell/wxhaskell/out/doc/wxhaskell.haddock  include ../my-cabal-make.inc

@@ -1,7 +1,7 @@ Phooey is a library for functional user intefaces.  It's currently built on wxHaskell, but could probably be tweaked to run on top of other imperative UI libraries.  For a fuller description and link to-documentation, please see the Haskell wiki page:+documentation, please see the project wiki page:    http://haskell.org/haskellwiki/phooey 

@@ -1,5 +1,5 @@ Name:                phooey-Version:             0.2.1+Version:             0.3 Synopsis: 	     Functional user interfaces Category:            User Interfaces Description:@@ -16,7 +16,7 @@   * The project wiki page <http://haskell.org/haskellwiki/phooey>   .   * Use of Phooey for composable interfaces in the TV library:-    <http://haskell.org/haskellwiki/TV>+    <http://haskell.org/haskellwiki/GuiTV>   .   This page and the module documentation pages have links to colorized   source code and to wiki pages where you can read and contribute /user@@ -35,11 +35,11 @@ Exposed-Modules:                           Graphics.UI.Phooey                      Graphics.UI.Phooey.Imperative-                     Graphics.UI.Phooey.CallbackT+                     Graphics.UI.Phooey.CallBackT                      Graphics.UI.Phooey.TagT                      Graphics.UI.Phooey.LayoutT                      Graphics.UI.Phooey.MonadUI-                     Graphics.UI.Phooey.AmA+                     Graphics.UI.Phooey.AFA                      Graphics.UI.Phooey.ArrowUI Extra-Source-Files:                      Examples

@@ -9,9 +9,7 @@ -- Stability   :  experimental -- Portability :  portable -- --- Phooey examples.------ Run them with 'runUI'+-- Phooey examples.  Run them with 'runUI' ----------------------------------------------------------------------  module Examples where

@@ -0,0 +1,51 @@+{-# 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)

@@ -1,54 +0,0 @@-{-# 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)

@@ -29,13 +29,12 @@   import Control.Arrow-import Graphics.UI.WX (Layout,boxed)  import Graphics.UI.Phooey.Imperative (Source,skip) import Graphics.UI.Phooey.TagT (Unop) import Graphics.UI.Phooey.LayoutT import qualified Graphics.UI.Phooey.MonadUI as M-import Graphics.UI.Phooey.AmA+import Graphics.UI.Phooey.AFA   {----------------------------------------------------------@@ -43,7 +42,7 @@ ----------------------------------------------------------}  -- | The UI arrow-newtype UI i o = UI (AmA (Kleisli M.UI) IO i o)+newtype UI i o = UI (AFA (Kleisli M.UI) IO i o)   deriving (Arrow,ArrowLoop)  -- | Run a 'UI' with window title \"Phooey GUI\".@@ -52,11 +51,11 @@  -- | Run a 'UI' with given window title. runNamedUI :: String -> UI () () -> IO ()-runNamedUI str (UI (AmA (Kleisli f))) = M.runUI str (f skip >> return ())+runNamedUI str (UI (AFA (Kleisli f))) = M.runNamedUI str (f skip)  -- | Wrap up monadic UI function as a 'UI' ui :: (Source i -> M.UI (Source o)) -> UI i o-ui = UI . AmA . Kleisli+ui = UI . AFA . Kleisli   {----------------------------------------------------------@@ -90,7 +89,7 @@  -- | Wrap a title around a 'UI' title :: String -> Unop (UI a b)-title str = mapLayoutU (boxed str)+title str = sourceOp (M.title str)   {----------------------------------------------------------@@ -121,10 +120,7 @@ ---- Misc unexported  sourceOp :: Unop (M.UI (Source b)) -> Unop (UI a b)-sourceOp f (UI (AmA (Kleisli g))) = ui (f . g)--mapLayoutU :: Unop Layout -> Unop (UI a b)-mapLayoutU f = sourceOp (M.mapLayout f)+sourceOp f (UI (AFA (Kleisli g))) = ui (f . g)  onLayoutT :: LayoutTOp IO -> Unop (UI a b) onLayoutT f = sourceOp (M.onLayoutT f)

@@ -19,7 +19,7 @@ -- description.)/ ---------------------------------------------------------------------- -module Graphics.UI.Phooey.CallbackT (CallBackT(..), runCB) where+module Graphics.UI.Phooey.CallBackT (CallBackT(..), runCB) where  import Control.Monad.Reader import Control.Monad.Trans

@@ -44,7 +44,7 @@       return (fromMaybe fempty mbl, a)  -- | Create a window and run a 'LayoutT' in it.-runL :: String -> (Win -> LayoutT IO ()) -> IO ()+runL :: String -> (Win -> LayoutT IO a) -> IO () runL name f = runWio name $ \ win ->   liftM fst (runLayout (f win)) 

@@ -16,7 +16,7 @@ module Graphics.UI.Phooey.MonadUI   (   -- * The UI monad-   UI, runUI+   UI, runUI, runNamedUI   -- * High-level widgets   , stringDisplay, showDisplay, textEntry, islider   , checkBoxDisplay, checkBoxEntry, title@@ -26,13 +26,14 @@   , onLayoutT, mapLayout   ) where +import Control.Applicative import Control.Monad.Reader import Control.Monad.Trans import Graphics.UI.WX hiding (textEntry) import qualified Graphics.UI.WX as WX  import Graphics.UI.Phooey.Imperative-import Graphics.UI.Phooey.CallbackT+import Graphics.UI.Phooey.CallBackT import Graphics.UI.Phooey.TagT (Unop,mkTag,mapTag) import Graphics.UI.Phooey.LayoutT @@ -44,18 +45,22 @@ -- | The UI monad type UI = CallBackT (ReaderT Win (LayoutT IO)) --- | Run a 'UI'.-runUI :: String -> UI () -> IO ()-runUI name = runL name . runReaderT . runCB (lift.lift)+instance Functor UI where { fmap = (<$>) }+instance Applicative UI where { pure = return; (<*>) = ap } +-- | Run a 'UI' with window title \"Monadic Phooey GUI\".+runUI :: UI (Source ()) -> IO ()+runUI = runNamedUI "Monadic Phooey GUI" +-- | Run a 'UI' with given window title.+runNamedUI :: String -> UI (Source ()) -> IO ()+runNamedUI name = runL name . runReaderT . runCB (lift.lift)++ {----------------------------------------------------------     High-level widgets ----------------------------------------------------------} -mkText :: WX.Window a -> IO (WX.TextCtrl ())-mkText win = WX.textEntry win []- -- | String display widget stringDisplay :: Source String -> UI (Source ()) stringDisplay src = mkHWidget $ \ win ->@@ -73,6 +78,10 @@   do  ctl <- mkText win       return  (  Just (hwidget ctl)               ,  (get ctl text, onCommand ctl, skip))++mkText :: WX.Window a -> IO (WX.TextCtrl ())+mkText win = WX.textEntry win []+  -- | Slider widget with static initial value and dynamic bounds (min,max) islider :: Int -> Source (Int,Int) -> UI (Source Int)

@@ -0,0 +1,27 @@+{-# OPTIONS #-}
+
+----------------------------------------------------------------------
+-- |
+-- Module      :  MonadExamples
+-- Copyright   :  (c) Conal Elliott 2007
+-- License     :  LGPL
+-- 
+-- Maintainer  :  conal@conal.net
+-- Stability   :  experimental
+-- Portability :  portable
+-- 
+-- Monadic UI examples
+----------------------------------------------------------------------
+
+module MonadExamples where
+
+import Control.Monad (liftM2)
+
+import Graphics.UI.Phooey.Imperative (Source)
+import Graphics.UI.Phooey.MonadUI
+
+ui1  ::  UI (Source ())
+ui1  =   title "Shopping List" $
+         do  a  <- title "apples"   (islider 3  (return (0,10)))
+             b  <- title "bananas"  (islider 7  (return (0,10)))
+             title "total" (showDisplay (liftM2 (+) a b))