diff --git a/keera-hails-reactive-gtk.cabal b/keera-hails-reactive-gtk.cabal --- a/keera-hails-reactive-gtk.cabal +++ b/keera-hails-reactive-gtk.cabal @@ -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 diff --git a/src/Graphics/UI/Gtk/Reactive/ColorButton.hs b/src/Graphics/UI/Gtk/Reactive/ColorButton.hs --- a/src/Graphics/UI/Gtk/Reactive/ColorButton.hs +++ b/src/Graphics/UI/Gtk/Reactive/ColorButton.hs @@ -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 diff --git a/src/Graphics/UI/Gtk/Reactive/Entry.hs b/src/Graphics/UI/Gtk/Reactive/Entry.hs --- a/src/Graphics/UI/Gtk/Reactive/Entry.hs +++ b/src/Graphics/UI/Gtk/Reactive/Entry.hs @@ -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 diff --git a/src/Graphics/UI/Gtk/Reactive/Gtk2.hs b/src/Graphics/UI/Gtk/Reactive/Gtk2.hs --- a/src/Graphics/UI/Gtk/Reactive/Gtk2.hs +++ b/src/Graphics/UI/Gtk/Reactive/Gtk2.hs @@ -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) diff --git a/src/Graphics/UI/Gtk/Reactive/Label.hs b/src/Graphics/UI/Gtk/Reactive/Label.hs --- a/src/Graphics/UI/Gtk/Reactive/Label.hs +++ b/src/Graphics/UI/Gtk/Reactive/Label.hs @@ -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 diff --git a/tests/HaddockCoverage.hs b/tests/HaddockCoverage.hs new file mode 100644 --- /dev/null +++ b/tests/HaddockCoverage.hs @@ -0,0 +1,91 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Main (HaddockCoverage) +-- Copyright : (C) 2015 Ivan Perez +-- License : BSD-style (see the file LICENSE) +-- Maintainer : Ivan Perez +-- 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"] "" diff --git a/tests/hlint.hs b/tests/hlint.hs new file mode 100644 --- /dev/null +++ b/tests/hlint.hs @@ -0,0 +1,23 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Main (hlint) +-- Copyright : (C) 2013 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- Maintainer : Edward Kmett +-- 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