content: -- |
  -- 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
      (-->)
    , (-?>)
    , switchIn
    -- * 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 = whenI (<= 4) --> pure 0
  -- >>> streamAuto' a1 [1..10]
  -- [1, 2, 3, 4, 0, 0, 0, 0, 0, 0]
  --
  -- ('whenI' 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 "world"
  --          --> 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 l
                           (put True  *> saveAuto a)
                         $ \x -> do
                             (y, a') <- stepAuto a x
                             return (y, switched a')
  -- TODO: Add tests for the serialization here.
  
  -- | @'switchIn' n a1 a2@ will behave like @a1@ for @n@ steps of output,
  -- and then behave like @a2@ forever after.
  --
  -- More or less a more efficient/direct implementation of the common idiom:
  --
  -- @
  -- onFor n a1 --> a2
  -- @
  --
  --
  switchIn :: Monad m
           => Int           -- ^ number of outputs before switching
           -> Auto m a b    -- ^ initial behavior
           -> Auto m a b    -- ^ switched behavior
           -> Auto m a b
  switchIn n a1 a2 | n > 0     = mkAutoM l s t
                   | otherwise = switched a2
    where
      l = do
        flag <- get
        if flag
          then resumeAuto (switched a2)
          else switchIn <$> get <*> resumeAuto a1 <*> pure a2
      s = put False *> put n *> saveAuto a1
      t x = do
        (y, a1') <- stepAuto a1 x
        return (y, switchIn (n - 1) a1' a2)
      switched a = mkAutoM l
                           (put True *> saveAuto a)
                         $ \x -> do
                             (y, a') <- stepAuto a x
                             return (y, switched a')
  
  
  -- | 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 /replaces/ the contained 'Auto' with the /new/ one (just after
  -- emitting the "normal value"), 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 [101, 102, 103]
  -- , 104, 209, 315 -- second 'sumFrom', on second three items [104, 105, 106]
  -- , 107, 215, 324 -- third 'sumFrom', on third three items [107, 108, 109]
  -- , 110, 221, 333 -- final 'sumFrom', on fourth 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 documentation 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' (switchFromF (\x -> (x,) <$> never) 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 -< (sums, switchBlip)
  --
  -- -- alternatively
  -- a2' = sumFrom 0 &&& (tagBlips () . inB 3)
  -- @
  --
  -- >>> streamAuto' (switchFromF (const a2) a2) [101..112]
  -- [ 101, 203, 306  -- first 'sumFrom', on first three items [101, 102, 103]
  -- , 104, 209, 315  -- second 'sumFrom', on second three items [104, 105, 106]
  -- , 107, 215, 324  -- third 'sumFrom', on third three items [107, 108, 109]
  -- , 110, 221, 333] -- final 'sumFrom', on fourth 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 ())
  