diff --git a/keera-hails-reactivevalues.cabal b/keera-hails-reactivevalues.cabal --- a/keera-hails-reactivevalues.cabal +++ b/keera-hails-reactivevalues.cabal @@ -7,13 +7,18 @@ -- 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.2.0.0 +Version: 0.2.0.1 -- A short (one-line) description of the package. Synopsis: Haskell on Rails - Reactive Values -- A longer description of the package. --- Description: +Description: + This package contains a general definition of Reactive Values and several useful combinators. A reactive value is a /typed mutable value with access properties and change propagation/. Access property can be read-only, read-write or read-write. + . + How an RV is actually implemented, and when and how change propagation is executed is dependent on each RV. For instance, Gtk widget properties would normally use the standard event-handler installers to implement change propagation, whereas pure Haskell values might fork a thread (or not) and propagate changes asynchronously. + . + RVs can be created from pure models (see and ), Gtk+/WX/Qt/HTML DOM/Android widget properties/event handlers/getters/setters, files, sockets, FRP networks. Other backends are also available. See for a list of available backends, tutorials, etc. -- URL for the project homepage or repository. Homepage: http://www.keera.es/blog/community/ @@ -32,7 +37,7 @@ Maintainer: ivan.perez@keera.es -- A copyright notice. --- Copyright: +-- Copyright: Category: Development @@ -40,20 +45,88 @@ -- 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.8 +-- You can disable the hlint test suite with -f-test-hlint +flag test-hlint + default: True + manual: True +-- You can disable the haddock coverage test suite with -f-test-doc-coverage +flag test-doc-coverage + default: True + manual: True + +-- You can disable the haddock coverage test suite with -f-test-unit-tests +flag test-unit-tests + default: True + manual: True + Library hs-source-dirs: src/ - + ghc-options: -Wall -fno-warn-unused-do-bind -O2 -- Modules exported by the library. Exposed-modules: Data.ReactiveValue Control.GFunctor - + -- Packages needed in order to build this package. Build-depends: base >= 4 && < 5, contravariant + +-- Verify that the code follows reasonable coding standards +test-suite hlint + type: exitcode-stdio-1.0 + main-is: hlint.hs + ghc-options: -w -threaded -rtsopts -with-rtsopts=-N + hs-source-dirs: tests + + if !flag(test-hlint) + buildable: False + else + build-depends: + base >= 4 && < 5, + hlint >= 1.7 + +-- 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 + +-- Verify that the code is thoroughly documented +test-suite unit-tests + type: exitcode-stdio-1.0 + main-is: Tasty.hs + ghc-options: -Wall + hs-source-dirs: tests + + if !flag(test-unit-tests) + buildable: False + else + build-depends: + base >= 4 && < 5, + -- This library and testing deps + mtl, + keera-hails-reactivevalues, + + -- Testing libraries + tasty, + tasty-quickcheck, + tasty-hunit, + QuickCheck, + HUnit diff --git a/src/Data/ReactiveValue.hs b/src/Data/ReactiveValue.hs --- a/src/Data/ReactiveValue.hs +++ b/src/Data/ReactiveValue.hs @@ -241,7 +241,7 @@ -- | Wrap a monadic computation in a writable reactive value. wrapMW :: (a -> m ()) -> ReactiveFieldWrite m a -wrapMW f = ReactiveFieldWrite f +wrapMW = ReactiveFieldWrite -- | Wrap a monadic computation in a writable reactive value. -- It discards the written value and executes the operation. @@ -250,15 +250,16 @@ -- polymorphic in the value that may be written to it. Using -- 'wrapDo_' may save you some extra type signatures. wrapDo :: m () -> ReactiveFieldWrite m a -wrapDo f = wrapMW (const f) +wrapDo = wrapMW . const -- | Wrap a monadic computation in a writable reactive value of type -- unit. It discards the written value and executes the operation. wrapDo_ :: m () -> ReactiveFieldWrite m () -wrapDo_ f = wrapMW (\() -> f) +wrapDo_ = wrapDo -- *** Lifting (source) computations into readable RVs. +{-# ANN wrapMR "HLint: ignore Eta reduce" #-} -- | Wrap an reading operation and an notification installer in -- a readable reactive value. wrapMR :: m a -> (m () -> m ()) -> ReactiveFieldRead m a @@ -270,6 +271,7 @@ wrapMRPassive :: Monad m => m a -> ReactiveFieldRead m a wrapMRPassive f = ReactiveFieldRead f (const (return ())) +{-# ANN eventR "HLint: ignore Eta reduce" #-} -- | Wrap event-handler installers in RVs eventR :: Monad m => (m () -> m ()) -> ReactiveFieldRead m () eventR notifInstaller = ReactiveFieldRead (return ()) notifInstaller @@ -283,9 +285,11 @@ bijection :: (a -> b, b -> a) -> BijectiveFunc a b bijection = BijectiveFunc +{-# ANN direct "HLint: ignore Redundant bracket" #-} direct :: BijectiveFunc a b -> (a -> b) direct = fst . unBijectiveFunc +{-# ANN inverse "HLint: ignore Redundant bracket" #-} inverse :: BijectiveFunc a b -> (b -> a) inverse = snd . unBijectiveFunc @@ -309,8 +313,9 @@ pairRW :: (Monad m, ReactiveValueReadWrite a b m, ReactiveValueReadWrite c d m) - => a -> c -> ReactiveFieldReadWrite m (b, d) -pairRW a b = liftRW2 (bijection (id, id)) a b + => a -> c + -> ReactiveFieldReadWrite m (b, d) +pairRW = liftRW2 (bijection (id, id)) {-# INLINE eqCheck #-} eqCheck :: (Eq v, Monad m) => ReactiveFieldReadWrite m v -> ReactiveFieldReadWrite m v @@ -333,6 +338,7 @@ -- * Merging +{-# ANN lMerge "HLint: ignore Use const" #-} -- | Left merge (give priority to the value on the left) lMerge :: (Monad m, ReactiveValueRead a v m, ReactiveValueRead b v m) => a -> b -> ReactiveFieldRead m v @@ -379,8 +385,8 @@ => c -> v -> ReactiveFieldReadWrite m a ifRW_ c r = ReactiveFieldReadWrite setter getter notifier - where setter x = reactiveValueWrite r x - getter = reactiveValueRead r + where setter = reactiveValueWrite r + getter = reactiveValueRead r -- If either changes, the value *may* be propagated notifier p = do reactiveValueOnCanRead c (when' p) reactiveValueOnCanRead r (when' p) @@ -411,9 +417,9 @@ => c -> ReactiveFieldRead m Bool guardRO c = ReactiveFieldRead getter notifier - where getter = reactiveValueRead c + where getter = reactiveValueRead c -- If either changes, the value *may* be propagated - notifier p = reactiveValueOnCanRead c (when' p) + notifier = reactiveValueOnCanRead c . when' -- Propagate only if the condition holds where when' m = do x <- reactiveValueRead c @@ -425,7 +431,7 @@ -> (a -> Bool) -> ReactiveFieldRead m a guardRO' c p = ReactiveFieldRead getter notifier - where getter = reactiveValueRead c + where getter = reactiveValueRead c -- If either changes, the value *may* be propagated notifier = reactiveValueOnCanRead c . when' diff --git a/tests/HaddockCoverage.hs b/tests/HaddockCoverage.hs new file mode 100644 --- /dev/null +++ b/tests/HaddockCoverage.hs @@ -0,0 +1,94 @@ +----------------------------------------------------------------------------- +-- | +-- 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.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 + + -- Run haddock in the right sandbox. + -- NOTE: you need this version of haddock: + -- https://github.com/keera-studios/haddock/ + -- + -- TODO: adapt to use even the old version of haddock if the modified one is + -- not present. We can test with haddock --csv-coverage and no input + -- and check the exit code. + let haddockArgs = [ "--csv-coverage", "--no-warnings" ] ++ 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 + +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/Tasty.hs b/tests/Tasty.hs new file mode 100644 --- /dev/null +++ b/tests/Tasty.hs @@ -0,0 +1,51 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Main (Tasty) +-- Copyright : (C) 2015 Ivan Perez +-- License : BSD-style (see the file LICENSE) +-- Maintainer : Ivan Perez +-- Stability : provisional +-- Portability : portable +-- +-- Test reactive value laws using Quickcheck/HUnit/Tasty. +-- +-- See the following links for instructions and documentation: +-- https://github.com/feuerbach/tasty +-- https://ocharles.org.uk/blog/posts/2013-12-03-24-days-of-hackage-tasty.html +----------------------------------------------------------------------------- + +-- Testing libraries +import Test.Tasty +import Test.Tasty.QuickCheck +-- import Test.QuickCheck +-- import Test.Tasty.HUnit + +-- Tested libraries +import Control.Monad.Identity +import Data.ReactiveValue + +main :: IO () +main = defaultMain $ + testGroup "ReactiveValues" + [ testGroup "GetSetLaws" + [ testProperty "Getting after constant initialisation" getOnConst + ] + ] + +-- * Reactive Value laws + +-- ** Reactive Value get/set laws + +-- | Check that constR returns the value put in. +getOnConst :: Int -> Bool +getOnConst = + \val -> let rv = constR (val :: Int) + val' = runIdentity (reactiveValueRead rv) + in val == val' + +-- NOTE: To check that the testing system and the integration with cabal are +-- both working fine, you can use include this property in one of the tested +-- groups; the test suite should fail. +-- falseProperty = +-- testProperty "False" $ +-- \val -> not (val == (val :: Int)) 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) 2015 Ivan Perez, 2013-2014 Edward Kmett +-- License : BSD-style (see the file LICENSE) +-- Maintainer : Ivan Perez +-- Stability : provisional +-- Portability : portable +-- +-- This module runs HLint on the 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"] ++ args + unless (null hints) exitFailure