auto-0.4.1.0: src/Control/Auto/Blip.hs
{-# LANGUAGE ViewPatterns #-}
-- |
-- Module : Control.Auto.Blip
-- Description : Tools for generating and manipulating blip streams.
-- Copyright : (c) Justin Le 2015
-- License : MIT
-- Maintainer : justin@jle.im
-- Stability : unstable
-- Portability : portable
--
--
-- This module provides tools for generating and manipulating "blip
-- streams". The blip stream abstraction is not fundamental to 'Auto', but
-- rather, like /interval/, is a very useful semantic tool for the
-- denotation of many programs, games, simulations, and computations in
-- general that you are likely to write with this library.
--
module Control.Auto.Blip (
-- * 'Blip'
-- $blip
-- * The Blip type
Blip
, perBlip
-- ** Merging
, merge
, mergeL
, mergeR
, mergeLs
, mergeRs
, foldrB
, foldlB'
-- ** Blip stream creation (dangerous!)
, emitJusts
, emitOn
, onJusts
-- ** Blip stream collapse
, fromBlips
, fromBlipsWith
, holdWith
, holdWith_
-- * Step/"time" based Blip streams and generators
, never
, immediately
, inB
, every
, eachAt
, eachAt_
-- * Modifying Blip streams
, tagBlips
, modifyBlips
, (<&)
, (&>)
, once
, notYet
, lagBlips
, lagBlips_
, filterB
, splitB
, joinB
, mapMaybeB
, takeB
, takeWhileB
, dropB
, dropWhileB
-- * Scanning & Accumulating Blip streams
, accumB
, accumB_
, scanB
, scanB_
, mscanB
, mscanB_
, countB
-- * Blips on edges
, onChange
, onChange_
, became
, became_
, became'
, noLonger
, noLonger_
, noLonger'
, onFlip
, onFlip_
, onFlip'
) where
import Control.Applicative
import Control.Arrow
import Control.Auto.Blip.Internal
import Control.Auto.Core
import Control.Category
import Data.Monoid
import Data.Profunctor
import Data.List
import Data.Serialize
import Prelude hiding ((.), id, sequence)
infixr 5 <&
infixl 5 &>
-- $blip
--
-- In the context of inputs/outputs of 'Auto', a @'Blip' a@ represents
-- a "blip stream" that occasionally, in isolated incidents, emits a value
-- of type @a@.
--
-- For example, @'Auto'' a ('Blip' b)@ is an 'Auto'' that a stream of @a@'s
-- as input and outputs a *blip stream* that occasionally emits with a @b@.
-- An @'Auto'' ('Blip' a) b@ is an 'Auto'' that takes a *blip stream* that
-- occasionally emits with a @a@ and outputs a stream of @b@'s.
--
-- If an 'Auto' takes or outputs a "blip stream", it comes with some
-- "semantic" contracts on to how the stream behaves. The main contract is
-- that your blip stream should only output on (meaningfully) "isolated"
-- incidents, and never on continuous regions of the input stream.
--
-- By this, we mean that every emitted value is (conceptually) emitted
-- "alone", and not as a part of continuous on/off chunks.
--
-- == Example situations
--
-- A good example would be, say, a blip stream that emits every time
-- a user/player sends a certain type of command. Or a blip stream that
-- emits every time a slowly-moving value crosses over from positive to
-- negative.
--
-- A bad example would be a blip stream that emits when a player /doesn't/
-- send a certain less-common type of command. Or a blip stream that emits
-- whenever a slowly-moving value /is/ positive or negative.
--
-- == Contrast with /Intervals/
--
-- Blip streams are contrasted with another semantic tool: stream
-- _intervals_, manipulated with "Control.Auto.Interval". /Intervals/ are
-- adjacent/contiguous "chunks" of on/off behavior, and are on or off for
-- contiguous "chunks" at a time. So when deciding whether or not you want
-- to use the semantics of blip streams or the semantics of /Interval/,
-- consider: is this behavior going to be "on/off" for chunks at a time
-- (such as an interval that is on whenever a slowly-moving value is
-- positive)? Or is it something that is usually "not on", but makes
-- separate, isolated, "blips" --- each emitted value alone and
-- (semantically) isolated from the rest.
--
-- == Motivations
--
-- The main motivations of the semantic concept of blip streams (and why they
-- even exist in the first place) is probably for how well they integrate
-- with /Interval/ semantics and, with intervals, the various powerful
-- switching combinators from "Control.Auto.Switch". Many of the
-- combinators in that module are designed so that switches can be
-- "triggered" by blip stream emissions.
--
-- Blip streams have many usages, as will be explained later. You'll also
-- find that blip streams work well with their cousins, /interval/ streams.
-- But perhaps the use case that stands out above all (and is alone enough
-- to motivate their existence) is in switching.
--
-- == "Blip semantics"
--
-- We say that a blip stream has "blip semantics" when it is used in
-- a way that its emitted values are "isolated", "alone", "discrete", in
-- this way. When it is not, we say that the stream "breaks" blip
-- semantics.
--
-- Note that this can't really be enforced by the types, so if you're
-- a library or framework developer, it's up to you to take care that the
-- blip streams you offer all conform to blip semantics. However, if
-- you're just making an application, you can use most of the combinators
-- in this library/module and not worry.
--
-- Also note that in many of these cases, "blip semantics" depends on how
-- the 'Auto's are /composed/, and what they are composed to. If the value
-- in question is "almost always" positive and only negative at isolated
-- points in time, then such a "blip stream that emits whenever the value
-- is negative" has proper blip semantics. If the value in question is
-- slowly-moving and meandering, and might spend a lot of time negative at
-- a time, then the same blip stream would /not/ preserve blip semantics.
--
-- === Why semantics are important
--
-- Why should you care? I can't tell you want to do, right?
--
-- Well, for the same reason that typeclasses like 'Eq', 'Functor', and
-- 'Monad' have laws. Yeah, you can make any instance you want that
-- satisfies the types. But almost all of the usefulness of those
-- typeclasses comes from our ability to "reason" about the behavior of
-- their instances, and to be able to develop an intuition about their
-- usage. We would be surprised if we had an 'Eq' instance where @x == x@
-- and @x /= x@ are both true...and it would completely break down any
-- attempt at understanding what 'Eq' code "means".
--
-- You can think of "blip semantics" as being the "laws" of blip streams.
-- If we assume that things follow blip semantics properly, then we can
-- reason about them in a unified and useful way. If we can trust that
-- blip streams actually behave "like blip streams", then blip streams
-- become an extremely useful tool for denoting certain behaviors and
-- programs.
--
-- If we can't...then it becomes a lot less useful :)
--
-- In particular, one big use case for blip streams (the switching
-- mechanisms "Control.Auto.Switch") all only "work well" when your blip
-- streams follow proper semantics.
--
-- === Combinators preserve semantics
--
-- /Most/ of the combinators in this module try their best to preserve blip
-- semantics. That is, you can't use them in a way that will produce
-- a non-semantic-abiding blip stream. You can "trust" them, and if you
-- use only safe combinators, you don't ever have to worry. Well. That
-- much, at least.
--
-- There are a few notable exceptions:
--
-- * 'every', 'eachAt', 'eachAt_', when you pass in an interval of 1.
-- * 'onChange', when the input value isn't ever expected to stay the same
-- between steps.
-- * 'emitOn', 'emitJusts', 'onJusts', in the cases mentioned in the
-- documentation for 'emitOn'.
--
--
-- == Practical examples
--
-- There are many practical examples of using blip streams in the various
-- examples in <https://github.com/mstksg/auto-examples auto-examples>,
-- especially from /chatbot/. There, blip streams are used in many
-- situations, primarily streams for players sending certain commands. It's
-- also used in /hangman/, to signify player events such as victory,
-- good/bad guesses, etc.
--
-- Blip streams work very closely with the various switching combinators in
-- "Control.Auto.Switch". If anything, if there is only one reason to use
-- blip streams, it's with the various switching mechanisms in that module.
-- All of the switching combinators rely on the fact that your blip streams
-- follow proper semantics, further emphasizing the importance of
-- conforming to the semantics.
--
-- == For library, framework, and back-end developers
--
-- Remember that this module is only meant to export "safe" combinators
-- that try their best to maintain blip semantics. Think of this module
-- as a useful guideline to help programmers maintain semantics at
-- compile-time, by only exporting not-as-dangerous combinators.
--
-- However, all of these rules are for the denotation of your /program
-- logic/. These rules are for the benefit of reasoning about the behavior
-- of your program at the logic level.
--
-- As a library or framework or back-end developer, however, you aren't
-- programming at the logic level, but rather at the gritty implementation
-- level. So, you might want to provide blip streams and for your
-- library users or application developers or the game logic you are
-- writing.
--
-- For this, you might find the hidden constructors and tools in
-- "Control.Auto.Blip.Internal" helpful, and there is more information at
-- the documentation for that module.
--
-- | Merge all the blip streams together into one, favoring the first
-- emitted value.
mergeLs :: [Blip a] -> Blip a
mergeLs = foldr mergeL NoBlip
-- | Merge all the blip streams together into one, favoring the last
-- emitted value.
mergeRs :: [Blip a] -> Blip a
mergeRs = foldl' mergeR NoBlip
-- | Merge all of the blip streams together, using the given merging
-- function associating from the right.
--
-- __DEPRECATED__: In its current form, 'foldrB' will disappear in @0.5@.
-- The new version will be:
--
-- @
-- foldrB :: (a -> a -> a) -> [Blip a] -> Blip b
-- @
--
-- Which will not emit if nothing emits. This really was supposed to be
-- the intended behavior originally.
--
-- For this reason, please do not use this anymore. As it is currently
-- implemented, it doesn't really make any sense, either.
--
-- To begin using the new behavior, you can use:
--
-- @
-- foldr (merge f) mempty
-- @
--
foldrB :: (a -> a -> a) -> a -> [Blip a] -> Blip a
foldrB f x0 = foldr (merge f) (Blip x0)
-- foldrB :: (a -> a -> a) -> [Blip a] -> Blip a
-- foldrB f = foldr (merge f) NoBlip
-- | Merge all of the blip streams together, using the given merging
-- function associating from the left.
--
-- __DEPRECATED__: In its current form, 'foldlB'' will disappear in @0.5@.
-- The new version will be:
--
-- @
-- foldlB' :: (a -> a -> a) -> [Blip a] -> Blip b
-- @
--
-- Which will not emit if nothing emits. This really was supposed to be
-- the intended behavior originally.
--
-- For this reason, please do not use this anymore. As it is currently
-- implemented, it doesn't really make any sense, either.
--
-- To begin using the new behavior, you can use:
--
-- @
-- foldl' (merge f) mempty
-- @
foldlB' :: (a -> a -> a) -> a -> [Blip a] -> Blip a
foldlB' f x0 = foldl' (merge f) (Blip x0)
-- foldlB' :: (a -> a -> a) -> [Blip a] -> Blip a
-- foldlB' f = foldl' (merge f) NoBlip
-- | Takes two 'Auto's producing blip streams and returns a "merged"
-- 'Auto' that emits when either of the original 'Auto's emit. When both
-- emit at the same time, the left (first) one is favored.
--
-- prop> a1 <& a2 == mergeL <$> a1 <*> a2
(<&) :: Monad m
=> Auto m a (Blip b)
-> Auto m a (Blip b)
-> Auto m a (Blip b)
(<&) = liftA2 mergeL
-- | Takes two 'Auto's producing blip streams and returns a "merged"
-- 'Auto' that emits when either of the original 'Auto's emit. When both
-- emit at the same time, the right (second) one is favored.
--
-- prop> a1 &> a2 == mergeR <$> a1 <*> a2
(&>) :: Monad m
=> Auto m a (Blip b)
-> Auto m a (Blip b)
-> Auto m a (Blip b)
(&>) = liftA2 mergeR
-- | An 'Auto' that ignores its input and produces a blip stream never
-- emits.
never :: Auto m a (Blip b)
never = mkConst NoBlip
-- | Produces a blip stream that emits with the first received input value,
-- and never again after that.
--
-- Often used with 'pure':
--
-- > immediately . pure "Emit me!"
--
-- Or, in proc notation:
--
-- > blp <- immediately -< "Emit me!"
--
-- to get a blip stream that emits a given value (eg., "Emit me!") once
-- and stops emitting ever again.
--
-- >>> streamAuto' (immediately . pure "Emit me!") [1..5]
-- [Blip "Emit Me!", NoBlip, NoBlip, NoBlip, NoBlip]
--
immediately :: Auto m a (Blip a)
immediately = mkState f False
where
f _ True = (NoBlip, True)
f x False = (Blip x, True)
-- | Produces a blip stream that only emits once, with the input value on
-- the given step number. It emits the input /on/ that many steps.
--
-- prop> immediately == inB 1
inB :: Int -- ^ number of steps before value is emitted.
-> Auto m a (Blip a)
inB = mkState f . Just
where
f _ Nothing = (NoBlip, Nothing)
f x (Just i) | i <= 1 = (Blip x, Nothing)
| otherwise = (NoBlip, Just (i - 1))
-- | Produces a blip stream that emits the input value whenever the input
-- satisfies a given predicate.
--
-- Warning! This 'Auto' has the capability of "breaking" blip semantics.
-- Be sure you know what you are doing when using this. Blip streams are
-- semantically supposed to only emit at discrete, separate occurrences.
-- Do not use this for interval-like (on and off for chunks at a time)
-- things; each input should be dealt with as a separate thing.
--
-- For interval semantics, we have 'Interval' from "Control.Auto.Interval".
--
-- Good example:
--
-- > -- is only emitting at discrete blips
-- > emitOn even . iterator (+ 1) 0
--
-- Bad examples:
--
-- > -- is emitting for "durations" or "intervals" of time.
-- > emitOn (< 10) . iterator (+ 1) 0
-- >
-- > emitOn (const True) . foo
--
-- These bad examples would be good use cases of 'Interval'.
--
-- Can be particularly useful with prisms from the /lens/ package, where
-- things like @emitOn (has _Right)@ and @emitOn (hasn't _Right)@ will emit
-- the input @Either a b@ whenever it is or isn't a 'Right'. See
-- 'emitJusts' for more common uses with /lens/.
--
emitOn :: (a -> Bool) -- ^ predicate to emit on
-> Auto m a (Blip a)
emitOn p = mkFunc $ \x -> if p x then Blip x else NoBlip
-- | An 'Auto' that runs every input through a @a -> 'Maybe' b@ test and
-- produces a blip stream that emits the value inside every 'Just' result.
--
-- Particularly useful with prisms from the /lens/ package, where things
-- like @emitJusts (preview _Right)@ will emit the @b@ whenever the input
-- @Either a b@ stream is a @Right@.
--
-- Warning! Carries all of the same dangers of 'emitOn'. You can easily
-- break blip semantics with this if you aren't sure what you are doing.
-- Remember to only emit at discrete, separate occurences, and not for
-- interval-like (on and off for chunks at a time) things. For interval
-- semantics, we have "Control.Auto.Interval".
--
-- See the examples of 'emitOn' for more concrete good/bad use cases.
emitJusts :: (a -> Maybe b) -- ^ "predicate" to emit on.
-> Auto m a (Blip b)
emitJusts p = mkFunc (maybe NoBlip Blip . p)
-- | @'every' n@ is an 'Auto' that emits with the incoming inputs on every
-- @n@th input value. First emitted value is on the @n@th step.
--
-- Will obviously break blip semantics when you pass in 1.
--
every :: Int -- ^ emit every @n@ steps.
-> Auto m a (Blip a)
every (max 1 -> n) = mkState f n
where
f x i | i <= 1 = (Blip x, n )
| otherwise = (NoBlip, i - 1)
-- | @'eachAt' n xs@ is an 'Auto' that ignores its input and creates
-- a blip stream that emits each element of @xs@ one at a time, evey @n@
-- steps. First emitted value is at step @n@.
--
-- Once the list is exhausted, never emits again.
--
-- Obviously breaks blip semantics when you pass in 1.
--
-- The process of serializing and resuming this 'Auto' is O(n) space and
-- time with the length of @xs@. So don't serialize this if you plan on
-- passing an infinite list :) See "Control.Auto.Generate" for more
-- options.
--
-- prop> eachAt n xs == perBlip (fromList xs) . every n
eachAt :: Serialize b
=> Int -- ^ emit every @n@ steps
-> [b] -- ^ list to emit values from
-> Auto m a (Blip b)
eachAt (max 1 -> n) xs = mkState (\_ -> _eachAtF n) (n, xs)
-- | The non-serializing/non-resumable version of 'eachAt'.
eachAt_ :: Int -- ^ emit every @n@ steps
-> [b] -- ^ list to emit values from
-> Auto m a (Blip b)
eachAt_ (max 1 -> n) xs = mkState_ (\_ -> _eachAtF n) (n, xs)
_eachAtF :: Int -> (Int, [b]) -> (Blip b, (Int, [b]))
_eachAtF n (i, xs) = case xs of
[] -> (NoBlip, (0 , xs))
y:ys | i <= 1 -> (Blip y, (n , ys))
| otherwise -> (NoBlip, (i - 1, xs))
-- | Suppress all upstream emissions when the predicate (on the emitted
-- value) fails.
filterB :: (a -> Bool) -- ^ filtering predicate
-> Auto m (Blip a) (Blip a)
filterB p = mkFunc $ \x -> case x of
Blip x' | p x' -> x
_ -> NoBlip
-- | "Splits" a blip stream based on a predicate. Takes in one blip stream
-- and produces two: the first emits whenever the input emits with a value
-- that passes the predicate, and the second emits whenever the input emits
-- with a value that doesn't.
splitB :: (a -> Bool)
-> Auto m (Blip a) (Blip a, Blip a)
splitB p = mkFunc $ \x -> case x of
Blip x' | p x' -> (x, NoBlip)
| otherwise -> (NoBlip, x)
_ -> (NoBlip, NoBlip)
-- | "Collapses" a blip stream of blip streams into single blip stream.
-- that emits whenever the inner-nested stream emits.
joinB :: Auto m (Blip (Blip a)) (Blip a)
joinB = mkFunc (blip NoBlip id)
-- | Applies the given function to every emitted value, and suppresses all
-- those for which the result is 'Nothing'. Otherwise, lets it pass
-- through with the value in the 'Just'.
mapMaybeB :: (a -> Maybe b)
-> Auto m (Blip a) (Blip b)
mapMaybeB f = mkFunc $ \x -> case x of
Blip x' -> maybe NoBlip Blip $ f x'
_ -> NoBlip
-- | Supress all upstream emitted values except for the very first.
once :: Auto m (Blip a) (Blip a)
once = mkState f False
where
f _ True = (NoBlip, True )
f e@(Blip _) False = (e, True )
f _ False = (NoBlip, False)
-- | Suppress only the first emission coming from upstream, and let all the
-- others pass uninhibited.
notYet :: Auto m (Blip a) (Blip a)
notYet = mkState f False
where
f e True = (e , True )
f (Blip _) False = (NoBlip, True )
f _ False = (NoBlip, False)
-- | @'takeB' n@ allows only the first @n@ emissions to pass; it suppresses
-- all of the rest.
takeB :: Int -- ^ number of emissions to allow to pass
-> Auto m (Blip a) (Blip a)
takeB = mkState f . max 0
where
f _ 0 = (NoBlip, 0 )
f e@(Blip _) i = (e , i-1)
f _ i = (NoBlip, i )
-- | Allow all emitted valuesto pass until the first that fails the
-- predicate.
takeWhileB :: (a -> Bool) -- ^ filtering predicate
-> Auto m (Blip a) (Blip a)
takeWhileB p = mkState f False
where
f _ True = (NoBlip, True )
f e@(Blip x) False | p x = (e , False)
f _ False = (NoBlip, True )
-- | @'dropB' n@ suppresses the first @n@ emissions from upstream and
-- passes through the rest uninhibited.
dropB :: Int -- ^ number of emissions to suppress initially
-> Auto m (Blip a) (Blip a)
dropB = mkState f . max 0
where
f x 0 = (x , 0 )
f (Blip _) i = (NoBlip, i-1)
f _ i = (NoBlip, i )
-- | Suppress all emited values until the first one satisfying the
-- predicate, then allow the rest to pass through.
dropWhileB :: (a -> Bool) -- ^ filtering predicate
-> Auto m (Blip a) (Blip a)
dropWhileB p = mkState f False
where
f e True = (e , True )
f e@(Blip x) False | p x = (NoBlip, False)
| otherwise = (e , True )
f _ False = (NoBlip, False)
-- | Takes in a blip stream and outputs a blip stream where each emission
-- is delayed/lagged by one step.
--
-- >>> streamAuto' (emitOn (\x -> x `mod` 3 == 0)) [1..9]
-- >>> [NoBlip, NoBlip, Blip 3, NoBlip, NoBlip, Blip 6, NoBlip, NoBlip, Blip 9]
-- >>> streamAuto' (lagBlips . emitOn (\x -> x `mod` 3 == 0)) [1..9]
-- >>> [NoBlip, NoBlip, NoBlip, Blip 3, NoBlip, NoBlip, Blip 6, NoBlip, NoBlip]
--
lagBlips :: Serialize a => Auto m (Blip a) (Blip a)
lagBlips = mkState (\x s -> (s, x)) NoBlip
-- | The non-serializing/non-resuming version of 'lagBlips'.
lagBlips_ :: Auto m (Blip a) (Blip a)
lagBlips_ = mkState_ (\x s -> (s, x)) NoBlip
-- | Accumulates all emissions in the incoming blip stream with
-- a "folding function", with a given starting value. @b -> a -> b@, with
-- a starting @b@, gives @'Auto' m ('Blip' a) ('Blip' b)@.
--
-- The resulting blip stream will emit every time the input stream emits,
-- but with the "accumulated value".
--
-- Basically 'accum', but on blip stream emissions.
--
-- prop> accumB f x0 == perBlip (accum f x0)
accumB :: Serialize b
=> (b -> a -> b) -- ^ folding function
-> b -- ^ initial value
-> Auto m (Blip a) (Blip b)
accumB f = mkState (_accumBF f)
-- | The non-serializing/non-resuming version of 'accumB'.
accumB_ :: (b -> a -> b) -- ^ folding function
-> b -- ^ initial value
-> Auto m (Blip a) (Blip b)
accumB_ f = mkState_ (_accumBF f)
_accumBF :: (b -> a -> b) -> Blip a -> b -> (Blip b, b)
_accumBF f e y0 = case e of
Blip x -> let y1 = f y0 x
in (Blip y1, y1)
NoBlip -> (NoBlip , y0)
-- | The output is the result of folding up every emitted value seen thus
-- far, with the given folding function and initial value.
--
-- prop> scanB f x0 == holdWith x0 . accumB f x0
--
-- >>> let a = scanB (+) 0 . eachAt 2 [1,2,3]
-- >>> take 8 . streamAuto' a $ repeat ()
-- [0, 1, 1, 3, 3, 6, 6, 6, 6]
scanB :: Serialize b
=> (b -> a -> b) -- ^ folding function
-> b -- ^ initial value
-> Auto m (Blip a) b
scanB f = accum (_scanBF f)
-- | The non-serializing/non-resuming version of 'scanB'.
scanB_ :: (b -> a -> b)
-> b -- ^ folding function
-> Auto m (Blip a) b -- ^ initial value
scanB_ f = accum_ (_scanBF f)
_scanBF :: (b -> a -> b) -> b -> Blip a -> b
_scanBF f y0 = blip y0 (f y0)
-- | The output is the 'mconcat' (monoid sum) of all emitted values seen
-- this far.
mscanB :: (Monoid a, Serialize a)
=> Auto m (Blip a) a
mscanB = scanB (<>) mempty
-- | The non-serializing/non-resuming version of 'mscanB'.
mscanB_ :: Monoid a
=> Auto m (Blip a) a
mscanB_ = scanB_ (<>) mempty
-- | The output is the number of emitted values received from the upstream
-- blip stream so far.
countB :: Auto m (Blip a) Int
countB = accum (\i -> (i +) . blip 0 (const 1)) 0
-- | Blip stream that emits whenever the predicate applied to the input
-- switches from false to true. Emits with the triggering input value.
became :: Serialize a
=> (a -> Bool) -- ^ change condition
-> Auto m a (Blip a)
became p = accum (_becameF p) NoBlip
-- | Blip stream that emits whenever the predicate applied to the input
-- switches from true to false. Emits with the triggering input value.
noLonger :: Serialize a
=> (a -> Bool) -- ^ change condition
-> Auto m a (Blip a)
noLonger p = became (not . p)
-- | Blip stream that emits whenever the predicate applied to the input
-- switches from true to false or false to true. Emits with the triggering
-- input value.
onFlip :: (Serialize a, Monad m)
=> (a -> Bool) -- ^ change condition
-> Auto m a (Blip a)
onFlip p = became p &> noLonger p
-- | The non-serializing/non-resumable version of 'became'.
became_ :: (a -> Bool) -- ^ change condition
-> Auto m a (Blip a)
became_ p = accum_ (_becameF p) NoBlip
-- | The non-serializing/non-resumable version of 'noLonger'.
noLonger_ :: (a -> Bool) -- ^ change condition
-> Auto m a (Blip a)
noLonger_ p = became_ (not . p)
-- | The non-serializing/non-resumable version of 'onFlip'.
onFlip_ :: Monad m
=> (a -> Bool) -- ^ change condition
-> Auto m a (Blip a)
onFlip_ p = became_ p &> noLonger_ p
_becameF :: (a -> Bool) -> Blip a -> a -> Blip a
_becameF p e x | p x = blip (Blip x) (const NoBlip) e
| otherwise = NoBlip
-- | Like 'became', but emits a '()' instead of the triggering input value.
--
-- Useful because it can be serialized without the output needing
-- a 'Serialize' instance.
became' :: (a -> Bool) -- ^ change condition
-> Auto m a (Blip ())
became' p = accum f NoBlip
where
f e x | p x = blip (Blip ()) (const NoBlip) e
| otherwise = NoBlip
-- | Like 'noLonger', but emits a '()' instead of the triggering input
-- value.
--
-- Useful because it can be serialized without the output needing
-- a 'Serialize' instance.
noLonger' :: (a -> Bool) -- ^ change condition
-> Auto m a (Blip ())
noLonger' p = became' (not . p)
-- | Like 'onFlip', but emits a 'Bool' instead of the triggering input
-- value. An emitted 'True' indicates that the predicate just became true;
-- an emitted 'False' indicates that the predicate just became false.
--
-- Useful because it can be serialized without the output needing
-- a 'Serialize' instance.
onFlip' :: Monad m
=> (a -> Bool) -- ^ change condition
-> Auto m a (Blip Bool)
onFlip' p = fmap (True <$) (became' p) &> fmap (False <$) (noLonger' p)
-- | Blip stream that emits whenever the input value changes. Emits with
-- the new value.
--
-- Warning: Note that, when composed on a value that is never expected to
-- keep the same value twice, this technically breaks blip semantics.
onChange :: (Serialize a, Eq a) => Auto m a (Blip a)
onChange = mkState _onChangeF Nothing
-- | The non-serializing/non-resumable version of 'onChange'.
onChange_ :: Eq a => Auto m a (Blip a)
onChange_ = mkState_ _onChangeF Nothing
_onChangeF :: Eq a => a -> Maybe a -> (Blip a, Maybe a)
_onChangeF x Nothing = (NoBlip, Just x )
_onChangeF x (Just x') | x == x' = (NoBlip, Just x')
| otherwise = (Blip x, Just x )
-- | An 'Auto' that emits whenever it receives a 'Just' input, with the
-- value inside the 'Just'.
--
-- Warning! Carries all of the same dangers of 'emitOn'. You can easily
-- break blip semantics with this if you aren't sure what you are doing.
-- Remember to only emit at discrete, separate occurences, and not for
-- interval-like (on and off for chunks at a time) things. For interval
-- semantics, we have "Control.Auto.Interval".
--
-- See the examples of 'emitOn' for more concrete good/bad use cases.
onJusts :: Auto m (Maybe a) (Blip a)
onJusts = mkFunc (maybe NoBlip Blip)
-- | @'fromBlips' d@ is an 'Auto' that decomposes the incoming blip
-- stream by constantly outputting @d@ except when the stream emits, and
-- outputs the emitted value when it does.
fromBlips :: a -- ^ the "default value" to output when the input is not
-- emitting.
-> Auto m (Blip a) a
fromBlips d = mkFunc (blip d id)
-- | @'fromBlipsWith' d f@ is an 'Auto' that decomposes the incoming blip
-- stream by constantly outputting @d@ except when the stream emits, and
-- outputs the result of applying @f@ to the emitted value when it does.
fromBlipsWith :: b -- ^ the 'default value" to output when the input is not
-- emitting.
-> (a -> b) -- ^ the function to apply to the emitted value
-- whenever input is emitting.
-> Auto m (Blip a) b
fromBlipsWith d f = mkFunc (blip d f)
-- | @'holdWith' y0@ is an 'Auto' whose output is always the /most recently
-- emitted/ value from the input blip stream. Before anything is emitted,
-- @y0@ is outputted as a placeholder.
--
-- Contrast with 'hold' from "Control.Auto.Interval".
holdWith :: Serialize a
=> a
-> Auto m (Blip a) a
holdWith = accum f
where
f x = blip x id
-- | A non-serializing/non-resumable version of 'holdWith'.
holdWith_ :: a
-> Auto m (Blip a) a
holdWith_ = accum_ f
where
f x = blip x id
-- | Re-emits every emission from the input blip stream, but replaces its
-- value with the given value.
--
-- prop> tagBlips x == modifyBlips (const x)
tagBlips :: b -- ^ value to replace every emitted value with
-> Auto m (Blip a) (Blip b)
tagBlips y = mkFunc (y <$)
-- | Re-emits every emission from the input blip stream, but applies the
-- given function to the emitted value.
modifyBlips :: (a -> b) -- ^ function to modify emitted values with
-> Auto m (Blip a) (Blip b)
modifyBlips f = mkFunc (fmap f)
-- | Takes an @'Auto' m a b@ (an 'Auto' that turns incoming @a@s into
-- outputting @b@s) into an @'Auto' m ('Blip' a) ('Blip' b)@; the original
-- 'Auto' is lifted to only be applied to emitted contents of a blip
-- stream.
--
-- When the stream emits, the original 'Auto' is "stepped" with the emitted
-- value; when it does not, it is paused and frozen until the next
-- emission.
--
-- >>> let sums = perBlip (sumFrom 0)
-- >>> let blps = eachAt 2 [1,5,2]
-- >>> take 8 . streamAuto' blps $ repeat ()
-- [NoBlip, Blip 1, NoBlip, Blip 5, NoBlip, Blip 2, NoBlip, NoBlip]
-- >>> take 8 . streamAuto' (sums . blps) $ repeat ()
-- [NoBlip, Blip 1, NoBlip, Blip 6, NoBlip, Blip 8, NoBlip, NoBlip]
--
perBlip :: Monad m => Auto m a b -> Auto m (Blip a) (Blip b)
perBlip = dimap to from . right
where
to = blip (Left ()) Right
from = either (const NoBlip) Blip