essence-of-live-coding 0.2.3 → 0.2.4

raw patch · 10 files changed

+299/−27 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• essence-of-live-coding.cabal +5/−2
• src/LiveCoding/Cell/Feedback.lhs +0/−22
• src/LiveCoding/Cell/Util.hs +102/−0
• test/Cell.hs +32/−0
• test/Cell/Monad/Trans.hs +26/−0
• test/Cell/Util.hs +91/−0
• test/Main.hs +5/−1
• test/Monad/Trans.hs +2/−2
• test/Util.hs +31/−0

@@ -1,5 +1,10 @@ # Revision history for essence-of-live-coding +## 0.2.4++* Extended testing utilities+* Extended LiveCoding.Cell.Util by buffer, edge, boundedFIFO and other utilities+ ## 0.2.3  * Added printTimeC debugging utility

@@ -1,5 +1,5 @@ name:                essence-of-live-coding-version:             0.2.3+version:             0.2.4 synopsis: General purpose live coding framework description:   essence-of-live-coding is a general purpose and type safe live coding framework.@@ -93,7 +93,10 @@   type: exitcode-stdio-1.0   main-is: Main.hs   other-modules:-      Feedback+      Cell+    , Cell.Monad.Trans+    , Cell.Util+    , Feedback     , Handle     , Handle.LiveProgram     , Monad

@@ -77,25 +77,3 @@ sumFeedback = feedback 0 $ arr   $ \(a, accum) -> (accum, a + accum) \end{code}--\fxerror{Mention keepJust and keep}-\begin{comment}-\begin{code}-keepJust-  :: (Monad m, Data a)-  => Cell m (Maybe a) (Maybe a)-keepJust = feedback Nothing $ arr keep-  where-    keep (Nothing, Nothing) = (Nothing, Nothing)-    keep (_, Just a) = (Just a, Just a)-    keep (Just a, Nothing) = (Just a, Just a)---- | Initialise with a value 'a'.---   If the input is 'Nothing', @keep a@ will output the stored indefinitely.---   A new value can be stored by inputting 'Maybe a'.-keep :: (Data a, Monad m) => a -> Cell m (Maybe a) a-keep a = feedback a $ proc (ma, aOld) -> do-  let aNew = fromMaybe aOld ma-  returnA -< (aNew, aNew)-\end{code}-\end{comment}

