Yampa 0.10.3 → 0.10.4

raw patch · 9 files changed

+211/−56 lines, 9 filesdep +Yampadep +directorydep +filepathdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: Yampa, directory, filepath, process, regex-posix

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG +8/−1
• Yampa.cabal +39/−2
• src/FRP/Yampa.hs +4/−2
• src/FRP/Yampa/Basic.hs +8/−0
• src/FRP/Yampa/Event.hs +31/−29
• src/FRP/Yampa/Integration.hs +4/−3
• tests/AFRPTests.hs +5/−7
• tests/HaddockCoverage.hs +94/−0
• tests/testAFRPMain.hs +18/−12

@@ -1,5 +1,12 @@+2015-11-14 Ivan Perez <ivan.perez@keera.co.uk>+        * tests/: Include haddock. Regression tests now exit with proper exit+          code.+        * src/: Includes more documentation.+        * Yampa.cabal: Include haddock and regression test suites.+          Version bump (0.10.4).+ 2015-10-02 Ivan Perez <ivan.perez@keera.co.uk>-        * src:/ Event instances of Applicative and Alternative.+        * src/: Event instances of Applicative and Alternative.         * Yampa.cabal: Version bump (0.10.3).  2015-06-19 Ivan Perez <ivan.perez@keera.co.uk>

@@ -1,5 +1,5 @@ name: Yampa-version: 0.10.3+version: 0.10.4 cabal-version: >= 1.8 license: BSD3 license-file: LICENSE@@ -34,12 +34,21 @@    CHANGELOG - -- 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++-- You can disable the regression test suite with -f-test-regression+flag test-regression+  default: True+  manual: True+ library   hs-source-dirs:  src   ghc-options : -O3 -Wall -fno-warn-name-shadowing@@ -95,6 +104,34 @@     build-depends:       base,       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++test-suite regression+  type: exitcode-stdio-1.0+  main-is: testAFRPMain.hs+  hs-source-dirs: tests+  if !flag(test-regression)+    buildable: False+  else+    build-depends:+      base,+      Yampa  source-repository head   type:     git

@@ -383,9 +383,11 @@      -- ** Integration and differentiation     integral,             -- :: VectorSpace a s => SF a a--    derivative,           -- :: VectorSpace a s => SF a a        -- Crude!     imIntegral,           -- :: VectorSpace a s => a -> SF a a+    impulseIntegral,      -- :: VectorSpace a k => SF (a, Event a) a+    count,                -- :: Integral b => SF (Event a) (Event b)+    derivative,           -- :: VectorSpace a s => SF a a        -- Crude!+      -- Temporarily hidden, but will eventually be made public.     -- iterFrom,          -- :: (a -> a -> DTime -> b -> b) -> b -> SF a b

