keera-hails-reactivevalues 0.2.0.0 → 0.2.0.1

raw patch · 5 files changed

+264/−17 lines, 5 filesdep +HUnitdep +QuickCheckdep +directoryPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: HUnit, QuickCheck, directory, filepath, hlint, keera-hails-reactivevalues, mtl, process, regex-posix, tasty, tasty-hunit, tasty-quickcheck

API changes (from Hackage documentation)

Files

• keera-hails-reactivevalues.cabal +80/−7
• src/Data/ReactiveValue.hs +16/−10
• tests/HaddockCoverage.hs +94/−0
• tests/Tasty.hs +51/−0
• tests/hlint.hs +23/−0

@@ -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 <https://github.com/keera-studios/keera-hails/tree/master/keera-hails-mvc-model-lightmodel keera-hails-mvc-model-lightmodel> and  <https://github.com/keera-studios/keera-hails/tree/master/keera-hails-mvc-model-protectedmodel keera-hails-mvc-model-protectedmodel>), Gtk+/WX/Qt/HTML DOM/Android widget properties/event handlers/getters/setters, files, sockets, FRP networks. Other backends are also available. See <https://github.com/keera-studios/keera-hails keera-hails> 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

@@ -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' 

@@ -0,0 +1,94 @@+-----------------------------------------------------------------------------+-- |+-- 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.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"] "" 

@@ -0,0 +1,51 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Main (Tasty)+-- Copyright   :  (C) 2015 Ivan Perez+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Ivan Perez <ivan.perez@keera.co.uk>+-- 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))

@@ -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 <ivan.perez@keera.co.uk>+-- 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