@@ -6,7 +6,13 @@ import Control.Arrow import Control.Monad.IO.Class import Data.Data (Data)+import Data.Functor (void)+import Data.Maybe +-- containers+import Data.Sequence hiding (take)+import qualified Data.Sequence as Sequence+ -- time import Data.Time.Clock @@ -14,6 +20,8 @@ import LiveCoding.Cell import LiveCoding.Cell.Feedback +-- * State accumulation+ -- | Sum all past inputs, starting by the given number sumFrom :: Monad m => Integer -> Cell m Integer Integer sumFrom n0 = feedback n0 $ proc (n, acc) -> returnA -< (acc, acc + n)@@ -31,6 +39,43 @@   where     cellStep b a = let b' = step a b in return (b, b') +-- | Like 'foldC', but does not delay the output.+foldC' :: (Data b, Monad m) => (a -> b -> b) -> b -> Cell m a b+foldC' step cellState = Cell { .. }+  where+    cellStep b a = let b' = step a b in return (b', b')++-- | Initialise with a value 'a'.+--   If the input is 'Nothing', @keep a@ will output the stored indefinitely.+--   A new value can be stored by inputting 'Maybe a'.+keep :: (Data a, Monad m) => a -> Cell m (Maybe a) a+keep a = feedback a $ proc (ma, aOld) -> do+  let aNew = fromMaybe aOld ma+  returnA -< (aNew, aNew)++-- | Like 'keep', but returns 'Nothing' until it is initialised by a @'Just' a@ value.+keepJust+  :: (Monad m, Data a)+  => Cell m (Maybe a) (Maybe a)+keepJust = feedback Nothing $ arr keep+  where+    keep (Nothing, Nothing) = (Nothing, Nothing)+    keep (_, Just a) = (Just a, Just a)+    keep (Just a, Nothing) = (Just a, Just a)++-- | @boundedFIFO n@ keeps the first @n@ present values.+boundedFIFO :: (Data a, Monad m) => Int -> Cell m (Maybe a) (Seq a)+boundedFIFO n = foldC' step empty+  where+    step Nothing  as = as+    step (Just a) as = Sequence.take n $ a <| as++-- | Returns 'True' iff the current input value is 'True' and the last input value was 'False'.+edge :: Monad m => Cell m Bool Bool+edge = proc b -> do+  bLast <- delay False -< b+  returnA -< b && not bLast+ -- * Debugging utilities  -- | Print the current UTC time, prepended with the first 8 characters of the given message.@@ -40,3 +85,60 @@ -- | Like 'printTime', but as a cell. printTimeC :: MonadIO m => String -> Cell m () () printTimeC msg = constM $ printTime msg++-- * Buffers++-- | A command to send to 'buffer'.+data BufferCommand a+  = Push a+  -- ^ Add an 'a' to the buffer.+  | Pop+  -- ^ Remove the oldest element from the buffer.++-- | Pushes @'Just' a@ and does nothing on 'Nothing'.+maybePush :: Maybe a -> [BufferCommand a]+maybePush = (Push <$>) . maybeToList++-- | Pops on @'Just' a@ and does nothing on 'Nothing'.+maybePop :: Maybe a -> [BufferCommand b]+maybePop = (const Pop <$>) . maybeToList++{- | Single-consumer, multi-producer buffer.++The output value is the oldest value in the buffer,+if it exists.++* Add elements by inputting @'Push' a@.+* Remove elements by inputting 'Pop'.+-}+buffer :: (Monad m, Data a) => Cell m [BufferCommand a] (Maybe a)+buffer = Cell { .. }+  where+    cellState = empty+    cellStep as commands = return (currentHead as, nextBuffer as commands)+    currentHead as = case viewl as of+      EmptyL   -> Nothing+      a :< as' -> Just a+    nextBuffer as [] = as+    nextBuffer as (Push a : commands) = nextBuffer (as |> a) commands+    nextBuffer as (Pop : commands) = nextBuffer (Sequence.drop 1 as) commands++{- | Equip a 'Cell' with a 'buffer'.++* Whenever @'Just' a@ value enters @buffered cell@,+  it is added to the buffer.+* Whenever @cell@ emits @'Just' b@,+  the oldest value is dropped from the buffer.+* @cell@ is always fed with 'Just' the oldest value from the buffer,+  except when the buffer is empty, then it is fed 'Nothing'.++This construction guarantees that @cell@ produces exactly one output for every input value.+-}+buffered+  :: (Monad m, Data a)+  => Cell m (Maybe a) (Maybe b)+  -> Cell m (Maybe a) (Maybe b)+buffered cell = feedback Nothing $ proc (aMaybe, ticked) -> do+  aMaybe' <- buffer -< maybePop ticked ++ maybePush aMaybe+  bMaybe' <- cell   -< aMaybe'+  returnA           -< (bMaybe', void bMaybe')

