Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Dev regression #365 #368

Open
wants to merge 4 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion rhine/src/FRP/Rhine/Schedule/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -30,8 +30,8 @@
newtype RunningResult b state = RunningResult {getRunningResult :: Result state b}

-- | Transform an n-ary product of at least one type into a nonempty list of all its content.
apInjs_NPNonEmpty :: (SListI xs) => NP f (x ': xs) -> NonEmpty (NS f (x ': xs))

Check warning on line 33 in rhine/src/FRP/Rhine/Schedule/Internal.hs

View workflow job for this annotation

GitHub Actions / Run hlint

Suggestion in apInjs_NPNonEmpty in module FRP.Rhine.Schedule.Internal: Use camelCase ▫︎ Found: "apInjs_NPNonEmpty ::\n (SListI xs) => NP f (x ': xs) -> NonEmpty (NS f (x ': xs))" ▫︎ Perhaps: "apInjsNPNonEmpty ::\n (SListI xs) => NP f (x ': xs) -> NonEmpty (NS f (x ': xs))"
apInjs_NPNonEmpty (fx :* fxs) = Z fx :| (S <$> apInjs_NP fxs)

Check warning on line 34 in rhine/src/FRP/Rhine/Schedule/Internal.hs

View workflow job for this annotation

GitHub Actions / Run hlint

Suggestion in apInjs_NPNonEmpty in module FRP.Rhine.Schedule.Internal: Use camelCase ▫︎ Found: "apInjs_NPNonEmpty (fx :* fxs) = ..." ▫︎ Perhaps: "apInjsNPNonEmpty (fx :* fxs) = ..."

-- | A nonempty list of 'StreamT's, unzipped into their states and their steps.
data Streams m b = forall state (states :: [Type]).
Expand All @@ -58,7 +58,7 @@
-- Separate into finished streams and still running streams
& fmap
( \(finished, running) ->
let finishedStates = finished <&> (hliftA (getRunningResult >>> resultState >>> I))
let finishedStates = finished <&> hliftA (getRunningResult >>> resultState >>> I)
outputs =
finished
<&> (hliftA (getRunningResult >>> output >>> K) >>> hcollapse)
Expand Down
18 changes: 18 additions & 0 deletions rhine/test/Clock/FixedStep.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,10 @@

module Clock.FixedStep where

-- base
import Data.List (sort)
import Data.Maybe (catMaybes)

-- vector-sized
import Data.Vector.Sized (toList)

Expand All @@ -12,8 +16,13 @@ import Test.Tasty (testGroup)
-- tasty-hunit
import Test.Tasty.HUnit (testCase, (@?=))

-- monad-schedule
import Control.Monad.Schedule.Trans (runScheduleIO)

-- rhine
import FRP.Rhine

-- rhine (test)
import Util

tests =
Expand Down Expand Up @@ -50,4 +59,13 @@ tests =
, Nothing
, Just ([24, 21, 18, 15], 24)
]
, testGroup
"Schedule"
[ testCase "Can schedule two FixedStep clocks" $ do
let f300 = absoluteS @@ FixedStep @300
let f500 = absoluteS @@ FixedStep @500
output <- runScheduleIO @_ @Integer $ runRhine (f300 +@+ f500) $ replicate 10 ()
let timestamps = either id id <$> catMaybes output
timestamps @?= sort timestamps
]
]
69 changes: 55 additions & 14 deletions rhine/test/Schedule.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,9 +3,10 @@
module Schedule where

-- base
import Control.Arrow ((>>>))
import Control.Arrow (arr, (>>>))
import Data.Functor (($>))
import Data.Functor.Identity
import Data.List (sort)

-- tasty
import Test.Tasty
Expand All @@ -14,16 +15,21 @@
import Test.Tasty.HUnit

-- monad-schedule
import Control.Monad.Schedule.Trans (Schedule, runScheduleT, wait)
import Control.Monad.Schedule.Trans (Schedule, ScheduleT, runScheduleIO, runScheduleT, wait)

