keera-hails-reactive-gtk 0.3 → 0.5
raw patch · 7 files changed
+200/−18 lines, 7 filesdep +directorydep +filepathdep +hlintdep ~basenew-uploader
Dependencies added: directory, filepath, hlint, process, regex-posix
Dependency ranges changed: base
Files
- keera-hails-reactive-gtk.cabal +74/−10
- src/Graphics/UI/Gtk/Reactive/ColorButton.hs +2/−2
- src/Graphics/UI/Gtk/Reactive/Entry.hs +1/−1
- src/Graphics/UI/Gtk/Reactive/Gtk2.hs +8/−4
- src/Graphics/UI/Gtk/Reactive/Label.hs +1/−1
- tests/HaddockCoverage.hs +91/−0
- tests/hlint.hs +23/−0
keera-hails-reactive-gtk.cabal view
@@ -7,16 +7,31 @@ -- 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.3+Version: 0.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: +Description:+ A layer defining RVs for GTK+ fields and actions.+ .+ Reactive Values are an abstraction for reactive programming based on setters+ and getters with change-based propagation.+ .+ They enable easy communication/synchronization rules via Reactive Rules+ (RRs), which can keep two type-compatible RVs in sync directionally or+ bidirectionally.+ .+ This library provides operations to turn GTK+ object properties and+ fields into RVs, so that they can be used to create reactive user+ interfaces with minimal effort.+ .+ For details, please see the paper "Bridging the GUI Gap with Reactive Values+ and Relations", by Ivan Perez and Henrik Nilsson at Haskell Symposium 2015. -- URL for the project homepage or repository.-Homepage: http://www.keera.es/blog/community/+Homepage: http://www.keera.co.uk/blog/community/ -- The license under which the package is released. License: BSD3@@ -29,10 +44,10 @@ -- An email address to which users can send suggestions, bug reports, -- and patches.-Maintainer: ivan.perez@keera.es+Maintainer: ivan.perez@keera.co.uk -- A copyright notice.--- Copyright: +-- Copyright: Category: Development @@ -40,14 +55,16 @@ -- Extra files to be distributed with the package, such as examples or -- a README.--- Extra-source-files: +-- Extra-source-files: -- Constraint on the version of Cabal needed to build this package.-Cabal-version: >=1.2+cabal-version: >= 1.10 Library+ default-language: Haskell2010+ hs-source-dirs: src/- + ghc-options: -Wall -fno-warn-unused-do-bind -O2 -- Modules exported by the library.@@ -69,9 +86,9 @@ -- , Graphics.UI.Gtk.Reactive.TypedComboBoxUnsafe , Graphics.UI.Gtk.Reactive.ToggleButton , Graphics.UI.Gtk.Reactive.TreeView- , Graphics.UI.Gtk.Reactive.Widget + , Graphics.UI.Gtk.Reactive.Widget , Graphics.UI.Gtk.Reactive.Window- + -- Packages needed in order to build this package. Build-depends: base >= 4 && < 5 , bytestring@@ -82,3 +99,50 @@ , gtk-helpers , keera-hails-reactivevalues , cairo++source-repository head+ type: git+ location: git://github.com/keera-studios/keera-hails+ subdir: keera-hails-reactive-gtk++-- You can disable the hlint test suite with -f-test-hlint+flag test-hlint+ default: False+ manual: True++-- You can disable the haddock coverage test suite with -f-test-doc-coverage+flag test-doc-coverage+ default: False+ manual: True++test-suite hlint+ type: exitcode-stdio-1.0+ main-is: hlint.hs+ hs-source-dirs: tests+ if !flag(test-hlint)+ buildable: False+ else+ build-depends:+ base,+ hlint >= 1.7++ default-language: Haskell2010++-- Verify that the code is thoroughly documented+test-suite haddock-coverage+ type: exitcode-stdio-1.0+ main-is: HaddockCoverage.hs+ ghc-options: -Wall+ hs-source-dirs: tests++ if !flag(test-doc-coverage)+ buildable: False+ else+ build-depends:+ base >= 4 && < 5,+ directory,+ filepath,+ process,+ regex-posix++ default-language: Haskell2010
src/Graphics/UI/Gtk/Reactive/ColorButton.hs view
@@ -17,7 +17,7 @@ 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@@ -41,7 +41,7 @@ instance ReactiveValueReadWrite ColorButton Color4 IO where instance ReactiveValueRead ColorButton Color4 IO where- reactiveValueOnCanRead = reactiveValueOnCanRead . colorButtonColorReactive + reactiveValueOnCanRead = reactiveValueOnCanRead . colorButtonColorReactive reactiveValueRead = reactiveValueRead . colorButtonColorReactive instance ReactiveValueWrite ColorButton Color4 IO where
src/Graphics/UI/Gtk/Reactive/Entry.hs view
@@ -23,7 +23,7 @@ instance ReactiveValueReadWrite Entry String IO where instance ReactiveValueRead Entry String IO where- reactiveValueOnCanRead = reactiveValueOnCanRead . entryTextReactive + reactiveValueOnCanRead = reactiveValueOnCanRead . entryTextReactive reactiveValueRead = reactiveValueRead . entryTextReactive instance ReactiveValueWrite Entry String IO where
src/Graphics/UI/Gtk/Reactive/Gtk2.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} module Graphics.UI.Gtk.Reactive.Gtk2 where import Control.Monad (void)@@ -11,7 +12,7 @@ import System.Glib -- @G: cairoContextGetFontOptions | ["cairo","Context","Get","Font","Options"]-cairoContextGetFontOptionsPassive :: (PangoContext) -> ReactiveFieldRead IO (FontOptions)+cairoContextGetFontOptionsPassive :: PangoContext -> ReactiveFieldRead IO (FontOptions) cairoContextGetFontOptionsPassive w = wrapMRPassive (cairoContextGetFontOptions w) @@ -3032,7 +3033,7 @@ statusIconVisiblePassive :: StatusIconClass self => (self) -> ReactiveFieldReadWrite IO (Bool) statusIconVisiblePassive w = passivePropertyNE w statusIconVisible -+#ifndef darwin_HOST_OS -- @S: plugEmbedded plugEmbeddedReactive :: PlugClass self => self -> ReactiveFieldRead IO () plugEmbeddedReactive = (`reactiveSignalIO` plugEmbedded)@@ -3086,6 +3087,9 @@ -- @S: socketPlugRemoved -- TODO++#endif+ -- @C: afterDeleteText -- TODO -- @C: afterEditableChanged@@ -4454,7 +4458,7 @@ -- @G: drawableGetID | ["drawable","Get","ID"]-drawableGetIDPassive :: DrawableClass d => (d) -> ReactiveFieldRead IO (NativeWindowId)+drawableGetIDPassive :: (DrawWindowClass d, DrawableClass d) => (d) -> ReactiveFieldRead IO (NativeWindowId) drawableGetIDPassive w = wrapMRPassive (drawableGetID w) @@ -8063,7 +8067,7 @@ -- @T: treeViewSetModel | ["tree","View","Set","Model"]-treeViewSetModelReactive :: (TreeViewClass self, TreeModelClass model) => (self) -> ReactiveFieldWrite IO (model)+treeViewSetModelReactive :: (TreeViewClass self, TreeModelClass model) => (self) -> ReactiveFieldWrite IO (Maybe model) treeViewSetModelReactive w = wrapMW (treeViewSetModel w)
src/Graphics/UI/Gtk/Reactive/Label.hs view
@@ -14,7 +14,7 @@ instance ReactiveValueReadWrite Label String IO where instance ReactiveValueRead Label String IO where- reactiveValueOnCanRead = reactiveValueOnCanRead . labelTextReactive + reactiveValueOnCanRead = reactiveValueOnCanRead . labelTextReactive reactiveValueRead = reactiveValueRead . labelTextReactive instance ReactiveValueWrite Label String IO where
+ tests/HaddockCoverage.hs view
@@ -0,0 +1,91 @@+-----------------------------------------------------------------------------+-- |+-- Module : Main (HaddockCoverage)+-- Copyright : (C) 2015 Ivan Perez+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ivan Perez <ivan.perez@keera.co.uk>+-- Stability : provisional+-- Portability : portable+--+-- Copyright notice: This file borrows code+-- https://hackage.haskell.org/package/lens-4.7/src/tests/doctests.hsc+-- which is itself licensed BSD-style as well.+--+-- Run haddock on a source tree and report if anything in any+-- module is not documented.+-----------------------------------------------------------------------------+module Main where++import Control.Applicative+import Control.Monad+import Data.List+import System.Directory+import System.Exit+import System.FilePath+import System.IO+import System.Process+import Text.Regex.Posix++main :: IO ()+main = do+ -- Find haskell modules+ -- TODO: Ideally cabal should do this (provide us with the+ -- list of modules). An alternative would be to use cabal haddock+ -- but that would need a --no-html argument or something like that.+ -- Alternatively, we could use cabal haddock with additional arguments.+ --+ -- See:+ -- https://github.com/keera-studios/haddock/commit/d5d752943c4e5c6c9ffcdde4dc136fcee967c495+ -- https://github.com/haskell/haddock/issues/309#issuecomment-150811929+ files <- getSources++ let haddockArgs = [ "--no-warnings", "--ignore-all-exports" ] ++ files+ let cabalArgs = [ "exec", "--", "haddock" ] ++ haddockArgs+ (code, out, _err) <- readProcessWithExitCode "cabal" cabalArgs ""++ -- Filter out coverage lines, and find those that denote undocumented+ -- modules.+ --+ -- TODO: is there a way to annotate a function as self-documenting,+ -- in the same way we do with ANN for hlint?+ let isIncompleteModule :: String -> Bool+ isIncompleteModule line = isCoverageLine line && not (line =~ "^ *100%")+ where isCoverageLine :: String -> Bool+ isCoverageLine line = line =~ "^ *[0-9]+%"++ let incompleteModules :: [String]+ incompleteModules = filter isIncompleteModule $ lines out++ -- Based on the result of haddock, report errors and exit.+ -- Note that, unline haddock, this script does not+ -- output anything to stdout. It uses stderr instead+ -- (as it should).+ case (code, incompleteModules) of+ (ExitSuccess , []) -> return ()+ -- (ExitFailure _, _) -> exitFailure+ (_ , _) -> do+ hPutStrLn stderr "The following modules are not fully documented:"+ mapM_ (hPutStrLn stderr) incompleteModules+ exitFailure++getSources :: IO [FilePath]+getSources = filter isHaskellFile <$> go "src"+ where+ go dir = do+ (dirs, files) <- getFilesAndDirectories dir+ (files ++) . concat <$> mapM go dirs++ isHaskellFile fp = (isSuffixOf ".hs" fp || isSuffixOf ".lhs" fp)+ && not (any (`isSuffixOf` fp) excludedFiles)++ excludedFiles = [ ]++getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])+getFilesAndDirectories dir = do+ c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir+ (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c++-- find-based implementation (not portable)+--+-- getSources :: IO [FilePath]+-- getSources = fmap lines $ readProcess "find" ["src/", "-iname", "*hs"] ""
+ tests/hlint.hs view
@@ -0,0 +1,23 @@+-----------------------------------------------------------------------------+-- |+-- Module : Main (hlint)+-- Copyright : (C) 2013 Edward Kmett+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Edward Kmett <ekmett@gmail.com>+-- Stability : provisional+-- Portability : portable+--+-- This module runs HLint on the lens source tree.+-----------------------------------------------------------------------------+module Main where++import Control.Monad+import Language.Haskell.HLint+import System.Environment+import System.Exit++main :: IO ()+main = do+ args <- getArgs+ hints <- hlint $ ["src", "--cross", "--hint=tests/HLint.hs" ] ++ args+ unless (null hints) exitFailure