-- | -- Module : Control.Auto.Switch -- Description : Combinators for dynamically switching between and -- sequencing 'Auto's. -- Copyright : (c) Justin Le 2015 -- License : MIT -- Maintainer : justin@jle.im -- Stability : unstable -- Portability : portable -- -- -- A collection of versatile switching mechanisms. Switching is really -- a core mechanic at the heart of how to structure a lot of program -- logics. Switching from one "mode" to another, from dead to alive, from -- room to room, menu to menu...switching between 'Auto's is a core part -- about how many programs are built. -- -- All of the switches here take advantage of either blip semantics (from -- "Control.Auto.Blip") or /Interval/ semantics (from -- "Control.Auto.Interval")...so this is where maintaining semantically -- meaningful blip streams and intervals pays off! -- -- Each switch here has various examples, and you'll find many of these in -- use in the <https://github.com/mstksg/auto-examples example projects>. -- -- Note the naming convention going on here (also used in -- "Control.Auto.Serialize"): A switch "from" a blip stream is triggered -- "internally" by the 'Auto' being switched itself; a switch "on" a blip -- stream is triggered "externally" by an 'Auto' that is /not/ swiched. -- module Control.Auto.Switch ( -- * Sequential switching (-->) , (-?>) -- * Arbitrary switching , switchFrom_ , switchOn_ -- * Function-based switches , switchOnF , switchOnF_ , switchFromF , switchFromF_ -- * Resetting , resetOn , resetFrom ) where import Control.Applicative import Control.Arrow import Control.Auto.Blip import Control.Auto.Blip.Internal import Control.Auto.Core import Control.Auto.Interval import Control.Category import Data.Maybe import Data.Serialize import Prelude hiding ((.), id) infixr 1 --> infixr 1 -?> -- | "This, then that". Behave like the first 'Interval' (and run its -- effects) as long as it is "on" (outputting 'Just'). As soon as it turns -- off (is 'Nothing), it'll "switch over" and begin behaving like the -- second 'Auto' forever, running the effects of the second 'Auto', too. -- Works well if the 'Auto's follow interval semantics from -- "Control.Auto.Interval". -- -- >>> let a1 = whileI (<= 4) --> pure 0 -- >>> streamAuto' a1 [1..10] -- [1, 2, 3, 4, 0, 0, 0, 0, 0, 0] -- -- ('whileI' only lets items satisfying the predicate pass through as "on", -- and is "off" otherwise; 'pure' is the 'Auto' that always produces the -- same output) -- -- Association works in a way that you can "chain" '-->'s, as long as you -- have an appropriate 'Auto' (and not 'Interval') at the end: -- -- >>> let a2 = onFor 3 . sumFrom 0 -- --> onFor 3 . sumFrom 100 -- --> pure 0 -- >>> streamAuto' a2 [1..10] -- [1,3,6,104,109,115,0,0,0,0] -- -- @a --> b --> c@ associates as @a --> (b --> c)@ -- -- This is pretty invaluable for having 'Auto's "step" through a series of -- different 'Auto's, progressing their state from one stage to the next. -- 'Auto's can control when they want to be "moved on" from by turning -- "off" (outputting 'Nothing'). -- -- Note that recursive bindings work just fine, so: -- -- >>> let a3 = onFor 2 . pure "hello" -- --> onFor 2 . pure "goodbye" -- --> a3 -- >>> let (res3, _) = stepAutoN' 8 a3 () -- >>> res3 -- ["hello", "hello", "world", "world", "hello", "hello", "world", "world"] -- -- the above represents an infinite loop between outputting "hello" and -- outputting "world". -- -- For serialization, an extra byte cost is incurred per invocation of -- '-->'. For cyclic switches like @a3@, every time the cycle "completes", -- it adds another layer of '-->' byte costs. For example, initially, -- saving @a3@ incurs a cost for the two '-->'s. After @a3@ loops once, -- it incurs a cost for another two '-->'s, so it costs four '-->'s. After -- @a3@ loops another time, it is like a cost of six '-->'s. So be aware -- that for cyclic bindings like @a3@, space for serialization grows at -- O(n). -- -- By the way, it might be worth contrasting this with '<|!>' and '<|?>' -- from "Control.Auto.Interval", which have the same type signatures. -- Those alternative-y operators always /feed the input to both sides/, -- /run both sides/, and output the first 'Just'. With '<|!>', you can -- "switch back and forth" to the first 'Auto' as soon as the first 'Auto' -- is "on" ('Just') again. -- -- '-->', in contrast, runs /only/ the first 'Auto' until it is -- off ('Nothing')...then runs /only/ the second 'Auto'. This transition is -- one-way, as well. (-->) :: Monad m => Interval m a b -- ^ initial behavior -> Auto m a b -- ^ final behavior, when the initial -- behavior turns off. -> Auto m a b a1 --> a2 = fmap fromJust (a1 -?> fmap Just a2) -- | A variation of '-->', where the right hand side can also be an -- interval/'Maybe'. The entire result is, then, a 'Maybe'. Probably less -- useful than '-->' in most situations. (-?>) :: Monad m => Interval m a b -- ^ initial behavior -> Interval m a b -- ^ final behavior, when the initial -- behavior turns off. -> Interval m a b a1 -?> a2 = mkAutoM l s t where l = do flag <- get if flag then resumeAuto (switched a2) else (-?> a2) <$> resumeAuto a1 s = put False *> saveAuto a1 t x = do (y1, a1') <- stepAuto a1 x case y1 of Just _ -> return (y1, a1' -?> a2) Nothing -> do (y, a2') <- stepAuto a2 x return (y, switched a2') switched a = mkAutoM (switched <$> resumeAuto a) (put True *> saveAuto a) $ \x -> do (y, a') <- stepAuto a x return (y, switched a') -- TODO: Add tests for the serialization here. -- | Takes an 'Auto' who has both a normal output stream and a blip stream -- output stream, where the blip stream emits new 'Auto's. -- -- You can imagine 'switchFrom_' as a box containing a single 'Auto' like -- the one just described. It feeds its input into the contained 'Auto', -- and its output stream is the "normal value" output stream of the -- contained 'Auto'. -- -- However, as soon as the blip stream of the contained 'Auto' emits a new -- 'Auto'...it immediately /replaces/ the contained 'Auto' with the /new/ -- one. And the whole thing starts all over again. -- -- @'switchFrom_' a0@ will "start" with @a0@ already in the box. -- -- This is mostly useful to allow 'Auto's to "replace themselves" or -- control their own destiny, or the behavior of their successors. -- -- In the following example, @a1@ is an 'Auto' that behaves like -- a cumulative sum but also outputs a blip stream that will emit an 'Auto' -- containing @'pure' 100@ (the 'Auto' that always emits 100) after three -- steps. -- -- @ -- a1 :: Auto' Int (Int, Blip (Auto' Int Int)) -- a1 = proc x -> do -- sums <- sumFrom 0 -< x -- switchBlip <- inB 4 -< pure 100 -- id -< (sums, switchBlip) -- -- -- alternatively -- a1' = sumFrom 0 &&& (tagBlips (pure 100) . inB 4) -- @ -- -- So, @'switchFrom_' a1@ will be the output of 'count' for three steps, -- and then switch to @'pure' 100@ afterwards (when the blip stream -- emits): -- -- >>> streamAuto' (switchFrom_ a1) [1..10] -- [1,3,6,10,100,100,100,100,100,100] -- -- This is fun to use with recursion, so you can get looping switches: -- -- @ -- a2 :: Auto' Int (Int, Blip (Auto' Int Int)) -- a2 = proc x -> do -- sums <- sumFrom 0 -< x -- switchBlip <- inB 3 -< switchFrom_ a2 -- id -< (c, switchBlip) -- -- -- alternatively -- a2' = sumFrom 0 &&& (tagBlips (switchFrom_ a2') . inB 3) -- @ -- -- >>> streamAuto' (switchFrom_ a2) [101..112] -- [ 101, 203, 306 -- first 'sumFrom', on first three items -- , 104, 209, 315 -- second 'sumFrom', on second three items -- , 107, 215, 324 -- third 'sumFrom', on third three items (107, 108, 109) -- , 110, 221, 333] -- final 'sumFrom', on fourht three items (110, 111, 112) -- -- Note that this combinator is inherently unserializable, so you are going -- to lose all serialization capabilities if you use this. So sad, I know! -- :( This fact is reflected in the underscore suffix, as per convention. -- -- If you want to use switching /and/ have serialization, you can use the -- perfectly serialization-safe alternative, 'switchFromF', which slightly -- less powerful in ways that are unlikely to be missed in practical usage. -- That is, almost all non-contrived real life usages of 'switchFrom_' can -- be recovered using 'switchFromF'. -- switchFrom_ :: Monad m => Auto m a (b, Blip (Auto m a b)) -- ^ 'Auto' outputting a -- normal output (@b@) -- and a blip stream -- containing the 'Auto' -- to replace itself -- with. -> Auto m a b switchFrom_ a0 = mkAutoM_ $ \x -> do ((y, ea1), a0') <- stepAuto a0 x return $ case ea1 of Blip a1 -> (y, a1) NoBlip -> (y, switchFrom_ a0') -- | You can think of this as a little box containing a single 'Auto' -- inside. Takes two input streams: an input stream of normal values, and -- a blip stream containing 'Auto's. It feeds the input stream into the -- contained 'Auto'...but every time the input blip stream emits with a new -- 'Auto', /replaces/ the contained 'Auto' with the emitted one. Then -- starts the cycle all over, immediately giving the new 'Auto' the -- received input. -- -- Useful for being able to externally "swap out" 'Auto's for a given -- situation by just emitting a new 'Auto' in the blip stream. -- -- For example, here we push several 'Auto's one after the other into the -- box: @'sumFrom' 0@, @'productFrom' 1@, and 'count'. @'eachAt_' 4@ emits -- each 'Auto' in the given list every four steps, starting on the fourth. -- -- @ -- newAutos :: Auto' Int (Blip (Auto' Int Int)) -- newAutos = eachAt_ 4 [sumFrom 0, productFrom 1, count] -- -- a :: Auto' Int Int -- a = proc i -> do -- blipAutos <- newAutos -< () -- switchOn_ (pure 0) -< (i, blipAutos) -- -- -- alternatively -- a' = switchOn_ (pure 0) . (id &&& newAutos) -- @ -- -- >>> streamAuto' a [1..12] -- [ 1, 3, 6 -- output from sumFrom 0 -- , 4, 20, 120 -- output from productFrom 1 -- , 0, 1, 2, 3, 4, 5] -- output from count -- -- Like 'switchFrom_', this combinator is inherently unserializable. So if -- you use it, you give up serialization for your 'Auto's. This is -- reflected in the underscore suffix. -- -- If you wish to have the same switching devices but keep serialization, -- you can use 'switchOnF', which is slightly less powerful, but should be -- sufficient for all practical use cases. -- switchOn_ :: Monad m => Auto m a b -- ^ initial 'Auto' -> Auto m (a, Blip (Auto m a b)) b switchOn_ a0 = mkAutoM_ $ \(x, ea1) -> do let a = case ea1 of NoBlip -> a0 Blip a1 -> a1 (y, a') <- stepAuto a x return (y, switchOn_ a') -- | Essentially identical to 'switchFrom_', except insead of the 'Auto' -- outputting a blip stream of new 'Auto's to replace itself with, it emits -- a blip stream of @c@ --- and 'switchFromF' uses the @c@ to create the -- new 'Auto'. -- -- Here is the equivalent of the two examples from 'switchFrom_', -- implemented with 'switchFromF'; see the documentatino for 'switchFrom_' -- for a description of what they are to do. -- -- @ -- a1 :: Auto' Int (Int, Blip Int) -- a1 = proc x -> do -- sums <- sumFrom 0 -< x -- switchBlip <- inB 4 -< 100 -- id -< (sums, switchBlip) -- -- -- alternatively -- a1' = sumFrom 0 &&& (tagBlips 100 . inB 4) -- @ -- -- >>> streamAuto' (switchFrom_ pure a1) [1..10] -- [1,3,6,10,100,100,100,100,100,100] -- -- @ -- a2 :: Auto' Int (Int, Blip ()) -- a2 = proc x -> do -- sums <- sumFrom 0 -< x -- switchBlip <- inB 3 -< () -- id -< (c, switchBlip) -- -- -- alternatively -- a2' = sumFrom 0 &&& (tagBlips () . inB 3) -- @ -- -- >>> streamAuto' (switchFromF (const a2) a2) [101..112] -- [ 101, 203, 306 -- first 'sumFrom', on first three items -- , 104, 209, 315 -- second 'sumFrom', on second three items -- , 107, 215, 324 -- third 'sumFrom', on third three items (107, 108, 109) -- , 110, 221, 333] -- final 'sumFrom', on fourht three items (110, 111, 112) -- -- Or, if you're only ever going to use @a2@ in switching form: -- -- @ -- a2s :: Auto' Int Int -- a2s = switchFromF (const a2s) $ proc x -> do -- sums <- sumFrom 0 -< x -- switchBlip <- inB 3 -< () -- id -< (c, swichBlip) -- -- -- or -- a2s' = switchFromF (const a2s') -- $ sumFrom 0 &&& (tagBlips () . inB 3) -- @ -- -- >>> streamAuto' a2s [101..112] -- [101, 203, 306, 104, 209, 315, 107, 215, 324, 110, 221, 333] -- -- As you can see, all of the simple examples from 'switchFrom_' can be -- implemented in 'switchFromF'...and so can most real-life examples. The -- advantage is that 'switchFromF' is serializable, and 'switchFrom_' is -- not. -- -- Note that for the examples above, instead of using 'const', we could -- have actually used the input parameter to create a new 'Auto' based on -- what we outputted. -- switchFromF :: (Monad m, Serialize c) => (c -> Auto m a (b, Blip c)) -- ^ function to generate the -- next 'Auto' to behave like -> Auto m a (b, Blip c) -- ^ initial 'Auto'. the @b@ -- is the output, and the -- blip stream triggers new -- 'Auto's to replace this -- one. -> Auto m a b switchFromF f = go Nothing where go mz a = mkAutoM (l a) s t where s = put mz *> saveAuto a t x = do ((y, ez), a') <- stepAuto a x return $ case ez of Blip z -> (y, go (Just z) (f z)) NoBlip -> (y, go mz a' ) l a = do mz <- get case mz of Just z -> go mz <$> resumeAuto (f z) Nothing -> go mz <$> resumeAuto a -- | The non-serializing/non-resuming version of 'switchFromF'. You sort -- of might as well use 'switchFrom_'; this version might give rise to more -- "disciplined" code, however, by being more restricted in power. switchFromF_ :: Monad m => (c -> Auto m a (b, Blip c)) -- ^ function to generate the -- next 'Auto' to behave like -> Auto m a (b, Blip c) -- ^ initial 'Auto'. the @b@ -- is the output, and the -- blip stream triggers new -- 'Auto's to replace this -- one. -> Auto m a b switchFromF_ f a0 = mkAutoM_ $ \x -> do ((y, ez), a0') <- stepAuto a0 x return $ case ez of Blip z -> (y, switchFromF_ f (f z)) NoBlip -> (y, switchFromF_ f a0' ) -- | Gives an 'Auto' the ability to "reset" itself on command -- -- Basically acts like @'fmap' 'fst'@ -- -- @ -- fmap fst :: Monad m => Auto m a (b, Blip c) -> Auto m a b -- @ -- -- But...whenever the blip stream emits..."resets" the 'Auto' back to the -- original state, as if nothing ever happened. -- -- Note that this resetting happens on the step /after/ the blip stream -- emits. -- -- Here is a summer that sends out a signal to reset itself whenever the -- cumulative sum reaches 10 or higher: -- -- @ -- limitSummer :: Auto' Int (Int, Blip ()) -- limitSummer = (id &&& became (>= 10)) . sumFrom 0 -- @ -- -- And now we throw it into 'resetFrom': -- -- @ -- resettingSummer :: Auto' Int Int -- resettingSummer = resetFrom limitSummer -- @ -- -- >>> streamAuto' resettingSummer [1..10] -- [ 1, 3, 6, 10 -- and...reset! -- , 5, 11 -- and...reset! -- , 7, 15 -- and...reset! -- , 9, 19 ] -- resetFrom :: Monad m => Auto m a (b, Blip c) -- ^ The self-resetting 'Auto' -> Auto m a b resetFrom a = switchFromF (const a') a' where a' = second (tagBlips ()) . a -- | Essentially identical to 'switchOn_', except instead of taking in -- a blip stream of new 'Auto's to put into the box, takes a blip stream -- of @c@ --- and 'switchOnF' uses the @c@ to create the new 'Auto' to put -- in the box. -- -- Here is the equivalent of the two examples from 'switchOn_', -- implemented with 'switchOnF'; see the documentatino for 'switchOn_' -- for a description of what they are to do. -- -- @ -- newAuto :: Int -> Auto' Int Int -- newAuto 1 = sumFrom 0 -- newAuto 2 = productFrom 1 -- newAuto 3 = count -- newAuto _ = error "Do you expect rigorous error handling from a toy example?" -- -- a :: Auto' Int Int -- a = proc i -> do -- blipAutos <- eachAt 4 [1,2,3] -< () -- switchOnF_ newAuto (pure 0) -< (i, blipAutos) -- @ -- -- >>> streamAuto' a [1..12] -- [ 1, 3, 6 -- output from sumFrom 0 -- , 4, 20, 120 -- output from productFrom 1 -- , 0, 1, 2, 3, 4, 5] -- output from count -- -- Instead of sending in the "replacement 'Auto'", sends in a number, which -- corresponds to a specific replacement 'Auto'. -- -- As you can see, all of the simple examples from 'switchOn_' can be -- implemented in 'switchOnF'...and so can most real-life examples. The -- advantage is that 'switchOnF' is serializable, and 'switchOn_' is -- not. -- switchOnF :: (Monad m, Serialize c) => (c -> Auto m a b) -- ^ function to generate the next 'Auto' -- to behave like -> Auto m a b -- ^ initial starting 'Auto' to behave -- like -> Auto m (a, Blip c) b switchOnF f = go Nothing where go mz a0 = mkAutoM (l a0) (s mz a0) (t mz a0) l a0 = do mz <- get case mz of Just z -> go mz <$> resumeAuto (f z) Nothing -> go mz <$> resumeAuto a0 s mz a0 = put mz *> saveAuto a0 t mz a0 (x, ez) = case ez of NoBlip -> do (y, a0') <- stepAuto a0 x return (y, go mz a0') Blip z -> do (y, a1) <- stepAuto (f z) x return (y, go (Just z) a1) -- | The non-serializing/non-resuming version of 'switchOnF'. You sort of -- might as well use 'switchOn_'; this version might give rise to more -- "disciplined" code, however, by being more restricted in power. switchOnF_ :: Monad m => (c -> Auto m a b) -- ^ function to generate the next 'Auto' -- to behave like -> Auto m a b -- ^ initial starting 'Auto' to behave -- like -> Auto m (a, Blip c) b switchOnF_ f a0 = mkAutoM_ $ \(x, ez) -> case ez of NoBlip -> do (y, a0') <- stepAuto a0 x return (y, switchOnF_ f a0') Blip z -> do (y, a1) <- stepAuto (f z) x return (y, switchOnF_ f a1) -- | Takes an innocent 'Auto' and wraps a "reset button" around it. It -- behaves just like the original 'Auto' at first, but when the input blip -- stream emits, the internal 'Auto' is reset back to the beginning. -- -- Here we have 'sumFrom' wrapped around a reset button, and we send -- in a blip stream that emits every 4 steps; so every 4th step, the whole -- summer resets. -- -- >>> let a = resetOn (sumFrom 0) . (id &&& every 4) -- >>> streamAuto' a [101..112] -- [ 101, 203, 306 -- , 104, 209, 315 -- resetted! -- , 107, 215, 324 -- resetted! -- , 110, 221, 333] -- resetted! resetOn :: Monad m => Auto m a b -- ^ 'Auto' to repeatedly reset -> Auto m (a, Blip c) b resetOn a = switchOnF (const a) a . second (tagBlips ())