@@ -0,0 +1,32 @@+{-# LANGUAGE ScopedTypeVariables #-}+module Cell where++-- base+import Prelude hiding (id)+import Control.Category+import Data.Functor.Identity++-- transformers+import Control.Monad.Trans.Identity++-- test-framework+import Test.Framework++-- test-framework-quickcheck2+import Test.Framework.Providers.QuickCheck2++-- QuickCheck+import Test.QuickCheck++-- essence-of-live-coding+import LiveCoding++import qualified Cell.Util+import qualified Cell.Monad.Trans++test = testGroup "Cell"+  [ testProperty "steps produces outputs"+    $ \(inputs :: [Int]) -> inputs === fst (runIdentity $ steps (id :: Cell Identity Int Int) inputs)+  , Cell.Util.test+  , Cell.Monad.Trans.test+  ]

@@ -0,0 +1,26 @@+{-# LANGUAGE Arrows #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Cell.Monad.Trans where++-- transformers+import Control.Monad.Trans.Reader++-- test-framework+import Test.Framework++-- test-framework-quickcheck2+import Test.Framework.Providers.QuickCheck2++-- QuickCheck+import Test.QuickCheck hiding (output)++-- essence-of-live-coding+import LiveCoding++import Util++test = testGroup "Cell.Monad.Trans"+  [ testProperty "readerC" $ inIdentityT $ proc (n :: Int) -> do+      nReader <- runReaderC' $ constM ask -< (n, ())+      returnA -< n === nReader+  ]

@@ -0,0 +1,91 @@+{-# LANGUAGE Arrows #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Cell.Util where++-- base+import qualified Control.Category as C+import Data.Functor.Identity+import Data.Maybe+import Control.Monad++-- transformers+import Control.Monad.Trans.Reader++-- test-framework+import Test.Framework++-- test-framework-quickcheck2+import Test.Framework.Providers.QuickCheck2++-- QuickCheck+import Test.QuickCheck hiding (output)++-- essence-of-live-coding+import LiveCoding++import Util++test = testGroup "Utility unit tests"+--   [ testProperty "Buffer works as expected" CellSimulation+--       { cell = buffer+--       , input = []+--     --   , input =+--     --       [ []+--     --       , [Pop]+--     --       , [Push (23 :: Int)]+--     --       , []+--     --       , [Pop, Pop]+--     --       , [Push 42, Pop]+--     --       , [Push 1, Push 2]+--     --       , []+--     --       , []+--     --       , [Pop, Push 3]+--     --       , []+--     --       , [Pop]+--     --       , [Pop]+--     --       , []+--     --       ]+--       , output = []+--     --   , output =+--     --       [ Nothing+--     --       , Nothing+--     --       , Just 23+--     --       , Just 23+--     --       , Nothing+--     --       , Nothing+--     --       , Just 1+--     --       , Just 1+--     --       , Just 1+--     --       , Just 2+--     --       , Just 2+--     --       , Just 3+--     --       , Nothing+--     --       , Nothing+--     --       ]+--       }+  [ testProperty "buffered works as expected" CellSimulation+    { cell = buffered C.id+    , input =+        [ Just (23 :: Int)+        ]+    , output =+        [ Nothing+        ]+    }+  , testProperty "buffered can be used in an asynchronous setting" $ do+      jointInputs <- arbitrary -- Simulates when input arrives and when inner cell is activated+      -- Make sure cell is ticked at the last time, and no new input arrives+      let innerCell = proc (aMaybe :: Maybe Int) -> do+            isScheduled <- constM ask -< ()+            returnA -< guard isScheduled >> aMaybe+          outerCell = buffered innerCell+          (outputs, _) = runIdentity $ steps (runReaderC' outerCell) jointInputs+          labelString = unwords [show jointInputs, show outputs, show $ length jointInputs, show $ length outputs]+          inputs = snd $ unzip jointInputs+          bufferNotEmpty = isJust $ listToMaybe $ reverse outputs+      -- Make sure each message arrived exactly once, in order+      return+        $ counterexample labelString+        $ catMaybes inputs === catMaybes outputs+        .||. bufferNotEmpty+  ]

@@ -17,14 +17,17 @@ import Test.QuickCheck  -- essence-of-live-coding+import qualified Cell import qualified Feedback import qualified Handle import qualified Monad+import qualified Monad.Trans+ import LiveCoding -import qualified Monad.Trans import qualified TestData.Foo1 as Foo1 import qualified TestData.Foo2 as Foo2+ import Util  intToInteger :: Int -> Integer@@ -107,6 +110,7 @@         , output2 = [23, 24, 25]         }       ]+    , Cell.test     , Handle.test     , Monad.test     , Feedback.test

@@ -20,6 +20,6 @@     $ \(stateT :: Int) (stateInternal :: Int)       -> State { .. } === migrate State { stateInternal = 23, .. } stateInternal   , testProperty "Migrates from runStateL"-  $ \(stateT :: Int) (stateInternal :: Int)-    -> stateInternal === migrate 42 State { .. }+    $ \(stateT :: Int) (stateInternal :: Int)+      -> stateInternal === migrate 42 State { .. }   ]

@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RecordWildCards #-} module Util where @@ -50,3 +51,33 @@   let cell2' = hotCodeSwapCell cell2 cell1'   (bs2, _) <- steps cell2' as2   return (bs1, bs2)++-- FIXME move to essence-of-live-coding-quickcheck+-- https://github.com/turion/essence-of-live-coding/issues/36+instance (Arbitrary a, Testable prop) => Testable (Cell Identity a prop) where+  property cell = property $ do+    as <- arbitrary+    let (props, _) = runIdentity $ steps cell as+    return $ conjoin props++-- | Helper to unify cells to the 'Identity' monad.+inIdentityT :: Cell Identity a prop -> Cell Identity a prop+inIdentityT = id++-- | Basic unit test for 'Cell's.+--   Check whether a given 'input' to your 'cell' results in a given 'output'.+data CellSimulation a b = CellSimulation+  { cell :: Cell Identity a b+  , input :: [a]+  , output :: [b]+  }++instance (Eq b, Show b) => Testable (CellSimulation a b) where+  property CellSimulation { .. } = property CellMigrationSimulation+    { cell1 = cell+    , cell2 = cell+    , input1 = input+    , input2 = []+    , output1 = output+    , output2 = []+    }