packages feed

keera-hails-reactive-gtk (empty) → 0.0.3.5

raw patch · 18 files changed

+476/−0 lines, 18 filesdep +basedep +gtkdep +gtk-helperssetup-changed

Dependencies added: base, gtk, gtk-helpers, keera-hails-reactivevalues, mtl, transformers

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2012, Ivan Perez++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Ivan Perez nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ keera-hails-reactive-gtk.cabal view
@@ -0,0 +1,77 @@+-- hails.cabal auto-generated by cabal init. For additional options,+-- see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package.+Name:                keera-hails-reactive-gtk++-- The package version. See the Haskell package versioning policy+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for+-- standards guiding when and how versions should be incremented.+Version:             0.0.3.5++-- A short (one-line) description of the package.+Synopsis:            Haskell on Gtk rails - Reactive Fields for Gtk widgets++-- A longer description of the package.+-- Description:         ++-- URL for the project homepage or repository.+Homepage:            http://www.keera.es/blog/community/++-- The license under which the package is released.+License:             BSD3++-- The file containing the license text.+License-file:        LICENSE++-- The package author(s).+Author:              Ivan Perez++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer:          ivan.perez@keera.es++-- A copyright notice.+-- Copyright:           ++Category:            Development++Build-type:          Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+-- Extra-source-files:  ++-- Constraint on the version of Cabal needed to build this package.+Cabal-version:       >=1.2++Library+  hs-source-dirs: src/+  +  ghc-options: -Wall -fno-warn-unused-do-bind -O2++  -- Modules exported by the library.+  Exposed-modules: Graphics.UI.Gtk.Reactive+                 , Graphics.UI.Gtk.Reactive.Button+                 , Graphics.UI.Gtk.Reactive.ColorButton+                 , Graphics.UI.Gtk.Reactive.CheckMenuItem+                 , Graphics.UI.Gtk.Reactive.Entry+                 , Graphics.UI.Gtk.Reactive.MenuItem+                 , Graphics.UI.Gtk.Reactive.Property+                 , Graphics.UI.Gtk.Reactive.Scale+                 , Graphics.UI.Gtk.Reactive.SpinButton+                 , Graphics.UI.Gtk.Reactive.TextView+                 , Graphics.UI.Gtk.Reactive.ToolButton+                 -- , Graphics.UI.Gtk.Reactive.TypedComboBoxUnsafe+                 , Graphics.UI.Gtk.Reactive.ToggleButton+                 , Graphics.UI.Gtk.Reactive.TreeView+                 , Graphics.UI.Gtk.Reactive.Widget +                 , Graphics.UI.Gtk.Reactive.Window+  +  -- Packages needed in order to build this package.+  Build-depends: base >= 4 && < 5+               , mtl+               , transformers+               , gtk+               , gtk-helpers+               , keera-hails-reactivevalues
+ src/Graphics/UI/Gtk/Reactive.hs view
@@ -0,0 +1,18 @@+module Graphics.UI.Gtk.Reactive+   (module Exported)+  where++import Graphics.UI.Gtk.Reactive.ColorButton          as Exported+import Graphics.UI.Gtk.Reactive.Button               as Exported+import Graphics.UI.Gtk.Reactive.Entry                as Exported+import Graphics.UI.Gtk.Reactive.CheckMenuItem        as Exported+import Graphics.UI.Gtk.Reactive.MenuItem             as Exported+import Graphics.UI.Gtk.Reactive.Scale                as Exported+import Graphics.UI.Gtk.Reactive.SpinButton           as Exported+import Graphics.UI.Gtk.Reactive.TextView             as Exported+import Graphics.UI.Gtk.Reactive.ToolButton           as Exported+import Graphics.UI.Gtk.Reactive.ToggleButton         as Exported+import Graphics.UI.Gtk.Reactive.TreeView             as Exported+import Graphics.UI.Gtk.Reactive.Widget               as Exported+import Graphics.UI.Gtk.Reactive.Window               as Exported+-- import  Graphics.UI.Gtk.Reactive.TypedComboBoxUnsafe  as  Exported
+ src/Graphics/UI/Gtk/Reactive/Button.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE MultiParamTypeClasses #-}+-- | Publishes the main elements of a menuitem+module Graphics.UI.Gtk.Reactive.Button where++import Control.Monad+import Graphics.UI.Gtk+import Data.ReactiveValue++buttonActivateField :: Button -> ReactiveFieldActivatable IO+buttonActivateField b = mkActivatable op+ where op f = void (b `onClicked` f)++instance ReactiveValueActivatable IO Button where+  defaultActivation = buttonActivateField
+ src/Graphics/UI/Gtk/Reactive/CheckMenuItem.hs view
@@ -0,0 +1,12 @@+-- | Publishes the main elements of a checkmenuitem+module Graphics.UI.Gtk.Reactive.CheckMenuItem where++import Control.Monad+import Graphics.UI.Gtk+import Data.ReactiveValue++checkMenuItemActiveReactive :: CheckMenuItem -> ReactiveFieldReadWrite IO Bool+checkMenuItemActiveReactive e = ReactiveFieldReadWrite setter getter notifier+ where getter   = checkMenuItemGetActive e+       setter   = checkMenuItemSetActive e+       notifier = void . (on e checkMenuItemToggled)
+ src/Graphics/UI/Gtk/Reactive/ColorButton.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE TypeSynonymInstances  #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+-- | Publishes the main elements of an entry as reactive fields+module Graphics.UI.Gtk.Reactive.ColorButton where++import Control.Monad (void, when)+import Graphics.UI.Gtk+import Data.ReactiveValue+import Data.Word+import Graphics.UI.Gtk.Reactive.Property++type Color4 = (Word16, Word16, Word16, Word16)++colorButtonColorReactive :: ColorButton -> ReactiveFieldReadWrite IO Color4+colorButtonColorReactive e = ReactiveFieldReadWrite setter getter notifier+ where getter     = do (Color r g b) <- colorButtonGetColor e+                       alpha         <- colorButtonGetAlpha e+                       return (r, g, b, alpha)+                       +       setter c@(r,g,b,a) = postGUIAsync $ do+                              c' <- getter+                              when (c /= c') $ do+                                colorButtonSetColor e (Color r g b)+                                colorButtonSetAlpha e a+       notifier p = void (e `onColorSet` p)++colorButtonColorReactive' :: ColorButton -> ReactiveFieldReadWrite IO Color4+colorButtonColorReactive' e = liftRW2 (colorButtonRGBReactive e) (colorButtonAlphaReactive e) color4_colorAlpha++colorButtonRGBReactive :: ColorButton -> ReactiveFieldReadWrite IO Color+colorButtonRGBReactive e = eqCheck $ ReactiveFieldReadWrite+  (colorButtonSetColor e) (colorButtonGetColor e) (void.onColorSet e)++colorButtonAlphaReactive :: ColorButton -> ReactiveFieldReadWrite IO Word16+colorButtonAlphaReactive e = reactivePropertyH e onColorSet colorButtonAlpha++color4_colorAlpha :: BijectiveFunc Color4 (Color, Word16)+color4_colorAlpha = bijection (\(r,g,b,a) -> (Color r g b, a), \(Color r g b, a) -> (r,g,b,a))++instance ReactiveValueReadWrite ColorButton Color4 IO where++instance ReactiveValueRead ColorButton Color4 IO where+ reactiveValueOnCanRead = reactiveValueOnCanRead . colorButtonColorReactive + reactiveValueRead      = reactiveValueRead . colorButtonColorReactive++instance ReactiveValueWrite ColorButton Color4 IO where+ reactiveValueWrite = reactiveValueWrite . colorButtonColorReactive
+ src/Graphics/UI/Gtk/Reactive/Entry.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE TypeSynonymInstances  #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+-- | Publishes the main elements of an entry as reactive fields+module Graphics.UI.Gtk.Reactive.Entry where++import Data.ReactiveValue+import Graphics.UI.Gtk+import Graphics.UI.Gtk.Reactive.Property++entryTextReactive :: (EditableClass e, EntryClass e) => e -> ReactiveFieldReadWrite IO String+entryTextReactive e = reactiveProperty e editableChanged entryText++-- import Control.Monad (void, when)+-- entryTextReactive :: (EditableClass e, EntryClass e) => e -> ReactiveFieldReadWrite IO String+-- entryTextReactive e = ReactiveFieldReadWrite setter getter notifier+--  where getter     = get e entryText+--        setter v   = postGUIAsync $ do+--                       p <- get e entryText+--                       when (p /= v) $ set e [entryText := v]+--        notifier p = void (on e editableChanged p)++instance ReactiveValueReadWrite Entry String IO where++instance ReactiveValueRead Entry String IO where+ reactiveValueOnCanRead = reactiveValueOnCanRead . entryTextReactive + reactiveValueRead      = reactiveValueRead . entryTextReactive++instance ReactiveValueWrite Entry String IO where+ reactiveValueWrite = reactiveValueWrite . entryTextReactive
+ src/Graphics/UI/Gtk/Reactive/MenuItem.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE MultiParamTypeClasses #-}+-- | Publishes the main elements of a menuitem+module Graphics.UI.Gtk.Reactive.MenuItem where++import Control.Monad+import Control.Monad.Trans(liftIO)+import Graphics.UI.Gtk+import Data.ReactiveValue++menuItemActivateField :: MenuItem -> ReactiveFieldActivatable IO+menuItemActivateField m = mkActivatable op+ where op f = void (m `on` menuItemActivate $ liftIO f)++instance ReactiveValueActivatable IO MenuItem where+  defaultActivation = menuItemActivateField
+ src/Graphics/UI/Gtk/Reactive/Property.hs view
@@ -0,0 +1,89 @@+-- | Publishes the main elements of a scale as reactive fields+module Graphics.UI.Gtk.Reactive.Property where++import Control.Monad (void, when)+import Graphics.UI.Gtk+import Data.ReactiveValue++-- * Attributes as reactive values++-- ** Signal-based reactimation functions.++-- | Create an RV based on a widget's attribute and signal. Before setting,+-- the value is checked against the current one. If they are the same, the+-- value is *not* set.+reactiveProperty :: Eq b+                 => self+                 -> Signal self (IO ()) -> Attr self b+                 -> ReactiveFieldReadWrite IO b+reactiveProperty e sig attr =+  ReactiveFieldReadWrite setter getter notifier+ where getter     = get e attr+       setter v   = postGUIAsync $ do+                      p <- getter+                      when (p /= v) $ set e [ attr := v ]+       notifier p = void (on e sig p)++-- | Create an RV based on a widget's attribute and signal.+-- Before setting, the value is *not* checked against the current one.+-- The value is thus set even if they are the same. +reactivePropertyNE :: self+                   -> Signal self (IO ()) -> Attr self b+                   -> ReactiveFieldReadWrite IO b+reactivePropertyNE e sig attr =+  ReactiveFieldReadWrite setter getter notifier+ where getter     = get e attr+       setter v   = postGUIAsync $ set e [ attr := v ]+       notifier p = void (on e sig p)++-- ** Handler-based reactimation functions++-- | Create an RV based on a widget's attribute and a handler.+-- Before setting, the value is checked against the current one.+-- If they are the same, the value is *not* set.+reactivePropertyH :: Eq b+                  => self+                  -> (self -> IO () -> IO (ConnectId self)) -> Attr self b+                  -> ReactiveFieldReadWrite IO b+reactivePropertyH e sig attr =+  ReactiveFieldReadWrite setter getter notifier+ where getter     = get e attr+       setter v   = postGUIAsync $ do+                      p <- getter+                      when (p /= v) $ set e [ attr := v ]+       notifier p = void (e `sig` p)++-- * Passive properties++-- | A passive reactive value is one that does not report when it changes.+--+-- This function returns a RW RV that encloses the given property, without+-- firing change events. The value of the attribute is *not* set if it is the+-- same as the current one.+--+-- To set without diffing, see 'passivePropertyNE'.+passiveProperty :: Eq b+                 => self+                 -> Attr self b+                 -> ReactiveFieldReadWrite IO b+passiveProperty e attr =+  ReactiveFieldReadWrite setter getter notifier+ where getter     = get e attr+       setter v   = postGUIAsync $ do+                      p <- getter+                      when (p /= v) $ set e [ attr := v ]+       notifier _ = return ()++-- | Return a RW RV that encloses the given property, without firing change+-- events.+--+-- When writing to this RV, the value is *not* diffed against the previous one.+-- The underlying widget can thus still fire signals based on that change.+passivePropertyNE :: self+                  -> Attr self b+                  -> ReactiveFieldReadWrite IO b+passivePropertyNE e attr =+  ReactiveFieldReadWrite setter getter notifier+ where getter     = get e attr+       setter v   = postGUIAsync $ set e [ attr := v ]+       notifier _ = return ()
+ src/Graphics/UI/Gtk/Reactive/Scale.hs view
@@ -0,0 +1,18 @@+-- | Publishes the main elements of a scale as reactive fields+module Graphics.UI.Gtk.Reactive.Scale where++import Control.GFunctor+import Data.ReactiveValue+import GHC.Float+import Graphics.UI.Gtk++import Graphics.UI.Gtk.Reactive.Property++scaleValueReactive :: RangeClass a => a -> ReactiveFieldReadWrite IO Float+scaleValueReactive e = float_double <$$> reactiveProperty e valueChanged rangeValue+ where float_double = bijection (double2Float, float2Double)++-- ReactiveFieldReadWrite setter getter notifier+--  where getter     = fmap double2Float $ get e rangeValue+--        setter v   = set e [ rangeValue := float2Double v ]+--        notifier p = void (on e valueChanged p)
+ src/Graphics/UI/Gtk/Reactive/SpinButton.hs view
@@ -0,0 +1,29 @@+-- | Publishes the main elements of a toggle button+module Graphics.UI.Gtk.Reactive.SpinButton where++import Control.GFunctor+import Data.ReactiveValue+import Graphics.UI.Gtk+import Graphics.UI.Gtk.Reactive.Property++spinButtonValueIntReactive :: SpinButton -> ReactiveFieldReadWrite IO Int+spinButtonValueIntReactive e =+  double_int <$$> reactivePropertyH e onValueSpinned spinButtonValue+ where double_int = bijection (round, fromIntegral)++spinButtonAdjustmentReactive :: SpinButton -> ReactiveFieldReadWrite IO Adjustment+spinButtonAdjustmentReactive = (`passiveProperty` spinButtonAdjustment)++spinButtonValueIntEditReactive :: SpinButton -> ReactiveFieldReadWrite IO Int+spinButtonValueIntEditReactive e =+  double_int <$$> reactivePropertyH e handler spinButtonValue+ where double_int = bijection (round, fromIntegral)+       handler = \s i -> do s `onValueSpinned` i+                            s `onEditableChanged` i++-- import Control.Monad+-- spinButtonActiveReactive :: SpinButton -> ReactiveFieldReadWrite IO Int+-- spinButtonActiveReactive e = ReactiveFieldReadWrite setter getter notifier+--  where getter   = spinButtonGetValueAsInt e+--        setter   = spinButtonSetValue e . fromIntegral+--        notifier = void . (onValueSpinned e)
+ src/Graphics/UI/Gtk/Reactive/TextView.hs view
@@ -0,0 +1,12 @@+-- | Publishes the main elements of a text view as reactive fields+module Graphics.UI.Gtk.Reactive.TextView where++import Control.Monad (void)+import Graphics.UI.Gtk+import Data.ReactiveValue++textViewTextReactive :: TextView -> ReactiveFieldReadWrite IO String+textViewTextReactive e = ReactiveFieldReadWrite setter getter notifier+ where getter     = get e textViewBuffer >>= (`get` textBufferText)+       setter v   = get e textViewBuffer >>= (\b -> set b [textBufferText := v])+       notifier p = get e textViewBuffer >>= (\b -> void (on b bufferChanged p))
+ src/Graphics/UI/Gtk/Reactive/ToggleButton.hs view
@@ -0,0 +1,12 @@+-- | Publishes the main elements of a toggle button+module Graphics.UI.Gtk.Reactive.ToggleButton where++import Control.Monad+import Graphics.UI.Gtk+import Data.ReactiveValue++toggleButtonActiveReactive :: ToggleButtonClass t => t -> ReactiveFieldReadWrite IO Bool+toggleButtonActiveReactive e = ReactiveFieldReadWrite setter getter notifier+ where getter   = toggleButtonGetActive e+       setter   = toggleButtonSetActive e+       notifier = void . (on e toggled)
+ src/Graphics/UI/Gtk/Reactive/ToolButton.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE MultiParamTypeClasses #-}+-- | Publishes the main elements of a menuitem+module Graphics.UI.Gtk.Reactive.ToolButton where++import Control.Monad+import Graphics.UI.Gtk+import Data.ReactiveValue++toolButtonActivateField :: ToolButton -> ReactiveFieldActivatable IO+toolButtonActivateField b = mkActivatable op+ where op f = void (b `onToolButtonClicked` f)++instance ReactiveValueActivatable IO ToolButton where+  defaultActivation = toolButtonActivateField
+ src/Graphics/UI/Gtk/Reactive/TreeView.hs view
@@ -0,0 +1,23 @@+module Graphics.UI.Gtk.Reactive.TreeView where++import Control.Monad.IO.Class (liftIO)+import Control.Monad (void)+import Data.ReactiveValue+import Graphics.UI.Gtk+import Graphics.UI.Gtk.Helpers.TreeView++-- treeViewSelectedRowsReactive :: TreeView -> ReactiveFieldRead IO [TreePath]+-- treeViewSelectedRowsReactive tv = ReactiveFieldRead getter notifier+--  where getter = treeSelectionGetSelectedRows =<< treeViewGetSelection tv+--        notifier p = void (tv `on` cursorChanged $ liftIO p)++treeViewSelectedRowsReactive :: TreeView -> ReactiveFieldRead IO [TreePath]+treeViewSelectedRowsReactive tv = ReactiveFieldRead getter notifier+ where getter = treeViewGetSelectedPath tv+       notifier p = void (tv `on` cursorChanged $ liftIO p)++treeViewGetSelectedReactive :: TreeView -> ListStore a -> ReactiveFieldRead IO (Maybe a)+treeViewGetSelectedReactive tv ls = ReactiveFieldRead getter notifier+ where getter = treeViewGetSelected tv ls+       notifier p = void (tv `on` cursorChanged $ liftIO p)+
+ src/Graphics/UI/Gtk/Reactive/Widget.hs view
@@ -0,0 +1,14 @@+module Graphics.UI.Gtk.Reactive.Widget where++import Control.Monad.IO.Class (liftIO)+import Control.Monad (void, when)+import Data.ReactiveValue+import Graphics.UI.Gtk++widgetVisibleReactive :: WidgetClass self => self -> ReactiveFieldReadWrite IO Bool+widgetVisibleReactive e = ReactiveFieldReadWrite setter getter notifier+ where getter     = get e widgetVisible+       setter v   = postGUIAsync $ do+                      p <- getter+                      when (p /= v) $ set e [ widgetVisible := v ]+       notifier p = void (e `on` mapEvent $ liftIO p >> return False)
+ src/Graphics/UI/Gtk/Reactive/Window.hs view
@@ -0,0 +1,19 @@+module Graphics.UI.Gtk.Reactive.Window where++import Control.Monad (void, when)+import Control.Monad.IO.Class (liftIO)+import Data.ReactiveValue+import Graphics.UI.Gtk++windowCloseReactive :: WindowClass self => self -> ReactiveFieldRead IO ()+windowCloseReactive self = ReactiveFieldRead getter notifier+  where getter     = return ()+        notifier p = void (self `on` deleteEvent $ liftIO p >> return True)++windowVisibilityPassive :: WindowClass self => self -> ReactiveFieldReadWrite IO Bool+windowVisibilityPassive self = ReactiveFieldReadWrite setter getter (const $ return ())+ where setter x = onViewAsync $ do+                     x' <- getter+                     when (x /= x') $+                       if x then widgetShowAll self else widgetHide    self+       getter = get self widgetVisible