-- automaton
import Data.Automaton (accumulateWith, constM, embed)
import Data.Automaton (accumulateWith, arrM, constM, embed, sumN, Automaton)

-- rhine

import Control.Concurrent (threadDelay)
import Control.Monad.Schedule.FreeAsync (FreeAsync, FreeAsyncT (FreeAsyncT), runFreeAsync)
import Data.List.NonEmpty (toList)
import FRP.Rhine.Clock (Clock (initClock), RunningClockInit)
import FRP.Rhine.Clock.FixedStep (FixedStep (FixedStep))
import FRP.Rhine.Schedule
import Util
import Control.Monad.IO.Class (MonadIO(..))

tests =
testGroup
Expand Down Expand Up @@ -55,18 +61,53 @@
]
]
, testGroup
"ParallelClock"
"ParallelClock ScheduleT IO"
[ testCase "chronological ticks" $ do
let
(runningClock, _time) = runSchedule (initClock $ ParallelClock (FixedStep @5) (FixedStep @3) :: RunningClockInit (Schedule Integer) Integer (Either () ()))
output = runSchedule $ embed runningClock $ replicate 6 ()
output
@?= [ (3, Right ())
, (5, Left ())
, (6, Right ())
, (9, Right ())
, (10, Left ())
, (12, Right ())
(runningClock, _time) <- runScheduleIO (initClock $ ParallelClock (FixedStep @500) (FixedStep @300) :: RunningClockInit (ScheduleT Integer IO) Integer (Either () ()))
output <- runScheduleIO $ embed runningClock $ replicate 20 ()
take 6 output
@?= [ (300, Right ())
, (500, Left ())
, (600, Right ())
, (900, Right ())
, (1000, Left ())
, (1200, Right ())
]
let timestamps = fst <$> output
timestamps @?= sort timestamps
]
, testGroup
"ParallelClock FreeAsync"
[ testCase "chronological ticks" $ do
(runningClock, _time) <- runFreeAsync $ runScheduleIO (initClock $ ParallelClock (FixedStep @500) (FixedStep @300) :: RunningClockInit (ScheduleT Integer (FreeAsync)) Integer (Either () ()))

Check warning on line 82 in rhine/test/Schedule.hs

View workflow job for this annotation

GitHub Actions / Run hlint

Warning in tests in module Schedule: Redundant bracket ▫︎ Found: "(FreeAsync)" ▫︎ Perhaps: "FreeAsync"
output <- runFreeAsync $ runScheduleIO $ embed runningClock $ replicate 20 ()
take 6 output
@?= [ (300, Right ())
, (500, Left ())
, (600, Right ())
, (900, Right ())
, (1000, Left ())
, (1200, Right ())
]
let timestamps = fst <$> output
timestamps @?= sort timestamps
]
, testGroup
"automaton"
[ testCase "IO" $ do
let automatonN n = constM (threadDelay $ n * 100000) >>> arr (const n) >>> sumN
output <- embed (scheduleList [automatonN 3, automatonN 5]) (replicate 20 ())
let timestamps = concatMap toList output
timestamps @?= sort timestamps
, testCase "ScheduleT IO without formal action" $ do
let automatonN n = (constM (liftIO $ threadDelay $ n * 100000) >>> arr (const n) >>> sumN) :: Automaton (ScheduleT Integer IO) () Int
output <- runScheduleIO $ embed (scheduleList [automatonN 3, automatonN 5]) (replicate 20 ())
let timestamps = concatMap toList output
timestamps @?= sort timestamps
, testCase "ScheduleT IO with formal action" $ do
let automatonN n = (constM (wait $ n * 100) >>> arr (const n) >>> sumN) :: Automaton (ScheduleT Integer IO) () Integer
output <- runScheduleIO $ embed (scheduleList [automatonN 3, automatonN 5]) (replicate 20 ())
let timestamps = concatMap toList output
timestamps @?= sort timestamps
]
]
Loading