Commits

Gideon Sireling committed fa6d3b6

refactor module names

  • Participants
  • Parent commits 8f3a4ab

Comments (0)

Files changed (19)

File binding-core/binding-core.cabal

 library
   build-depends:   base, stm
   hs-source-dirs:  src
-  exposed-modules: Binding.Variable, Binding.Core, Binding.List
+  exposed-modules: Data.Binding.Simple, Data.Binding.List, Data.Variable
 
 test-suite hunit
   type:            exitcode-stdio-1.0

File binding-core/src/Binding/Core.hs

-{-# LANGUAGE ExistentialQuantification #-}
-module Binding.Core (module Binding.Variable, Bindable, bind, Source) where
-
-import Binding.Variable
-
--- | A data binding:
--- @a@ is the type of the data source
--- @a -> d@ is a function that extracts data from the source
--- @t@ is the binding target
--- @d -> t -> IO ()@ is a function that applies data to the target
-data Binding a = forall d t. Binding (a -> d) t (t -> d -> IO ())
-
--- | A simple binding source.
-data Source v a = Variable v => Source {bindings :: v [Binding a] -- ^ the source's bindings
-                                       ,var      :: v a}          -- ^ the bound variable
-
--- | Update a single binding.
-update' :: a -> Binding a -> IO ()
-update' source (Binding extract target apply) = apply target $ extract source
-
--- | Update a binding source's bindings.
-update :: Source v a -> IO ()
-update (Source bindings var) = do bindings <- readVar bindings
-                                  a <- readVar var
-                                  mapM_ (update' a) bindings
-
-instance Variable v => Variable (Source v) where
-   newVar a = do bindings <- newVar []
-                 v <- newVar a
-                 return $ Source bindings v
-
-   readVar = readVar . var
-
-   writeVar s a = writeVar (var s) a >> update s
-
-   modifyVar s f = modifyVar (var s) f >> update s
-
-   modifyVar' s f = do b <- modifyVar' (var s) f
-                       update s
-                       return b
-
--- | Binding sources.
-class Variable b => Bindable b where
-   -- | Create a data binding
-   bind :: b a               -- ^ the binding source
-        -> (a -> d)          -- ^ a function that extracts data from the source
-        -> t                 -- ^ the binding target
-        -> (t -> d -> IO ()) -- ^ a function that applies data to the target
-        -> IO ()
-
-instance Variable v => Bindable (Source v) where
-   bind (Source bindings var) extract target apply =
-      do let binding = Binding extract target apply
-         --update the new binding
-         a <- readVar var
-         update' a binding
-         --add the new binding to the list
-         modifyVar bindings (binding:)

File binding-core/src/Binding/List.hs

-{-# LANGUAGE ExistentialQuantification #-}
-module Binding.List (module Binding.Core, BindingList, toBindingList, fromBindingList, length, position, seek, seekBy, next, prev, remove', remove, insert', insert) where
-
-import Prelude hiding (length)
-import qualified Prelude as P
-import Control.Monad
-
-import Binding.Core
-
--- | Associates a binding source with a list of data sources.
-data BindingList v a = Variable v => BindingList {source :: Source v a -- ^ the list's binding source
-                                                 ,list   :: v [v a]    -- ^ the bound list
-                                                 ,pos    :: v Int}     -- ^ the current position
--- [v a] is itself in a Variable, to allow for insertions and deletions.
-
--- | Create a binding list.
-toBindingList :: Variable v => [a] -> IO (BindingList v a)
-toBindingList [] = error "empty list"
-toBindingList list = do list'<- mapM newVar list >>= newVar
-                        source <- newVar (head list)
-                        pos <- newVar 0
-                        return $ BindingList source list' pos
-
--- | Update the binding list from the 'source'.
-update :: BindingList v a -> IO ()
-update (BindingList source list pos) = do list' <- readVar list
-                                          pos' <- readVar pos
-                                          readVar source >>= writeVar (list' !! pos')
-
--- | Extract the data from a binding list.
-fromBindingList :: Variable v => BindingList v a -> IO [a]
-fromBindingList b = do update b
-                       readVar (list b) >>= mapM readVar
-
--- | interface to the binding list's 'Source'
-instance Variable v => Variable (BindingList v) where
-   {- WARNING warn "Did you mean to use newBindingList?" -}
-   newVar = warn where warn a = toBindingList [a]
-   readVar = readVar . source
-   writeVar = writeVar . source
-   modifyVar = modifyVar . source
-   modifyVar' = modifyVar' . source
-
-instance Variable v => Bindable (BindingList v) where
-   bind = bind . source
-
--- | The size of a binding list.
-length :: Variable v => BindingList v a -> IO Int
-length b = do list <- readVar (list b)
-              return $ P.length list
-
--- | Get the current position.
-position :: Variable v => BindingList v a -> IO Int
-position b = readVar $ pos b
-
--- | Bind to a new position in a binding list.
--- Returns the new position; this is convenient for 'seekBy' and friends.
-seek:: Variable v => BindingList v a -> Int -> IO Int
-seek b new = do pos' <- readVar $ pos b
-                if pos' == new then return new else update b >> seek' b new
-
--- | Unconditional seek. Called after elements have changed position.
-seek':: BindingList v a -> Int -> IO Int
-seek' (BindingList source list pos) new = do list' <- readVar list
-                                             readVar (list' !! new) >>= writeVar source
-                                             writeVar pos new
-                                             return new
-
--- | Bind to a new position in a binding list.
-seekBy :: Variable v => (Int -> Int) -> BindingList v a -> IO Int
-seekBy f bindingList = do pos <- readVar (pos bindingList)
-                          seek bindingList $ f pos
-
--- | Bind to the next item in a binding list.
-next :: Variable v => BindingList v a -> IO Int
-next = seekBy succ
-
--- | Bind to the previous item in a binding list.
-prev :: Variable v => BindingList v a -> IO Int
-prev = seekBy pred
-
--- | Remove an element from a list.
-remove' :: [a] -> Int ->  [a]
-remove' list pos = let (xs, _:ys) = splitAt pos list
-                   in xs ++ ys
-
--- | Remove the current element from the list.
-remove :: BindingList v a -> IO Int
-remove b@(BindingList _ list pos) = do list' <- readVar list
-                                       pos' <- readVar pos
-                                       writeVar list $ remove' list' pos'
-                                       seek' b (if pos' == P.length list' - 1 then pos' - 1 else pos')
-
--- | Insert an element into a list.
-insert' :: [a] -> Int -> a -> [a]
-insert' list pos x = let (xs, ys) = splitAt pos list
-                     in xs ++ [x] ++ ys
-
--- | Insert an element into the list.
--- The new element is inserted after the current element.
--- This allows appending, but precludes prepending.
-insert :: BindingList v a -> a -> IO Int
-insert b@(BindingList _ list pos) x = do update b
-                                         list' <- readVar list
-                                         pos' <- readVar pos
-                                         x' <- newVar x
-                                         let pos'' = pos' + 1
-                                         writeVar list $ insert' list' pos'' x'
-                                         seek' b pos''

File binding-core/src/Binding/Variable.hs

--- | Mutable variables in the IO Monad
-module Binding.Variable where
-
-import Data.IORef
-import Control.Concurrent.MVar
-import Control.Concurrent.STM
-
-class Variable v where
-   -- | Create a new variable.
-   newVar     :: a -> IO (v a)
-   -- | Read a variable.
-   readVar    :: v a -> IO a
-   -- | Write a variable.
-   writeVar   :: v a -> a -> IO ()
-   -- | Modify a variable.
-   modifyVar  :: v a -> (a -> a) -> IO ()
-   -- | Modify a variable, and return some value.
-   modifyVar' :: v a -> (a -> (a,b)) -> IO b
-
-instance Variable IORef where
-   newVar     = newIORef
-   readVar    = readIORef
-   writeVar   = writeIORef
-   modifyVar  = modifyIORef
-   modifyVar' = atomicModifyIORef
-
-instance Variable MVar where
-   newVar         = newMVar
-   readVar        = takeMVar
-   writeVar       = putMVar
-   modifyVar v f  = modifyMVar_ v (return . f)
-   modifyVar' v f = modifyMVar v (return . f)
-
-instance Variable TVar where
-   newVar         = newTVarIO
-
-   readVar        = readTVarIO
-
-   writeVar v x   = atomically $ writeTVar v x
-
-   modifyVar v f  = atomically $ do x <- readTVar v
-                                    writeTVar v (f x)
-
-   modifyVar' v f = atomically $ do x <- readTVar v
-                                    let (x', y) = f x
-                                    writeTVar v x'
-                                    return y
-
-instance Variable TMVar where
-   newVar         = newTMVarIO
-
-   readVar v      = atomically $ takeTMVar v
-
-   writeVar v x   = atomically $ putTMVar v x
-
-   modifyVar v f  = atomically $ do x <- takeTMVar v
-                                    putTMVar v (f x)
-
-   modifyVar' v f = atomically $ do x <- takeTMVar v
-                                    let (x', y) = f x
-                                    putTMVar v x'
-                                    return y

File binding-core/src/Data/Binding/List.hs

+{-# LANGUAGE ExistentialQuantification #-}
+module Data.Binding.List (module Data.Binding.Simple, BindingList, toBindingList, fromBindingList, length, position, seek, seekBy, next, prev, remove', remove, insert', insert) where
+
+import Prelude hiding (length)
+import qualified Prelude as P
+import Control.Monad
+
+import Data.Binding.Simple
+
+-- | Associates a binding source with a list of data sources.
+data BindingList v a = Variable v => BindingList {source :: Source v a -- ^ the list's binding source
+                                                 ,list   :: v [v a]    -- ^ the bound list
+                                                 ,pos    :: v Int}     -- ^ the current position
+-- [v a] is itself in a Variable, to allow for insertions and deletions.
+
+-- | Create a binding list.
+toBindingList :: Variable v => [a] -> IO (BindingList v a)
+toBindingList [] = error "empty list"
+toBindingList list = do list'<- mapM newVar list >>= newVar
+                        source <- newVar (head list)
+                        pos <- newVar 0
+                        return $ BindingList source list' pos
+
+-- | Update the binding list from the 'source'.
+update :: BindingList v a -> IO ()
+update (BindingList source list pos) = do list' <- readVar list
+                                          pos' <- readVar pos
+                                          readVar source >>= writeVar (list' !! pos')
+
+-- | Extract the data from a binding list.
+fromBindingList :: Variable v => BindingList v a -> IO [a]
+fromBindingList b = do update b
+                       readVar (list b) >>= mapM readVar
+
+-- | interface to the binding list's 'Source'
+instance Variable v => Variable (BindingList v) where
+   {- WARNING warn "Did you mean to use newBindingList?" -}
+   newVar = warn where warn a = toBindingList [a]
+   readVar = readVar . source
+   writeVar = writeVar . source
+   modifyVar = modifyVar . source
+   modifyVar' = modifyVar' . source
+
+instance Variable v => Bindable (BindingList v) where
+   bind = bind . source
+
+-- | The size of a binding list.
+length :: Variable v => BindingList v a -> IO Int
+length b = do list <- readVar (list b)
+              return $ P.length list
+
+-- | Get the current position.
+position :: Variable v => BindingList v a -> IO Int
+position b = readVar $ pos b
+
+-- | Bind to a new position in a binding list.
+-- Returns the new position; this is convenient for 'seekBy' and friends.
+seek:: Variable v => BindingList v a -> Int -> IO Int
+seek b new = do pos' <- readVar $ pos b
+                if pos' == new then return new else update b >> seek' b new
+
+-- | Unconditional seek. Called after elements have changed position.
+seek':: BindingList v a -> Int -> IO Int
+seek' (BindingList source list pos) new = do list' <- readVar list
+                                             readVar (list' !! new) >>= writeVar source
+                                             writeVar pos new
+                                             return new
+
+-- | Bind to a new position in a binding list.
+seekBy :: Variable v => (Int -> Int) -> BindingList v a -> IO Int
+seekBy f bindingList = do pos <- readVar (pos bindingList)
+                          seek bindingList $ f pos
+
+-- | Bind to the next item in a binding list.
+next :: Variable v => BindingList v a -> IO Int
+next = seekBy succ
+
+-- | Bind to the previous item in a binding list.
+prev :: Variable v => BindingList v a -> IO Int
+prev = seekBy pred
+
+-- | Remove an element from a list.
+remove' :: [a] -> Int ->  [a]
+remove' list pos = let (xs, _:ys) = splitAt pos list
+                   in xs ++ ys
+
+-- | Remove the current element from the list.
+remove :: BindingList v a -> IO Int
+remove b@(BindingList _ list pos) = do list' <- readVar list
+                                       pos' <- readVar pos
+                                       writeVar list $ remove' list' pos'
+                                       seek' b (if pos' == P.length list' - 1 then pos' - 1 else pos')
+
+-- | Insert an element into a list.
+insert' :: [a] -> Int -> a -> [a]
+insert' list pos x = let (xs, ys) = splitAt pos list
+                     in xs ++ [x] ++ ys
+
+-- | Insert an element into the list.
+-- The new element is inserted after the current element.
+-- This allows appending, but precludes prepending.
+insert :: BindingList v a -> a -> IO Int
+insert b@(BindingList _ list pos) x = do update b
+                                         list' <- readVar list
+                                         pos' <- readVar pos
+                                         x' <- newVar x
+                                         let pos'' = pos' + 1
+                                         writeVar list $ insert' list' pos'' x'
+                                         seek' b pos''

File binding-core/src/Data/Binding/Simple.hs

+{-# LANGUAGE ExistentialQuantification #-}
+module Data.Binding.Simple (module Data.Variable, Bindable, bind, Source) where
+
+import Data.Variable
+
+-- | A data binding:
+-- @a@ is the type of the data source
+-- @a -> d@ is a function that extracts data from the source
+-- @t@ is the binding target
+-- @d -> t -> IO ()@ is a function that applies data to the target
+data Binding a = forall d t. Binding (a -> d) t (t -> d -> IO ())
+
+-- | A simple binding source.
+data Source v a = Variable v => Source {bindings :: v [Binding a] -- ^ the source's bindings
+                                       ,var      :: v a}          -- ^ the bound variable
+
+-- | Update a single binding.
+update' :: a -> Binding a -> IO ()
+update' source (Binding extract target apply) = apply target $ extract source
+
+-- | Update a binding source's bindings.
+update :: Source v a -> IO ()
+update (Source bindings var) = do bindings <- readVar bindings
+                                  a <- readVar var
+                                  mapM_ (update' a) bindings
+
+instance Variable v => Variable (Source v) where
+   newVar a = do bindings <- newVar []
+                 v <- newVar a
+                 return $ Source bindings v
+
+   readVar = readVar . var
+
+   writeVar s a = writeVar (var s) a >> update s
+
+   modifyVar s f = modifyVar (var s) f >> update s
+
+   modifyVar' s f = do b <- modifyVar' (var s) f
+                       update s
+                       return b
+
+-- | Binding sources.
+class Variable b => Bindable b where
+   -- | Create a data binding
+   bind :: b a               -- ^ the binding source
+        -> (a -> d)          -- ^ a function that extracts data from the source
+        -> t                 -- ^ the binding target
+        -> (t -> d -> IO ()) -- ^ a function that applies data to the target
+        -> IO ()
+
+instance Variable v => Bindable (Source v) where
+   bind (Source bindings var) extract target apply =
+      do let binding = Binding extract target apply
+         --update the new binding
+         a <- readVar var
+         update' a binding
+         --add the new binding to the list
+         modifyVar bindings (binding:)

File binding-core/src/Data/Variable.hs

+-- | Mutable variables in the IO Monad
+module Data.Variable where
+
+import Data.IORef
+import Control.Concurrent.MVar
+import Control.Concurrent.STM
+
+class Variable v where
+   -- | Create a new variable.
+   newVar     :: a -> IO (v a)
+   -- | Read a variable.
+   readVar    :: v a -> IO a
+   -- | Write a variable.
+   writeVar   :: v a -> a -> IO ()
+   -- | Modify a variable.
+   modifyVar  :: v a -> (a -> a) -> IO ()
+   -- | Modify a variable, and return some value.
+   modifyVar' :: v a -> (a -> (a,b)) -> IO b
+
+instance Variable IORef where
+   newVar     = newIORef
+   readVar    = readIORef
+   writeVar   = writeIORef
+   modifyVar  = modifyIORef
+   modifyVar' = atomicModifyIORef
+
+instance Variable MVar where
+   newVar         = newMVar
+   readVar        = takeMVar
+   writeVar       = putMVar
+   modifyVar v f  = modifyMVar_ v (return . f)
+   modifyVar' v f = modifyMVar v (return . f)
+
+instance Variable TVar where
+   newVar         = newTVarIO
+
+   readVar        = readTVarIO
+
+   writeVar v x   = atomically $ writeTVar v x
+
+   modifyVar v f  = atomically $ do x <- readTVar v
+                                    writeTVar v (f x)
+
+   modifyVar' v f = atomically $ do x <- readTVar v
+                                    let (x', y) = f x
+                                    writeTVar v x'
+                                    return y
+
+instance Variable TMVar where
+   newVar         = newTMVarIO
+
+   readVar v      = atomically $ takeTMVar v
+
+   writeVar v x   = atomically $ putTMVar v x
+
+   modifyVar v f  = atomically $ do x <- takeTMVar v
+                                    putTMVar v (f x)
+
+   modifyVar' v f = atomically $ do x <- takeTMVar v
+                                    let (x', y) = f x
+                                    putTMVar v x'
+                                    return y

File binding-core/tests/HUnit.hs

 import System.Exit
 import System.Random
 
-import Binding.List as B
+import Data.Binding.List as B
 import Prelude as P
 
 -- Change these to exercise different variable and data types

File binding-core/tests/QuickCheck.hs

 import Data.IORef
 import System.Exit
 
-import Binding.List as B
+import Data.Binding.List as B
 import Prelude as P
 
 -- Change these to exercise different variable and data types

File binding-gtk/binding-gtk.cabal

 library
   build-depends:   base, gtk, binding-core, mtl
   hs-source-dirs:  src
-  exposed-modules: Binding.Gtk
+  exposed-modules: Graphics.UI.Gtk.Binding
 
 source-repository head
   type:     hg

File binding-gtk/demo/lists.hs

 import Control.Monad
 import Graphics.UI.Gtk
 
-import Binding.List
-import Binding.Gtk
+import Data.Binding.List
+import Graphics.UI.Gtk.Binding
 
 data Person = Person {name::String, age::Int, active::Bool} deriving (Read, Show)
 

File binding-gtk/demo/simple.hs

 import Data.IORef
 import Graphics.UI.Gtk
 
-import Binding.Core
-import Binding.Gtk
+import Data.Binding.Simple
+import Graphics.UI.Gtk.Binding
 
 main = do --create widgits
           initGUI

File binding-gtk/src/Binding/Gtk.hs

-{-# LANGUAGE FlexibleContexts #-}
-module Binding.Gtk where
-
-import Control.Monad
-import Control.Monad.Trans
-import Graphics.UI.Gtk
-
-import Binding.List as B
-
--- | Bind a 'Source' to a control.
-bindToControl :: Bindable b =>
-                 b a      -- ^ the binding source
-              -> (a -> d) -- ^ a function that extracts data from the source
-              -> c        -- ^ the target control
-              -> Attr c d -- ^ the attribute of the control to bind to
-              -> IO ()
-bindToControl source extract control attribute = bind source extract control (\c d -> set c [attribute := d])
-
--- | Bind from a control to a 'Source'.
--- The source is updated when the control loses focus.
-bindFromControl :: (WidgetClass c, Bindable b) =>
-                   c             -- ^ the control
-                -> Attr c d      -- ^ the attribute of the control to bind from
-                -> (a -> d -> a) -- ^ a function that applies data from the control to the source
-                -> b a           -- ^ the binding source
-                -> IO (ConnectId c)
-bindFromControl control attribute apply source =
-   control `on` focusOutEvent $ liftIO $ do d <- get control attribute
-                                            a <- readVar source
-                                            writeVar source (apply a d)
-                                            return False
-
--- | Create a two-way data binding.
-bindControl :: (WidgetClass c, Bindable b) =>
-               b a           -- ^ the binding source
-            -> (a -> d)      -- ^ a function that extracts data from the source
-            -> c             -- ^ the control
-            -> Attr c d      -- ^ the attribute of the control to bind to
-            -> (a -> d -> a) -- ^ a function that applies data from the control to the source
-            -> IO (ConnectId c)
-bindControl source extract control attribute apply = do
-   bindToControl source extract control attribute
-   bindFromControl control attribute apply source
-
--- | Create a simple two-way data binding for a 'Textual' control.
-bindTextEntry :: (Show a, Read a, EntryClass c, WidgetClass c, Bindable b) =>
-                  b a -- ^ the binding source
-               -> c   -- ^ the control
-               -> IO (ConnectId c)
-bindTextEntry source control = do
-   bindToControl source show control entryText
-   control `on` focusOutEvent $ liftIO $ do d <- get control entryText
-                                            writeVar source (read d)
-                                            return False
-
--- | Create a set of navigation buttons for a binding list.
-navigation :: Variable v =>
-              BindingList v a -- ^ the binding list
-           -> a               -- ^ the default value for inserts
-           -> IO HButtonBox
-navigation bl new = do spin <- spinButtonNewWithRange 0 1 1
-                       let setRange = B.length bl >>= spinButtonSetRange spin 0 . fromIntegral . pred
-                       setRange
-                       afterValueSpinned spin $ spinButtonGetValueAsInt spin >>= seek bl >> return ()
-                       buttons <- forM [("<<", spinButtonSetValue spin 0)
-                                       ,(">>", spinButtonSpin spin SpinEnd 0)
-                                       ,("+", insert bl new >>= spinButtonSetValue spin . fromIntegral >> setRange)
-                                       ,("-", B.remove bl >>= spinButtonSetValue spin . fromIntegral >> setRange)]
-                                       $ \(l,c) -> do b <- buttonNewWithLabel l
-                                                      on b buttonActivated c
-                                                      return b
-
-                       let del = last buttons
-                       del `on` buttonActivated $ do l <- B.length bl
-                                                     del `set` [widgetSensitive := l > 1]
-
-                       (buttons !! 2) `on` buttonActivated $ del `set` [widgetSensitive := True] --"+"
-
-                       box <- hButtonBoxNew
-                       containerAdd box spin
-                       mapM_ (containerAdd box) buttons
-                       return box

File binding-gtk/src/Graphics/UI/Gtk/Binding.hs

+{-# LANGUAGE FlexibleContexts #-}
+module Graphics.UI.Gtk.Binding where
+
+import Control.Monad
+import Control.Monad.Trans
+import Graphics.UI.Gtk
+
+import Data.Binding.List as B
+
+-- | Bind a 'Source' to a control.
+bindToControl :: Bindable b =>
+                 b a      -- ^ the binding source
+              -> (a -> d) -- ^ a function that extracts data from the source
+              -> c        -- ^ the target control
+              -> Attr c d -- ^ the attribute of the control to bind to
+              -> IO ()
+bindToControl source extract control attribute = bind source extract control (\c d -> set c [attribute := d])
+
+-- | Bind from a control to a 'Source'.
+-- The source is updated when the control loses focus.
+bindFromControl :: (WidgetClass c, Bindable b) =>
+                   c             -- ^ the control
+                -> Attr c d      -- ^ the attribute of the control to bind from
+                -> (a -> d -> a) -- ^ a function that applies data from the control to the source
+                -> b a           -- ^ the binding source
+                -> IO (ConnectId c)
+bindFromControl control attribute apply source =
+   control `on` focusOutEvent $ liftIO $ do d <- get control attribute
+                                            a <- readVar source
+                                            writeVar source (apply a d)
+                                            return False
+
+-- | Create a two-way data binding.
+bindControl :: (WidgetClass c, Bindable b) =>
+               b a           -- ^ the binding source
+            -> (a -> d)      -- ^ a function that extracts data from the source
+            -> c             -- ^ the control
+            -> Attr c d      -- ^ the attribute of the control to bind to
+            -> (a -> d -> a) -- ^ a function that applies data from the control to the source
+            -> IO (ConnectId c)
+bindControl source extract control attribute apply = do
+   bindToControl source extract control attribute
+   bindFromControl control attribute apply source
+
+-- | Create a simple two-way data binding for a 'Textual' control.
+bindTextEntry :: (Show a, Read a, EntryClass c, WidgetClass c, Bindable b) =>
+                  b a -- ^ the binding source
+               -> c   -- ^ the control
+               -> IO (ConnectId c)
+bindTextEntry source control = do
+   bindToControl source show control entryText
+   control `on` focusOutEvent $ liftIO $ do d <- get control entryText
+                                            writeVar source (read d)
+                                            return False
+
+-- | Create a set of navigation buttons for a binding list.
+navigation :: Variable v =>
+              BindingList v a -- ^ the binding list
+           -> a               -- ^ the default value for inserts
+           -> IO HButtonBox
+navigation bl new = do spin <- spinButtonNewWithRange 0 1 1
+                       let setRange = B.length bl >>= spinButtonSetRange spin 0 . fromIntegral . pred
+                       setRange
+                       afterValueSpinned spin $ spinButtonGetValueAsInt spin >>= seek bl >> return ()
+                       buttons <- forM [("<<", spinButtonSetValue spin 0)
+                                       ,(">>", spinButtonSpin spin SpinEnd 0)
+                                       ,("+", insert bl new >>= spinButtonSetValue spin . fromIntegral >> setRange)
+                                       ,("-", B.remove bl >>= spinButtonSetValue spin . fromIntegral >> setRange)]
+                                       $ \(l,c) -> do b <- buttonNewWithLabel l
+                                                      on b buttonActivated c
+                                                      return b
+
+                       let del = last buttons
+                       del `on` buttonActivated $ do l <- B.length bl
+                                                     del `set` [widgetSensitive := l > 1]
+
+                       (buttons !! 2) `on` buttonActivated $ del `set` [widgetSensitive := True] --"+"
+
+                       box <- hButtonBoxNew
+                       containerAdd box spin
+                       mapM_ (containerAdd box) buttons
+                       return box

File binding-wx/binding-wx.cabal

 library
   build-depends:   base, wxcore, wx, binding-core, stm
   hs-source-dirs:  src
-  exposed-modules: Binding.Wx
-
+  exposed-modules: Graphics.UI.WX.Binding
+  
 source-repository head
   type:     hg
   location: https://bitbucket.org/accursoft/binding

File binding-wx/demo/lists.hs

 import Data.List
 import Graphics.UI.WX
 
-import Binding.List
-import Binding.Wx
+import Data.Binding.List
+import Graphics.UI.WX.Binding
 
 data Person = Person {name::String, age::Int, active::Bool} deriving (Read, Show)
 

File binding-wx/demo/simple.hs

 import Data.IORef
 import Graphics.UI.WX
 
-import Binding.Core
-import Binding.Wx
+import Data.Binding.Simple
+import Graphics.UI.WX.Binding
 
 main = start $ do --create widgits
                   window <- frame [text := "Data Binding with WxHaskell"]

File binding-wx/src/Binding/Wx.hs

-{-# LANGUAGE RankNTypes #-}
-module Binding.Wx where
-
-import Control.Monad
-import Graphics.UI.WX
-import Graphics.UI.WXCore
-
-import Binding.List as B
-
--- | Bind a 'Source' to a control.
-bindToControl :: Bindable b =>
-                 b a      -- ^ the binding source
-              -> (a -> d) -- ^ a function that extracts data from the source
-              -> c        -- ^ the target control
-              -> Attr c d -- ^ the attribute of the control to bind to
-              -> IO ()
-bindToControl source extract control attribute = bind source extract control (\c d -> set c [attribute := d])
-
--- | Bind from a control to a 'Source'.
--- The source is updated when the control loses focus.
-bindFromControl :: (Bindable b, Reactive c) =>
-                   c             -- ^ the control
-                -> Attr c d      -- ^ the attribute of the control to bind from
-                -> (a -> d -> a) -- ^ a function that applies data from the control to the source
-                -> b a           -- ^ the binding source
-                -> IO ()
-bindFromControl control attribute apply source =
-   set control [on focus := \f -> unless f $ do d <- get control attribute
-                                                a <- readVar source
-                                                writeVar source (apply a d)
-                                                propagateEvent]
-
--- | Create a two-way data binding.
-bindControl :: (Bindable b, Reactive c) =>
-               b a           -- ^ the binding source
-            -> (a -> d)      -- ^ a function that extracts data from the source
-            -> c             -- ^ the control
-            -> Attr c d      -- ^ the attribute of the control to bind to
-            -> (a -> d -> a) -- ^ a function that applies data from the control to the source
-            -> IO ()
-bindControl source extract control attribute apply = do
-   bindToControl source extract control attribute
-   bindFromControl control attribute apply source
-
--- | Create a simple two-way data binding for a 'Textual' control.
-bindTextual :: (Show a, Read a, Bindable b, Textual c, Reactive c) =>
-               b a -- ^ the binding source
-            -> c   -- ^ the control
-            -> IO ()
-bindTextual source control = do
-   bindToControl source show control text
-   set control [on focus := \f -> unless f $ do d <- get control text
-                                                writeVar source (read d)
-                                                propagateEvent]
-
--- | Create a set of navigation buttons for a binding list.
-navigation :: Variable v =>
-              Window w        -- ^ the buttons' owner
-           -> BindingList v a -- ^ the binding list
-           -> a               -- ^ the default value for inserts
-           -> IO Layout
-navigation owner bl new = do spin <- spinCtrl owner 0 1 [on select ::= \s -> get s selection >>= seek bl >> return ()]
-                             let setRange = B.length bl >>= spinCtrlSetRange spin 0 . pred
-                             setRange
-                             let go i = spin `set` [selection := i] >> seek bl i
-                             buttons <- forM [("<<", go 0 >> return ())
-                                             ,(">>", B.length bl >>= go . pred >> return ())
-                                             ,("+", insert bl new >>= go >> setRange)
-                                             ,("-", remove bl >>= go >> setRange)]
-                                             $ \(t,c) -> button owner [text := t, on command := c]
-
-                             let del = last buttons
-                             del `set` [on command :~ (>> do l <- B.length bl
-                                                             del `set` [enabled := l > 1])                                                               ]
-
-                             (buttons !! 2) `set` [on command :~ (>> del `set` [enabled := True])] --"+"
-
-                             return $ row 0 $ widget spin : map widget buttons

File binding-wx/src/Graphics/UI/WX/Binding.hs

+{-# LANGUAGE RankNTypes #-}
+module Graphics.UI.WX.Binding where
+
+import Control.Monad
+import Graphics.UI.WX
+import Graphics.UI.WXCore
+
+import Data.Binding.List as B
+
+-- | Bind a 'Source' to a control.
+bindToControl :: Bindable b =>
+                 b a      -- ^ the binding source
+              -> (a -> d) -- ^ a function that extracts data from the source
+              -> c        -- ^ the target control
+              -> Attr c d -- ^ the attribute of the control to bind to
+              -> IO ()
+bindToControl source extract control attribute = bind source extract control (\c d -> set c [attribute := d])
+
+-- | Bind from a control to a 'Source'.
+-- The source is updated when the control loses focus.
+bindFromControl :: (Bindable b, Reactive c) =>
+                   c             -- ^ the control
+                -> Attr c d      -- ^ the attribute of the control to bind from
+                -> (a -> d -> a) -- ^ a function that applies data from the control to the source
+                -> b a           -- ^ the binding source
+                -> IO ()
+bindFromControl control attribute apply source =
+   set control [on focus := \f -> unless f $ do d <- get control attribute
+                                                a <- readVar source
+                                                writeVar source (apply a d)
+                                                propagateEvent]
+
+-- | Create a two-way data binding.
+bindControl :: (Bindable b, Reactive c) =>
+               b a           -- ^ the binding source
+            -> (a -> d)      -- ^ a function that extracts data from the source
+            -> c             -- ^ the control
+            -> Attr c d      -- ^ the attribute of the control to bind to
+            -> (a -> d -> a) -- ^ a function that applies data from the control to the source
+            -> IO ()
+bindControl source extract control attribute apply = do
+   bindToControl source extract control attribute
+   bindFromControl control attribute apply source
+
+-- | Create a simple two-way data binding for a 'Textual' control.
+bindTextual :: (Show a, Read a, Bindable b, Textual c, Reactive c) =>
+               b a -- ^ the binding source
+            -> c   -- ^ the control
+            -> IO ()
+bindTextual source control = do
+   bindToControl source show control text
+   set control [on focus := \f -> unless f $ do d <- get control text
+                                                writeVar source (read d)
+                                                propagateEvent]
+
+-- | Create a set of navigation buttons for a binding list.
+navigation :: Variable v =>
+              Window w        -- ^ the buttons' owner
+           -> BindingList v a -- ^ the binding list
+           -> a               -- ^ the default value for inserts
+           -> IO Layout
+navigation owner bl new = do spin <- spinCtrl owner 0 1 [on select ::= \s -> get s selection >>= seek bl >> return ()]
+                             let setRange = B.length bl >>= spinCtrlSetRange spin 0 . pred
+                             setRange
+                             let go i = spin `set` [selection := i] >> seek bl i
+                             buttons <- forM [("<<", go 0 >> return ())
+                                             ,(">>", B.length bl >>= go . pred >> return ())
+                                             ,("+", insert bl new >>= go >> setRange)
+                                             ,("-", remove bl >>= go >> setRange)]
+                                             $ \(t,c) -> button owner [text := t, on command := c]
+
+                             let del = last buttons
+                             del `set` [on command :~ (>> do l <- B.length bl
+                                                             del `set` [enabled := l > 1])                                                               ]
+
+                             (buttons !! 2) `set` [on command :~ (>> del `set` [enabled := True])] --"+"
+
+                             return $ row 0 $ widget spin : map widget buttons