Gideon Sireling avatar Gideon Sireling committed 4951ed3

basic data binding

Comments (0)

Files changed (7)

binding-core/binding-core.cabal

+name:           binding-core
+version:        0.1
+cabal-version:  >= 1.2
+author:         Gideon Sireling
+synopsis:       Core data binding functionality
+build-type:     Simple
+category:       GUI, User Interfaces
+
+library
+  build-depends:   base, stm
+  hs-source-dirs:  src
+  exposed-modules: Binding.Core, Binding.Variable

binding-core/src/Binding/Core.hs

+{-# LANGUAGE ExistentialQuantification #-}
+module Binding.Core (Source, newSource, bindSource, readSource, writeSource, modifySource) 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 (d -> t -> IO ())
+
+-- | A binding source
+data Source v a = Variable v => Source {bindings::v [Binding a] -- ^ The source's bindings
+                                       ,source::v a}            -- ^ The data source
+
+-- | Update a single binding
+update' :: a -> Binding a -> IO ()
+update' source (Binding extract target apply) = apply (extract source) target
+
+-- | Update a binding source's bindings
+update :: Source v a -> IO ()
+update (Source bindings source) = do bindings <- readVar bindings
+                                     source <- readVar source
+                                     mapM_ (update' source) bindings
+
+-- | Create a binding source
+newSource :: Variable v => a -> IO (Source v a)
+newSource a = do source <- newVar a
+                 bindings <- newVar []
+                 return $ Source bindings source
+
+-- | Create a data binding
+bindSource :: Source v a        -- ^ The binding source
+           -> (a -> d)          -- ^ A function that extracts data from the source
+           -> t                 -- ^ The binding target
+           -> (d -> t -> IO ()) -- ^ A function that applies data to the target
+           -> IO ()
+bindSource (Source bindings source) extract target apply =
+    do let binding = Binding extract target apply
+       --activate the new binding
+       source <- readVar source
+       update' source binding
+       --add the new binding to the list
+       modifyVar bindings (binding:)
+
+-- | Read a binding source
+readSource :: Variable v => Source v a -> IO a
+readSource a = readVar (source a)
+
+-- | Write a binding source's data
+writeSource :: Variable v => Source v a -> a -> IO ()
+writeSource a d = writeVar (source a) d >> update a
+
+-- | Modify a binding source's data
+modifySource :: Variable v => Source v a -> (a -> a) -> IO ()
+modifySource a f = modifyVar (source a) f >> update a
+
+-- | Modify a binding source's data
+modifySource' :: Variable v => Source v a -> (a -> (a,b)) -> IO b
+modifySource' a f = do b <- modifyVar' (source a) f
+                       update a
+                       return b

binding-core/src/Binding/Variable.hs

+module Binding.Variable where
+
+import Data.IORef
+import Control.Concurrent.MVar
+import Control.Concurrent.STM
+
+-- | Mutable variables in the IO Monad
+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
+    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

binding-gtk/binding-gtk.cabal

+name:           binding-gtk
+version:        0.1
+cabal-version:  >= 1.2
+author:         Gideon Sireling
+synopsis:       Gtk2Hs interface for Data Binding
+build-type:     Simple
+category:       GUI, User Interfaces
+
+library
+  build-depends:   base, gtk, binding-core
+  hs-source-dirs:  src

binding-gtk/src/Binding/Gtk.hs

+module Binding.Gtk where
+
+import Control.Monad
+import Control.Monad.Trans
+import Graphics.UI.Gtk
+
+import Binding.Variable
+import Binding.Core
+
+-- | Bind a 'Source' to a control
+bindToControl :: Source v 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 = bindSource source extract control (\d t -> set t [attribute := d])
+
+-- | Bind from a control to a 'Source'
+-- The source is updated when the control loses focus
+bindFromControl :: (WidgetClass c, Variable v) =>
+                   c          -- ^ The control
+                -> Attr c d   -- ^ The attribute of the control to bind from
+                -> (d -> a)   -- ^ A function that applies data to the source
+                -> Source v a -- ^ The binding source
+                -> IO (ConnectId c)
+bindFromControl control attribute apply source =
+    control `on` focusOutEvent $ liftIO $ do t <- get control attribute
+                                             writeSource source (apply t)
+                                             return False
+
+-- | Create a two-way data binding
+bindControl :: (WidgetClass c, Variable v) =>
+               Source v 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
+            -> (d -> a)   -- ^ A function that applies data from the control to the source
+            -> IO (ConnectId c)
+bindControl source extract control attribute apply = do
+    bindSource source extract control (\d t -> set t [attribute := d])
+    control `on` focusOutEvent $ liftIO $ do t <- get control attribute
+                                             writeSource source (apply t)
+                                             return False
+
+-- | Create a simple two-way data binding for a 'Textual' control
+bindTextEntry :: (Show a, Read a, EntryClass c, WidgetClass c, Variable v) =>
+                  Source v a -- ^ The binding source
+               -> c          -- ^ The control
+               -> IO (ConnectId c)
+bindTextEntry source control = do
+    bindSource source show control (\d t -> set t [entryText := d])
+    control `on` focusOutEvent $ liftIO $ do t <- get control entryText
+                                             writeSource source (read t)
+                                             return False

binding-wx/binding-wx.cabal

+name:           binding-wx
+version:        0.1
+cabal-version:  >= 1.2
+author:         Gideon Sireling
+synopsis:       WxHaskell interface for Data Binding
+build-type:     Simple
+category:       GUI, User Interfaces
+
+library
+    build-depends:   base, wx, binding-core
+    hs-source-dirs:  src

binding-wx/src/Binding/Wx.hs

+-- WxHaskell declares @type Var a = Tvar a@ as the standard type for mutable variables.
+module Binding.Wx where
+
+import Control.Monad
+import Control.Concurrent.STM
+import Graphics.UI.WX.Attributes
+import Graphics.UI.WX.Classes
+import Graphics.UI.WX.Events
+
+import Binding.Core
+
+-- | Bind a 'Source' to a control
+bindToControl :: Source TVar 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 = bindSource source extract control (\d t -> set t [attribute := d])
+
+-- | Bind from a control to a 'Source'
+-- The source is updated when the control loses focus
+bindFromControl :: Reactive c => c -- ^ The control
+                -> Attr c d        -- ^ The attribute of the control to bind from
+                -> (d -> a)        -- ^ A function that applies data to the source
+                -> Source TVar a   -- ^ The binding source
+                -> IO ()
+bindFromControl control attribute apply source =
+    set control [on focus := \f -> unless f $ do d <- get control attribute
+                                                 writeSource source (apply d)
+                                                 propagateEvent]
+
+-- | Create a two-way data binding
+bindControl :: Reactive c =>
+               Source TVar 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
+            -> (d -> a)      -- ^ A function that applies data from the control to the source
+            -> IO ()
+bindControl source extract control attribute apply = do
+    bindSource source extract control (\d c -> set c [attribute := d])
+    set control [on focus := \f -> unless f $ do d <- get control attribute
+                                                 writeSource source (apply d)
+                                                 propagateEvent]
+
+-- | Create a simple two-way data binding for a 'Textual' control
+bindTextual :: (Show a, Read a, Textual c, Reactive c) =>
+               Source TVar a -- ^ The binding source
+            -> c             -- ^ The control
+            -> IO ()
+bindTextual source control = do
+    bindSource source show control (\d c -> set c [text := d])
+    set control [on focus := \f -> unless f $ do d <- get control text
+                                                 writeSource source (read d)
+                                                 propagateEvent]
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.