@@ -8,6 +8,14 @@ -- Stability   :  provisional -- Portability :  non-portable (GHC extensions) +-- | Defines basic signal functions, and elementary ways of altering them.+--+-- This module defines very basic ways of creating and modifying signal+-- functions. In particular, it defines ways of creating constant output+-- producing SFs, and SFs that just pass the signal through unmodified.+--+-- It also defines ways of altering the input and the output signal only+-- by inserting one value in the signal, or by transforming it. module FRP.Yampa.Basic (      -- * Basic signal functions

@@ -125,70 +125,71 @@ noEventSnd (a, _) = (a, NoEvent)  ---------------------------------------------------------------------------------- Eq instance----------------------------------------------------------------------------------- Right now, we could derive this instance. But that could possibly change.-+-- | Eq instance (equivalent to derived instance) instance Eq a => Eq (Event a) where+    -- | Equal if both NoEvent or both Event carrying equal values.     NoEvent   == NoEvent   = True     (Event x) == (Event y) = x == y     _         == _         = False  ---------------------------------------------------------------------------------- Ord instance--------------------------------------------------------------------------------+-- | Ord instance (equivalent to derived instance) instance Ord a => Ord (Event a) where+    -- | NoEvent is smaller than Event, Event x < Event y if x < y     compare NoEvent   NoEvent   = EQ     compare NoEvent   (Event _) = LT     compare (Event _) NoEvent   = GT     compare (Event x) (Event y) = compare x y ----------------------------------------------------------------------------------- Functor instance--------------------------------------------------------------------------------+-- | Functor instance (could be derived). instance Functor Event where+    -- | Apply function to value carried by 'Event', if any.     fmap _ NoEvent   = NoEvent     fmap f (Event a) = Event (f a)  ---------------------------------------------------------------------------------- Applicative instance--------------------------------------------------------------------------------+-- | Applicative instance (similar to 'Maybe'). instance Applicative Event where+    -- | Wrap a pure value in an 'Event'.     pure = Event+    -- | If any value (function or arg) is 'NoEvent', everything is.     NoEvent <*> _ = NoEvent     Event f <*> x = f <$> x +-- | Monad instance+instance Monad Event where+    -- | Combine events, return 'NoEvent' if any value in the+    -- sequence is 'NoEvent'.+    (Event x) >>= k = k x+    NoEvent  >>= _  = NoEvent ---------------------------------------------------------------------------------- Alternative instance-------------------------------------------------------------------------------+    (>>) = (*>) +    -- | See 'pure'.+    return          = pure+    -- | Fail with 'NoEvent'.+    fail _          = NoEvent+++-- | Alternative instance instance Alternative Event where+    -- | An empty alternative carries no event, so it is ignored.     empty = NoEvent+    -- | Merge favouring the left event ('NoEvent' only if both are+    -- 'NoEvent').     NoEvent <|> r = r     l       <|> _ = l  ---------------------------------------------------------------------------------- Forceable instance--------------------------------------------------------------------------------+-- | Forceable instance instance Forceable a => Forceable (Event a) where+    -- | Force an event by evaluating its argument.     force ea@NoEvent   = ea     force ea@(Event a) = force a `seq` ea ---------------------------------------------------------------------------------- NFData instance-------------------------------------------------------------------------------+-- | NFData instance instance NFData a => NFData (Event a) where+    -- | Evaluate value carried by event.     rnf NoEvent   = ()     rnf (Event a) = rnf a `seq` () @@ -199,6 +200,7 @@ -- These utilities are to be considered strictly internal to AFRP for the -- time being. +-- | Convert a maybe value into a event ('Event' is isomorphic to 'Maybe'). maybeToEvent :: Maybe a -> Event a maybeToEvent Nothing  = NoEvent maybeToEvent (Just a) = Event a

@@ -16,14 +16,15 @@     -- * Integration     integral,           -- :: VectorSpace a s => SF a a     imIntegral,         -- :: VectorSpace a s => a -> SF a a+    impulseIntegral,    -- :: VectorSpace a k => SF (a, Event a) a+    count,              -- :: Integral b => SF (Event a) (Event b)      -- * Differentiation-    derivative,         -- :: VectorSpace a s => SF a a         -- Crude!+    derivative          -- :: VectorSpace a s => SF a a         -- Crude! +     -- Temporarily hidden, but will eventually be made public.     -- iterFrom,           -- :: (a -> a -> DTime -> b -> b) -> b -> SF a b-    impulseIntegral,-    count  ) where 

@@ -40,7 +40,6 @@ module AFRPTests where  import FRP.Yampa-import FRP.Yampa.Task (forAll)  import AFRPTestsCommon import AFRPTestsArr@@ -141,15 +140,14 @@ 	format n i = "Test " ++ n ++ "_t" ++ show i ++ " failed."  -runRegTests :: IO ()+runRegTests :: IO Bool runRegTests = do     putStrLn ""     putStrLn "Running the AFRP regression tests ..."-    if allGood then-	putStrLn "All tests succeeded!"-     else-	forAll failedTests putStrLn-+    if allGood+      then putStrLn "All tests succeeded!"+      else mapM_ putStrLn failedTests+    return allGood  runSpaceTests :: IO () runSpaceTests = do

@@ -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.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" ] ++ files+  let cabalArgs   = [ "exec", "--", "haddock" ] ++ haddockArgs+  print cabalArgs+  (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 = [ "Vector2.hs", "Vector3.hs"+                    , "Point2.hs", "Point3.hs"+                    , "MergeableRecord.hs" ]++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"] ""

@@ -14,8 +14,10 @@  import AFRPTests -import System.IO+import Control.Monad (when) import System.Environment (getArgs, getProgName)+import System.Exit (exitWith, ExitCode(..))+import System.IO  -- main = runTests -- main = runSpaceTests@@ -52,20 +54,24 @@ main = do   pname <- getProgName   args <- getArgs-  let eFlags = if (length args) < 1 -                 then (Left allFlags)+  let eFlags = if (length args) < 1+                 then Left allFlags                  else parseArgs defFlags args   case eFlags of-    (Left tFlags) ->  -      if (tHelp tFlags)+    Right emsg  -> usage pname (Just emsg)+    Left tFlags ->+      if tHelp tFlags         then usage pname Nothing         else do-          if (tReg tFlags)-            then runRegTests-            else return ()-          if (tSpace tFlags)-            then runSpaceTests-            else return ()-    (Right emsg) -> usage pname (Just emsg)+          -- Run regresion tests, check if passed+          t <- if tReg tFlags+                 then runRegTests+                 else return True+          -- Run space tests+          when (tSpace tFlags)+                  runSpaceTests+          -- Communicate if all tests have passed+          let exitCode = if t then ExitSuccess else (ExitFailure 1)+          exitWith exitCode