Commits

Gideon Sireling  committed 60913a0

refactor

  • Participants
  • Parent commits dfa9dbe

Comments (0)

Files changed (5)

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

 -- @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 ())
+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'a bindings
 
 -- | Update a single binding.
 update' :: a -> Binding a -> IO ()
-update' source (Binding extract target apply) = apply (extract source) target
+update' source (Binding extract target apply) = apply target $ extract source
 
 -- | Update a binding source's bindings.
 update :: Source v a -> IO ()
     bind :: b 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
+         -> (t -> d -> IO ()) -- ^ A function that applies data to the target
          -> IO ()
 
 instance Variable v => Bindable (Source v) where

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, insert) where
+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
 prev :: Variable v => BindingList v a -> IO Int
 prev = seekBy pred
 
+-- | Remove an elment from a list.
+remove' :: Int -> [a] -> [a]
+remove' pos list = 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
-                                       let (xs, _:ys) = splitAt pos' list'
-                                       writeVar list $ xs ++ ys
-                                       seek' b (if null ys then pos' - 1 else pos')
+                                       writeVar list $ remove' pos' list'
+                                       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' x pos list = 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
-                                         let new = pos' + 1
                                          x' <- newVar x
-                                         let (xs, ys) = splitAt new list'
-                                         writeVar list $ xs ++ [x'] ++ ys
-                                         seek' b new
+                                         let pos'' = pos' + 1
+                                         writeVar list $ insert' x' pos'' list'
+                                         seek' b pos''

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

+-- | Mutable variables in the IO Monad
 module Binding.Variable where
 
 import Data.IORef

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

               -> 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 (\d c -> set c [attribute := d])
+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.
             -> (a -> d -> a) -- ^ A function that applies data from the control to the source
             -> IO (ConnectId c)
 bindControl source extract control attribute apply = do
-    bind source extract control (\d c -> set c [attribute := d])
+    bindToControl source extract control attribute
     bindFromControl control attribute apply source
 
 -- | Create a simple two-way data binding for a 'Textual' control.
                -> c   -- ^ The control
                -> IO (ConnectId c)
 bindTextEntry source control = do
-    bind source show control (\d c -> set c [entryText := d])
+    bindToControl source show control entryText
     control `on` focusOutEvent $ liftIO $ do d <- get control entryText
                                              writeVar source (read d)
                                              return False

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

               -> 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 (\d c -> set c [attribute := d])
+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.
             -> (a -> d -> a) -- ^ A function that applies data from the control to the source
             -> IO ()
 bindControl source extract control attribute apply = do
-    bind source extract control (\d c -> set c [attribute := d])
+    bindToControl source extract control attribute
     bindFromControl control attribute apply source
 
 -- | Create a simple two-way data binding for a 'Textual' control.
             -> c   -- ^ The control
             -> IO ()
 bindTextual source control = do
-    bind source show control (\d c -> set c [text := d])
+    bindToControl source show control text
     set control [on focus := \f -> unless f $ do d <- get control text
                                                  writeVar source (read d)
                                                  propagateEvent]