Atze,
On why I did not use Control.FRPNow.Time.integrate. Wrt code below, which is a bit contrived, in that I don’t really need to integrate sensor data, but if I can, I can then use the same concept for other algorithms, such as filtering and control:
The idea was to make sure that time of any sensor reading was as near as possible to the actual measurement. Assuming there are many streams running in parallel in an application, taking the time with the measurement (in same sync evaluation) was assumed to be more accurate than taking it code that consumes the stream and processes the data, after the event from the sync evaluation. Also, if a stream is treated like a pipe and filter, the time can be passed along for later processing stages.
As for what the code does, it measures distance every 10ms, integrates the stream, then stops when it reaches 1000.0.
integrateTelemetry :: EvStream (Double,Double) -> Double -> Behavior (Behavior (Double,Double))
integrateTelemetry stream startTime = foldEs update (0,startTime) stream where
update (total, prevTime) (cur, curTime) = let diff = (curTime - prevTime) * cur
in (total + diff, curTime)
makeTimedStream :: ((a -> IO ()) -> IO ()) -> Int -> Now (EvStream a)
makeTimedStream conv delayMs =
do (res,f) <- callbackStream
conn <- sync $ repeatedTimer (conv f) $ msDelay $ fromIntegral delayMs
return res
createIRStream :: SMBus.SMBus -> Now (EvStream (Double,Double))
createIRStream smbus =
do stream <- makeTimedStream (\f -> do d <- getDistance smbus
now <- getTime
f (d,now)) 10
return stream
testFRP smbus n = do stream <- createIRStream smbus
now <- sync getTime
b <- sample $ integrateTelemetry stream now
enoughEv <- sample (Control.FRPNow.when (((> n) . fst) <$> b))
let closeMessage i = "Current : " ++ show i
let doneMessage i = "Done : " ++ show i
let message = (closeMessage <$> b) `switch` (doneMessage <$> b <$ enoughEv)
traceChanges "Message : " message
return enoughEv