auto (empty) → 0.2.0.2
raw patch · 21 files changed
+9709/−0 lines, 21 filesdep +basedep +bytestringdep +cerealsetup-changed
Dependencies added: base, bytestring, cereal, containers, deepseq, profunctors, random, semigroups, transformers
Files
- .gitignore +4/−0
- CHANGELOG.md +20/−0
- LICENSE +21/−0
- README.md +407/−0
- Setup.hs +2/−0
- auto.cabal +86/−0
- src/Control/Auto.hs +141/−0
- src/Control/Auto/Blip.hs +777/−0
- src/Control/Auto/Blip/Internal.hs +180/−0
- src/Control/Auto/Collection.hs +855/−0
- src/Control/Auto/Core.hs +1821/−0
- src/Control/Auto/Effects.hs +495/−0
- src/Control/Auto/Generate.hs +299/−0
- src/Control/Auto/Interval.hs +726/−0
- src/Control/Auto/Process.hs +408/−0
- src/Control/Auto/Process/Random.hs +427/−0
- src/Control/Auto/Run.hs +476/−0
- src/Control/Auto/Serialize.hs +430/−0
- src/Control/Auto/Switch.hs +544/−0
- src/Control/Auto/Time.hs +548/−0
- tutorial/tutorial.md +1042/−0
+ .gitignore view
@@ -0,0 +1,4 @@+/cabal.sandbox.config+/dist+/.cabal-sandbox+/tmp
+ CHANGELOG.md view
@@ -0,0 +1,20 @@+0.2.0.2+-------+<https://github.com/mstksg/auto/releases/tag/v0.2.0.2>++* `dynZipF` and `dynMapF`, self-serializing dynamic collections.+++0.2.0.1+-------+<https://github.com/mstksg/auto/releases/tag/v0.2.0.1>++* `catchA` added to `Control.Auto.Effects`, allowing explicit catching of+ runtime exceptions thrown in underlying `IO`.+++0.2.0.0+-------+<https://github.com/mstksg/auto/releases/tag/v0.2.0.0>++* First official release. No backwards-incompatible changes until 0.3.0.0.
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2015 Justin Le++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ README.md view
@@ -0,0 +1,407 @@+Auto+====++(Working name)++Check it out!+-------------++~~~haskell+-- Let's impliement a PID feedback controller over a black box system.++import Control.Auto+import Prelude hiding ((.), id)++-- We represent a system as `System`, an `Auto` that takes stream of `Double`s+-- as input and transforms it into a stream of `Double`s as output. A+-- `System IO` might do IO in the process of creating its ouputs, for+-- instance.+--+type System m = Auto m Double Double++-- A PID controller adjusts the input to the black box system until the response+-- matches the target. It does this by adjusting the input based on the+-- current error, the cumulative sum, and the consecutative differences.+--+-- See http://en.wikipedia.org/wiki/PID_controller+--+-- Here, we just lay out the "concepts"/time-varying values in our system as a+-- recursive/cyclic graph of dependencies. It's a feedback system, after all.+--+pid :: (Double, Double, Double) -> System m -> System m+pid (kp, ki, kd) blackbox = proc target -> do+ rec -- err :: Double+ -- the difference of the response from the target+ let err = target - response++ -- cumulativeSum :: Double+ -- the cumulative sum of the errs+ cumulativeSum <- sumFrom 0 -< err++ -- changes :: Maybe Double+ -- the consecutive differences of the errors, with 'Nothing' at first.+ changes <- deltas -< err++ -- adjustment :: Double+ -- the adjustment term, from the PID algorithm+ let adjustment = kp * err+ + ki * cumulativeSum+ + kd * fromMaybe 0 changes++ -- the control input is the cumulative sum of the adjustments+ control <- sumFromD 0 -< adjustment++ -- the response of the system, feeding the control into the blackbox+ response <- blackbox -< control++ id -< response+~~~+++What is it?+-----------++**Auto** is a Haskell DSL and platform providing an API with declarative,+compositional, denotative semantics for discrete-step, locally stateful,+interactive programs, games, and automations, with implicitly derived+serialization. At the high-level, it allows you to describe your interactive+program or simulation as a *stream transformer*, by composition and+transformation of other stream transformers.++* **Haskell DSL/library**: It's a Haskell library that provides a+ domain-specific language for composing and declaring your programs/games.++ Why Haskell? Well, Haskell is one of the only languages that has a type+ system expressive enough to allow type-safe compositions without getting+ in your way. Every composition and component is checked at compile-time+ to make sure they even make sense, so you can work with an assurance that+ everything fits together in the end --- and also in the correct way. The+ type system can also guide you in your development as well. All this+ without the productivity overhead of explicit type annotations. In all+ honesty, it cuts the headache of large projects down --- and what you need+ to keep in your head as you develop and maintain --- by at least 90%.++* **Platform**: Not only gives the minimal tools for creating your programs,+ but also provides a platform to run and develop and integrate them, as+ well as many library/API functions for common processes.++* **Declarative**: It's not imperative. That is, unlike in other+ languages, you don't program your program by saying "this happens, then+ this happens...and then in case A, this happens; in case B, something else+ happens". Instead of specifying your program/game by a series of+ state-changing steps and procedures (a "game loop"), you instead declare+ "how things are". You declare fixed or evolving relationships between+ entities and processes and interactions. And this declaration process is+ high-level and pure.++* **Denotative**: Instead of your program being built of pieces that change+ things and execute things sequentially, your entire program is composed of+ meaningful semantic building blocks that "denote" constant relationships+ and concepts. The composition of such building blocks also denote new+ concepts. Your building blocks are well-defined *ideas*.++* **Compositional**: You build your eventually complex program/game out of+ small, simple components. These simple components compose with eachother;+ and compositions of components compose as well with other components.+ Every "layer" of composition is seamless. It's the [scalable program+ architecture][spa] principle in practice: If you combine an A with an A,+ you don't get a B; you get another A, which can combine with any other A.++ Like unix pipes, where you can build up complex programs by simply piping+ together simple, basic ones.++* **Discrete-step**: This library is meant for things that step discretely;+ there is no meaningful concept of "continuous time". Good examples+ include turn-based games, chat bots, and cellular automata; bad examples+ include real-time games and day trading simulations.++* **Locally stateful**: Every component encapsulates its own local (and+ "hidden") state. There is no global or impicitly shared state. This is+ in contrast to those "giant state monad" libraries/abstractions where you+ carry around the entire game/program state in some giant data type, and+ have your game loop simply be an update of that state.++ If you have a component representing a player, and a component+ representing an enemy --- the two components do not have to ever worry+ about the state of the other, or the structure of their shared state.++ Also, you never have to worry about something reading or modifying a part+ of the shared/global state it wasn't meant to read or modify! (Something+ you cannot guaruntee in the naive implementatation of the "giant state+ monad" technique).++* **Interactive**: The behavior and structure of your program can respond+ and vary dynamically with outside interaction. I'm not sure how else to+ elaborate on the word "interactive", actually!++* **Interactive programs, games and automations**: Programs, games, and+ automations/simulations. If you're making anything discrete-time that+ encapsulates some sort of internal state, especially if it's interactive,+ this is for you!! :D++* **Implicitly derived serialization**: All components and their+ compositions by construction are automatically "freezable" and+ serializable, and re-loaded and resumed with all internal state restored.+ As it has been called by ertes, it's "save states for free".++[spa]: http://www.haskellforall.com/2014/04/scalable-program-architectures.html++Intrigued? Excited? Start at [the tutorial][tutorial]!++[tutorial]: https://github.com/mstksg/auto/blob/master/tutorial/tutorial.md++It's a part of this package directory and also on github at the above link.+The current development documentation server is found at+<https://mstksg.github.io/auto>. You can find examples and demonstrations in+the [auto-examples][] repo on github; they are constantly being kept+up-to-date with the currently super unstable API.++[auto-examples]: https://github.com/mstksg/auto-examples++More examples and further descriptions will appear here as development+continues.++### Support++Though this library is not officially released yet, the official support and+discussion channel is #haskell-auto on freenode. You can also usually find me+(the maintainer and developer) as *jle`* on #haskell and #haskell-game. Also,+contributions to documentation and tests are welcome! :D++Why Auto?+---------++Auto is distinct from a "state transformer" (state monad, or explicit state+passing) in that it gives you the ability to implicitly *compose and isolate*+state transformers and state.++That is, imagine you have two different state monads with different states,+and you can compose them together into one giant loop, and:++1. You don't have to make a new "composite type"; you can add a new component+ dealing with its own state without changing the total state type.++2. You can't write anything cross-talking. You can't write anything that+ can interfere with the internal state of any components; each one is+ isolated.++So --- Auto is useful over a state monad/state transformer approach in cases+where you like to build your problem out of multiple individual components,+and compose them all together at once.++Examples include a multiple-module stateful chat bot, where every module of+the chat bot consists of its own internal state.++If you used a state monad approach, every time you added a new module with its+own state, you'd have to "add it into" your total state type.++This simply does *not* scale.++Imagine a large architecture, where every composition adds more and more+complexity.++Now, imagine you can just throw in another module with its own state without+any other component even "caring". Or be able to limit access implicitly,+without explicit "limiting through lifting" with `zoom` from lens, etc.+(Without that, you basically have "global state" --- the very thing that we+went to Functional Programming/Haskell to avoid in the first place! And the+thing that languages have been trying to prevent in the last twenty years of+language development. Why go "backwards"?)++In addition to all of these practical reasons, State imposes a large+*imperative* shift in your design.++State forces you to begin modeling your problem as "this happens, then this+happens, then this happens". When you choose to use a State monad or State+passing approach, you immediately begin to frame your entire program from an+imperative approach.++Auto lets you structure your program *denotatively* and declaratively. It+gives you that awesome style that functional programming promised in the first+place.++Instead of saying "do this then that", you say "this is how things...just+*are*. This is the structure of my program, and this is the nature of the+relationship between each component".++If you're already using Haskell...I shouldn't have to explain to you the+benefits of a high-level declarative style over an imperative one :)++Why not Auto?+-------------++That being said, there are cases where **Auto** is either the wrong tool or+not very helpful.++* Cases involving inherently continuous time. **Auto** is meant for+ situations where time progresses in discrete ticks --- integers, not+ reals. Auto is not suggested even to "simulate" continuous time with+ discrete sampling. You can do it...but FRP is a much, much better+ abstraction/system for handling this than **Auto** is. See the later+ section on FRP.++* Cases where you really don't have interactions/compositions between+ different stateful components. If all your program is just one `foldr` or+ `scanl` or `iterate`, and you don't have multiple interacting parts of+ your state, **Auto** really can't offer much. If, however, you have+ multiple folds or states that you want run together and compose, then this+ might be useful!++* Intense IO stuff and resource handling. **Auto** is not *pipes* or+ *conduit*. All IO is done "outside" of the **Auto** components; **Auto**+ can be useful for file processing and stream modification, but only if you+ separately handle the IO portions. **Auto** works very well with *pipes*+ or *conduit*; those libraries are used to "connect" **Auto** to the+ outside word, and provide a safe interface.+++Relation to FRP+---------------++**Auto** borrows a lot of concepts from *[Functional Reactive+Programming][frp]* --- especially arrowized, locally stateful libraries like+[netwire][]. **Auto** attempts to bring an applicable subset of FRP's+high-level concepts and semantics and transplant them into the world of+fundamentally discrete-step/discrete-time contexts. Users of such libraries+would likely be able to quickly pick up **Auto**, and the reverse is+(hopefully) true too.++Note that this library is not meant to be any sort of meaningful substitution+for implementing situations which involve concepts of continuous ("real+number-valued", as opposed to "integer valued") time (like real-time games);+you can "fake" it using **Auto**, but in those situations, FRP provides a much+superior semantics and set of concepts for working in such contexts.++[frp]: http://en.wikipedia.org/wiki/Functional_reactive_programming+[netwire]: https://hackage.haskell.org/package/netwire++Open questions+--------------++* In principle very little of your program should be over `IO` as a+ monad...but sometimes, it becomes quite convenient for abstraction+ purposes. Handling IO errors in a robust way isn't quite my strong point,+ and so while almost all `Auto` idioms avoid `IO` and runtime, for some+ applications it might be unavoidable. Providing industry-grade tools for+ making `IO` robust would be a good next priority.++A chatbot+---------++~~~haskell+import qualified Data.Map as M+import Data.Map (Map)+import Control.Auto+import Prelude hiding ((.), id)++-- Let's build a big chat bot by combining small chat bots.+-- A "ChatBot" is going to be an `Auto` taking in a tuple of an incoming nick,+-- message, and timestamp at every step; the result is a "blip stream" that+-- emits with messages whenever it wants to respond.++type Message = String+type Nick = String+type ChatBot m = Auto m (Nick, Message, UTCTime) (Blip [Message])+++-- Keeps track of last time a nick has spoken, and allows queries+seenBot :: Monad m => ChatBot m+seenBot = proc (nick, msg, time) -> do+ -- seens :: Map Nick UTCTime+ -- Map containing last time each nick has spoken+ seens <- accum addToMap M.empty -< (nick, time)++ -- query :: Blip Nick+ -- blip stream emits whenever someone queries for a last time seen;+ -- emits with the nick queried for+ query <- emitJusts getRequest -< words msg++ -- a function to get a response from a nick query+ let respond :: Nick -> [Message]+ respond qry = case M.lookup qry seens of+ Just t -> [qry ++ " last seen at " ++ show t ++ "."]+ Nothing -> ["No record of " ++ qry ++ "."]++ -- output is, whenever the `query` stream emits, map `respond` to it.+ id -< respond <$> query+ where+ addToMap :: Map Nick UTCTime -> (Nick, UTCTime) -> Map Nick UTCTime+ addToMap mp (nick, time) = M.insert nick time mp+ getRequest ("@seen":request:_) = Just request+ getRequest _ = Nothing+++-- Users can increase and decrease imaginary internet points for other users+karmaBot :: Monad m => ChatBot m+karmaBot = proc (_, msg, _) -> do+ -- karmaBlip :: Blip (Nick, Int)+ -- blip stream emits when someone modifies karma, with nick and increment+ karmaBlip <- emitJusts getComm -< msg++ -- karmas :: Map Nick Int+ -- keeps track of the total karma for each user by updating with karmaBlip+ karmas <- scanB updateMap M.empty -< karmaBlip++ -- function to look up a nick, if one is asked for+ let lookupKarma :: Nick -> [Message]+ lookupKarma nick = let karm = M.findWithDefault 0 nick karmas+ in [nick ++ " has a karma of " ++ show karm ++ "."]++ -- output is, whenever `karmaBlip` stream emits, look up the result+ id -< lookupKarma . fst <$> karmaBlip+ where+ getComm :: String -> Maybe (Nick, Int)+ getComm msg = case words msg of+ "@addKarma":nick:_ -> Just (nick, 1 )+ "@subKarma":nick:_ -> Just (nick, -1)+ "@karma":nick:_ -> Just (nick, 0)+ _ -> Nothing+ updateMap :: Map Nick Int -> (Nick, Int) -> Map Nick Int+ updateMap mp (nick, change) = M.insertWith (+) nick change mp+++-- Echos inputs prefaced with "@echo"...unless flood limit has been reached+echoBot :: Monad m => ChatBot m+echoBot = proc (nick, msg, time) -> do+ -- echoBlip :: Blip [Message]+ -- blip stream emits when someone wants an echo, with the message+ echoBlip <- emitJusts getEcho -< msg++ -- newDayBlip :: Blip UTCTime+ -- blip stream emits whenever the day changes+ newDayBlip <- onChange -< utctDay time++ -- echoCounts :: Map Nick Int+ -- `countEchos` counts the number of times each user asks for an echo, and+ -- `resetOn` makes it "reset" itself whenever `newDayBlip` emits.+ echoCounts <- resetOn countEchos -< (nick <$ echoBlip, newDayBlip)++ -- has this user flooded today...?+ let hasFlooded = M.lookup nick echoCounts > Just floodLimit+ -- output :: Blip [Message]+ -- blip stream emits whenever someone asks for an echo, limiting flood+ output | hasFlooded = ["No flooding!"] <$ echoBlip+ | otherwise = echoBlip++ -- output is the `output` blip stream+ id -< output+ where+ floodLimit = 5+ getEcho msg = case words msg of+ "@echo":xs -> Just [unwords xs]+ _ -> Nothing+ countEchos :: Auto m (Blip Nick) (Map Nick Int)+ countEchos = scanB countingFunction M.empty+ countingFunction :: Map Nick Int -> Nick -> Map Nick Int+ countingFunction mp nick = M.insertWith (+) nick 1 mp++-- Our final chat bot is the `mconcat` of all the small ones...it forks the+-- input between all three, and mconcats the outputs.+chatBot :: Monad m => ChatBot m+chatBot = mconcat [seenBot, karmaBot, echoBot]++-- Here, our chatbot will automatically serialize itself to "data.dat"+-- whenever it is run.+chatBotSerialized :: ChatBot IO+chatBotSerialized = serializing' "data.dat" chatBot+~~~
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ auto.cabal view
@@ -0,0 +1,86 @@+name: auto+version: 0.2.0.2+synopsis: Denotative, locally stateful programming DSL & platform+description: (Up to date documentation is maintained at+ <https://mstksg.github.com/auto>)+ .+ /auto/ is a Haskell DSL and platform providing+ declarative, compositional, denotative semantics for+ discrete-step, locally stateful, interactive programs,+ games, and automations, with implicitly derived+ serialization.+ .+ /auto/ works by providing a type that encapsulates+ "stream transformers", or locally stateful functions; by+ specifying your program as a (potentially cyclic) graph+ of relationships between streams, you create a way of+ "declaring" a system based simply on static relationships+ between quantities.+ .+ Instead of a "state monad" type solution, where all+ functions have access to a global state, /auto/ works by+ specifying relationships which each exist independently+ and on their own, without any global state.+ .+ A more fuller exposition is in the `README.md`, in this+ project directory and also online at+ <https://github.com/mstksg/auto/blob/master/README.md>;+ you can get started by reading the tutorial, which is+ also in this project directory in the `tutorial`+ directory, and also incidentally online at+ <https://github.com/mstksg/auto/blob/master/tutorial/tutorial.md>.+ Also, check out the+ <https://github.com/mstksg/auto-examples auto-examples>+ repository on github for plenty of real-world and toy+ examples to learn from!+ .+ Import "Control.Auto" to begin!++license: MIT+license-file: LICENSE+author: Justin Le+maintainer: justin@jle.im+copyright: (c) Justin Le 2015+category: Control+homepage: https://github.com/mstksg/auto+bug-reports: https://github.com/mstksg/issues+build-type: Simple+extra-source-files: README.md+ CHANGELOG.md+ tutorial/tutorial.md+ .gitignore+cabal-version: >=1.10++source-repository head+ type: git+ location: git://github.com/mstksg/auto.git++library+ exposed-modules: Control.Auto+ , Control.Auto.Blip+ , Control.Auto.Blip.Internal+ , Control.Auto.Collection+ , Control.Auto.Core+ , Control.Auto.Effects+ , Control.Auto.Generate+ , Control.Auto.Interval+ , Control.Auto.Process+ , Control.Auto.Process.Random+ , Control.Auto.Run+ , Control.Auto.Serialize+ , Control.Auto.Switch+ , Control.Auto.Time+ -- other-modules: + -- other-extensions: + build-depends: base >= 4.6 && < 4.8+ , bytestring >= 0.10.4.0 && < 0.11+ , cereal >= 0.4.1.1 && < 0.5+ , containers >= 0.5.5.1 && < 0.6+ , deepseq >= 1.3.0.2 && < 2.0+ , profunctors >= 4.4.1 && < 5.0+ , random >= 1.1 && < 2.0+ , semigroups >= 0.16.2.2 && < 0.17+ , transformers >= 0.4.2.0 && < 0.5+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall
+ src/Control/Auto.hs view
@@ -0,0 +1,141 @@+-- |+-- Module : Control.Auto+-- Description : Main entry point to the /auto/ library.+-- Copyright : (c) Justin Le 2015+-- License : MIT+-- Maintainer : justin@jle.im+-- Stability : unstable+-- Portability : portable+--+-- This module serves as the main entry point for the library; these are+-- all basically re-exports. The re-exports are chosen so you can start+-- doing "normal things" off the bat, including all of the types used in+-- this library.+--+-- Conspicuously missing are the most of the tools for working with+-- 'Interval', 'Blip' streams, switches, and the "collection" autos; those+-- are all pretty heavy, and if you do end up working with any of those+-- tools, simply importing the appropriate module should give you all you+-- need.+--+-- See the <https://github.com/mstksg/auto/blob/master/tutorial/tutorial.md tutorial>+-- if you need help getting started!+--++module Control.Auto (+ -- * Types+ -- ** Auto+ Auto+ , Auto'+ -- ** Misc+ , Blip+ , Interval+ , Interval'+ -- * Working with 'Auto'+ -- ** Running+ , stepAuto+ , stepAuto'+ , evalAuto+ , evalAuto'+ , streamAuto+ , streamAuto'+ , stepAutoN+ , stepAutoN'+ -- ** Serializing+ -- | See the header of the "serializing" section of "Control.Auto.Core"+ -- for more detail on how these work.+ , encodeAuto+ , decodeAuto+ , readAuto+ , writeAuto+ -- ** Strictness+ , forcer+ , seqer+ -- ** Internal monad+ , hoistA+ , generalizeA+ -- * Auto constructors+ , arrM+ , arrD+ -- ** from Accumulators+ -- *** Result-first+ , accum+ , accum_+ , accumM+ , accumM_+ -- *** Initial accumulator-first+ , accumD+ , accumD_+ , accumMD+ , accumMD_+ -- ** from State transformers+ , mkState+ , mkStateM+ , mkState_+ , mkStateM_+ -- ** Generators+ -- *** Effects+ , effect+ -- , exec+ -- *** Iterators+ , iterator+ , iterator_+ , iteratorM+ , iteratorM_+ -- * Common 'Auto's and combinators+ -- ** Processes+ , sumFrom+ , sumFrom_+ , sumFromD+ , sumFromD_+ , productFrom+ , productFrom_+ , mappender+ , mappender_+ , mappendFrom+ , lastVal+ , lastVal_+ , count+ -- ** Switches+ , (-->)+ -- ** Blips+ , emitJusts+ , emitOn+ , fromBlips+ , fromBlipsWith+ , holdWith+ , holdWith_+ , perBlip+ , never+ , immediately+ -- ** Intervals+ , onFor+ , during+ , off+ , toOn+ -- * Running+ , interactAuto+ , interactRS+ -- * Re-exports+ , module Control.Applicative+ , module Control.Arrow+ , module Control.Category+ , module Data.Functor.Identity+ , module Data.Semigroup+ ) where++import Control.Applicative+import Control.Arrow hiding (loop)+import Control.Auto.Blip+import Control.Auto.Core+import Control.Auto.Effects+import Control.Auto.Generate+import Control.Auto.Interval+import Control.Auto.Process+import Control.Auto.Run+import Control.Auto.Serialize+import Control.Auto.Switch+import Control.Auto.Time+import Control.Category+import Data.Functor.Identity+import Data.Semigroup
+ src/Control/Auto/Blip.hs view
@@ -0,0 +1,777 @@+{-# 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+ , 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.+foldrB :: (a -> a -> a) -> a -> [Blip a] -> Blip a+foldrB f b0 = foldr (merge f) (Blip b0)++-- | Merge all of the blip streams together, using the given merging+-- function associating from the left.+foldlB' :: (a -> a -> a) -> a -> [Blip a] -> Blip a+foldlB' f b0 = foldl' (merge f) (Blip b0)+++-- | 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 n = mkState f (n, False)+ where+ f _ (_, True ) = (NoBlip, (1 , True ))+ f x (i, False) | i <= 1 = (Blip x, (1 , True ))+ | otherwise = (NoBlip, (i-1, False))++-- | 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'.+--+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++-- | "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_ :: Monad m+ => (a -> Bool) -- ^ change condition+ -> Auto m a (Blip a)+became_ p = accum_ (_becameF p) NoBlip++-- | The non-serializing/non-resumable version of 'noLonger'.+noLonger_ :: Monad m+ => (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' :: Monad m+ => (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' :: Monad m+ => (a -> Bool) -- ^ change condition+ -> Auto m a (Blip ())+noLonger' p = became' (not . p)++-- | Like 'onFlip', but emits a '()' instead of the triggering input value.+--+-- 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
+ src/Control/Auto/Blip/Internal.hs view
@@ -0,0 +1,180 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}++-- |+-- Module : Control.Auto.Blip.Internal+-- Description : Exposing internal unsafe functions for working with+-- 'Blip'.+-- Copyright : (c) Justin Le 2015+-- License : MIT+-- Maintainer : justin@jle.im+-- Stability : unstable+-- Portability : portable+--+-- This module exposes an "unsafe" interface for working with the internal+-- representation of "blip streams". If you are programming at the logic+-- level or the application level, you should thoroughly be able to avoid+-- importing this, and should be happy with importing the 'Blip' type from+-- "Control.Auto" and blip stream manipulators from "Control.Auto.Blip".+--+-- If, however, you are programming a framework, library, or backend, you+-- might find it useful to manually create your own blip streams/sources.+-- In this case, this module will be useful.+--+-- It is important, as with most of this library in general, to always keep+-- in mind when you are programming at the "logic" level, and when you are+-- programming at the "backend" level. If you can justify that you are at+-- the backend level and not at the logic level of whatever you are+-- programming, then this is useful.+--+-- Be sure, of course, that whatever blip streams you do manually+-- construct and export preserve "Blip semantics", which is further+-- defined in "Control.Auto.Blip".+--+-- You have been warned!+--++module Control.Auto.Blip.Internal (+ Blip(..)+ , merge+ , merge'+ , mergeL+ , mergeR+ , blip+ ) where++import Control.DeepSeq+import Data.Semigroup+import Data.Serialize+import Data.Typeable+import GHC.Generics++infixr 5 `mergeL`+infixl 5 `mergeR`++-- | When used in the context of an input or output of an 'Auto', a @'Blip'+-- a@ represents a stream that occasionally, at "independent" or "discrete"+-- points, emits a value of type @a@.+--+-- Contrast this to 'Interval', where things are meant to be "on" or "off"+-- for contiguous chunks at a time; blip streams are "blippy", and+-- 'Interval's are "chunky".+--+-- It's here mainly because it's a pretty useful abstraction in the context+-- of the many combinators found in various modules of this library. If+-- you think of an @'Auto' m a ('Blip' b)@ as producing a "blip stream",+-- then there are various combinators and functions that are specifically+-- designed to manipulate blip streams.+--+-- For the purposes of the semantics of what 'Blip' is supposed to+-- represent, its constructors are hidden. (Almost) all of the various+-- 'Blip' combinators (and its very useful 'Functor' instance) "preserve+-- 'Blip'ness" --- one-at-a-time occurrences remain one-at-a-time under all+-- of these combinators, and you should have enough so that direct access+-- to the constructor is not needed.+--+-- If you are creating a framework, library, or backend, you might want to+-- manually create blip stream-producing 'Auto's for your users to+-- access. In this case, you can import the constructors and useful+-- internal (and, of course, semantically unsafe) functions from+-- "Control.Auto.Blip.Internal".+data Blip a = NoBlip+ | Blip !a+ deriving ( Functor+ , Show+ , Typeable+ , Generic+ )++-- | Merge two blip streams together; the result emits with /either/ of the+-- two merged streams emit. When both emit at the same time, emit the+-- result of '<>'-ing the values together.+instance Semigroup a => Semigroup (Blip a) where+ (<>) = merge (<>)++-- | Merge two blip streams together; the result emits with /either/ of the+-- two merged streams emit. When both emit at the same time, emit the+-- result of '<>'-ing the values together.+instance Semigroup a => Monoid (Blip a) where+ mempty = NoBlip+ mappend = merge (<>)++instance Serialize a => Serialize (Blip a)++-- TODO: Am I allowed to do this?+instance NFData a => NFData (Blip a)++-- | Merge two blip streams together; the result emits with /either/ of the+-- two merged streams emit. When both emit at the same time, emit the+-- result of applying the given function on the two emitted values.+--+-- Note that this might be too strict for some purposes; see 'mergeL' and+-- 'mergeR' for lazier alternatives.+merge :: (a -> a -> a) -- ^ merging function+ -> Blip a -- ^ first stream+ -> Blip a -- ^ second stream+ -> Blip a -- ^ merged stream+merge = merge' id id++-- | Slightly more powerful 'merge', but I can't imagine a situation where+-- this power is necessary.+--+-- If only the first stream emits, emit with the first function applied to the+-- value. If only the second stream emits, emit with the second function+-- applied to the value. If both emit, then emit with the third function+-- applied to both emitted values.+merge' :: (a -> c) -- ^ function for first stream+ -> (b -> c) -- ^ function for second stream+ -> (a -> b -> c) -- ^ merging function+ -> Blip a -- ^ first stream+ -> Blip b -- ^ second stream+ -> Blip c -- ^ merged stream+merge' f _ _ (Blip x) NoBlip = Blip (f x)+merge' _ g _ NoBlip (Blip y) = Blip (g y)+merge' _ _ h (Blip x) (Blip y) = Blip (h x y)+merge' _ _ _ NoBlip NoBlip = NoBlip++-- | Merges two blip streams together into one, which emits+-- /either/ of the original blip streams emit. If both emit at the same+-- time, the left (first) one is favored.+--+-- Lazy on the second stream if the first stream is emitting.+--+-- If we discount laziness, this is @'merge' 'const'@.+mergeL :: Blip a -- ^ first stream (higher priority)+ -> Blip a -- ^ second stream+ -> Blip a+mergeL b1@(Blip _) _ = b1+mergeL _ b2 = b2++-- | Merges two blip streams together into one, which emits+-- /either/ of the original blip streams emit. If both emit at the same+-- time, the right (second) one is favored.+--+-- Lazy on the first stream if the second stream is emitting.+--+-- If we discount laziness, this is @'merge' ('flip' 'const')@.+--+mergeR :: Blip a -- ^ first stream+ -> Blip a -- ^ second stream (higher priority)+ -> Blip a+mergeR _ b2@(Blip _) = b2+mergeR b1 _ = b1++-- | Deconstruct a 'Blip' by giving a default result if the 'Blip' is+-- non-occuring and a function to apply on the contents, if the 'Blip' is+-- occuring.+--+-- Try not to use if possible, unless you are a framework developer. If+-- you're just making an application, try to use the other various+-- combinators in this library. It'll help you preserve the semantics of+-- what it means to be 'Blip'py.+--+-- Analogous to 'maybe' from "Prelude".+blip :: b -- ^ default value+ -> (a -> b) -- ^ function to apply on value+ -> Blip a -- ^ 'Blip' to deconstruct+ -> b+blip d _ NoBlip = d+blip _ f (Blip x) = f x
+ src/Control/Auto/Collection.hs view
@@ -0,0 +1,855 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module : Control.Auto.Collection+-- Description : 'Auto's that represent collections of 'Auto's that can be+-- run in parallel, multiplexed, gathered...+-- Copyright : (c) Justin Le 2015+-- License : MIT+-- Maintainer : justin@jle.im+-- Stability : unstable+-- Portability : portable+--+-- The 'Auto's in this module are all dedicated to managing and working+-- with (possibly dynamic) "collections" of 'Auto's: an 'Auto' where the+-- output stream is typically /many/ output streams collected from running+-- many input streams through many internal 'Auto's.+--+-- Particularly useful because a lot of these allow you to add or take away+-- these "channels of inputs" (or "internal 'Auto's") dynamically; so,+-- useful for collections that can be added to or deleted from, like+-- monsters on a map.+--+-- These multiplex, merge, or collect input streams through many 'Auto's+-- and output the multiplexed, merged, or collected output streams.+--+-- A lot of these 'Auto's take advantaage /Interval/ semantics ('Maybe' for+-- continuous on/off periods) to signal when they want to be removed or+-- turned off.+--+-- For these, the best way to learn them is probably by seeing examples.+--+-- If there is a time when you might want collections of things+-- that can be added to or removed from dynamically, this might be what you+-- are looking for.+--+-- These collections are indispensible for coding real applications; many+-- examples of them in use are available in the+-- <https://github.com/mstksg/auto-examples auto-examples> project! See+-- those projects for "real-world" guides.+--++module Control.Auto.Collection (+ -- * Static collections+ zipAuto+ , dZipAuto+ , dZipAuto_+ , zipAutoB+ , dZipAutoB+ , dZipAutoB_+ -- * Dynamic collections+ , dynZip_+ , dynZipF+ , dynZipF_+ , dynMap_+ , dynMapF+ , dynMapF_+ -- * Multiplexers+ -- ** Single input, single output+ , mux+ , mux_+ -- ** Multiple input, multiple output+ , muxMany+ , muxMany_+ -- * "Gathering"/accumulating collections+ -- ** Single input, multiple output+ , gather+ , gather_+ , gather__+ --- ** Multiple input, multiple output+ , gatherMany+ , gatherMany_+ , gatherMany__+ ) where++import Control.Applicative+import Control.Arrow+import Control.Auto.Blip.Internal+import Control.Auto.Core+import Control.Auto.Interval+import Control.Auto.Time+import Control.Category+import Control.Monad hiding (mapM, mapM_, sequence, sequence_)+import Data.Foldable+import Data.IntMap.Strict (IntMap)+import Data.Map.Strict (Map)+import Data.Maybe+import Data.Monoid+import Data.Profunctor+import Data.Serialize+import Data.Traversable+import Prelude hiding (mapM, mapM_, concat, sequence, (.), id, sequence_)+import qualified Data.IntMap.Strict as IM+import qualified Data.Map.Strict as M++-- | Give a list of @'Auto' m a b@ and get back an @'Auto' m [a] [b]@ ---+-- take a list of @a@'s and feed them to each of the 'Auto's, and collects+-- their output @b@'s.+--+-- If the input list doesn't have enough items to give to all of the+-- 'Auto's wrapped, then use the given default value. Any extra items in+-- the input list are ignored.+--+-- For an example, we're going to make a list of 'Auto's that output+-- a running sum of all of their inputs, but each starting at a different+-- beginning value:+--+-- @+-- summerList :: [Auto' Int Int]+-- summerList = [sumFrom 0, sumFrom 10, sumFrom 20, sumFrom 30]+-- @+--+-- Then, let's throw it into 'zipAuto' with a sensible default value, 0:+--+-- @+-- summings0 :: Auto' [Int] [Int]+-- summings0 = zipAuto 0 summerList+-- @+--+-- Now let's try it out!+--+-- >>> let (r1, summings1) = stepAuto' summings0 [1,2,3,4]+-- >>> r1+-- [ 1, 12, 23, 34]+-- >>> let (r2, summings2) = stepAuto' summings1 [5,5]+-- >>> r2+-- [ 6, 17, 23, 34]+-- >>> let (r3, _ ) = stepAuto' summings2 [10,1,10,1,10000]+-- >>> r3+-- [16, 18, 33, 35]+--+zipAuto :: Monad m+ => a -- ^ default input value+ -> [Auto m a b] -- ^ 'Auto's to zip up+ -> Auto m [a] [b]+zipAuto x0 as = mkAutoM (zipAuto x0 <$> mapM resumeAuto as)+ (mapM_ saveAuto as)+ $ \xs -> do+ res <- zipWithM stepAuto as (xs ++ repeat x0)+ let (ys, as') = unzip res+ return (ys, zipAuto x0 as')++-- | Like 'zipAuto', but delay the input by one step. The first input to+-- all of them is the "default" value, and after that, feeds in the input+-- streams delayed by one.+--+-- Let's try the example from 'zipAuto', except with 'dZipAuto' instead:+--+-- @+-- summerList :: [Auto' Int Int]+-- summerList = map sumFrom [0, 10, 20, 30]+--+-- summings0 :: Auto' [Int] [Int]+-- summings0 = dZipAuto 0 summerList+-- @+--+-- Trying it out:+--+-- >>> let (r1, summings1) = stepAuto' summings0 [1,2,3,4]+-- >>> r1+-- [ 0, 10, 20, 30]+-- >>> let (r2, summings2) = stepAuto' summings1 [5,5]+-- >>> r2+-- [ 1, 12, 23, 34]+-- >>> let (r3, summings3) = stepAuto' summings2 [10,1,10,1,10000]+-- >>> r3+-- [ 6, 17, 23, 34]+-- >>> let (r4, _ ) = stepAuto' summings3 [100,100,100,100]+-- >>> r4+-- [16, 18, 33, 35]+--+dZipAuto :: (Serialize a, Monad m)+ => a -- ^ default input value+ -> [Auto m a b] -- ^ 'Auto's to zip up+ -> Auto m [a] [b]+dZipAuto x0 as = zipAuto x0 as . delay []++-- | The non-serializing/non-resuming version of 'dZipAuto'.+dZipAuto_ :: Monad m+ => a -- ^ default input value+ -> [Auto m a b] -- ^ 'Auto's to zip up+ -> Auto m [a] [b]+dZipAuto_ x0 as = zipAuto x0 as . delay_ []++-- | Takes a bunch of 'Auto's that take streams streams, and turns them+-- into one 'Auto' that takes a bunch of blip streams and feeds them into+-- each of the original 'Auto's, in order.+--+-- It's basically like 'zipAuto', except instead of taking in normal+-- streams of values, it takes in blip streams of values.+--+-- If the input streams ever number less than the number of 'Auto's zipped,+-- the other 'Auto's are stepped assuming no emitted value.+zipAutoB :: Monad m+ => [Auto m (Blip a) b] -- ^ 'Auto's to zip up+ -> Auto m [Blip a] [b]+zipAutoB = zipAuto NoBlip++-- | A delayed version of 'zipAutoB'+dZipAutoB :: (Serialize a, Monad m)+ => [Auto m (Blip a) b] -- ^ 'Auto's to zip up+ -> Auto m [Blip a] [b]+dZipAutoB = dZipAuto NoBlip++-- | The non-serializing/non-resuming version of 'dZipAutoB'.+dZipAutoB_ :: Monad m+ => [Auto m (Blip a) b] -- ^ 'Auto's to zip up+ -> Auto m [Blip a] [b]+dZipAutoB_ = dZipAuto_ NoBlip++-- | A dynamic box of 'Interval's. Takes a list of inputs to feed to each+-- one, in the order that they were added. Also takes a blip stream, which+-- emits with new 'Interval's to add to the box.+--+-- Add new 'Interval's to the box however you want with the blip stream.+--+-- As soon as an 'Interval' turns "off", the 'Interval' is removed from the+-- box, and its output is silenced.+--+-- The adding/removing aside, the routing of the inputs (the first field of+-- the tuple) to the internal 'Auto's and the outputs behaves the same as+-- with 'zipAuto'.+--+-- This will be a pretty powerful collection if you ever imagine adding and+-- destroying behaviors dynamically...like spawning new enemies, or+-- something like that.+--+-- Let's see an example...here we are going to be throwing a bunch of+-- 'Auto's that count to five and then die into our 'dynZip_'...once every+-- other step.+--+-- @+-- -- count upwards, then die when you reach 5+-- countThenDie :: 'Interval'' () Int+-- countThenDie = onFor 5 . iterator (+1) 1+--+-- -- emit a new `countThenDie` every two steps+-- throwCounters :: Auto' () ('Blip' ['Interval'' () Int])+-- throwCounters = tagBlips [countThenDie] . every 2+--+-- a :: Auto' () [Int]+-- a = proc _ -> do+-- newCounter <- throwCounters -< ()+-- dynZip_ () -< (repeat (), newCounter)+-- @+--+-- >>> let (res, _) = stepAutoN' 15 a ()+-- >>> res+-- [[], [1 ]+-- , [2, ]+-- , [3, 1 ]+-- , [4, 2 ]+-- , [5, 3, 1 ]+-- , [ 4, 2 ]+-- , [ 5, 3, 1 ]+-- , [ 4, 2 ]+-- , [ 5, 3, 1]+-- ]+--+-- This is a little unweildy, because 'Auto's maybe disappearing out of the+-- thing while you are trying to feed inputs into it. You might be feeding+-- an input to an 'Auto'...but one of the 'Auto's before it on the list has+-- disappeared, so it accidentally goes to the wrong one.+--+-- Because of this, it is suggested that you use 'dynMap_', which allows+-- you to "target" labeled 'Auto's with your inputs.+--+-- This 'Auto' is inherently unserializable, but you can use 'dynZipF' for+-- more or less the same functionality, with serialization possible. It's+-- only slightly less powerful...for all intents and purposes, you should+-- be able to use both in the same situations. All of the examples here+-- can be also done with 'dynZipF'.+--+dynZip_ :: Monad m+ => a -- "default" input to feed in+ -> Auto m ([a], Blip [Interval m a b]) [b]+dynZip_ x0 = go []+ where+ go as = mkAutoM_ $ \(xs, news) -> do+ let newas = as ++ blip [] id news+ res <- zipWithM stepAuto newas (xs ++ repeat x0)+ let (ys, as') = unzip [ (y, a) | (Just y, a) <- res ]+ return (ys, go as')++-- | Like 'dynZip_', but instead of taking in a blip stream of 'Interval's+-- directly, takes in a blip stream of 'k's to trigger adding more+-- 'Interval's to the "box", using the given @k -> 'Interval' m a b@+-- function to make the new 'Interval' to add.+--+-- Pretty much all of the power of 'dynZip_', but with serialization.+--+-- See 'dynZip_' for examples and caveats.+--+-- You could theoretically recover the behavior of 'dynZip_' with+-- @'dynZipF' id@, if there wasn't a 'Serialize' constraint on the @k@.+dynZipF :: (Serialize k, Monad m)+ => (k -> Interval m a b) -- ^ function to generate a new+ -- 'Interval' for each coming @k@+ -- in the blip stream.+ -> a -- ^ "default" input to feed in+ -> Auto m ([a], Blip [k]) [b]+dynZipF f x0 = go []+ where+ go ksas = mkAutoM (do ks <- get+ as <- mapM (resumeAuto . f) ks+ return $ go (zip ks as) )+ (do let (ks,as) = unzip ksas+ put ks+ mapM_ saveAuto as)+ (goFunc ksas)+ goFunc = _dynZipF f x0 go++-- | The non-serializing/non-resuming version of 'dynZipF'. Well, you+-- really might as well use 'dynZip_', which is more powerful...but maybe+-- using this can inspire more disciplined usage. Also works as a drop-in+-- replacement for 'dynZipF'.+dynZipF_ :: Monad m+ => (k -> Interval m a b)+ -> a+ -> Auto m ([a], Blip [k]) [b]+dynZipF_ f x0 = go []+ where+ go ksas = mkAutoM_ (goFunc ksas)+ goFunc = _dynZipF f x0 go++_dynZipF :: Monad m+ => (k -> Interval m a b)+ -> a+ -> ([(k, Interval m a b)] -> Auto m ([a], Blip [k]) [b])+ -> [(k, Interval m a b)]+ -> ([a], Blip [k])+ -> m ([b], Auto m ([a], Blip [k]) [b])+_dynZipF f x0 go ksas (xs, news) = do+ let adds = blip [] (map (id &&& f)) news+ newksas = ksas ++ adds+ (newks,newas) = unzip newksas+ res <- zipWithM stepAuto newas (xs ++ repeat x0)+ let resks = zip newks res+ (ys, ksas') = unzip [ (y, (k,a)) | (k, (Just y, a)) <- resks ]+ return (ys, go ksas')+++-- | A dynamic box of 'Auto's, indexed by an 'Int'. Takes an 'IntMap' of+-- inputs to feed into their corresponding 'Auto's, and collect all of the+-- outputs into an output 'IntMap'.+--+-- Whenever any of the internal 'Auto's return 'Nothing', they are removed+-- from the collection.+--+-- Toy examples here are of limited use, but let's try it out. Here we+-- will have a 'dynMap_' that feeds each internal 'Auto' back to itself.+-- The result of each is sent directly back to itself.+--+-- >>> import qualified Data.IntMap as IM+-- >>> let dm0 :: Auto' (IM.IntMap Int) (IM.IntMap Int)+-- dm0 = proc x -> do+-- initials <- immediately -< [ Just <$> sumFrom 0+-- , Just <$> sumFrom 10 ]+-- newIs <- every 3 -< [ Just <$> sumFrom 0 ]+-- dynMap_ (-1) -< (x, initials `mergeL` newIs)+-- >>> let (res1, dm1) = stepAuto' dm0 mempty+-- >>> res1+-- fromList [(0, -1), (1, 9)]+-- >>> let (res2, dm2) = stepAuto' dm1 (IM.fromList [(0,100),(1,50)])+-- >>> res2+-- fromList [(0, 99), (1, 59)]+-- >>> let (res3, dm3) = stepAuto' dm2 (IM.fromList [(0,10),(1,5)])+-- >>> res3+-- fromList [(0, 109), (1, 64), (2, -1)]+-- >>> let (res4, _ ) = stepAuto' dm3 (IM.fromList [(1,5),(2,5)])+-- >>> res4+-- fromList [(0, 108), (1, 69), (2, 4)]+--+-- One quirk is that every internal 'Auto' is "stepped" at every step with+-- the default input; 'gatherMany' is a version of this where 'Auto's that+-- do not have a corresponding "input" are left unstepped, and their last+-- output preserved in the aggregate output. As such, 'gatherMany' might+-- be seen more often.+--+-- This 'Auto' is inherently unserializable, but you can use 'dynMapF' for+-- more or less the same functionality, with serialization possible. It's+-- only slightly less powerful...for all intents and purposes, you should+-- be able to use both in the same situations. All of the examples here+-- can be also done with 'dynMapF'.+--+dynMap_ :: Monad m+ => a -- ^ "default" input to feed in+ -> Auto m (IntMap a, Blip [Interval m a b]) (IntMap b)+dynMap_ x0 = go 0 IM.empty+ where+ go i as = mkAutoM_ $ \(xs, news) -> do+ let newas = zip [i..] (blip [] id news)+ newas' = as `IM.union` IM.fromList newas+ newc = i + length newas+ resMap = zipIntMapWithDefaults stepAuto Nothing (Just x0) newas' xs+ res <- sequence resMap+ let res' = IM.filter (isJust . fst) res+ ys = fromJust . fst <$> res'+ as' = snd <$> res'+ return (ys, go newc as')++-- | Like 'dynMap_', but instead of taking in a blip stream of 'Interval's+-- directly, takes in a blip stream of 'k's to trigger adding more+-- 'Interval's to the "box", using the given @k -> 'Interval' m a b@+-- function to make the new 'Interval' to add.+--+-- Pretty much all of the power of 'dynMap_', but with serialization.+--+-- See 'dynMap_' for examples and use cases.+--+-- You could theoretically recover the behavior of 'dynMap_' with+-- @'dynMapF' id@, if there wasn't a 'Serialize' constraint on the @k@.+dynMapF :: (Serialize k, Monad m)+ => (k -> Interval m a b) -- ^ function to generate a new+ -- 'Interval' for each coming @k@+ -- in the blip stream.+ -> a -- ^ "default" input to feed in+ -> Auto m (IntMap a, Blip [k]) (IntMap b)+dynMapF f x0 = go 0 IM.empty IM.empty+ where+ go i ks as = mkAutoM (do i' <- get+ ks' <- get+ as' <- mapM (resumeAuto . f) ks'+ return (go i' ks' as') )+ (put i *> put ks *> mapM_ saveAuto as)+ (goFunc i ks as)+ goFunc = _dynMapF f x0 go++-- | The non-serializing/non-resuming version of 'dynMapF'. Well, you+-- really might as well use 'dynMap_', which is more powerful...but maybe+-- using this can inspire more disciplined usage. Also works as a drop-in+-- replacement for 'dynMapF'.+dynMapF_ :: Monad m+ => (k -> Interval m a b)+ -> a+ -> Auto m (IntMap a, Blip [k]) (IntMap b)+dynMapF_ f x0 = go 0 IM.empty IM.empty+ where+ go i ks as = mkAutoM_ (goFunc i ks as)+ goFunc = _dynMapF f x0 go++-- just splitting out the functionality so that I can write this logic once+-- for both the serializing and non serializing versions+_dynMapF :: Monad m+ => (k -> Interval m a b)+ -> a+ -> (Int -> IntMap k -> IntMap (Interval m a b) -> Auto m (IntMap a, Blip [k]) (IntMap b))+ -> Int+ -> IntMap k+ -> IntMap (Interval m a b)+ -> (IntMap a, Blip [k])+ -> m (IntMap b, Auto m (IntMap a, Blip [k]) (IntMap b))+_dynMapF f x0 go i ks as (xs, news) = do+ let newks = zip [1..] (blip [] id news)+ newas = (map . second) f newks+ newks' = ks `IM.union` IM.fromList newks+ newas' = as `IM.union` IM.fromList newas+ newc = i + length newks+ resMap = zipIntMapWithDefaults stepAuto Nothing (Just x0) newas' xs+ res <- sequence resMap+ let ys' = IM.mapMaybe fst res+ as' = snd <$> IM.intersection res ys'+ ks' = IM.intersection newks' ys'+ return (ys', go newc ks' as')+++-- | 'Auto' multiplexer. Stores a bunch of internal 'Auto's indexed by+-- a key. At every step, takes a key-input pair, feeds the input to the+-- 'Auto' stored at that key and outputs the output.+--+-- If the key given does not yet have an 'Auto' stored at that key,+-- initializes a new 'Auto' at that key by using the supplied function.+--+-- Once initialized, these 'Auto's are stored there forever.+--+-- You can play around with some combinators from "Control.Auto.Switch";+-- for example, with 'resetOn', you can make 'Auto's that "reset"+-- themselves when given a certain input. 'switchOnF' could be put to use+-- here too in neat ways.+--+-- >>> let mx0 = mux (\_ -> sumFrom 0)+-- >>> let (res1, mx1) = stepAuto' mx0 ("hello", 5)+-- >>> res1+-- 5+-- >>> let (res2, mx2) = stepAuto' mx1 ("world", 3)+-- >>> res2+-- 3+-- >>> let (res3, mx3) = stepAuto' mx2 ("hello", 4)+-- >>> res3+-- 9+-- >>> streamAuto' mx3 [("world", 2), ("foo", 6), ("foo", 1), ("hello", 2)]+-- [5, 6, 7, 11]+mux :: (Serialize k, Ord k, Monad m)+ => (k -> Auto m a b) -- ^ function to create a new 'Auto' if none at+ -- that key already exists.+ -> Auto m (k, a) b+mux f = dimap (uncurry M.singleton) (head . M.elems) (muxMany f)++-- | The non-serializing/non-resuming version of 'mux'.+mux_ :: (Ord k, Monad m)+ => (k -> Auto m a b) -- ^ function to create a new 'Auto' if none at+ -- that key already exists+ -> Auto m (k, a) b+mux_ f = dimap (uncurry M.singleton) (head . M.elems) (muxMany_ f)++-- | 'Auto' multiplexer, like 'mux', except allows update/access of many+-- 'Auto's at a time. Instead of taking in a single key-value pair and+-- outputting a single result, takes in an entire 'Map' of key-value pairs+-- and outputs a 'Map' of key-result pairs.+--+-- >>> import qualified Data.Map as M+-- >>> let mx0 = mux (\_ -> sumFrom 0)+-- >>> let (res1, mx1) = stepAuto' mx0 (M.fromList [ ("hello", 5)+-- , ("world", 3) ])+-- >>> res1+-- fromList [("hello", 5), ("world", 3)]+-- >>> let (res2, mx2) = stepAuto' mx1 (M.fromList [ ("hello", 4)+-- , ("foo" , 7) ])+-- >>> res2+-- fromList [("foo", 7), ("hello", 9)]+-- >>> let (res3, _ ) = mx2 (M.fromList [("world", 3), ("foo", 1)])+-- >>> res3+-- fromList [("foo", 8), ("world", 6)]+--+-- See 'mux' for more notes.+muxMany :: (Serialize k, Ord k, Monad m)+ => (k -> Auto m a b) -- ^ function to create a new 'Auto' if+ -- none at that key already exists+ -> Auto m (Map k a) (Map k b)+muxMany f = go mempty+ where+ -- go :: Map k (Auto m a b) -> Auto m (Map k a) (Map k b)+ go as = mkAutoM l (s as) (t as)+ l = do+ ks <- get+ let as = M.fromList (map (id &&& f) ks)+ go <$> mapM resumeAuto as+ s as = put (M.keys as) *> mapM_ saveAuto as+ t = _muxManyF f go++-- | The non-serializing/non-resuming version of 'muxMany'.+muxMany_ :: forall m a b k. (Ord k, Monad m)+ => (k -> Auto m a b) -- ^ function to create a new 'Auto' if+ -- none at that key already exists+ -> Auto m (Map k a) (Map k b)+muxMany_ f = go mempty+ where+ go :: Map k (Auto m a b) -> Auto m (Map k a) (Map k b)+ go = mkAutoM_ . _muxManyF f go++_muxManyF :: forall k m a b. (Ord k, Monad m)+ => (k -> Auto m a b) -- ^ f : make new Autos+ -> (Map k (Auto m a b) -> Auto m (Map k a) (Map k b)) -- ^ go: make next step+ -> Map k (Auto m a b) -- ^ as: all current Autos+ -> Map k a -- ^ xs: Inputs+ -> m (Map k b, Auto m (Map k a) (Map k b)) -- ^ Outputs, and next Auto.+_muxManyF f go as xs = do+ -- all the outputs of the autos with the present inputs; autos without+ -- inputs are ignored.+ outs <- sequence steps+ let ys = fmap fst outs+ allas' = M.union (fmap snd outs) allas+ return (ys, go allas')+ where+ -- new Autos, from the function. Only on new ones not found in `as`.+ newas :: Map k (Auto m a b)+ newas = M.mapWithKey (\k _ -> f k) (M.difference xs as)+ -- all Autos, new and old. Prefer the old ones.+ allas :: Map k (Auto m a b)+ allas = M.union as newas+ -- Step all the autos with all the inputs. Lose the Autos that have no+ -- corresponding input.+ steps :: Map k (m (b, Auto m a b))+ steps = M.intersectionWith stepAuto allas xs++e2m :: Either (a, b) b -> (Maybe a, b)+e2m (Left (x, y)) = (Just x , y)+e2m (Right y) = (Nothing, y)++_muxgathermapF :: (k -> Maybe c -> Interval m a b) -> k -> (Maybe c, a) -> (Maybe c, Interval m a b)+_muxgathermapF f k (mz, _) = (mz, f k mz)++-- | Keeps an internal 'Map' of 'Interval's and, at every step, the output is+-- the last seen output of every 'Interval', indexed under the proper key.+--+-- At every step, the input is a key-value pair; 'gather' will feed that+-- input value to the 'Interval' under the proper key and update the output+-- map with that new result.+--+-- If the key offered the input is not yet a part of the collection,+-- initializes it with the given function.+--+-- Any 'Interval' that turns "off" (outputs 'Nothing') from this will be+-- immediately removed from the collection. If something for that key is+-- received again, it will re-initialize it.+--+-- >>> let sumUntil :: Interval' Int Int+-- sumUntil = proc x -> do+-- sums <- sumFrom 0 -< x+-- stop <- became (> 10) -< sums+-- before -< (sums, stop)+-- -- (a running sum, "on" until the sum is greater than 10)+-- >>> let gt0 = gather (\_ -> sumUntil)+-- >>> let (res1, gt1) = stepAuto' gt0 ("hello", 5)+-- >>> res1+-- fromList [("hello", 5)]+-- >>> let (res2, gt2) = stepAuto' gt1 ("world", 7)+-- >>> res2+-- fromList [("hello", 5), ("world", 7)]+-- >>> let (res3, gt3) = stepAuto' gt2 ("foo", 4)+-- >>> res3+-- fromList [("foo", 4), ("hello", 5), ("world", 7)]+-- >>> let (res4, gt4) = stepAuto' gt3 ("world", 8)+-- >>> res4+-- fromList [("foo", 4), ("hello", 5)]+-- >>> streamAuto' gt4 [("world", 2),("bar", 9),("world", 6),("hello", 11)]+-- [ fromList [("foo", 4), ("hello", 5), ("world", 2)]+-- , fromList [("bar", 9), ("foo", 4), ("hello", 5), ("world", 2)]+-- , fromList [("bar", 9), ("foo", 4), ("hello", 5), ("world", 8)]+-- , fromList [("bar", 9), ("foo", 4), ("world", 8)]+-- ]+--+-- In practice this ends up being a very common collection; see the+-- <https://github.com/mstksg/auto-examples auto-examples> project for many+-- examples!+--+-- Because everything needs a 'key', you don't have the fancy+-- "auto-generate new keys" feature of 'dynMap'...however, you could always+-- pull a new key from @'perBlip' 'enumFromA'@ or something.+--+-- Like with 'mux', combinators from "Control.Auto.Switch" like 'resetOn'+-- and 'switchOnF' are very useful here!+--+gather :: (Ord k, Monad m, Serialize k, Serialize b)+ => (k -> Interval m a b) -- ^ function to create a new 'Auto'+ -- if none at that key already+ -- exists+ -> Auto m (k, a) (Map k b)+gather = lmap (uncurry M.singleton) . gatherMany++-- | The non-serializing/non-resuming version of 'gather':+--+-- __Does__ serialize the actual __'Auto's__ themselves; the 'Auto's are+-- all serialized and re-loaded/resumed when 'gather_ f' is resumed.+--+-- Does __not__ serialize the "last outputs", so resumed 'Auto's that have+-- not yet been re-run/accessed to get a fresh output are not represented+-- in the output map at first.+--+gather_ :: (Ord k, Monad m, Serialize k)+ => (k -> Interval m a b) -- ^ function to create a new 'Auto'+ -- if none at that key already+ -- exists+ -> Auto m (k, a) (Map k b)+gather_ = lmap (uncurry M.singleton) . gatherMany_++-- | The non-serializing/non-resuming vervsion of 'gather':+--+-- Serializes neither the 'Auto's themselves nor the "last outputs" ---+-- essentially, serializes/resumes nothing.+gather__ :: (Ord k, Monad m)+ => (k -> Interval m a b) -- ^ function to create a new+ -- 'Auto' if none at that key+ -- already exists+ -> Auto m (k, a) (Map k b)+gather__ = lmap (uncurry M.singleton) . gatherMany__+++-- | Much like 'gather', except allows you to pass in multiple key-value+-- pairs every step, to update multiple internal 'Auto's.+--+-- >>> import qualified Data.Map as M+-- >>> let sumUntil :: Interval' Int Int+-- sumUntil = proc x -> do+-- sums <- sumFrom 0 -< x+-- stop <- became (> 10) -< sums+-- before -< (sums, stop)+-- -- (a running sum, "on" until the sum is greater than 10)+-- >>> let gm0 = gatherMany (\_ -> sumUntil)+-- >>> let (res1, gm1) = stepAuto' gm0 (M.fromList [ ("hello", 5)+-- , ("world", 7)+-- ])+-- >>> res1+-- fromList [("hello", 5), ("world", 7)]+-- >>> let (res2, gm2) = stepAuto' gm1 (M.fromList [ ("foo", 4)+-- , ("hello", 3)+-- ])+-- >>> res2+-- fromList [("foo", 4), ("hello", 8), ("world", 7)]+-- >>> let (res3, gm3) = stepAuto' gm2 (M.fromList [ ("world", 8)+-- , ("bar", 9)+-- ])+-- >>> res3+-- fromList [("bar", 9), ("foo", 4), ("hello", 8)]+-- >>> let (res4, _ ) = stepAuto' gm3 (M.fromList [ ("world", 2)+-- , ("bar", 10)+-- ])+-- >>> res4+-- fromList [("foo", 4), ("hello", 8), ("world", 2)]+--+-- See 'gather' for more notes.+gatherMany :: forall k a m b. (Ord k, Monad m, Serialize k, Serialize b)+ => (k -> Interval m a b) -- ^ function to create a new+ -- 'Auto' if none at that key+ -- already exists+ -> Auto m (Map k a) (Map k b)+gatherMany f = lmap (fmap Right) (gatherFMany f')+ where+ f' :: k -> Maybe () -> Interval m a b+ f' k _ = f k++-- | The non-serializing/non-resuming version of 'gatherMany':+--+-- __Does__ serialize the actual __'Auto's__ themselves; the 'Auto's are+-- all serialized and re-loaded/resumed when 'gatherMany_ f' is resumed.+--+-- Does __not__ serialize the "last outputs", so resumed 'Auto's that have+-- not yet been re-run/accessed to get a fresh output are not represented+-- in the output map at first.+--+gatherMany_ :: forall k a m b. (Ord k, Monad m, Serialize k)+ => (k -> Interval m a b) -- ^ function to create a new+ -- 'Auto' if none at that key+ -- already exists+ -> Auto m (Map k a) (Map k b)+gatherMany_ f = lmap (fmap Right) (gatherFMany_ f')+ where+ f' :: k -> Maybe () -> Interval m a b+ f' k _ = f k++-- | The non-serializing/non-resuming vervsion of 'gatherMany':+--+-- Serializes neither the 'Auto's themselves nor the "last outputs" ---+-- essentially, serializes/resumes nothing.+gatherMany__ :: forall k a m b. (Ord k, Monad m)+ => (k -> Interval m a b) -- ^ function to create a new+ -- 'Auto' if none at that key+ -- already exists+ -> Auto m (Map k a) (Map k b)+gatherMany__ f = lmap (fmap Right) (gatherFMany__ f')+ where+ f' :: k -> Maybe () -> Interval m a b+ f' k _ = f k++gatherFMany :: forall k m a b c. (Ord k, Monad m, Serialize c, Serialize k, Serialize b)+ => (k -> Maybe c -> Interval m a b)+ -> Auto m (Map k (Either (c, a) a)) (Map k b)+gatherFMany f = go mempty mempty+ where+ go :: Map k (Maybe c, Auto m a (Maybe b))+ -> Map k b+ -> Auto m (Map k (Either (c, a) a)) (Map k b)+ go as ys = mkAutoM l (s as ys) (t as ys)+ l = go <$> _loadAs f <*> get+ s as ys = put (zip (M.keys as) (map fst (M.elems as)))+ *> mapM_ (saveAuto . snd) as+ *> put ys+ t = _gatherFManyF f go++gatherFMany_ :: forall k m a b c. (Ord k, Monad m, Serialize c, Serialize k)+ => (k -> Maybe c -> Interval m a b)+ -> Auto m (Map k (Either (c, a) a)) (Map k b)+gatherFMany_ f = go mempty mempty+ where+ go :: Map k (Maybe c, Interval m a b)+ -> Map k b+ -> Auto m (Map k (Either (c, a) a)) (Map k b)+ go as ys = mkAutoM l (s as) (t as ys)+ l = go <$> _loadAs f <*> pure mempty+ s as = put (zip (M.keys as) (map fst (M.elems as)))+ *> mapM_ (saveAuto . snd) as+ t = _gatherFManyF f go++_loadAs :: forall k a m b c. (Serialize k, Serialize c, Ord k)+ => (k -> Maybe c -> Interval m a b)+ -> Get (Map k (Maybe c, Interval m a b))+_loadAs f = do+ kszs <- get :: Get [(k, Maybe c)]+ let as = M.fromList (map (\(k, mz) -> (k, (mz, f k mz))) kszs)+ mapM (mapM resumeAuto) as+++gatherFMany__ :: forall k a m b c. (Ord k, Monad m)+ => (k -> Maybe c -> Interval m a b)+ -> Auto m (Map k (Either (c, a) a)) (Map k b)+gatherFMany__ f = go mempty mempty+ where+ go :: Map k (Maybe c, Auto m a (Maybe b))+ -> Map k b+ -> Auto m (Map k (Either (c, a) a)) (Map k b)+ go as ys = mkAutoM_ (_gatherFManyF f go as ys)++-- you know the type signature looks awful, but this function pretty much+-- wrote itself because of the type signature. Haskell is awesome, isn't+-- it? I could have never written this without Haskell's type system.+_gatherFManyF :: forall k m a b c inAuto outAuto outOut.+ ( Ord k+ , Monad m+ , inAuto ~ (Interval m a b)+ , outAuto ~ (Auto m (Map k (Either (c, a) a)) (Map k b))+ , outOut ~ (Map k b, Auto m (Map k (Either (c, a) a)) (Map k b))+ )+ => (k -> Maybe c -> inAuto) -- f+ -> (Map k (Maybe c, inAuto) -> Map k b -> outAuto) -- go+ -> Map k (Maybe c, inAuto) -- as+ -> Map k b -- ys+ -> Map k (Either (c, a) a) -- xs+ -> m outOut+_gatherFManyF f go as ys xs = do+ outs <- sequence steps :: m (Map k (Maybe c, (Maybe b, Auto m a (Maybe b))))+ let outs', rems :: Map k (Maybe c, (Maybe b, Auto m a (Maybe b)))+ (outs', rems) = M.partition (isJust . fst . snd) outs+ as' = M.difference allas rems+ ys' = M.difference ys rems+ as'' = M.union (fmap (second snd) outs') as'+ newys = fmap (fromJust . fst . snd) outs'+ ys'' = M.union newys ys'+ return (ys'', go as'' ys'')+ where+ _mzxs = fmap e2m xs+ newas = M.mapWithKey (_muxgathermapF f) (M.difference _mzxs as)+ allas = M.union as newas+ steps :: Map k (m (Maybe c, (Maybe b, Auto m a (Maybe b))))+ steps = M.intersectionWith interf allas _mzxs+ interf :: (Maybe c, Auto m a (Maybe b))+ -> (Maybe c, a)+ -> m (Maybe c, (Maybe b, Auto m a (Maybe b)))+ interf (mc, a) (_, x) = sequence (mc, stepAuto a x)++type MapMerge m k a b c = (k -> a -> b -> Maybe c)+ -> (m a -> m c)+ -> (m b -> m c)+ -> m a -> m b -> m c++genericZipMapWithDefaults :: (Monoid (m c), Functor m)+ => MapMerge m k a b c+ -> (a -> b -> c) -> Maybe a -> Maybe b+ -> m a -> m b -> m c+genericZipMapWithDefaults mm f x0 y0 = mm f' zx zy+ where+ f' _ x y = Just (x `f` y)+ zx = case y0 of+ Nothing -> const mempty+ Just y' -> fmap (`f` y')+ zy = case x0 of+ Nothing -> const mempty+ Just x' -> fmap (x' `f`)++zipIntMapWithDefaults :: (a -> b -> c) -> Maybe a -> Maybe b -> IntMap a -> IntMap b -> IntMap c+zipIntMapWithDefaults = genericZipMapWithDefaults IM.mergeWithKey++_zipMapWithDefaults :: Ord k => (a -> b -> c) -> Maybe a -> Maybe b -> Map k a -> Map k b -> Map k c+_zipMapWithDefaults = genericZipMapWithDefaults M.mergeWithKey
+ src/Control/Auto/Core.hs view
@@ -0,0 +1,1821 @@+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ExistentialQuantification #-}++-- |+-- Module : Control.Auto.Core+-- Description : Core types, constructors, and utilities.+-- Copyright : (c) Justin Le 2015+-- License : MIT+-- Maintainer : justin@jle.im+-- Stability : unstable+-- Portability : portable+--+-- This module defines and provides the core types, (smart) constructors,+-- and general high and low-level utilities used by the /auto/ library.+--+-- A lot of low-level functionality is provided here which is most likely+-- unnecessary for most applications; many are mostly for internal usage or+-- advanced/fine-grained usage. It also isn't really enough to do too many+-- useful things, either. It's recommended that you import "Control.Auto"+-- instead, which re-organizes the more useful parts of this module in+-- addition with useful parts of others to provide a nice packaged entry+-- point. If something in here becomes useful for more than just+-- fine-tuning or low-level tweaking, it is probably supposed to be in+-- "Control.Auto" anyway.+--+-- Information on how to use these types is available in the+-- <https://github.com/mstksg/auto/blob/master/tutorial/tutorial.md tutorial>!+--++module Control.Auto.Core (+ -- * Auto+ -- ** Type+ Auto+ , Auto'+ , autoConstr+ , toArb+ , purifyAuto+ -- ** Running+ , stepAuto+ , stepAuto'+ , evalAuto+ , evalAuto'+ , execAuto+ , execAuto'+ -- ** Serializing+ -- $serializing+ , encodeAuto+ , decodeAuto+ , saveAuto+ , resumeAuto+ , unserialize+ -- ** Underlying monad+ , hoistA+ , generalizeA+ -- ** Special modifiers+ , interceptO+ -- * Auto constructors+ -- ** Lifting values and functions+ , mkConst+ , mkConstM+ , mkFunc+ , mkFuncM+ -- ** from State transformers+ , mkState+ , mkState_+ , mkStateM+ , mkStateM_+ , mkState'+ , mkStateM'+ -- ** from Accumulators+ -- *** Result-first+ , accum+ , accum_+ , accumM+ , accumM_+ -- *** Initial accumulator-first+ , accumD+ , accumD_+ , accumMD+ , accumMD_+ -- ** Arbitrary Autos+ , mkAuto+ , mkAuto_+ , mkAutoM+ , mkAutoM_+ -- * Strictness+ , forceSerial+ , forcer+ , seqer+ ) where++import Control.Applicative+import Control.Arrow+import Control.Category+import Control.DeepSeq+import Control.Monad hiding (sequence)+import Control.Monad.Fix+import Data.ByteString hiding (empty)+import Data.Functor.Identity+import Data.Profunctor+import Data.Semigroup+import Data.Serialize+import Data.String+import Data.Traversable+import Data.Typeable+import Prelude hiding ((.), id, sequence)+++-- | The 'Auto' type. For this library, an 'Auto' semantically+-- represents/denotes a /a relationship/ between an input and an+-- output that is preserved over multiple steps, where that relationship is+-- (optionally) maintained within the context of a monad.+--+-- A lot of fancy words, I know...but you can think of an 'Auto' as nothing+-- more than a "stream transformer". A stream of sequential inputs come in+-- one at a time, and a stream of outputs pop out one at a time, as well.+--+-- Using the 'streamAuto' function, you can "unwrap" the inner stream+-- transformer from any 'Auto': if @a :: 'Auto' m a b@, 'streamAuto' lets+-- you turn it into an @[a] -> m [b]@. "Give me a stream of @a@s, one at+-- a time, and I'll give you a list of @b@s, matching a relationship to+-- your stream of @a@s."+--+-- @+-- -- unwrap your inner [a] -> m [b]!+-- 'streamAuto' :: Monad m => 'Auto' m a b -> ([a] -> m [b])+-- @+--+-- There's a handy type synonym 'Auto'' for relationships that don't really+-- need a monadic context; the @m@ is just 'Identity':+--+-- @+-- type Auto' = Auto Identity+-- @+--+-- So if you had an @a :: 'Auto'' a b@, you can use 'streamAuto'' to+-- "unwrap" the inner stream transformer, @[a] -> [b]@.+--+-- @+-- -- unwrap your inner [a] -> [b]!+-- 'streamAuto'' :: 'Auto'' a b -> ([a] -> [b])+-- @+--+-- All of the 'Auto's given in this library maintain some sort of semantic+-- relationship between streams --- for some, the outputs might be the+-- inputs with a function applied; for others, the outputs might be the+-- cumulative sum of the inputs.+--+-- See the+-- <https://github.com/mstksg/auto/blob/master/tutorial/tutorial.md tutorial>+-- for more information!+--+-- Operationally, an @'Auto' m a b@ is implemented as a "stateful+-- function". A function from an @a@ where, every time you "apply" it, you+-- get a @b@ and an "updated 'Auto'"/function with updated state.+--+-- You can get this function using 'stepAuto':+--+-- @+-- 'stepAuto' :: 'Auto' m a b -> (a -> m (b, 'Auto' m a b))+-- @+--+-- Or, for 'Auto'', 'stepAuto'':+--+-- @+-- 'stepAuto'' :: 'Auto'' a b -> (a -> (b, 'Auto'' a b))+-- @+--+-- "Give me an @a@ and I'll give you a @b@ and your "updated" 'Auto'".+--+-- 'Auto's really are mostly useful because they can be composed, chained,+-- and modified using their various typeclass instances, like 'Category',+-- 'Applicative', 'Functor', 'Arrow', etc., and also with the combinators+-- in this library. You can build complex programs as a complex 'Auto' by+-- building up smaller and smaller components. See the tutorial for more+-- information on this.+--+-- This type also contains information on its own serialization, so you can+-- serialize and re-load the internal state to binary or disk. See the+-- "serialization" section in the documentation for "Control.Auto.Core", or+-- the documentation for 'mkAutoM' for more details.+--+data Auto m a b = AutoFunc !(a -> b)+ | AutoFuncM !(a -> m b)+ | forall s. AutoState (Get s, s -> Put) !(a -> s -> (b, s)) !s+ | forall s. AutoStateM (Get s, s -> Put) !(a -> s -> m (b, s)) !s+ | AutoArb (Get (Auto m a b)) Put !(a -> (b, Auto m a b))+ | AutoArbM (Get (Auto m a b)) Put !(a -> m (b, Auto m a b))+ deriving ( Typeable )++-- | Special case of 'Auto' where the underlying 'Monad' is 'Identity'.+--+-- Instead of "wrapping" an @[a] -> m [b]@, it "wraps" an @[a] -> [b]@.+type Auto' = Auto Identity+++-- | Re-structure 'Auto' internals to use the 'Arb' ("arbitrary")+-- constructors, as recursion-based mealy machines.+--+-- Almost always a bad idea in every conceivable situation. Why is it even+-- here?+--+-- I'm sorry.+toArb :: Monad m => Auto m a b -> Auto m a b+toArb a = a_+ where+ a_ = case a of+ AutoFunc f -> AutoArb (pure a_)+ (return ())+ $ \x -> (f x, a_)+ AutoFuncM f -> AutoArbM (pure a_)+ (return ())+ $ \x -> liftM (, a_) (f x)+ AutoState gp@(g,p) f s ->+ let a' s' = AutoArb (toArb . AutoState gp f <$> g)+ (p s')+ $ \x -> let (y, s'') = f x s'+ in (y, a' s'')+ in a' s+ AutoStateM gp@(g,p) f s ->+ let a' s' = AutoArbM (toArb . AutoStateM gp f <$> g)+ (p s)+ $ \x -> do+ (y, s'') <- f x s'+ return (y, a' s'')+ in a' s+ AutoArb l s f -> AutoArb (toArb <$> l)+ s+ $ \x -> let (y, a') = f x+ in (y, toArb a')+ AutoArbM l s f -> AutoArbM (toArb <$> l)+ s+ $ \x -> do+ (y, a') <- f x+ return (y, toArb a')+++-- | Returns a string representation of the internal constructor of the+-- 'Auto'. Useful for debugging the result of compositions and functions+-- and seeing how they affect the internal structure of the 'Auto'.+--+-- In the order of efficiency, "AutoFunc"s tend to be faster than+-- "AutoState"s tend to be faster than "AutoArb"s. However, when composing+-- one with the other (using 'Category' or 'Applicative'), the two have to+-- be "reduced" to the greatest common denominator; composing an "AutoFunc"+-- with an "AutoArb" produces an "AutoArb".+--+-- More benchmarking is to be done to be able to rigorously say what these+-- really mean, performance wise.+autoConstr :: Auto m a b -> String+autoConstr (AutoFunc {}) = "AutoFunc"+autoConstr (AutoFuncM {}) = "AutoFuncM"+autoConstr (AutoState {}) = "AutoState"+autoConstr (AutoStateM {}) = "AutoStateM"+autoConstr (AutoArb {}) = "AutoArb"+autoConstr (AutoArbM {}) = "AutoArbM"++-- | Swaps out the underlying 'Monad' of an 'Auto' using the given monad+-- morphism "transforming function", a natural transformation.+--+-- Basically, given a function to "swap out" any @m a@ with an @m' a@, it+-- swaps out the underlying monad of the 'Auto'.+--+-- This forms a functor, so you rest assured in things like this:+--+-- @+-- hoistA id == id+-- hoistA f a1 . hoistA f a2 == hoistA f (a1 . a2)+-- @+hoistA :: (Monad m, Monad m')+ => (forall c. m c -> m' c) -- ^ monad morphism;+ -- the natural transformation+ -> Auto m a b+ -> Auto m' a b+hoistA _ (AutoFunc f) = AutoFunc f+hoistA g (AutoFuncM f) = AutoFuncM (g . f)+hoistA _ (AutoState gp f s) = AutoState gp f s+hoistA g (AutoStateM gp f s) = AutoStateM gp (\x s' -> g (f x s')) s+hoistA g (AutoArb gt pt f) = AutoArb (fmap (hoistA g) gt)+ pt+ $ \x -> let (y, a') = f x+ in (y, hoistA g a')+hoistA g (AutoArbM gt pt f) = AutoArbM (fmap (hoistA g) gt)+ pt+ $ \x -> g $ do+ (y, a') <- f x+ return (y, hoistA g a')++-- | Generalizes an @'Auto'' a b@ to an @'Auto' m a b'@ for any 'Monad'+-- @m@, using 'hoist'.+--+generalizeA :: Monad m => Auto' a b -> Auto m a b+generalizeA = hoistA (return . runIdentity)++-- | Force the serializing components of an 'Auto'.+--+-- TODO: Test if this really works+forceSerial :: Auto m a b -> Auto m a b+forceSerial a = case a of+ AutoArb _ l s -> l `seq` s `seq` a+ AutoArbM _ l s -> l `seq` s `seq` a+ _ -> a++-- $serializing+--+-- The 'Auto' type offers an interface in which you can serialize+-- ("freeze") and "resume" an Auto, in 'ByteString' (binary) form.+--+-- You can "freeze" any 'Auto' into a 'ByteString' using 'encodeAuto' (or,+-- if you want the raw 'Put' (from "Data.Serialize") for some reason,+-- there's 'saveAuto'.+--+-- You can "resume" any 'Auto' from a 'ByteString' using 'decodeAuto' (or,+-- if you want the raw 'Get' for some reason, there's 'resumeAuto').+--+-- Note 'decodeAuto' and 'resumeAuto' "resume" a /given 'Auto'/. That is,+-- if you call 'decodeAuto' on a "fresh 'Auto'", it'll decode+-- a 'ByteString' into /that 'Auto', but "resumed"/. That is, it'll "fast+-- forward" that 'Auto' into the state it was when it was saved.+--+-- For example, let's say I have @a = 'sumFrom' 0@, the 'Auto' whose output+-- is the cumulative sum of all of its inputs so far. If I feed it 3 and+-- 10, it'll have its internal accumulator as 13, keeping track of all the+-- numbers it has seen so far.+--+-- >>> let a = sumFrom 0+-- >>> let (_, a' ) = stepAuto' a 3+-- >>> let (_, a'') = stepAuto' a' 10+--+-- I can then use 'encodeAuto' to "freeze"/"save" the 'Auto' into the+-- 'ByteString' @bs@:+--+-- >>> let bs = encodeAuto a''+--+-- To "resume" / "load" it, I can use 'decodeAuto' to "resume" the+-- /original/ @a@. Remember, 'a' was our original 'Auto', the summer+-- 'Auto' with a starting accumulator of 0. We use 'decodeAuto' to+-- "resume" it, with and resume it with its internal accumulator at 13.+--+-- >>> let (Right resumed) = decodeAuto a bs+-- >>> let (y, _) = stepAuto' resumed 0+-- 13+--+-- Note that all of these would have had the same result:+--+-- >>> let (Right resumed) = decodeAuto a' bs+-- >>> let (Right resumed) = decodeAuto a'' bs+-- >>> let (Right resumed) = decodeAuto (sumFrom 0) bs+--+-- I mean, after all, if 'decodeAuto' "fast forwards" an 'Auto' to the+-- state it was at when it was frozen...then all of these should really be+-- resumed to the same point, right?+--+-- One way you can think about it is that 'resumeAuto' / 'decodeAuto' takes+-- an 'Auto' and creates a "blueprint" from that 'Auto', on how to "load+-- it"; the blueprint contains what the form of the internal state is, and+-- their offets in the 'ByteString'. So in the above, 'a', 'a'', 'a''',+-- and @'sumFrom' 0@ all have the same "blueprint" --- their internal+-- states are of the same structure.+--+-- Now, the /magic/ of this all is that combining and transforming 'Auto's+-- with the combinators in this library will also /compose serialization+-- strategies/ .... complex 'Auto's and combinations/chains of 'Auto's+-- create serialization strategies "for free". The+-- <https://github.com/mstksg/auto-examples auto-examples> repo has a lot+-- of examples that use this to great effect, serializing entire+-- applications and entire chat bots without writing any serialization+-- code; it all does it "by itself". Be sure to read about the caveats in+-- the+-- <https://github.com/mstksg/auto/blob/master/tutorial/tutorial.md tutorial>.+--+-- Some specific 'Auto's (indicated by a naming convention) might choose to+-- have internal state, yet ignore it when saving/loading. So, saving it+-- actaully saves no state, and "resuming" it really doesn't do anything.+-- That is, @'decodeAuto' a_ bs = Right a_@. There isn't a real way to+-- identify from the type of the 'Auto' if it will properly save/resume or+-- not, so you have to keep track of this yourself. In all of the 'Auto'+-- "included" in this library, any 'Auto' whose name /does not/ end in @_@+-- /will serialize and resume/. An 'Auto' whose name ends in @_@ is taken+-- by naming convention to be a non-resuming 'Auto'.+--+-- In your own compositions, if you are sure to always use resuming+-- 'Auto's, your composition will also be properly resuming...so you don't+-- have to worry about this! You shouldn't really ever be "surprised",+-- because you'll always explicitly chose the resuming version for 'Auto's+-- you want to resume, and the non-resuming version for those you don't.+--+-- Now, /making/ or /writing/ your own generic 'Auto' combinators and+-- transformers that take advantage of serialization is a bit of+-- a headache. When you can, you might be able to make combinators out of+-- the existing functions in this library. Sometimes, however, it's+-- unavoidable. If you are making your own 'Auto' combinators, making sure+-- serialization works as expected is tough; check out the documentation+-- for 'mkAutoM' for more details.+--++-- | Encode an 'Auto' and its internal state into a 'ByteString'.+encodeAuto :: Auto m a b -> ByteString+encodeAuto = runPut . saveAuto+{-# INLINE encodeAuto #-}++-- | "Resume" an 'Auto' from its 'ByteString' serialization, giving+-- a 'Left' if the deserialization is not possible.+decodeAuto :: Auto m a b -> ByteString -> Either String (Auto m a b)+decodeAuto = runGet . resumeAuto+{-# INLINE decodeAuto #-}++-- | Returns a 'Get' from an 'Auto' --- instructions (from+-- "Data.Serialize") on taking a ByteString and "restoring" the originally+-- saved 'Auto', in the originally saved state.+resumeAuto :: Auto m a b -> Get (Auto m a b)+resumeAuto a = case a of+ AutoState gp f _ -> AutoState gp f <$> fst gp+ AutoStateM gp f _ -> AutoStateM gp f <$> fst gp+ AutoArb g _ _ -> g+ AutoArbM g _ _ -> g+ _ -> return a+{-# INLINE resumeAuto #-}++-- | Returns a 'Put' --- instructions (from "Data.Serialize") on how to+-- "freeze" the 'Auto', with its internal state, and save it to a binary+-- encoding. It can later be reloaded and "resumed" by+-- 'resumeAuto'/'decodeAuto'.+saveAuto :: Auto m a b -> Put+saveAuto a = case a of+ AutoState (_, p) _ s -> p s+ AutoStateM (_, p) _ s -> p s+ AutoArb _ p _ -> p+ AutoArbM _ p _ -> p+ _ -> return ()+{-# INLINE saveAuto #-}++-- | Takes an 'Auto' that is serializable/resumable and returns an 'Auto'+-- that is not. That is, when it is "saved", saves no data, and when it is+-- "resumed", resets itself back to the initial configuration every time;+-- in other words, @'decodeAuto' (unserialize a) bs = Right (unserialize+-- a)@. Trying to "resume" it will just always give itself, unchanged.+unserialize :: Monad m => Auto m a b -> Auto m a b+unserialize a =+ case a of+ AutoFunc _ -> a+ AutoFuncM _ -> a+ AutoState _ f s -> AutoState (pure s, const (put ())) f s+ AutoStateM _ f s -> AutoStateM (pure s, const (put ())) f s+ AutoArb _ _ f -> AutoArb (pure a) (put ()) (second unserialize . f)+ AutoArbM _ _ f -> AutoArbM (pure a) (put ()) (liftM (second unserialize) . f)++-- | "Runs" the 'Auto' through one step.+--+-- That is, given an @'Auto' m a b@, returns a function that takes an @a@+-- and returns a @b@ and an "updated"/"next" 'Auto'; an @a -> m (b, 'Auto'+-- m a b)@.+--+-- This is the main way of running an 'Auto' "step by step", so if you have+-- some sort of game loop that updates everything every "tick", this is+-- what you're looking for. At every loop, gather input @a@, feed it into+-- the 'Auto', "render" the result @b@, and get your new 'Auto' to run the+-- next time.+--+-- Here is an example with @'sumFrom' 0@, the 'Auto' whose output is the+-- cumulative sum of the inputs, and an underying monad of @Identity@.+-- Here,+--+-- @+-- stepAuto :: Auto Identity Int Int+-- -> (Int -> Identity (Int, Auto Identity Int Int))+-- @+--+-- Every time you "step", you give it an 'Int' and get a resulting 'Int'+-- (the cumulative sum) and the "updated 'Auto'", with the updated+-- accumulator.+--+-- >>> let a0 :: Auto Identity Int Int+-- a0 = sumFrom 0+-- >>> let Identity (res1, a1) = stepAuto a0 4 -- run with 4+-- >>> res1+-- 4 -- the cumulative sum, 4+-- >>> let Identity (res2, a2) = stepAuto a1 5 -- run with 5+-- >>> res2+-- 9 -- the cumulative sum, 4 + 5+-- >>> let Identity (res3, _ ) = stepAuto a2 3 -- run with 3+-- >>> res3+-- 12 -- the cumulative sum, 4 + 5 + 3+--+-- By the way, for the case where your 'Auto' is under 'Identity', we have+-- a type synomym 'Auto''...and a convenience function to make "running" it+-- more streamlined:+--+-- >>> let a0 :: Auto' Int Int+-- a0 = sumFrom 0+-- >>> let (res1, a1) = stepAuto' a0 4 -- run with 4+-- >>> res1+-- 4 -- the cumulative sum, 4+-- >>> let (res2, a2) = stepAuto' a1 5 -- run with 5+-- >>> res2+-- 9 -- the cumulative sum, 4 + 5+-- >>> let (res3, _ ) = stepAuto' a2 3 -- run with 3+-- >>> res3+-- 12 -- the cumulative sum, 4 + 5 + 3+--+-- But, if your 'Auto' actaully has effects when being stepped, 'stepAuto'+-- will execute them:+--+-- >>> let a0 :: Auto IO Int Int+-- a0 = effect (putStrLn "hey!") *> sumFrom 0+-- >>> (res1, a1) <- stepAuto a0 4 -- run with 4+-- hey! -- IO effect+-- >>> res1+-- 4 -- the cumulative sum, 4+-- >>> (res2, a2) <- stepAuto a1 5 -- run with 5+-- hey! -- IO effect+-- >>> res2+-- 9 -- the cumulative sum, 4 + 5+-- >>> (res3, _ ) <- stepAuto a2 3 -- run with 3+-- hey! -- IO effect+-- >>> res3+-- 12 -- the cumulative sum, 4 + 5 + 3+--+-- (Here, @'effect' ('putStrLn' "hey")@ is an @'Auto' IO Int ()@, which+-- ignores its input and just executes @'putStrLn' "hey"@ every time it is+-- run. When we use '*>' from "Control.Applicative", we "combine" the two+-- 'Auto's together and run them /both/ on each input (4, 5, 3...)...but+-- for the "final" output at the end, we only return the output of the+-- second one, @'sumFrom' 0@ (5, 9, 12...))+--+-- If you think of an @'Auto' m a b@ as a "stateful function" @a -> m b@,+-- then 'stepAuto' lets you "run" it.+--+-- In order to directly run an 'Auto' on a stream, an @[a]@, use+-- 'streamAuto'. That gives you an @[a] -> m [b]@.+--+stepAuto :: Monad m+ => Auto m a b -- ^ the 'Auto' to step+ -> a -- ^ the input+ -> m (b, Auto m a b) -- ^ the output, and the updated 'Auto''.+stepAuto a x = case a of+ AutoFunc f ->+ return (f x, a)+ AutoFuncM f -> do+ y <- f x+ return (y, a)+ AutoState gp f s ->+ let (y, s') = f x s+ a' = AutoState gp f s'+ in return (y, a')+ AutoStateM gp f s -> do+ (y, s') <- f x s+ let a' = AutoStateM gp f s'+ return (y, a')+ AutoArb _ _ f -> return (f x)+ AutoArbM _ _ f -> f x+{-# INLINE stepAuto #-}++-- | "Runs" an 'Auto'' through one step.+--+-- That is, given an @'Auto'' a b@, returns a function that takes an @a@+-- and returns a @b@ and an "updated"/"next" 'Auto''; an @a -> (b, 'Auto''+-- a b)@.+--+-- See 'stepAuto' documentation for motivations, use cases, and more+-- details. You can use this instead of 'stepAuto' when your underyling+-- monad is 'Identity', and your 'Auto' doesn't produce any effects.+--+-- Here is an example with @'sumFrom' 0@, the 'Auto'' whose output is the+-- cumulative sum of the inputs+--+-- @+-- stepAuto' :: Auto' Int Int+-- -> (Int -> (Int, Auto' Int Int))+-- @+--+-- Every time you "step", you give it an 'Int' and get a resulting 'Int'+-- (the cumulative sum) and the "updated 'Auto''", with the updated+-- accumulator.+--+-- >>> let a0 :: Auto' Int Int+-- a0 = sumFrom 0+-- >>> let (res1, a1) = stepAuto' a0 4 -- run with 4+-- >>> res1+-- 4 -- the cumulative sum, 4+-- >>> let (res2, a2) = stepAuto' a1 5 -- run with 5+-- >>> res2+-- 9 -- the cumulative sum, 4 + 5+-- >>> let (res3, _ ) = stepAuto' a2 3 -- run with 3+-- >>> res3+-- 12 -- the cumulative sum, 4 + 5 + 3+--+-- If you think of an @'Auto'' a b@ as a "stateful function" @a -> b@,+-- then 'stepAuto'' lets you "run" it.+--+-- In order to directly run an 'Auto'' on a stream, an @[a]@, use+-- 'streamAuto''. That gives you an @[a] -> [b]@.+--+stepAuto' :: Auto' a b -- ^ the 'Auto'' to step+ -> a -- ^ the input+ -> (b, Auto' a b) -- ^ the output, and the updated 'Auto''+stepAuto' a x = case a of+ AutoFunc f -> (f x, a)+ AutoFuncM f -> (runIdentity (f x), a)+ AutoState gp f s -> let (y, s') = f x s+ a' = AutoState gp f s'+ in (y, a')+ AutoStateM gp f s -> let (y, s') = runIdentity (f x s)+ a' = AutoStateM gp f s'+ in (y, a')+ AutoArb _ _ f -> f x+ AutoArbM _ _ f -> runIdentity (f x)+{-# INLINE stepAuto' #-}++-- | In theory, "purifying" an 'Auto''" should prep it for faster+-- evaluation when used with 'stepAuto'' or 'streamAuto''. But the+-- benchmarks have not been run yet, so stay tuned!+--+-- TODO: Benchmark+purifyAuto :: Auto' a b -> Auto' a b+purifyAuto a@(AutoFunc {}) = a+purifyAuto (AutoFuncM f) = AutoFunc (runIdentity . f)+purifyAuto a@(AutoState {}) = a+purifyAuto (AutoStateM gp f s) = AutoState gp (\x s' -> runIdentity (f x s')) s+purifyAuto (AutoArb g p f) = AutoArb (purifyAuto <$> g)+ p+ $ \x -> let (y, a') = f x+ in (y, purifyAuto a')+purifyAuto (AutoArbM g p f) = AutoArb (purifyAuto <$> g)+ p+ $ \x -> let (y, a') = runIdentity (f x)+ in (y, purifyAuto a')++-- | Like 'stepAuto', but drops the "next 'Auto'" and just gives the+-- result.+evalAuto :: Monad m+ => Auto m a b -- ^ 'Auto' to run+ -> a -- ^ input+ -> m b -- ^ output+evalAuto a = liftM fst . stepAuto a++-- | Like 'stepAuto'', but drops the "next 'Auto''" and just gives the+-- result. 'evalAuto' for 'Auto''.+evalAuto' :: Auto' a b -- ^ 'Auto' to run+ -> a -- ^ input+ -> b -- ^ output+evalAuto' a = fst . stepAuto' a++-- | Like 'stepAuto', but drops the result and just gives the "updated+-- 'Auto'".+execAuto :: Monad m+ => Auto m a b -- ^ 'Auto' to run+ -> a -- ^ input+ -> m (Auto m a b) -- ^ updated 'Auto'+execAuto a = liftM snd . stepAuto a++-- | Like 'stepAuto'', but drops the result and just gives the "updated+-- 'Auto''". 'execAuto' for 'Auto''.+execAuto' :: Auto' a b -- ^ 'Auto'' to run+ -> a -- ^ input+ -> Auto' a b -- ^ updated 'Auto''+execAuto' a = snd . stepAuto' a++-- | A special 'Auto' that acts like the 'id' 'Auto', but forces results as+-- they come through to be fully evaluated, when composed with other+-- 'Auto's.+--+-- TODO: Test if this really works+forcer :: NFData a => Auto m a a+forcer = mkAuto_ $ \x -> x `deepseq` (x, forcer)+{-# INLINE forcer #-}++-- | A special 'Auto' that acts like the 'id' 'Auto', but forces results as+-- they come through to be evaluated to Weak Head Normal Form, with 'seq',+-- when composed with other 'Auto's.+--+-- TODO: Test if this really works+seqer :: Auto m a a+seqer = mkAuto_ $ \x -> x `seq` (x, seqer)+{-# INLINE seqer #-}++-- | Abstraction over lower-level funging with serialization; lets you+-- modify the result of an 'Auto' by being able to intercept the @(b,+-- 'Auto' m a b)@ output and return a new output value @m c@.+--+-- Note that this is a lot like 'fmap':+--+-- @+-- fmap :: (b -> c) -> Auto m a b -> Auto m a c+-- @+--+-- Except gives you access to both the @b@ and the "updated 'Auto'";+-- instead of an @b -> c@, you get to pass a @(b, 'Auto' m a b) -> m c@.+--+-- Basically experimenting with a bunch of abstractions over different+-- lower-level modification of 'Auto's, because making sure the+-- serialization works as planned can be a bit difficult.+--+interceptO :: Monad m+ => ((b, Auto m a b) -> m c) -- ^ intercepting function+ -> Auto m a b+ -> Auto m a c+interceptO f = go+ where+ go a0 = mkAutoM (go <$> resumeAuto a0)+ (saveAuto a0)+ $ \x -> do+ o@(_, a1) <- stepAuto a0 x+ y <- f o+ return (y, go a1)++-- compMAuto :: (Monad m, Monad m') => Auto m b (m' c) -> Auto m a (m' b) -> Auto m a (m' c)+-- compMAuto g f = AutoArbM undefined+-- undefined+-- $ \x -> do+-- Output y f' <- stepAuto f x+-- undefined+++-- doesn't work like you'd think lol.+-- serialForcer :: Monad m => Auto m a a+-- serialForcer = a+-- where+-- a = mkAuto_ $ \x -> let outp = Output x a+-- in forceSerial a `seq` outp++-- | Construct an 'Auto' by explicity giving its serialization,+-- deserialization, and the function from @a@ to a @b@ and "updated+-- 'Auto'".+--+-- Ideally, you wouldn't have to use this unless you are making your own+-- framework. Try your best to make what you want by assembling+-- primtives together. Working with serilization directly is hard.+--+-- See 'mkAutoM' for more detailed instructions on doing this right.+mkAuto :: Get (Auto m a b) -- ^ resuming/loading 'Get'+ -> Put -- ^ saving 'Put'+ -> (a -> (b, Auto m a b)) -- ^ step function+ -> Auto m a b+mkAuto = AutoArb+{-# INLINE mkAuto #-}++-- | Construct an 'Auto' by explicitly giving its serializiation,+-- deserialization, and the (monadic) function from @a@ to a @b@ and the+-- "updated 'Auto'".+--+-- See the "serialization" section in the "Control.Auto.Core" module for+-- more information.+--+-- Ideally, you wouldn't have to use this unless you are making your own+-- framework. Try your best to make what you want by assembling+-- primtives together.+--+-- But sometimes you have to write your own combinators, and you're going+-- to have to use 'mkAutoM' to make it work.+--+-- Sometimes, it's simple:+--+-- @+-- fmap :: (a -> b) -> Auto r a -> Auto r b+-- fmap f a0 = mkAutoM (do aResumed <- resumeAuto a0+-- return (fmap f aResumed) )+-- (saveAuto a0)+-- $ \x -> do+-- (y, a1) <- stepAuto a0 x+-- return (f y, fmap f a1)+-- @+--+-- Serializing @'fmap' f a0@ is just the same as serializing @a0@. And to+-- resume it, we resume @a0@ to get a resumed version of @a0@, and then we+-- apply @'fmap' f@ to the 'Auto' that we resumed.+--+-- Also another nice "simple" example is:+--+-- @+-- catchA :: Exception e+-- => Auto IO a b+-- -> Auto IO a (Either e b)+-- catchA a = mkAutoM (do aResumed <- resumeAuto a+-- return (catchA aResumed) )+-- (saveAuto a)+-- $ \x -> do+-- eya' <- try $ stepAuto a x+-- case eya' of+-- Right (y, a') -> return (Right y, catchA a')+-- Left e -> return (Left e , catchA a )+-- @+--+-- Which is basically the same principle, in terms of serializing and+-- resuming strategies.+--+-- When you have "switching" --- things that behave like different 'Auto's+-- at different points in time --- then things get a little complicated,+-- because you have to figure out which 'Auto' to resume.+--+-- For example, let's look at the source of '-?>':+--+-- @+-- (-?>) :: 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')+-- @+--+-- We have to invent a serialization and reloading scheme, taking into+-- account the two states that the resulting 'Auto' can be in:+--+-- 1. Initially, it is behaving like @a1@. So, to save it, we put+-- a flag saying that we are still in stage 1 ('False'), and then+-- put @a1@'s current serialization data.+-- 2. After the switch, it is behaving like @a2@. So, to save it, we put+-- a flag saying that we are now in stage 2 ('True'), and then put+-- @a2@'s current.+--+-- Now, when we /resume/ @a1 '-?>' a2@, 'resumeAuto' on @a1 '-?>' a2@ will+-- give us @l@. So the 'Get' we use --- the process we use to resume the+-- entire @a1 '-?>' a2@, will /start/ at the initial 'Get'/loading+-- function, @l@ here. We have to encode our branching and+-- resuming/serialization scheme into the initial, front-facing @l@. So+-- @l@ has to check for the flag, and if the flag is true, load in the data+-- for the switched state; otherwise, load in the data for the pre-switched+-- state.+--+-- Not all of them are this tricky. Mostly "switching" combinators will be+-- tricky, because switching means changing what you are serializing.+--+-- This one might be considerably easier, because of 'mapM':+--+-- @+-- zipAuto :: Monad m+-- => a -- ^ default input value+-- -> [Auto m a b] -- ^ 'Auto's to zip up+-- -> Auto m [a] [b]+-- zipAuto x0 as = mkAutoM (zipAuto x0 <$> mapM resumeAuto as)+-- (mapM_ saveAuto as)+-- $ \xs -> do+-- res <- zipWithM stepAuto as (xs ++ repeat x0)+-- let (ys, as') = unzip res+-- return (ys, zipAuto x0 as')+-- @+--+-- To serialize, we basically sequence 'saveAuto' over all of the internal+-- 'Auto's --- serialize each of their serialization data one-by-one one+-- after the other in our binary.+--+-- To load, we do the same thing; we go over every 'Auto' in @as@ and+-- 'resumeAuto' it, and then collect the results in a list --- a list of+-- resumed 'Auto's. And then we apply @'zipAuto' x0@ to that list of+-- 'Auto's, to get our resumed @'zipAuto' x0 as@.+--+-- So, it might be complicated. In the end, it might be all worth it, too,+-- to have implicit serialization compose like this. Think about your+-- serialization strategy first. Step back and think about what you need+-- to serialize at every step, and remember that it's _the initial_+-- "resuming" function that has to "resume everything"...it's not the+-- resuming function that exists when you finally save your 'Auto', it's+-- the resuming 'Get' that was there /at the beginning/. For '-?>', the+-- intial @l@ had to know how to "skip ahead".+--+-- And of course as always, test.+--+-- If you need to make your own combinator or transformer but are having+-- trouble with the serializtion, feel free to contact me at+-- <justin@jle.im>, on freenode at /#haskell/ or /#haskell-auto/, open+-- a <https://github.com/mstksg/auto/issues github issue>, etc. Just+-- contact me somehow, I'll be happy to help!+--+mkAutoM :: Get (Auto m a b) -- ^ resuming/loading 'Get'+ -> Put -- ^ saving 'Put'+ -> (a -> m (b, Auto m a b)) -- ^ (monadic) step function+ -> Auto m a b+mkAutoM = AutoArbM+{-# INLINE mkAutoM #-}++-- | Like 'mkAuto', but without any way of meaningful serializing or+-- deserializing.+--+-- Be careful! This 'Auto' can still carry arbitrary internal state, but+-- it cannot be meaningfully serialized or re-loaded/resumed. You can+-- still pretend to do so using+-- 'resumeAuto'/'saveAuto'/'encodeAuto'/'decodeAuto' (and the type system+-- won't stop you), but when you try to "resume"/decode it, its state will+-- be lost.+mkAuto_ :: (a -> (b, Auto m a b)) -- ^ step function+ -> Auto m a b+mkAuto_ f = mkAuto (pure (mkAuto_ f)) (return ()) f+{-# INLINE mkAuto_ #-}++-- | Like 'mkAutoM', but without any way of meaningful serializing or+-- deserializing.+--+-- Be careful! This 'Auto' can still carry arbitrary internal state, but+-- it cannot be meaningfully serialized or re-loaded/resumed. You can+-- still pretend to do so using+-- 'resumeAuto'/'saveAuto'/'encodeAuto'/'decodeAuto' (and the type system+-- won't stop you), but when you try to "resume"/decode it, its state will+-- be reset.+mkAutoM_ :: (a -> m (b, Auto m a b)) -- ^ (monadic) step function+ -> Auto m a b+mkAutoM_ f = mkAutoM (pure (mkAutoM_ f)) (return ()) f+{-# INLINE mkAutoM_ #-}++-- | Construct the 'Auto' whose output is always the given value, ignoring+-- its input.+--+-- Provided for API constency, but you should really be using 'pure' from+-- the 'Applicative' instance, from "Control.Applicative", which does the+-- same thing.+mkConst :: b -- ^ constant value to be outputted+ -> Auto m a b+mkConst = AutoFunc . const+{-# INLINE mkConst #-}++-- | Construct the 'Auto' that always "executes" the given monadic value at+-- every step, yielding the result as its output and ignoring its input.+--+-- Provided for API consistency, but you shold really be using 'effect'+-- from "Control.Auto.Effects", which does the same thing.+mkConstM :: m b -- ^ monadic action to be executed at every step+ -> Auto m a b+mkConstM = AutoFuncM . const+{-# INLINE mkConstM #-}++-- | Construct a stateless 'Auto' that simply applies the given (pure)+-- function to every input, yielding the output. The output stream is just+-- the result of applying the function to every input.+--+-- prop> streamAuto' (mkFunc f) = map f+--+-- This is rarely needed; you should be using 'arr' from the 'Arrow'+-- instance, from "Control.Arrow".+mkFunc :: (a -> b) -- ^ pure function+ -> Auto m a b+mkFunc = AutoFunc+{-# INLINE mkFunc #-}++-- | Construct a stateless 'Auto' that simply applies and executes the givne+-- (monadic) function to every input, yielding the output. The output+-- stream is the result of applying the function to every input,+-- executing/sequencing the action, and returning the returned value.+--+-- prop> streamAuto (mkFuncM f) = mapM f+--+-- It's recommended that you use 'arrM' from "Control.Auto.Effects". This+-- is only really provided for consistency.+mkFuncM :: (a -> m b) -- ^ "monadic" function+ -> Auto m a b+mkFuncM = AutoFuncM+{-# INLINE mkFuncM #-}++-- | Construct an 'Auto' from a state transformer: an @a -> s -> (b, s)@+-- gives you an @'Auto' m a b@, for any 'Monad' @m@. At every step, it+-- takes in the @a@ input, runs the function with the stored internal+-- state, returns the @b@ result, and now contains the new resulting state.+-- You have to intialize it with an initial state, of course.+--+-- From the "stream transformer" point of view, this is rougly equivalent+-- to 'mapAccumL' from "Data.List", with the function's arguments and+-- results in the backwards order.+--+-- prop> streamAuto' (mkState f s0) = snd . mapAccumL (\s x -> swap (f x s))+--+-- Try not to use this if it's ever avoidable, unless you're a framework+-- developer or something. Try make something by combining/composing the+-- various 'Auto' combinators.+--+-- If your state @s@ does not have a 'Serialize' instance, then you should+-- either write a meaningful one, provide the serialization methods+-- manually with 'mkState'', or throw away serializability and use+-- 'mkState_'.+mkState :: Serialize s+ => (a -> s -> (b, s)) -- ^ state transformer+ -> s -- ^ intial state+ -> Auto m a b+mkState = AutoState (get, put)+{-# INLINE mkState #-}++-- | Construct an 'Auto' from a "monadic" state transformer: @a -> s ->+-- m (b, s)@ gives you an @'Auto' m a b@. At every step, it takes in the+-- @a@ input, runs the function with the stored internal state and+-- "executes" the @m (b, s)@ to get the @b@ output, and stores the @s@ as+-- the new, updated state. Must be initialized with an initial state.+--+-- Try not to use this if it's ever avoidable, unless you're a framework+-- developer or something. Try make something by combining/composing the+-- various 'Auto' combinators.+--+-- This version is a wrapper around 'mkAuto', that keeps track of the+-- serialization and re-loading of the internal state for you, so you don't+-- have to deal with it explicitly.+--+-- If your state @s@ does not have a 'Serialize' instance, then you should+-- either write a meaningful one, provide the serialization methods+-- manually with 'mkStateM'', or throw away serializability and use+-- 'mkStateM_'.+mkStateM :: Serialize s+ => (a -> s -> m (b, s)) -- ^ (monadic) state transformer+ -> s -- ^ initial state+ -> Auto m a b+mkStateM = AutoStateM (get, put)+{-# INLINE mkStateM #-}++-- | A version of 'mkState', where the internal state doesn't have+-- a 'Serialize' instance, so you provide your own instructions for getting+-- and putting the state.+--+-- See 'mkState' for more details.+mkState' :: Get s -- ^ 'Get'; strategy for reading and deserializing the state+ -> (s -> Put) -- ^ 'Put'; strategy for serializing given state+ -> (a -> s -> (b, s)) -- ^ state transformer+ -> s -- ^ intial state+ -> Auto m a b+mkState' = curry AutoState+{-# INLINE mkState' #-}++-- | A version of 'mkStateM', where the internal state doesn't have+-- a 'Serialize' instance, so you provide your own instructions for getting+-- and putting the state.+--+-- See 'mkStateM' for more details.+mkStateM' :: Get s -- ^ 'Get'; strategy for reading and deserializing the state+ -> (s -> Put) -- ^ 'Put'; strategy for serializing given state+ -> (a -> s -> m (b, s)) -- ^ (monadic) state transformer+ -> s -- ^ initial state+ -> Auto m a b+mkStateM' = curry AutoStateM+{-# INLINE mkStateM' #-}++-- | A version of 'mkState', where the internal state isn't serialized. It+-- can be "saved" and "loaded", but the state is lost in the process.+--+-- See 'mkState' for more details.+--+-- Useful if your state @s@ cannot have a meaningful 'Serialize' instance.+mkState_ :: (a -> s -> (b, s)) -- ^ state transformer+ -> s -- ^ initial state+ -> Auto m a b+mkState_ f s0 = AutoState (return s0, \_ -> return ()) f s0+{-# INLINE mkState_ #-}++-- | A version of 'mkStateM', where the internal state isn't serialized.+-- It can be "saved" and "loaded", but the state is lost in the process.+--+-- See 'mkStateM' for more details.+--+-- Useful if your state @s@ cannot have a meaningful 'Serialize' instance.+mkStateM_ :: (a -> s -> m (b, s)) -- ^ (monadic) state transformer+ -> s -- ^ initial state+ -> Auto m a b+mkStateM_ f s0 = AutoStateM (return s0, \_ -> return ()) f s0+{-# INLINE mkStateM_ #-}++-- | Construct an 'Auto' from a "folding" function: @b -> a -> b@ yields an+-- @'Auto' m a b@. Basically acts like a 'foldl' or a 'scanl'. There is+-- an internal accumulator that is "updated" with an @a@ at every step.+-- Must be given an initial accumulator.+--+-- Example: an 'Auto' that sums up all of its input.+--+-- >>> let summer = accum (+) 0+-- >>> let (sum1, summer') = stepAuto' summer 3+-- >>> sum1+-- 3+-- >>> let (sum2, summer'') = stepAuto' summer' 10+-- >>> sum2+-- 13+-- >>> streamAuto' summer'' [1..10]+-- [14,16,19,23,28,34,41,49,58,68]+--+-- If your accumulator @b@ does not have a 'Serialize' instance, then you+-- should either write a meaningful one, or throw away serializability and+-- use 'accum_'.+accum :: Serialize b+ => (b -> a -> b) -- ^ accumulating function+ -> b -- ^ initial accumulator+ -> Auto m a b+accum f = mkState (\x s -> let y = f s x in (y, y))+{-# INLINE accum #-}++-- | Construct an 'Auto' from a "monadic" "folding" function: @b -> a ->+-- m b@ yields an @'Auto' m a b@. Basically acts like a 'foldM' or 'scanM'+-- (if it existed). here is an internal accumulator that is "updated" with+-- an input @a@ with the result of the executed @m b@ at every step. Must+-- be given an initial accumulator.+--+-- See 'accum' for more details.+--+-- If your accumulator @b@ does not have a 'Serialize' instance, then you+-- should either write a meaningful one, or throw away serializability and+-- use 'accumM_'.+accumM :: (Serialize b, Monad m)+ => (b -> a -> m b) -- ^ (monadic) accumulating function+ -> b -- ^ initial accumulator+ -> Auto m a b+accumM f = mkStateM (\x s -> liftM (join (,)) (f s x))+{-# INLINE accumM #-}++-- | A version of 'accum', where the internal accumulator isn't+-- serialized. It can be "saved" and "loaded", but the state is lost in the+-- process.+--+-- See 'accum' for more details.+--+-- Useful if your accumulator @b@ cannot have a meaningful 'Serialize'+-- instance.+accum_ :: (b -> a -> b) -- ^ accumulating function+ -> b -- ^ intial accumulator+ -> Auto m a b+accum_ f = mkState_ (\x s -> let y = f s x in (y, y))+{-# INLINE accum_ #-}++-- | A version of 'accumM_, where the internal accumulator isn't+-- serialized. It can be "saved" and "loaded", but the state is lost in the+-- process.+--+-- See 'accumM' for more details.+--+-- Useful if your accumulator @b@ cannot have a meaningful 'Serialize'+-- instance.+accumM_ :: Monad m+ => (b -> a -> m b) -- ^ (monadic) accumulating function+ -> b -- ^ initial accumulator+ -> Auto m a b+accumM_ f = mkStateM_ (\x s -> liftM (join (,)) (f s x))+{-# INLINE accumM_ #-}++-- | A "delayed" version of 'accum', where the first output is the initial+-- state of the accumulator, before applying the folding function. Useful+-- in recursive bindings.+--+-- >>> let summerD = accumD (+) 0+-- >>> let (sum1, summerD') = stepAuto' summerD 3+-- >>> sum1+-- 0+-- >>> let (sum2, summerD'') = stepAuto' summerD' 10+-- >>> sum2+-- 3+-- >>> streamAuto' summerD'' [1..10]+-- [13,14,16,19,23,28,34,41,49,58]+--+-- (Compare with the example in 'accum')+--+accumD :: Serialize b+ => (b -> a -> b) -- ^ accumulating function+ -> b -- ^ initial accumulator+ -> Auto m a b+accumD f = mkState (\x s -> (s, f s x))+{-# INLINE accumD #-}++-- | A "delayed" version of 'accumM', where the first output is the initial+-- state of the accumulator, before applying the folding function. Useful+-- in recursive bindings.+accumMD :: (Serialize b, Monad m)+ => (b -> a -> m b) -- ^ (monadic) accumulating function+ -> b -- ^ initial accumulator+ -> Auto m a b+accumMD f = mkStateM (\x s -> liftM (s,) (f s x))+{-# INLINE accumMD #-}++-- | The non-resuming/non-serializing version of 'accumD'.+accumD_ :: (b -> a -> b) -- ^ accumulating function+ -> b -- ^ intial accumulator+ -> Auto m a b+accumD_ f = mkState_ (\x s -> (s, f s x))+{-# INLINE accumD_ #-}++-- | The non-resuming/non-serializing version of 'accumMD'.+accumMD_ :: Monad m+ => (b -> a -> m b) -- ^ (monadic) accumulating function+ -> b -- ^ initial accumulator+ -> Auto m a b+accumMD_ f = mkStateM_ (\x s -> liftM (s,) (f s x))+{-# INLINE accumMD_ #-}++-- | Maps over the output stream of the 'Auto'.+--+-- >>> streamAuto' (sumFrom 0) [1..10]+-- [1,3,6,10,15,21,28,36,45,55]+-- >>> streamAuto' (show <$> sumFrom 0) [1..10]+-- ["1","3","6","10","15","21","28","36","45","55"]+instance Monad m => Functor (Auto m a) where+ fmap = rmap+ {-# INLINE fmap #-}++-- | 'pure' creates the "constant" 'Auto':+--+-- >>> streamAuto' (pure "foo") [1..5]+-- ["foo","foo","foo","foo","foo"]+--+-- '<*>' and 'liftA2' etc. give you the ability to fork the input stream+-- over many 'Auto's, and recombine the results:+--+-- >>> streamAuto' (sumFrom 0) [1..10]+-- [ 1, 3, 6, 10, 15]+-- >>> streamAuto' (productFrom 1) [1..10]+-- [ 1, 2, 6, 24, 120]+-- >>> streamAuto' (liftA2 (+) (sumFrom 0) (productFrom 1)) [1..5]+-- [ 2, 5, 12, 34, 135]+--+-- For effectful 'Auto', you can imagine '*>' as "forking" the input stream+-- through both, and only keeping the result of the second:+--+-- @+-- 'effect' 'print' *> 'sumFrom' 0+-- @+--+-- would, for example, behave just like @'sumFrom' 0@, except printing the+-- input to 'IO' at every step.+--+instance Monad m => Applicative (Auto m a) where+ pure = mkConst+ {-# INLINE pure #-}+ af <*> ax = case (af, ax) of+ (AutoFunc f, AutoFunc x) ->+ AutoFunc (f <*> x)+ (AutoFunc f, AutoFuncM x) ->+ AutoFuncM $ \i -> liftM (f i) (x i)+ (AutoFunc f, AutoState gp x s) ->+ AutoState gp (\i s' -> first (f i) (x i s')) s+ (AutoFunc f, AutoStateM gp x s) ->+ AutoStateM gp (\i s' -> liftM (first (f i)) (x i s')) s+ (AutoFunc f, AutoArb l s x) ->+ AutoArb (fmap (af <*>) l) s $ \i -> (f i *** (af <*>)) $ x i+ (AutoFunc f, AutoArbM l s x) ->+ AutoArbM (fmap (af <*>) l) s $ \i -> liftM (f i *** (af <*>)) (x i)+ (AutoFuncM f, AutoFunc x) ->+ AutoFuncM $ \i -> liftM ($ x i) (f i)+ (AutoFuncM f, AutoFuncM x) ->+ AutoFuncM $ \i -> f i `ap` x i+ (AutoFuncM f, AutoState gp x s) ->+ AutoStateM gp (\i s' -> liftM (($ x i s') . first) (f i)) s+ (AutoFuncM f, AutoStateM gp x s) ->+ AutoStateM gp (\i s' -> liftM2 first (f i) (x i s')) s+ (AutoFuncM f, AutoArb l s x) ->+ AutoArbM (fmap (af <*>) l) s $ \i -> liftM (($ x i) . (*** (af <*>))) (f i)+ (AutoFuncM f, AutoArbM l s x) ->+ AutoArbM (fmap (af <*>) l) s $ \i -> liftM2 (*** (af <*>)) (f i) (x i)+ (AutoState gp f s, AutoFunc x) ->+ AutoState gp (\i s' -> first ($ x i) (f i s')) s+ (AutoState gp f s, AutoFuncM x) ->+ AutoStateM gp (\i s' -> liftM (\x' -> first ($ x') (f i s')) (x i)) s+ (AutoState gpf f sf, AutoState gpx x sx) ->+ AutoState (mergeStSt gpf gpx)+ (\i (sf', sx') -> let (f', sf'') = f i sf'+ (x', sx'') = x i sx'+ in (f' x', (sf'', sx'')))+ (sf, sx)+ (AutoState gpf f sf, AutoStateM gpx x sx) ->+ AutoStateM (mergeStSt gpf gpx)+ (\i (sf', sx') -> do let (f', sf'') = f i sf'+ (x', sx'') <- x i sx'+ return (f' x', (sf'', sx'')))+ (sf, sx)+ (AutoStateM gp f s, AutoFunc x) ->+ AutoStateM gp (\i s' -> liftM (first ($ x i)) (f i s')) s+ (AutoStateM gp f s, AutoFuncM x) ->+ AutoStateM gp (\i s' -> do (f', s'') <- f i s'+ x' <- x i+ return (f' x', s'')+ ) s+ (AutoStateM gpf f sf, AutoState gpx x sx) ->+ AutoStateM (mergeStSt gpf gpx)+ (\i (sf', sx') -> do (f', sf'') <- f i sf'+ let (x', sx'') = x i sx'+ return (f' x', (sf'', sx''))+ ) (sf, sx)+ (AutoStateM gpf f sf, AutoStateM gpx x sx) ->+ AutoStateM (mergeStSt gpf gpx)+ (\i (sf', sx') -> do (f', sf'') <- f i sf'+ (x', sx'') <- x i sx'+ return (f' x', (sf'', sx''))+ ) (sf, sx)+ -- i give up!+ _ -> uncurry ($) <$> (af &&& ax)+ {-# INLINE (<*>) #-}++-- | When the underlying 'Monad'/'Applicative' @m@ is an 'Alternative',+-- fork the input through each one and "squish" their results together+-- inside the 'Alternative' context. Somewhat rarely used, because who+-- uses an 'Alternative' @m@?+--+-- >>> streamAuto (arrM (mfilter even . Just)) [1..10]+-- Nothing+-- >>> streamAuto (arrM (Just . negate)) [1..10]+-- Just [-1,-2,-3,-4,-5,-6,-7,-8,-9,-10]+-- >>> streamAuto (arrM (mfilter even . Just)) <|> arrM (Just . negate)) [1..10]+-- Just [-1,2,-3,4,-5,6,-7,8,-9,10]+--+instance (Monad m, Alternative m) => Alternative (Auto m a) where+ empty = mkConstM empty+ a1 <|> a2 = mkAutoM ((<|>) <$> resumeAuto a1 <*> resumeAuto a2)+ (saveAuto a1 *> saveAuto a2)+ $ \x -> let res1 = second (<|> a2) `liftM` stepAuto a1 x+ res2 = second (a1 <|>) `liftM` stepAuto a2 x+ in res1 <|> res2++-- | Gives the ability to "compose" two 'Auto's; feeds the input stream+-- into the first, feeds that output stream into the second, and returns as+-- a result the output stream of the second.+instance Monad m => Category (Auto m) where+ id = mkFunc id+ ag . af = case (ag, af) of+ (AutoFunc g, AutoFunc f) ->+ AutoFunc (g . f)+ (AutoFunc g, AutoFuncM f) ->+ AutoFuncM (return . g <=< f)+ (AutoFunc g, AutoState gpf f s) ->+ AutoState gpf (\x s' -> first g (f x s')) s+ (AutoFunc g, AutoStateM gpf f s) ->+ AutoStateM gpf (\x s' -> liftM (first g) (f x s')) s+ (AutoFunc g, AutoArb l s f) ->+ AutoArb (fmap (ag .) l) s $ \x -> (g *** fmap g) (f x)+ (AutoFunc g, AutoArbM l s f) ->+ AutoArbM (fmap (ag .) l) s $ \x -> liftM (g *** fmap g) (f x)+ (AutoFuncM g, AutoFunc f) ->+ AutoFuncM (g <=< return . f)+ (AutoFuncM g, AutoFuncM f) ->+ AutoFuncM (g <=< f)+ (AutoFuncM g, AutoState gpf f s) ->+ AutoStateM gpf (\x s' -> firstM g (f x s')) s+ (AutoFuncM g, AutoStateM gpf f s) ->+ AutoStateM gpf (\x s' -> firstM g =<< f x s') s+ (AutoFuncM g, AutoArb l s f) ->+ AutoArbM (fmap (ag .) l)+ s+ $ \x -> do+ let (y, af') = f x+ y' <- g y+ return (y', ag . af')+ (AutoFuncM g, AutoArbM l s f) ->+ AutoArbM (fmap (ag .) l)+ s+ $ \x -> do+ (y, af') <- f x+ y' <- g y+ return (y', ag . af')+ (AutoState gpg g sg, AutoFunc f) ->+ AutoState gpg (g . f) sg+ (AutoState gpg g sg, AutoFuncM f) ->+ AutoStateM gpg (\x sg' -> liftM (`g` sg') (f x)) sg+ (AutoState gpg g sg, AutoState gpf f sf) ->+ AutoState (mergeStSt gpg gpf)+ (\x (sg', sf') -> let (y, sf'') = f x sf'+ (z, sg'') = g y sg'+ in (z, (sg'', sf'')) )+ (sg, sf)+ (AutoState gpg g sg, AutoStateM gpf f sf) ->+ AutoStateM (mergeStSt gpg gpf)+ (\x (sg', sf') -> do+ (y, sf'') <- f x sf'+ let (z, sg'') = g y sg'+ return (z, (sg'', sf'')) )+ (sg, sf)+ (AutoState gpg@(gg,pg) g sg, AutoArb l s f) ->+ AutoArb (liftA2 (\sg' af' -> AutoState gpg g sg' . af') gg l)+ (pg sg *> s)+ $ \x -> let (y, af') = f x+ (z, sg') = g y sg+ ag' = AutoState gpg g sg'+ in (z, ag' . af')+ (AutoState gpg@(gg,pg) g sg, AutoArbM l s f) ->+ AutoArbM (liftA2 (\sg' af' -> AutoState gpg g sg' . af') gg l)+ (pg sg *> s)+ $ \x -> do+ (y, af') <- f x+ let (z, sg') = g y sg+ ag' = AutoState gpg g sg'+ return (z, ag' . af')+ (AutoStateM gpg g sg, AutoFunc f) ->+ AutoStateM gpg (g <=< return . f) sg+ (AutoStateM gpg g sg, AutoFuncM f) ->+ AutoStateM gpg (\x sg' -> flip g sg' =<< f x) sg+ (AutoStateM gpg g sg, AutoState gpf f sf) ->+ AutoStateM (mergeStSt gpg gpf)+ (\x (sg', sf') -> do+ let (y, sf'') = f x sf'+ (z, sg'') <- g y sg'+ return (z, (sg'', sf'')) )+ (sg, sf)+ (AutoStateM gpg g sg, AutoStateM gpf f sf) ->+ AutoStateM (mergeStSt gpg gpf)+ (\x (sg', sf') -> do+ (y, sf'') <- f x sf'+ (z, sg'') <- g y sg'+ return (z, (sg'', sf'')) )+ (sg, sf)+ (AutoStateM gpg@(gg,pg) g sg, AutoArb l s f) ->+ AutoArbM (liftA2 (\sg' af' -> AutoStateM gpg g sg' . af') gg l)+ (pg sg *> s)+ $ \x -> do+ let (y, af') = f x+ (z, sg') <- g y sg+ let ag' = AutoStateM gpg g sg'+ return (z, ag' . af')+ (AutoStateM gpg@(gg,pg) g sg, AutoArbM l s f) ->+ AutoArbM (liftA2 (\sg' af' -> AutoStateM gpg g sg' . af') gg l)+ (pg sg *> s)+ $ \x -> do+ (y, af') <- f x+ (z, sg') <- g y sg+ let ag' = AutoStateM gpg g sg'+ return (z, ag' . af')+ (AutoArb l s g, AutoFunc f) ->+ AutoArb (fmap (. af) l) s (second (. af) . g . f)+ (AutoArb l s g, AutoFuncM f) ->+ AutoArbM (fmap (. af) l) s (return . second (. af) . g <=< f)+ (AutoArb l s g, AutoState gpf@(gf,pf) f sf) ->+ AutoArb (liftA2 (\ag' sf' -> ag' . AutoState gpf f sf') l gf)+ (s *> pf sf)+ $ \x -> let (y, sf') = f x sf+ af' = AutoState gpf f sf'+ (z, ag') = g y+ in (z, ag' . af')+ (AutoArb l s g, AutoStateM gpf@(gf,pf) f sf) ->+ AutoArbM (liftA2 (\ag' sf' -> ag' . AutoStateM gpf f sf') l gf)+ (s *> pf sf)+ $ \x -> do+ (y, sf') <- f x sf+ let af' = AutoStateM gpf f sf'+ (z, ag') = g y+ return (z, ag' . af')+ (AutoArb lg sg g, AutoArb lf sf f) ->+ AutoArb (liftA2 (.) lg lf)+ (sg *> sf)+ $ \x -> let (y, af') = f x+ (z, ag') = g y+ in (z, ag' . af')+ (AutoArb lg sg g, AutoArbM lf sf f) ->+ AutoArbM (liftA2 (.) lg lf)+ (sg *> sf)+ $ \x -> do+ (y, af') <- f x+ let (z, ag') = g y+ return (z, ag' . af')+ (AutoArbM l s g, AutoFunc f) ->+ AutoArbM (fmap (. af) l)+ s+ (liftM (second (. af)) . g . f)+ (AutoArbM l s g, AutoFuncM f) ->+ AutoArbM (fmap (. af) l)+ s+ (liftM (second (. af)) . g <=< f)+ (AutoArbM l s g, AutoState gpf@(gf,pf) f sf) ->+ AutoArbM (liftA2 (\ag' sf' -> ag' . AutoState gpf f sf') l gf)+ (s *> pf sf)+ $ \x -> do+ let (y, sf') = f x sf+ af' = AutoState gpf f sf'+ (z, ag') <- g y+ return (z, ag' . af')+ (AutoArbM l s g, AutoStateM gpf@(gf,pf) f sf) ->+ AutoArbM (liftA2 (\ag' sf' -> ag' . AutoStateM gpf f sf') l gf)+ (s *> pf sf)+ $ \x -> do+ (y, sf') <- f x sf+ let af' = AutoStateM gpf f sf'+ (z, ag') <- g y+ return (z, ag' . af')+ (AutoArbM lg sg g, AutoArb lf sf f) ->+ AutoArbM (liftA2 (.) lg lf)+ (sg *> sf)+ $ \x -> do+ let (y, af') = f x+ (z, ag') <- g y+ return (z, ag' . af')+ (AutoArbM lg sg g, AutoArbM lf sf f) ->+ AutoArbM (liftA2 (.) lg lf)+ (sg *> sf)+ $ \x -> do+ (y, af') <- f x+ (z, ag') <- g y+ return (z, ag' . af')+ {-# INLINE (.) #-}++mergeStSt :: (Get s, s -> Put)+ -> (Get s', s' -> Put)+ -> (Get (s, s'), (s, s') -> Put)+mergeStSt (gg, pg) (gf, pf) = (liftA2 (,) gg gf, uncurry (*>) . (pg *** pf))++-- | 'lmap' lets you map over the /input/ stream, and 'rmap' lets you map+-- over the /output/ stream. Note that, as with all 'Profunctor's, 'rmap'+-- is 'fmap'.+instance Monad m => Profunctor (Auto m) where+ lmap f = a_+ where+ a_ a = case a of+ AutoFunc fa -> AutoFunc (fa . f)+ AutoFuncM fa -> AutoFuncM (fa . f)+ AutoState gpg fa s -> AutoState gpg (fa . f) s+ AutoStateM gpg fa s -> AutoStateM gpg (fa . f) s+ AutoArb l s fa -> AutoArb (a_ <$> l)+ s+ $ \x -> let (y, a') = fa (f x)+ in (y, a_ a')+ AutoArbM l s fa -> AutoArbM (a_ <$> l)+ s+ $ \x -> do+ (y, a') <- fa (f x)+ return (y, a_ a')+ {-# INLINE lmap #-}+ rmap g = a_+ where+ a_ a = case a of+ AutoFunc fa -> AutoFunc (g . fa)+ AutoFuncM fa -> AutoFuncM (liftM g . fa)+ AutoState gpg fa s -> AutoState gpg (\x -> first g . fa x) s+ AutoStateM gpg fa s -> AutoStateM gpg (\x -> liftM (first g) . fa x) s+ AutoArb l s fa -> AutoArb (a_ <$> l)+ s+ $ \x -> let (y, a') = fa x+ in (g y, a_ a')+ AutoArbM l s fa -> AutoArbM (a_ <$> l)+ s+ $ \x -> do+ (y, a') <- fa x+ return (g y, a_ a')+ {-# INLINE rmap #-}+ dimap f g = a_+ where+ a_ a = case a of+ AutoFunc fa -> AutoFunc (g . fa . f)+ AutoFuncM fa -> AutoFuncM (liftM g . fa . f)+ AutoState gpg fa s -> AutoState gpg (\x -> first g . fa (f x)) s+ AutoStateM gpg fa s -> AutoStateM gpg (\x -> liftM (first g) . fa (f x)) s+ AutoArb l s fa -> AutoArb (a_ <$> l)+ s+ $ \x -> let (y, a') = fa (f x)+ in (g y, a_ a')+ AutoArbM l s fa -> AutoArbM (a_ <$> l)+ s+ $ \x -> do+ (y, a') <- fa (f x)+ return (g y, a_ a')+ {-# INLINE dimap #-}++-- | See 'Arrow' instance.+instance Monad m => Strong (Auto m) where+ first' = first+ second' = second++-- | See 'ArrowChoice' instance+instance Monad m => Choice (Auto m) where+ left' = left+ right' = right++-- | See 'ArrowLoop' instance+instance MonadFix m => Costrong (Auto m) where+ unfirst = loop++-- | Gives us 'arr', which is a "stateless" 'Auto' that behaves just like+-- a function; its outputs are the function applied the corresponding+-- inputs.+--+-- >>> streamAuto' (arr negate) [1..10]+-- [-1,-2,-3,-4,-5,-6,-7,-8,-9,-10]+--+-- Also allows you to have an 'Auto' run on only the "first" or "second"+-- field in an input stream that is tuples...and also allows 'Auto's to run+-- side-by-side on an input stream of tuples (run each on either tuple+-- field).+--+-- >>> streamAuto' (sumFrom 0) [4,6,8,7]+-- [4,10,18,25]+-- >>> streamAuto' (first (sumFrom 0)) [(4,True),(6,False),(8,False),(7,True)]+-- [(4,True),(10,False),(18,False),(25,True)]+-- >>> streamAuto' (productFrom 1) [1,3,5,2]+-- [1,3,15,30]+-- >>> streamAuto' (sumFrom 0 *** productFrom 1) [(4,1),(6,3),(8,5),(7,2)]+-- [(4,1),(10,3),(18,15),(25,30)]+--+-- Most importantly, however, allows for "proc" notation; see the+-- <https://github.com/mstksg/auto/blob/master/tutorial/tutorial.md tutorial>!+-- for more details.+--+instance Monad m => Arrow (Auto m) where+ arr = mkFunc+ first a = case a of+ AutoFunc f ->+ AutoFunc (first f)+ AutoFuncM f ->+ AutoFuncM (firstM f)+ AutoState gp fa s ->+ AutoState gp (\(x, z) -> first (,z) . fa x) s+ AutoStateM gp fa s ->+ AutoStateM gp (\(x, z) -> liftM (first (,z)) . fa x) s+ AutoArb l s f ->+ AutoArb (first <$> l)+ s+ $ \(x, z) -> let (y, a') = f x+ in ((y, z), first a')+ AutoArbM l s f ->+ AutoArbM (first <$> l)+ s+ $ \(x, z) -> do+ (y, a') <- f x+ return ((y, z), first a')+ second a = case a of+ AutoFunc f ->+ AutoFunc (second f)+ AutoFuncM f ->+ AutoFuncM (secondM f)+ AutoState gp fa s ->+ AutoState gp (\(z, x) -> first (z,) . fa x) s+ AutoStateM gp fa s ->+ AutoStateM gp (\(z, x) -> liftM (first (z,)) . fa x) s+ AutoArb l s f ->+ AutoArb (second <$> l)+ s+ $ \(z, x) -> let (y, a') = f x+ in ((z, y), second a')+ AutoArbM l s f ->+ AutoArbM (second <$> l)+ s+ $ \(z, x) -> do+ (y, a') <- f x+ return ((z, y), second a')++-- | Allows you to have an 'Auto' only act on "some" inputs (only on+-- 'Left's, for example), and be "paused" otherwise.+--+-- >>> streamAuto' (sumFrom 0) [1,4,2,5]+-- [1,5,7,12]+-- >>> streamAuto' (left (sumFrom 0)) [Left 1, Right 'a', Left 4, Left 2, Right 'b', Left 5]+-- [Left 1, Right 'a', Left 5, Left 6, Right 'b', Left 12]+--+-- Again mostly useful for "proc" notation, with branching.+--+instance Monad m => ArrowChoice (Auto m) where+ left a0 = a+ where+ a = case a0 of+ AutoFunc f ->+ AutoFunc (left f)+ AutoFuncM f ->+ AutoFuncM (\x -> case x of+ Right y -> return (Right y)+ Left y -> liftM Left (f y))+ AutoState gp f s ->+ AutoState gp (\x s' -> case x of+ Right y -> (Right y, s')+ Left y -> first Left (f y s')+ ) s+ AutoStateM gp f s ->+ AutoStateM gp (\x s' -> case x of+ Right y -> return (Right y, s')+ Left y -> liftM (first Left) (f y s')+ ) s+ AutoArb l s f ->+ AutoArb (left <$> l)+ s+ $ \x -> case x of+ Right y -> (Right y, a)+ Left y -> (Left *** left) (f y)+ AutoArbM l s f ->+ AutoArbM (left <$> l)+ s+ $ \x -> case x of+ Right y -> return (Right y, a)+ Left y -> liftM (Left *** left) (f y)+ {-# INLINE left #-}+ right a0 = a+ where+ a = case a0 of+ AutoFunc f ->+ AutoFunc (fmap f)+ AutoFuncM f ->+ AutoFuncM (sequence . fmap f)+ AutoState gp f s ->+ AutoState gp (\x s' -> case x of+ Left y -> (Left y, s')+ Right y -> first Right (f y s')+ ) s+ AutoStateM gp f s ->+ AutoStateM gp (\x s' -> case x of+ Left y -> return (Left y, s')+ Right y -> liftM (first Right) (f y s')+ ) s+ AutoArb l s f ->+ AutoArb (right <$> l)+ s+ $ \x -> case x of+ Left y -> (Left y, a)+ Right y -> (Right *** right) (f y)+ AutoArbM l s f ->+ AutoArbM (right <$> l)+ s+ $ \x -> case x of+ Left y -> return (Left y, a)+ Right y -> liftM (Right *** right) (f y)+ {-# INLINE right #-}++-- | Finds the fixed point of self-referential 'Auto's (for example,+-- feeding the output stream of an 'Auto' to itself). Mostly used with+-- proc notation to allow recursive bindings.+instance MonadFix m => ArrowLoop (Auto m) where+ loop a = case a of+ AutoFunc f ->+ AutoFunc (\x -> fst . fix $ \(_, d) -> f (x, d))+ AutoFuncM f ->+ AutoFuncM (\x -> liftM fst . mfix $ \(_, d) -> f (x, d))+ AutoState gp f s ->+ AutoState gp (\x s' -> first fst . fix $ \ ~((_, d), _) -> f (x, d) s') s+ AutoStateM gp f s ->+ AutoStateM gp (\x s' -> liftM (first fst) . mfix $ \ ~((_, d), _) -> f (x, d) s') s+ AutoArb l s f ->+ AutoArb (loop <$> l)+ s+ $ \x -> (fst *** loop)+ . fix+ $ \ ~((_, d), _) -> f (x, d)+ AutoArbM l s f ->+ AutoArbM (loop <$> l)+ s+ $ \x -> liftM (fst *** loop)+ . mfix+ $ \ ~((_, d), _) -> f (x, d)+ {-# INLINE loop #-}++-- Utility instances++-- | Fork the input stream and '<>' the outputs. See the 'Monoid'+-- instance.+instance (Monad m, Semigroup b) => Semigroup (Auto m a b) where+ (<>) = liftA2 (<>)++-- | Fork the input stream and mappend the outputs. 'mempty' is a constant+-- stream of 'mempty's, ignoring its input.+--+-- >>> streamAuto' (mconcat [arr (take 3), accum (++) ""]) ["hello","world","good","bye"]+-- ["helhello","worhelloworld","goohelloworldgood","byehelloworldgoodbye"]+instance (Monad m, Monoid b) => Monoid (Auto m a b) where+ mempty = pure mempty+ mappend = liftA2 mappend++-- | String literals in code will be 'Auto's that constanty produce that+-- string.+--+-- >>> take 6 . streamAuto' (onFor 2 . "hello" --> "world") $ repeat ()+-- ["hello","hello","world","world","world","world"]+instance (Monad m, IsString b) => IsString (Auto m a b) where+ fromString = pure . fromString++-- | Fork the input stream and add, multiply, etc. the outputs. 'negate'+-- will negate the ouptput stream. 'fromInteger' will be a constant stream+-- of that 'Integer', so you can write 'Auto's using numerical literals in+-- code:+--+-- >>> streamAuto' (sumFrom 0) [1..10]+-- [1,3,6,10,15,21,28,36,45,55]+-- >>> streamAuto' (4 + sumFrom 0) [1..10]+-- [5,7,10,14,19,25,32,40,49,59]+--+instance (Monad m, Num b) => Num (Auto m a b) where+ (+) = liftA2 (+)+ (*) = liftA2 (*)+ (-) = liftA2 (-)+ negate = fmap negate+ abs = fmap abs+ signum = fmap signum+ fromInteger = pure . fromInteger++-- | Fork the input stream and divide the outputs. 'recip' maps 'recip' to+-- the output stream; 'fromRational' will be a constant stream of that+-- 'Rational', so you can write 'Auto's using numerical literals in code;+-- see 'Num' instance.+instance (Monad m, Fractional b) => Fractional (Auto m a b) where+ (/) = liftA2 (/)+ recip = fmap recip+ fromRational = pure . fromRational++-- | A bunch of constant producers, mappers-of-output-streams, and+-- forks-and-recombiners.+instance (Monad m, Floating b) => Floating (Auto m a b) where+ pi = pure pi+ exp = fmap exp+ sqrt = fmap sqrt+ log = fmap log+ (**) = liftA2 (**)+ logBase = liftA2 logBase+ sin = fmap sin+ tan = fmap tan+ cos = fmap cos+ asin = fmap asin+ atan = fmap atan+ acos = fmap acos+ sinh = fmap sinh+ tanh = fmap tanh+ cosh = fmap cosh+ asinh = fmap asinh+ atanh = fmap atanh+ acosh = fmap acosh+++-- Utility functions++firstM :: Monad m => (a -> m b) -> (a, c) -> m (b, c)+firstM f ~(x, y) = liftM (, y) (f x)+{-# INLINE firstM #-}++secondM :: Monad m => (a -> m b) -> (c, a) -> m (c, b)+secondM f ~(x, y) = liftM (x,) (f y)+{-# INLINE secondM #-}
+ src/Control/Auto/Effects.hs view
@@ -0,0 +1,495 @@+{-# LANGUAGE TupleSections #-}++-- |+-- Module : Control.Auto.Effects+-- Description : Accessing, executing, and manipulating underyling monadic+-- effects.+-- Copyright : (c) Justin Le 2015+-- License : MIT+-- Maintainer : justin@jle.im+-- Stability : unstable+-- Portability : portable+--+-- This module exports the preferred ways of interacting with the+-- underlying 'Monad' of the 'Auto' type, including accessing, executing,+-- and manipulating such effects.+--++module Control.Auto.Effects (+ -- * Running effects+ -- ** Continually+ arrM+ , effect+ -- ** From inputs+ , effects+ -- ** On 'Blip's+ , arrMB+ , effectB+ , execB+ -- * One-time effects+ , cache+ , execOnce+ , cache_+ , execOnce_+ -- * Manipulating underlying monads+ -- ** "Sealing off" monadic 'Auto's+ , sealState+ , sealState_+ , sealReader+ , sealReader_+ -- ** "Unrolling"/"reifying" monadic 'Auto's+ , runStateA+ , runReaderA+ , runWriterA+ , runTraversableA+ -- ** Hoists+ , hoistA+ , generalizeA+ -- ** Working with IO+ , catchA+ -- ** Constructing monadic 'Auto's from other monads+ , fromState+ , fromState_+ ) where++import Control.Applicative+import Control.Auto.Blip+import Control.Exception+import Control.Auto.Core+import Control.Monad.Trans.Writer (WriterT, runWriterT)+import Control.Auto.Generate+import Control.Category+import Control.Monad hiding (mapM, mapM_)+import Control.Monad.Trans.Reader (ReaderT, runReaderT)+import Data.Monoid+import Control.Monad.Trans.State (StateT, runStateT)+import Data.Foldable+import Data.Serialize+import Data.Traversable+import Prelude hiding ((.), id, mapM, mapM_)++-- | The very first output executes a monadic action and uses the result as+-- the output, ignoring all input. From then on, it persistently outputs+-- that first result.+--+-- Like 'execOnce', except outputs the result of the action instead of+-- ignoring it.+--+-- Useful for loading resources in IO on the "first step", like+-- a word list:+--+-- @+-- dictionary :: Auto IO a [String]+-- dictionary = cache (lines <$> readFile "wordlist.txt")+-- @+--+cache :: (Serialize b, Monad m)+ => m b -- ^ monadic action to execute and use the result of+ -> Auto m a b+cache m = snd <$> iteratorM (_cacheF m) (False, undefined)++-- | The non-resumable/non-serializable version of 'cache'. Every time the+-- 'Auto' is deserialized/reloaded, it re-executes the action to retrieve+-- the result again.+--+-- Useful in cases where you want to "re-load" an expensive resource on+-- every startup, instead of saving it to in the save states.+--+-- @+-- dictionary :: Auto IO a [String]+-- dictionary = cache_ (lines <$> readFile "dictionary.txt")+-- @+cache_ :: Monad m+ => m b -- ^ monadic action to execute and use the result of+ -> Auto m a b+cache_ m = snd <$> iteratorM_ (_cacheF m) (False, undefined)++_cacheF :: Monad m => m b -> (Bool, b) -> m (Bool, b)+_cacheF m (False, _) = liftM (True,) m+_cacheF _ (True , x) = return (True, x)+{-# INLINE _cacheF #-}++-- | Always outputs '()', but when asked for the first output, executes the+-- given monadic action.+--+-- Pretty much like 'cache', but always outputs '()'.+--+execOnce :: Monad m+ => m b -- ^ monadic action to execute; result discared+ -> Auto m a ()+execOnce m = mkStateM (\_ -> _execOnceF m) False++-- | The non-resumable/non-serializable version of 'execOnce'. Every time+-- the 'Auto' is deserialized/reloaded, the action is re-executed again.+execOnce_ :: Monad m+ => m b -- ^ monadic action to execute; result discared+ -> Auto m a ()+execOnce_ m = mkStateM_ (\_ -> _execOnceF m) False++_execOnceF :: Monad m => m a -> Bool -> m ((), Bool)+_execOnceF m = go+ where+ go False = liftM (const ((), True)) m+ go _ = return ((), True)++-- | The input stream is a stream of monadic actions, and the output stream+-- is the result of their executions, through executing them.+effects :: Monad m => Auto m (m a) a+effects = arrM id++-- | Applies the given "monadic function" (function returning a monadic+-- action) to every incoming item; the result is the result of executing+-- the action returned.+--+-- Note that this essentially lifts a "Kleisli arrow"; it's like 'arr', but+-- for "monadic functions" instead of normal functions:+--+-- @+-- arr :: (a -> b) -> Auto m a b+-- arrM :: (a -> m b) -> Auto m a b+-- @+--+-- prop> arrM f . arrM g == arrM (f <=< g)+--+-- One neat trick you can do is that you can "tag on effects" to a normal+-- 'Auto' by using '*>' from "Control.Applicative". For example:+--+-- >>> let a = arrM print *> sumFrom 0+-- >>> ys <- streamAuto a [1..5]+-- 1 -- IO output+-- 2+-- 3+-- 4+-- 5+-- >>> ys+-- [1,3,6,10,15] -- the result+--+-- Here, @a@ behaves "just like" @'sumFrom' 0@...except, when you step it,+-- it prints out to stdout as a side-effect. We just gave automatic+-- stdout logging behavior!+--+arrM :: (a -> m b) -- ^ monadic function+ -> Auto m a b+arrM = mkFuncM+{-# INLINE arrM #-}++-- | Maps one blip stream to another; replaces every emitted value with the+-- result of the monadic function, executing it to get the result.+arrMB :: Monad m+ => (a -> m b)+ -> Auto m (Blip a) (Blip b)+arrMB = perBlip . arrM+{-# INLINE arrMB #-}++-- | Maps one blip stream to another; replaces every emitted value with the+-- result of a fixed monadic action, run every time an emitted value is+-- received.+effectB :: Monad m+ => m b+ -> Auto m (Blip a) (Blip b)+effectB = perBlip . effect+{-# INLINE effectB #-}++-- | Outputs the identical blip stream that is received; however, every+-- time it sees an emitted value, executes the given monadic action on the+-- side.+execB :: Monad m+ => m b+ -> Auto m (Blip a) (Blip a)+execB mx = perBlip (arrM $ \x -> mx >> return x)+{-# INLINE execB #-}++-- | Takes an 'Auto' that works with underlying global, mutable state, and+-- "seals off the state" from the outside world.+--+-- An 'Auto (StateT s m) a b' maps a stream of 'a' to a stream of 'b', but+-- does so in the context of requiring an initial 's' to start, and+-- outputting a modified 's'.+--+-- Consider this example 'State' 'Auto':+--+-- @+-- foo :: Auto (State s) Int Int+-- foo = proc x -> do+-- execB (modify (+1)) . emitOn odd -< x+-- execB (modify (*2)) . emitOn even -< x+-- st <- effect get -< ()+-- sumX <- sumFrom 0 -< x+-- id -< sumX + st+-- @+--+-- On every output, the "global" state is incremented if the input is odd+-- and doubled if the input is even. The stream @st@ is always the value+-- of the global state at that point. @sumX@ is the cumulative sum of the+-- inputs. The final result is the sum of the value of the global state+-- and the cumulative sum.+--+-- In writing like this, you lose some of the denotative properties because+-- you are working with a global state that updates at every output. You+-- have some benefit of now being able to work with global state, if that's+-- what you wanted I guess.+--+-- To "run" it, you could use 'streamAuto' to get a @'State' Int Int@:+--+-- >>> let st = streamAuto foo [1..10] :: State Int Int+-- >>> runState st 5+-- ([ 7, 15, 19, 36, 42, 75, 83,136,156,277], 222)+--+-- (The starting state is 5 and the ending state after all of that is 222)+--+-- However, writing your entire program with global state is a bad bad+-- idea! So, how can you get the "benefits" of having small parts like+-- @foo@ be written using 'State', and being able to use it in a program+-- with no global state?+--+-- Using 'sealState'!+--+-- @+-- sealState :: Auto (State s) a b -> s -> Auto' a b+-- sealState foo 5 :: Auto' Int Int+-- @+--+-- @+-- bar :: Auto' Int (Int, String)+-- bar = proc x -> do+-- food <- sealState foo 5 -< x+-- id -< (food, show x)+-- @+--+-- >>> streamAuto' bar [1..10]+-- [ (7, "1"), (15, "2"), (19, "3"), (36, "4"), (42, "5"), (75, "6") ...+--+-- We say that @'sealState' f s0@ takes an input stream, and the output+-- stream is the result of running the stream through @f@, first with an+-- initial state of @s0@, and afterwards with each next updated state.+--+sealState :: (Monad m, Serialize s)+ => Auto (StateT s m) a b+ -> s+ -> Auto m a b+sealState a s0 = mkAutoM (sealState <$> resumeAuto a <*> get)+ (saveAuto a *> put s0)+ $ \x -> do+ ((y, a'), s1) <- runStateT (stepAuto a x) s0+ return (y, sealState a' s1)++-- | The non-resuming/non-serializing version of 'sealState'.+sealState_ :: Monad m+ => Auto (StateT s m) a b+ -> s+ -> Auto m a b+sealState_ a s0 = mkAutoM (sealState_ <$> resumeAuto a <*> pure s0)+ (saveAuto a)+ $ \x -> do+ ((y, a'), s1) <- runStateT (stepAuto a x) s0+ return (y, sealState_ a' s1)++-- | Turns an @a -> 'StateT' s m b@ arrow into an @'Auto' m a b@, when+-- given an initial state. Will continually "run the function", using the+-- state returned from the last run.+fromState :: (Serialize s, Monad m)+ => (a -> StateT s m b)+ -> s+ -> Auto m a b+fromState st = mkStateM (runStateT . st)++-- | Non-seralizing/non-resuming version of 'fromState'. The state isn't+-- serialized/resumed, so every time the 'Auto' is resumed, it starts over+-- with the given initial state.+fromState_ :: Monad m+ => (a -> StateT s m b)+ -> s+ -> Auto m a b+fromState_ st = mkStateM_ (runStateT . st)++-- | "Unrolls" the underlying @'WriterT' w m@ 'Monad', so that an 'Auto'+-- that takes in a stream of @a@ and outputs a stream of @b@ will now+-- output a stream @(b, w)@, where @w@ is the accumulated log of the+-- underlying 'Writer' at every step.+--+-- @+-- foo :: Auto (Writer (Sum Int)) Int Int+-- foo = effect (tell 1) *> effect (tell 1) *> sumFrom 0+-- @+--+-- >>> let fooWriter = streamAuto foo+-- >>> runWriter $ fooWriter [1..10]+-- ([1,3,6,10,15,21,28,36,45,55], Sum 20)+--+-- @foo@ increments an underlying counter twice every time it is stepped;+-- its "result" is just the cumulative sum of the inputs.+--+-- When we "stream" it, we get a @[Int] -> 'Writer' (Sum Int)+-- [Int]@...which we can give an input list and 'runWriter' it, getting+-- a list of outputs and a "final accumulator state" of 10, for stepping it+-- ten times.+--+-- We can write and compose own 'Auto's under 'Writer', using the+-- convenience of a shared accumulator, and then "use them" with other+-- 'Auto's:+--+-- @+-- bar :: Auto' Int Int+-- bar = proc x -> do+-- (y, w) <- runWriterA foo -< x+-- blah <- blah -< w+-- @+--+-- And now you have access to the underlying accumulator of @foo@ to+-- access. There, @w@ represents the continually updating accumulator+-- under @foo@, and will be different/growing at every "step".+--+runWriterA :: (Monad m, Monoid w)+ => Auto (WriterT w m) a b+ -> Auto m a (b, w)+runWriterA a = mkAutoM (runWriterA <$> resumeAuto a)+ (saveAuto a)+ $ \x -> do+ ((y, a'), w) <- runWriterT (stepAuto a x)+ return ((y, w), runWriterA a')++-- | Takes an 'Auto' that operates under the context of a read-only+-- environment, an environment value, and turns it into a normal 'Auto'+-- that always "sees" that value when it asks for one.+--+-- >>> let a = effect ask :: Auto (Reader b) a b+-- >>> let rdr = streamAuto' a [1..5] :: Reader b [b]+-- >>> runReader rdr "hey"+-- ["hey", "hey", "hey", "hey", "hey"]+--+-- Useful if you wanted to use it inside/composed with an 'Auto' that does+-- not have a global environment:+--+-- @+-- bar :: Auto' Int String+-- bar = proc x -> do+-- hey <- sealReader (effect ask) "hey" -< ()+-- id -< hey ++ show x+-- @+--+-- >>> streamAuto' bar [1..5]+-- ["hey1", "hey2", "hey3", "hey4", "hey5"]+--+-- Note that this version serializes the given @r@ environment, so that+-- every time the 'Auto' is reloaded/resumed, it resumes with the+-- originally given @r@ environment, ignoring whatever @r@ is given to it+-- when trying to resume it. If this is not the behavior you want, use+-- 'sealReader_'.+--+sealReader :: (Monad m, Serialize r)+ => Auto (ReaderT r m) a b -- ^ 'Auto' run over 'Reader'+ -> r -- ^ the perpetual environment+ -> Auto m a b+sealReader a r = mkAutoM (sealReader <$> resumeAuto a <*> get)+ (saveAuto a *> put r)+ $ \x -> do+ (y, a') <- runReaderT (stepAuto a x) r+ return (y, sealReader a' r)++-- | The non-resuming/non-serializing version of 'sealReader'. Does not+-- serialize/reload the @r@ environment, so that whenever you "resume" the+-- 'Auto', it uses the new @r@ given when you are trying to resume, instead+-- of loading the originally given one.+sealReader_ :: Monad m+ => Auto (ReaderT r m) a b -- ^ 'Auto' run over 'Reader'+ -> r -- ^ the perpetual environment+ -> Auto m a b+sealReader_ a r = mkAutoM (sealReader_ <$> resumeAuto a <*> pure r)+ (saveAuto a)+ $ \x -> do+ (y, a') <- runReaderT (stepAuto a x) r+ return (y, sealReader_ a' r)++-- | "Unrolls" the underlying 'StateT' of an 'Auto' into an 'Auto' that+-- takes in an input state every turn (in addition to the normal input) and+-- outputs, along with the original result, the modified state.+--+-- So now you can use any @'StateT' s m@ as if it were an @m@. Useful if+-- you want to compose and create some isolated 'Auto's with access to an+-- underlying state, but not your entire program.+--+-- Also just simply useful as a convenient way to use an 'Auto' over+-- 'State' with 'stepAuto' and friends.+--+-- When used with @'State' s@, it turns an @'Auto' ('State' s) a b@ into an+-- @'Auto'' (a, s) (b, s)@.+runStateA :: Monad m+ => Auto (StateT s m) a b -- ^ 'Auto' run over a state transformer+ -> Auto m (a, s) (b, s) -- ^ 'Auto' whose inputs and outputs are a start transformer+runStateA a = mkAutoM (runStateA <$> resumeAuto a)+ (saveAuto a)+ $ \(x, s) -> do+ ((y, a'), s') <- runStateT (stepAuto a x) s+ return ((y, s'), runStateA a')++-- | "Unrolls" the underlying 'ReaderT' of an 'Auto' into an 'Auto' that+-- takes in the input "environment" every turn in addition to the normal+-- input.+--+-- So you can use any @'ReaderT' r m@ as if it were an @m@. Useful if you+-- want to compose and create some isolated 'Auto's with access to an+-- underlying environment, but not your entire program.+--+-- Also just simply useful as a convenient way to use an 'Auto' over+-- 'Reader' with 'stepAuto' and friends.+--+-- When used with @'Reader' r@, it turns an @'Auto' ('Reader' r) a b@ into+-- an @'Auto'' (a, r) b@.+runReaderA :: Monad m+ => Auto (ReaderT r m) a b -- ^ 'Auto' run over global environment+ -> Auto m (a, r) b -- ^ 'Auto' receiving environments+runReaderA a = mkAutoM (runReaderA <$> resumeAuto a)+ (saveAuto a)+ $ \(x, r) -> do+ (y, a') <- runReaderT (stepAuto a x) r+ return (y, runReaderA a')++-- | "Unrolls" the underlying 'Monad' of an 'Auto' if it happens to be+-- 'Traversable' ('[]', 'Maybe', etc.).+--+-- It can turn, for example, an @'Auto' [] a b@ into an @'Auto'' a [b]@; it+-- collects all of the results together. Or an @'Auto' 'Maybe' a b@ into+-- an @'Auto'' a ('Maybe' b)@.+--+-- This might be useful if you want to make some sort of "underyling+-- inhibiting" 'Auto' where the entire computation might just end up being+-- 'Nothing' in the end. With this, you can turn that+-- possibly-catastrophically-failing 'Auto' (with an underlying 'Monad' of+-- 'Maybe') into a normal 'Auto', and use it as a normal 'Auto' in+-- composition with other 'Auto's...returning 'Just' if your computation+-- succeeded.+runTraversableA :: (Monad f, Traversable f)+ => Auto f a b -- ^ 'Auto' run over traversable structure+ -> Auto m a (f b) -- ^ 'Auto' returning traversable structure+runTraversableA = go . return+ where+ go a = mkAuto (go <$> mapM resumeAuto a)+ (mapM_ saveAuto a)+ $ \x -> let o = a >>= (`stepAuto` x)+ y = liftM fst o+ a' = liftM snd o+ in (y, go a')++-- | Wraps a "try" over an underlying 'IO' monad; if the Auto encounters a+-- runtime exception while trying to "step" itself, it'll output a 'Left'+-- with the 'Exception'. Otherwise, will output 'left'.+--+-- Note that you have to explicitly specify the type of the exceptions you+-- are catching; see "Control.Exception" documentation for more details.+--+-- TODO: Possibly look into bringing in some more robust tools from+-- monad-control and other industry established error handling routes?+-- Also, can we modify an underlying monad with implicit cacting behavior?+catchA :: Exception e+ => Auto IO a b -- ^ Auto over IO, expecting an+ -- exception of a secific type.+ -> Auto IO a (Either e b)+catchA a = a_+ where+ a_ = mkAutoM (catchA <$> resumeAuto a)+ (saveAuto a)+ $ \x -> do+ eya' <- try $ stepAuto a x+ case eya' of+ Right (y, a') -> return (Right y, catchA a')+ Left e -> return (Left e , a_)
+ src/Control/Auto/Generate.hs view
@@ -0,0 +1,299 @@+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module : Control.Auto.Generate+-- Description : 'Auto's that act as generators or "producers", ignoring input.+-- Copyright : (c) Justin Le 2015+-- License : MIT+-- Maintainer : justin@jle.im+-- Stability : unstable+-- Portability : portable+--+-- This module contains various 'Auto's that act as "producing" streams;+-- they all ignore their input streams and produce output streams through+-- a pure or monadic process.+--++module Control.Auto.Generate (+ -- * From lists+ fromList+ , fromList_+ , fromLongList+ -- * Constant producers+ -- $constant+ , pure+ , effect+ -- * From functions+ -- ** Iterating+ , iterator+ , iterator_+ , iteratorM+ , iteratorM_+ -- ** Enumerating results of a function+ , discreteF+ , discreteF_+ -- ** Unfolding+ -- | "Iterating with state".+ , unfold+ , unfold_+ , unfoldM+ , unfoldM_+ -- * Enumerating+ , enumFromA+ , enumFromA_+ ) where++import Control.Applicative+import Control.Auto.Core+import Control.Auto.Interval+import Control.Category+import Data.Serialize+import Prelude hiding ((.), id)++-- | An 'Interval' that ignores the input stream and just outputs items+-- from the given list. Is "on" as long as there are still items in the+-- list left, and "off" after there is nothing left in the list to output.+--+-- Serializes itself by storing the entire rest of the list in binary, so+-- if your list is long, it might take up a lot of space upon+-- storage. If your list is infinite, it makes an infinite binary, so be+-- careful!+--+-- 'fromLongList' can be used for longer lists or infinite lists; or, if+-- your list can be boild down to an 'unfoldr', you can use 'unfold'.+--+-- * Storing: O(n) time and space on length of remaining list+-- * Loading: O(1) time in the number of times the 'Auto' has been+-- stepped + O(n) time in the length of the remaining list.+--+fromList :: Serialize b+ => [b] -- ^ list to output element-by-element+ -> Interval m a b+fromList = mkState (const _uncons)++-- | A version of 'fromList' that is safe for long or infinite lists, or+-- lists with unserializable elements.+--+-- There is a small cost in the time of loading/resuming, which is @O(n)@+-- on the number of times the Auto had been stepped at the time of+-- saving. This is because it has to drop the @n@ first elements in the+-- list, to "resume" to the proper position.+--+-- * Storing: O(1) time and space on the length of the remaining list+-- * Loading: O(n) time on the number of times the 'Auto' has been+-- stepped, maxing out at O(n) on the length of the entire input list.+--+fromLongList :: [b] -- ^ list to output element-by-element+ -> Interval m a b+fromLongList xs = go 0 xs+ where+ loader = do+ stopped <- get+ if stopped+ then return finished+ else do+ i <- get+ return (go i (drop i xs))+ finished = mkAuto loader+ (put True)+ (const (Nothing, finished))+ go i ys = mkAuto loader+ (put (False, i))+ $ \_ -> case ys of+ (y':ys') -> (Just y', go (i + 1) ys')+ [] -> (Nothing, finished)++-- | The non-resuming/non-serializing version of 'fromList'.+fromList_ :: [b] -- ^ list to output element-by-element+ -> Interval m a b+fromList_ = mkState_ (const _uncons)++_uncons :: [a] -> (Maybe a, [a])+_uncons [] = (Nothing, [])+_uncons (x:xs) = (Just x , xs)++-- | Analogous to 'unfoldr' from "Prelude". Creates an 'Interval'+-- (that ignores its input) by maintaining an internal accumulator of type+-- @c@ and, at every step, applying to the unfolding function to the+-- accumulator. If the result is 'Nothing', then the 'Interval' will turn+-- "off" forever (output 'Nothing' forever); if the result is @'Just' (y,+-- acc)@, then it will output @y@ and store @acc@ as the new accumulator.+--+-- Given an initial accumulator.+--+-- >>> let countFromTil n m = flip unfold n $ \i -> if i <= m+-- then Just (i, i+1)+-- else Nothing+-- >>> take 8 . streamAuto' (countFromTil 5 10) $ repeat ()+-- [Just 5, Just 6, Just 7, Just 8, Just 9, Just 10, Nothing, Nothing]+--+-- @'unfold' f c0@ behaves like @'overList' ('unfoldr' f c0)@.+--+unfold :: Serialize c+ => (c -> Maybe (b, c)) -- ^ unfolding function+ -> c -- ^ initial accumulator+ -> Interval m a b+unfold f = mkState (_unfoldF f) . Just++-- | Like 'unfold', but the unfolding function is monadic.+unfoldM :: (Serialize c, Monad m)+ => (c -> m (Maybe (b, c))) -- ^ unfolding function+ -> c -- ^ initial accumulator+ -> Interval m a b+unfoldM f = mkStateM (_unfoldMF f) . Just++-- | The non-resuming & non-serializing version of 'unfold'.+unfold_ :: (c -> Maybe (b, c)) -- ^ unfolding function+ -> c -- ^ initial accumulator+ -> Interval m a b+unfold_ f = mkState_ (_unfoldF f) . Just++-- | The non-resuming & non-serializing version of 'unfoldM'.+unfoldM_ :: Monad m+ => (c -> m (Maybe (b, c))) -- ^ unfolding function+ -> c -- ^ initial accumulator+ -> Interval m a b+unfoldM_ f = mkStateM_ (_unfoldMF f) . Just++_unfoldF :: (c -> Maybe (b, c))+ -> a+ -> Maybe c+ -> (Maybe b, Maybe c)+_unfoldF _ _ Nothing = (Nothing, Nothing)+_unfoldF f _ (Just x) = case f x of+ Just (y, x') -> (Just y, Just x')+ Nothing -> (Nothing, Nothing)++_unfoldMF :: Monad m+ => (c -> m (Maybe (b, c)))+ -> a+ -> Maybe c+ -> m (Maybe b, Maybe c)+_unfoldMF _ _ Nothing = return (Nothing, Nothing)+_unfoldMF f _ (Just x) = do+ res <- f x+ return $ case res of+ Just (y, x') -> (Just y, Just x')+ Nothing -> (Nothing, Nothing)+++-- | Analogous to 'iterate' from "Prelude". Keeps accumulator value and+-- continually applies the function to the accumulator at every step,+-- outputting the result.+--+-- The first result is the initial accumulator value.+--+-- >>> take 10 . streamAuto' (iterator (*2) 1) $ repeat ()+-- [1, 2, 4, 8, 16, 32, 64, 128, 256, 512]+iterator :: Serialize b+ => (b -> b) -- ^ iterating function+ -> b -- ^ starting value and initial output+ -> Auto m a b+iterator f = accumD (\x _ -> f x)++-- | Like 'iterator', but with a monadic function.+iteratorM :: (Serialize b, Monad m)+ => (b -> m b) -- ^ (monadic) iterating function+ -> b -- ^ starting value and initial output+ -> Auto m a b+iteratorM f = accumMD (\x _ -> f x)++-- | The non-resuming/non-serializing version of 'iterator'.+iterator_ :: (b -> b) -- ^ iterating function+ -> b -- ^ starting value and initial output+ -> Auto m a b+iterator_ f = accumD_ (\x _ -> f x)++-- | The non-resuming/non-serializing version of 'iteratorM'.+iteratorM_ :: Monad m+ => (b -> m b) -- ^ (monadic) iterating function+ -> b -- ^ starting value and initial output+ -> Auto m a b+iteratorM_ f = accumMD_ (\x _ -> f x)++-- | Continually enumerate from the starting value, using `succ`.+enumFromA :: (Serialize b, Enum b)+ => b -- ^ initial value+ -> Auto m a b+enumFromA = iterator succ++-- | The non-serializing/non-resuming version of `enumFromA`.+enumFromA_ :: Enum b+ => b -- ^ initial value+ -> Auto m a b+enumFromA_ = iterator_ succ++-- | Given a function from discrete enumerable inputs, iterates through all+-- of the results of that function.+--+-- >>> take 10 . streamAuto' (discreteF (^2) 0) $ repeat ()+-- [0, 1, 4, 9, 16, 25, 36, 49, 64, 81]+discreteF :: (Enum c, Serialize c)+ => (c -> b) -- ^ discrete function+ -> c -- ^ initial input+ -> Auto m a b+discreteF f = mkState $ \_ x -> (f x, succ x)++-- | The non-resuming/non-serializing version of `discreteF`.+discreteF_ :: Enum c+ => (c -> b) -- ^ discrete function+ -> c -- ^ initial input+ -> Auto m a b+discreteF_ f = mkState_ $ \_ x -> (f x, succ x)++-- $constant+--+-- Here we have the "constant producers": 'Auto's whose output is always+-- the same value, or the result of executing the same monadic action.+--+-- @+-- 'pure' :: 'Monad' m => b -> 'Auto' m a b+-- 'effect' :: 'Monad' m => m b -> 'Auto' m a b+-- @+--+-- 'pure' always outputs the same value, ignoring its input, and 'effect'+-- always outputs the result of executing the same monadic action, ignoring+-- its input.++-- | To get every output, executes the monadic action and returns the+-- result as the output. Always ignores input.+--+-- This is basically like an "effectful" 'pure':+--+-- @+-- 'pure' :: b -> 'Auto' m a b+-- 'effect' :: m b -> 'Auto' m a b+-- @+--+-- The output of 'pure' is always the same, and the output of 'effect' is+-- always the result of the same monadic action. Both ignore their inputs.+--+-- Fun times when the underling 'Monad' is, for instance, 'Reader'.+--+-- >>> let a = effect ask :: Auto (Reader b) a b+-- >>> let r = evalAuto a () :: Reader b b+-- >>> runReader r "hello"+-- "hello"+-- >>> runReader r 100+-- 100+--+-- If your underling monad has effects ('IO', 'State', 'Maybe', 'Writer',+-- etc.), then it might be fun to take advantage of '*>' from+-- "Control.Applicative" to "tack on" an effect to a normal 'Auto':+--+-- >>> let a = effect (modify (+1)) *> sumFrom 0 :: Auto (State Int) Int Int+-- >>> let st = streamAuto a [1..10]+-- >>> let (ys, s') = runState st 0+-- >>> ys+-- [1,3,6,10,15,21,28,36,45,55]+-- >>> s'+-- 10+--+-- Out 'Auto' @a@ behaves exactly like @'sumFrom' 0@, except at each step,+-- it also increments the underlying/global state by one. It is @'sumFrom'+-- 0@ with an "attached effect".+--+effect :: m b -- ^ monadic action to contually execute.+ -> Auto m a b+effect = mkConstM+{-# INLINE effect #-}
+ src/Control/Auto/Interval.hs view
@@ -0,0 +1,726 @@+-- |+-- Module : Control.Auto.Interval+-- Description : Tools for working with "interval" semantics: "On or off"+-- 'Auto's.+-- Copyright : (c) Justin Le 2015+-- License : MIT+-- Maintainer : justin@jle.im+-- Stability : unstable+-- Portability : portable+--+--+-- This module provides combinators and utilities for working with the+-- semantic concept of "intervals": an 'Auto' whose output stream is "on"+-- or "off" for (conceputally) contiguous chunks of time.+--++module Control.Auto.Interval (+ -- * Intervals+ -- $intervals+ Interval+ , Interval'+ -- * Static 'Interval's+ , off+ , toOn+ , fromInterval+ , fromIntervalWith+ , onFor+ , offFor+ , window+ -- * Filter 'Interval's+ , whenI+ , unlessI+ -- * Choice+ , (<|!>)+ , (<|?>)+ , chooseInterval+ , choose+ -- * Blip-based 'Interval's+ , after+ , before+ , between+ , hold+ , hold_+ , holdFor+ , holdFor_+ -- * Composition with 'Interval'+ , during+ , compI+ , bindI+ ) where++import Control.Applicative+import Control.Arrow+import Control.Auto.Blip.Internal+import Control.Auto.Core+import Control.Category+import Control.Monad (join)+import Data.Maybe+import Data.Profunctor+import Data.Serialize+import Prelude hiding ((.), id, mapM)++-- $intervals+--+-- An auto that exhibits this "interval" behavior is represented with the+-- 'Interval' type synonym:+--+-- @+-- type 'Interval' m a b = 'Auto' m a ('Maybe' b)+-- type 'Interval'' a b = 'Auto'' a ('Maybe' b)+-- @+--+-- So, the compiler sees an @'Interval' m a b@ as if it were an @'Auto'+-- m a ('Maybe' b)@. If it helps you reason about type signatures and type+-- inference, you can make the substitution in your head too!+--+-- An @'Interval' m a b@ takes an input stream of @a@s and output stream of+-- @b@s that are "on" and "off" for chunks at a time; 'Nothing' is+-- interpreted as "off", and @'Just' x@ is interpreted as "on" with a value+-- of @x@.+--+-- A classic example is @'onFor' :: 'Int' -> 'Interval' m a a@. With+-- @'onFor' n@, the output stream behaves exactly like the input stream for+-- the first @n@ steps, then is "off" forever after:+--+-- >>> streamAuto' (onFor 3) [1..7]+-- [Just 1, Just 2, Just 3, Nothing, Nothing, Nothing, Nothing]+--+-- == Motivation+--+-- Intervals happen to particularly useful when used with the various+-- /switching/ combinators from "Control.Auto.Switch".+--+-- You might find it useful to "sequence" 'Auto's such that they "switch"+-- from one to the other, dynamically. For example, an 'Auto' that acts+-- like @'pure' 0@ for three steps, and then like 'count' for the rest:+--+-- >>> let a1 = (onFor 3 . pure 0) --> count+-- >>> take 8 . streamAuto' a1 $ repeat ()+-- [0, 0, 0, 1, 2, 3, 4, 5]+--+-- (Recall that @'pure' x@ is the 'Auto' that ignores the input stream and+-- gives an output stream of constant @x@s)+--+-- Or in reverse, an 'Auto' that behaves like 'count' until the count is+-- above 3, then switches to @'pure' 0@+--+-- >>> let a2 = (whenI (<= 3) . count) --> pure 0+-- >>> take 8 . streamAuto' a2 $ repeat ()+-- [1, 2, 3, 0, 0, 0, 0, 0]+--+-- That's just a small example using one switching combinator, '-->'. But+-- hopefully it demonstrates that one powerful motivation behind+-- "intervals" being a "thing" is because of how it works with switches.+--+-- Another neat motivation is that intervals work pretty well with the+-- 'Blip' semantic tool, as well.+--+-- The following 'Interval' will be "off" and suppress all of its input+-- (from 'count') /until/ the blip stream produced by @'inB' 3@ emits+-- something, then it'll allow 'count' to pass.+--+-- >>> let a3 = after . (count &&& inB 3)+-- >>> let a3 = proc () -> do+-- c <- count -< ()+-- blp <- inB 3 -< ()+-- after -< (c, blp)+-- >>> take 5 . streamAuto' a3 $ repeat ()+-- [Nothing, Nothing, Just 3, Just 4, Just 4]+--+-- Intervals are also used for things that want their 'Auto's to "signal"+-- when they are "off". 'Interval' is the universal language for, "you can+-- be done with me", when it is needed. For example, the 'interactAuto'+-- loop takes an 'Interval String String', and "turns off" on the first+-- 'Nothing' or "off" value. 'gather' keeps a collection of 'Interval's,+-- and removes them whenever they output a 'Nothing'/turn "off".+--+-- == The Contract+--+-- So, why have an 'Interval' type, and not always just use 'Auto'?+--+-- You can say that, if you are given an 'Interval', then it comes with+-- a "contract" (by documentation) that the 'Auto' will obey /interval+-- semantics/.+--+-- @'Auto' m a ('Maybe' b)@ can mean a lot of things and represent a lot of+-- things.+--+-- However, if you offer something of an 'Interval' type, or if you find+-- something of an 'Interval' type, it comes with some sort of assurance+-- that that 'Auto' will /behave/ like an interval: on and off for+-- contiguous periods of time.+--+-- In addition, this allows us to further clarify /what our functions+-- expect/. By saying that a function expects an 'Interval':+--+-- @+-- chooseInterval :: [Interval m a b]+-- -> Interval m a b+-- @+--+-- 'chooseInterval' has the ability to "state" that it /expects/ things+-- that follow interval semantics in order to "function" properly and in+-- order to properly "return" an 'Interval'.+--+-- Of course, this is not enforced by the compiler. However, it's useful+-- to create a way to clearly state that what you are offering or what you+-- are expecting does indeed follow this useful pattern.+--+-- == Combinators+--+-- === Converting back into normal streams+--+-- You can take an incoming interval stream and output a "normal"+-- "always-on" stream by using the 'fromInterval' and 'fromIntervalWith'+-- 'Auto's, analogous to 'fromMaybe' and 'maybe' from "Data.Maybe",+-- respectively:+--+-- >>> let a = fromIntervalWith "off" show . onFor 2+-- >>> streamAuto' a [1..5]+-- ["1", "2", "off", "off", "off"]+--+-- You can also use '<|!>', coming up next....+--+-- === Choice+--+-- You can "choose" between interval streams, with choice combinators like+-- '<|?>' and '<|!>'.+--+-- >>> let a = onFor 2 . pure "hello"+-- <|!> onFor 4 . pure "world"+-- <|!> pure "goodbye!"+-- >>> take 6 . streamAuto' a $ repeat ()+-- ["hello", "hello", "world", "world", "goodbye!", "goodbye!"]+--+-- The above could also be written with 'choose':+--+-- >>> let a = choose (pure "goodbye!")+-- [ onFor 2 . pure "hello"+-- , onFor 4 . pure "world"+-- ]+--+-- === Composition+--+-- Another tool that makes 'Interval's powerful is the ability to compose+-- them.+--+-- If you have an @'Auto' m a b@ and an @'Auto' m b c@, then you can+-- compose them with '.'.+--+-- If you have an @'Auto' m a b@ and an @'Interval' m b c@, then you can+-- compose them by throwing in a 'toOn' in the chain, or @'fmap' 'Just'@:+--+-- @+-- a :: 'Auto' m a b+-- i :: 'Interval' m b c+-- i . 'toOn' . a :: 'Interval' m a c+-- 'fmap' 'Just' a :: 'Interval' m a b+-- i . 'fmap' 'Just' a :: 'Interval' m a c+-- @+--+-- If you have an @'Interval' m a b@ and an @'Auto' m b c@, you can "lift"+-- the second 'Auto' to be an 'Auto' that only "acts" on "on"/'Just'+-- outputs of the 'Interval':+--+-- @+-- i :: 'Interval' m a b+-- a :: 'Auto' m b c+-- 'during' a :: 'Auto' m ('Maybe' a) ('Maybe' b)+-- 'during' a . i :: 'Interval' m a c+-- @+--+-- Finally, the kleisli composition: if you have an @'Interval' m a b@ and+-- an @'Interval' m b c@, you can use 'compI': (or also 'bindI')+--+-- @+-- i1 :: 'Interval' m a b+-- i2 :: 'Interval' m b c+-- i2 `'compI'` i1 :: 'Interval' m a b c+-- 'bindI' i2 . i1 :: 'Interval' m a b c+-- @+--+-- >>> let a1 = when (< 5) `compI` offFor 2+-- >>> streamAuto' a1 [1..6]+-- [Nothing, Nothing, Just 3, Just 4, Nothing, Nothing]+--+-- The implementation works so that any "on"/'Just' inputs will step the+-- lifted 'Auto' like normal, with the contents of the 'Just', and any+-- "off"/'Nothing' inputs cause the lifted 'Auto' to be skipped.+--+-- 'compI' adds a lot of power to 'Interval' because now you can always+-- work "with 'Interval's", bind them just like normal 'Auto's, and then+-- finally "exit" them after composing and combining many.+--+-- == Warning: Switching+--+-- Note that when any of these combinators "block" (or "inhibit" or+-- "suppress", whatever you call it) their input as a part of a composition+-- pipeline (as in for 'off', 'onFor', 'offFor', etc.), the /input/ 'Auto's+-- are /still stepped/ and "run". If the inputs had any monad effects,+-- they would too be executed at every step. In order to "freeze" and not+-- run or step an 'Auto' at all, you have to use switches.+--++infixr 3 <|?>+infixr 3 <|!>+infixr 1 `compI`++-- | Represents a relationship between an input and an output, where the+-- output can be "on" or "off" (using 'Just' and 'Nothing') for contiguous+-- chunks of time.+--+-- "Just" a type alias for @'Auto' m a ('Maybe' b)@. If you ended up here+-- with a link...no worries! If you see @'Interval' m a b@, just think+-- @'Auto' m a ('Maybe' b)@ for type inference/type checking purposes.+--+-- If you see something of type 'Interval', you can rest assured that it+-- has "interval semantics" --- it is on and off for meaningfully+-- contiguous chunks of time, instead of just on and off willy nilly. If+-- you have a function that expects an 'Interval', then the function+-- expects its argument to behave in this way.+--+type Interval m a b = Auto m a (Maybe b)++-- | 'Interval', specialized with 'Identity' as its underlying 'Monad'.+-- Analogous to 'Auto'' for 'Auto'.+type Interval' a b = Auto' a (Maybe b)++-- | The output stream is alwayas off, regardless of the input.+--+-- Note that any monadic effects of the input 'Auto' when composed with+-- 'off' are still executed, even though their result value is suppressed.+--+-- prop> off == pure Nothing+off :: Interval m a b+off = mkConst Nothing++-- | The output stream is always on, with exactly the value of the+-- corresponding input.+--+-- prop> toOn == arr Just+toOn :: Interval m a a+toOn = mkFunc Just++-- | An "interval collapsing" 'Auto'. A stream of on/off values comes in;+-- the output is the value of the input when the input is on, and the+-- "default value" when the input is off.+--+-- Much like 'fromMaybe' from "Data.Maybe".+--+-- prop> fromInterval d = arr (fromMaybe d)+fromInterval :: a -- ^ value to output for "off" periods+ -> Auto m (Maybe a) a+fromInterval d = mkFunc (fromMaybe d)++-- | An "interval collapsing" 'Auto'. A stream of on/off values comes in;+-- when the input is off, the output is the "default value". When the+-- input is off, the output is the given function applied to the "on"+-- value.+--+-- Much like 'maybe' from "Data.Maybe".+--+-- prop> fromIntervalWith d f = arr (maybe d f)+fromIntervalWith :: b -- ^ default value, when input is off+ -> (a -> b) -- ^ function to apply when input is on+ -> Auto m (Maybe a) b+fromIntervalWith d f = mkFunc (maybe d f)++-- | For @'onFor' n@, the first @n@ items in the output stream are always+-- "on" (passing through with exactly the value of the corresponding+-- input); for the rest, the output stream is always "off", suppressing all+-- input values forevermore.+--+-- If a number less than 0 is passed, 0 is used.+--+onFor :: Int -- ^ amount of steps to stay "on" for+ -> Interval m a a+onFor = mkState f . Just . max 0+ where+ f x (Just i) | i > 0 = (Just x , Just (i - 1))+ f _ _ = (Nothing, Nothing)++-- | For @'offFor' n@, the first @n@ items in the output stream are always+-- "off", suppressing all input; for the rest, the output stream is always+-- "on", outputting exactly the value of the corresponding input.+offFor :: Int -- ^ amount of steps to be "off" for.+ -> Interval m a a+offFor = mkState f . Just . max 0+ where+ f _ (Just i) | i > 0 = (Nothing, Just (i - 1))+ f x _ = (Just x , Nothing )++-- | A combination of 'onFor' and 'offFor'; for @'window' b e@, the output+-- stream will be "on" from item @b@ to item @e@ inclusive with the value+-- of the corresponding input; for all other times, the output stream is+-- always off, suppressing any input.+window :: Int -- ^ start of window+ -> Int -- ^ end of window (inclusive)+ -> Interval m a a+window b e = mkState f (Just 1)+ where+ f _ Nothing = (Nothing, Nothing)+ f x (Just i) | i > e = (Nothing, Nothing)+ | i < b = (Nothing, Just (i + 1))+ | otherwise = (Just x , Just (i + 1))++-- | The output is "on" with exactly the value of he corresponding input+-- when the input passes the predicate, and is "off" otherwise.+--+-- >>> let a = whenI (\x -> x >= 2 && x <= 4)+-- >>> streamAuto' a [1..6]+-- [Nothing, Just 2, Just 3, Just 4, Nothing, Nothing]+--+-- Careful when using this; you could exactly create an 'Interval' that+-- "breaks" "interval semantics"; for example, 'whenI even', when you know+-- your input stream does not consist of chunks of even numbers and odd+-- numbers at a time.+--+whenI :: (a -> Bool) -- ^ interval predicate+ -> Interval m a a+whenI p = mkFunc f+ where+ f x | p x = Just x+ | otherwise = Nothing++-- | Like 'whenI', but only allows values to pass whenever the input does+-- not satisfy the predicate. Blocks whenever the predicate is true.+--+-- >>> let a = unlessI (\x -> x < 2 &&& x > 4)+-- >>> steamAuto' a [1..6]+-- >>> res+-- [Nothing, Just 2, Just 3, Just 4, Nothing, Nothing]+--+unlessI :: (a -> Bool) -- ^ interval predicate+ -> Interval m a a+unlessI p = mkFunc f+ where+ f x | p x = Nothing+ | otherwise = Just x++-- | Takes two input streams --- a stream of normal values, and a blip+-- stream. Before the first emitted value of the input blip stream, the+-- output is always "off", suppressing all inputs. /After/ the first+-- emitted value of the input blip stream, the output is always "on" with+-- the corresponding value of the first input stream.+--+-- >>> let a = after . (count &&& inB 3)+-- >>> take 6 . streamAuto' a $ repeat ()+-- >>> res+-- [Nothing, Nothing, Just 3, Just 4, Just 5, Just 6]+--+-- ('count' is the 'Auto' that ignores its input and outputs the current+-- step count at every step, and @'inB' 3@ is the 'Auto' generating+-- a blip stream that emits at the third step.)+--+-- Be careful to remember that in the above example, 'count' is still "run"+-- at every step, and is progressed (and if it were an 'Auto' with monadic+-- effects, they would still be executed). It just isn't allowed to pass+-- its output values through 'after' until the blip stream emits.+--+after :: Interval m (a, Blip b) a+after = mkState f False+ where+ f (x, _ ) True = (Just x , True )+ f (x, Blip _) False = (Just x , True )+ f _ False = (Nothing, False)++-- | Takes two input streams --- a stream of normal values, and a blip+-- stream. Before the first emitted value of the input blip stream, the+-- output is always "on" with the corresponding value of the first input+-- stream. /After/ the first emitted value of the input blip stream, the+-- output will be "off" forever, suppressing all input.+--+-- >>> let a = before . (count &&& inB 3)+-- >>> take 5 . streamAuto' a $ repeat ()+-- >>> res+-- [Just 1, Just 2, Nothing, Nothing, Nothing]+--+-- ('count' is the 'Auto' that ignores its input and outputs the current+-- step count at every step, and @'inB' 3@ is the 'Auto' generating+-- a blip stream that emits at the third step.)+--+-- Be careful to remember that in the above example, 'count' is still "run"+-- at every step, and is progressed (and if it were an 'Auto' with monadic+-- effects, they would still be executed). It just isn't allowed to pass+-- its output values through 'before' after the blip stream emits.+--+before :: Interval m (a, Blip b) a+before = mkState f False+ where+ f _ True = (Nothing, True )+ f (_, Blip _) False = (Nothing, True )+ f (x, _ ) False = (Just x , False)++-- | Takes three input streams: a stream of normal values, a blip stream of+-- "turning-on" blips, and a blip stream of "turning-off" blips. After the+-- first blip stream emits, the output will switch to "on" with the value+-- of the first input stream. After the second blip stream emits, the+-- output will switch to "off", supressing all inputs. An emission from+-- the first stream toggles this "on"; an emission from the second stream+-- toggles this "off".+--+-- >>> let a = between . (count &&& (inB 3 &&& inB 5))+-- >>> take 7 . streamAuto' a $ repeat ()+-- [Nothing, Nothing, Just 3, Just 4, Nothing, Nothing, Nothing]+between :: Interval m (a, (Blip b, Blip c)) a+between = mkState f False+ where+ f (_, (_, Blip _)) _ = (Nothing, False)+ f (x, (Blip _, _)) _ = (Just x , True )+ f (x, _ ) True = (Just x , True )+ f _ False = (Nothing, False)++-- | The output is constantly "on" with the last emitted value of the input+-- blip stream. However, before the first emitted value, it is "off".+-- value of the input blip stream. From then on, the output is always the+-- last emitted value+--+-- >>> let a = hold . inB 3+-- >>> streamAuto' a [1..5]+-- [Nothing, Nothing, Just 3, Just 3, Just 3]+--+-- If you want an @'Auto' m ('Blip' a) a@ (no 'Nothing'...just a "default+-- value" before everything else), then you can use 'holdWith' from+-- "Control.Auto.Blip"...or also just 'hold' with '<|!>' or 'fromInterval'.+hold :: Serialize a+ => Interval m (Blip a) a+hold = accum f Nothing+ where+ f x = blip x Just++-- | The non-serializing/non-resuming version of 'hold'.+hold_ :: Interval m (Blip a) a+hold_ = accum_ f Nothing+ where+ f x = blip x Just++-- | For @'holdFor' n@, The output is only "on" if there was an emitted+-- value from the input blip stream in the last @n@ steps. Otherwise, is+-- off.+--+-- Like 'hold', but it only "holds" the last emitted value for the given+-- number of steps.+--+-- >>> let a = holdFor 2 . inB 3+-- >>> streamAuto' 7 a [1..7]+-- >>> res+-- [Nothing, Nothing, Just 3, Just 3, Nothing, Nothing, Nothing]+--+holdFor :: Serialize a+ => Int -- ^ number of steps to hold the last emitted value for+ -> Interval m (Blip a) a+holdFor n = mkState (_holdForF n) (Nothing, max 0 n)++-- | The non-serializing/non-resuming version of 'holdFor'.+holdFor_ :: Int -- ^ number of steps to hold the last emitted value for+ -> Interval m (Blip a) a+holdFor_ n = mkState_ (_holdForF n) (Nothing, max 0 n)++_holdForF :: Int -> Blip a -> (Maybe a, Int) -> (Maybe a, (Maybe a, Int))+_holdForF n = f -- n should be >= 0+ where+ f x s = (y, (y, i))+ where+ (y, i) = case (x, s) of+ (Blip b, _ ) -> (Just b , n )+ (_ , (_, 0)) -> (Nothing, 0 )+ (_ , (z, j)) -> (z , j - 1)++-- | Forks a common input stream between the two 'Interval's and returns,+-- itself, an 'Interval'. If the output of the first one is "on", the+-- whole thing is on with that output. Otherwise, the output is exactly+-- that of the second one.+--+-- >>> let a = (onFor 2 . pure "hello") <|?> (onFor 4 . pure "world")+-- >>> take 5 . streamAuto' a $ repeat ()+-- >>> res+-- [Just "hello", Just "hello", Just "world", Just "world", Nothing]+--+-- You can drop the parentheses, because of precedence; the above could+-- have been written as:+--+-- >>> let a' = onFor 2 . pure "hello" <|?> onFor 4 . pure "world"+--+-- Warning: If your underlying monad produces effects, remember that /both/+-- 'Auto's are run at every step, along with any monadic effects,+-- regardless of whether they are "on" or "off".+--+-- Note that more often than not, '<|!>' is probably more useful. This+-- is useful only in the case that you really, really want an interval at+-- the end of it all.+--+(<|?>) :: Monad m+ => Interval m a b -- ^ choice 1+ -> Interval m a b -- ^ choice 2+ -> Interval m a b+(<|?>) = liftA2 (<|>)++-- | Forks a common input stream between an 'Interval' and an 'Auto', and+-- returns, itself, a normal non-interval 'Auto'.. If the+-- output of the first one is "on", the output of the whole thing is that+-- "on" value. Otherwise, the output is exactly that of the second one.+--+-- >>> let a1 = (onFor 2 . pure "hello") <|!> pure "world"+-- >>> take 5 . streamAuto' a1 $ repeat ()+-- ["hello", "hello", "world", "world", "world"]+--+-- This one is neat because it associates from the right, so it can be+-- "chained":+--+-- >>> let a2 = onFor 2 . pure "hello"+-- <|!> onFor 4 . pure "world"+-- <|!> pure "goodbye!"+-- >>> take 6 . streamAuto' a2 $ repeat ()+-- ["hello", "hello", "world", "world", "goodbye!", "goodbye!"]+--+-- > a <|!> b <|!> c+--+-- associates as+--+-- > a <|!> (b <|!> c)+--+-- So using this, you can "chain" a bunch of choices between intervals, and+-- then at the right-most, "final" one, provide the default behavior.+--+-- Warning: If your underlying monad produces effects, remember that /both/+-- 'Auto's are run at every step, along with any monadic effects,+-- regardless of whether they are "on" or "off".+(<|!>) :: Monad m+ => Interval m a b -- ^ interval 'Auto'+ -> Auto m a b -- ^ "normal" 'Auto'+ -> Auto m a b+(<|!>) = liftA2 (flip fromMaybe)++-- | Forks an input stream between all 'Interval's in the list. The result+-- is an 'Interval' whose output is "on" when any of the original+-- 'Interval's is on, with the value of the /first/ "on" one.+--+-- prop> chooseInterval == foldr (<|?>) off+chooseInterval :: Monad m+ => [Interval m a b] -- ^ the 'Auto's to run and+ -- choose from+ -> Interval m a b+chooseInterval = foldr (<|?>) (pure Nothing)++-- | Forks an input stream between all 'Interval's in the list, plus+-- a "default 'Auto'. The output is the value of the first "on"+-- 'Interval'; if there isn't any, the output from the "default 'Auto'" is+-- used.+--+-- prop> choose == foldr (<|!>)+choose :: Monad m+ => Auto m a b -- ^ the 'Auto' to behave like if all+ -- others are 'Nothing'+ -> [Interval m a b] -- ^ 'Auto's to run and choose from+ -> Auto m a b+choose = foldr (<|!>)++-- | "Lifts" an @'Auto' m a b@ (transforming @a@s into @b@s) into an+-- @'Auto' m ('Maybe' a) ('Maybe' b)@ (or, @'Interval' m ('Maybe' a) b@,+-- transforming /intervals/ of @a@s into /intervals/ of @b@.+--+-- It does this by running the 'Auuto' as normal when the input is "on",+-- and freezing it/being "off" when the input is /off/.+--+-- >>> let a1 = during (sumFrom 0) . onFor 2 . pure 1+-- >>> take 5 . streamAuto' a1 $ repeat ()+-- [Just 1, Just 2, Nothing, Nothing, Nothing]+--+-- >>> let a2 = during (sumFrom 0) . offFor 2 . pure 1+-- >>> take 5 . streamAuto' a2 $ repeat ()+-- [Nothing, Nothing, Just 1, Just 2, Just 3]+--+-- (Remember that @'pure' x@ is the 'Auto' that ignores its input and+-- constantly just pumps out @x@ at every step)+--+-- Note the difference between putting the 'sumFrom' "after" the+-- 'offFor' in the chain with 'during' (like the previous example)+-- and putting the 'sumFrom' "before":+--+-- >>> let a3 = offFor 2 . sumFrom 0 . pure 1+-- >>> take 5 . streamAuto' a3 $ repeat ()+-- [Nothing, Nothing, Just 3, Just 4, Just 5]+--+-- In the first case (with @a2@), the output of @'pure' 1@ was suppressed+-- by 'offFor', and @'during' ('sumFrom' 0)@ was only summing on the times+-- that the 1's were "allowed through"...so it only "starts counting" on+-- the third step.+--+-- In the second case (with @a3@), the output of the @'pure' 1@ is never+-- suppressed, and went straight into the @'sumFrom' 0@. 'sumFrom' is+-- always summing, the entire time. The final output of that @'sumFrom' 0@+-- is suppressed at the end with @'offFor' 2@.+--+during :: Monad m+ => Auto m a b -- ^ 'Auto' to lift to work over intervals+ -> Auto m (Maybe a) (Maybe b)+during = dimap to from . right+ where+ from = either (const Nothing) Just+ to = maybe (Left ()) Right++-- | "Lifts" (more technically, "binds") an @'Interval' m a b@ into+-- an @'Interval' m ('Maybe' a) b@.+--+-- Does this by running the 'Auto' as normal when the input is "on", and+-- freezing it/being "off" when the input is /off/.+--+-- It's kind of like 'during', but the resulting @'Maybe' ('Maybe' b))@ is+-- "joined" back into a @'Maybe' b@.+--+-- prop> bindI a == fmap join (during a)+--+-- This is really an alternative formulation of 'compI'; typically, you+-- will be using 'compI' more often, but this form can also be useful (and+-- slightly more general). Note that:+--+-- prop> bindI f == compI f id+--+-- This combinator allows you to properly "chain" ("bind") together series+-- of inhibiting 'Auto's. If you have an @'Interval' m a b@ and an+-- @'Interval' m b c@, you can chain them into an @'Interval' m a c@.+--+-- @+-- f :: 'Interval' m a b+-- g :: 'Interval' m b c+-- 'bindI' g . f :: 'Interval' m a c+-- @+--+-- (Users of libraries with built-in inhibition semantics like Yampa and+-- netwire might recognize this as the "default" composition in those other+-- libraries)+--+-- See 'compI' for examples of this use case.+--+bindI :: Monad m+ => Interval m a b -- ^ 'Interval' to bind+ -> Interval m (Maybe a) b+bindI = fmap join . during++-- | Composes two 'Interval's, the same way that '.' composes two 'Auto's:+--+-- @+-- (.) :: Auto m b c -> Auto m a b -> Auto m a c+-- compI :: Interval m b c -> Interval m a b -> Interval m a c+-- @+--+-- Basically, if any 'Interval' in the chain is "off", then the entire rest+-- of the chain is "skipped", short-circuiting a la 'Maybe'.+--+-- (Users of libraries with built-in inhibition semantics like Yampa and+-- netwire might recognize this as the "default" composition in those other+-- libraries)+--+-- As a contrived example, how about an 'Auto' that only allows values+-- through during a window...between, say, the second and fourth steps:+--+-- >>> let window' start dur = onFor dur `compI` offFor (start - 1)+-- >>> streamAuto' (window' 2 3)+-- [Nothing, Just 2, Just 3, Just 4, Nothing, Nothing]+--+compI :: Monad m+ => Interval m b c -- ^ compose this 'Interval'...+ -> Interval m a b -- ^ ...to this one+ -> Interval m a c+compI f g = fmap join (during f) . g
+ src/Control/Auto/Process.hs view
@@ -0,0 +1,408 @@+-- |+-- Module : Control.Auto.Process+-- Description : 'Auto's useful for various commonly occurring processes.+-- Copyright : (c) Justin Le 2015+-- License : MIT+-- Maintainer : justin@jle.im+-- Stability : unstable+-- Portability : portable+--+-- Various 'Auto's describing relationships following common processes,+-- like 'sumFrom', whose output is the cumulative sum of the input.+--+-- Also has some 'Auto' constructors inspired from digital signal+-- processing signal transformation systems and statistical models.+--+-- Note that all of these can be turned into an equivalent version acting+-- on blip streams, with 'perBlip':+--+-- @+-- 'sumFrom' n :: 'Num' a => 'Auto' m a a+-- 'perBlip' ('sumFrom' n) :: 'Num' a => 'Auto' m ('Blip' a) ('Blip' a)+-- @+--+module Control.Auto.Process (+ -- * Numerical+ sumFrom+ , sumFrom_+ , sumFromD+ , sumFromD_+ , productFrom+ , productFrom_+ , deltas+ , deltas_+ -- ** Numerical signal transformations/systems+ , movingAverage+ , movingAverage_+ , impulseResponse+ , impulseResponse_+ , autoRegression+ , autoRegression_+ , arma+ , arma_+ -- * Monoidal/Semigroup+ , mappender+ , mappender_+ , mappendFrom+ , mappendFrom_+ ) where++import Control.Auto.Core+import Control.Auto.Interval+import Data.Semigroup+import Data.Serialize++-- | The stream of outputs is the cumulative/running sum of the inputs so+-- far, starting with an initial count.+--+-- The first output takes into account the first input. See 'sumFromD' for+-- a version where the first output is the initial count itself.+--+-- prop> sumFrom x0 = accum (+) x0+sumFrom :: (Serialize a, Num a)+ => a -- ^ initial count+ -> Auto m a a+sumFrom = accum (+)++-- | The non-resuming/non-serializing version of 'sumFrom'.+sumFrom_ :: Num a+ => a -- ^ initial count+ -> Auto m a a+sumFrom_ = accum_ (+)++-- | Like 'sumFrom', except the first output is the starting count.+--+-- >>> let a = sumFromD 5+-- >>> let (y1, a') = stepAuto' a 10+-- >>> y1+-- 5+-- >>> let (y2, _ ) = stepAuto' a' 3+-- >>> y2+-- 10+--+-- >>> streamAuto' (sumFrom 0) [1..10]+-- [1,3,6,10,15,21,28,36,45,55]+-- >>> streamAuto' (sumFromD 0) [1..10]+-- [0,1,3,6,10,15,21,28,36,45]+--+-- It's 'sumFrom', but "delayed".+--+-- Useful for recursive bindings, where you need at least one value to be+-- able to produce its "first output" without depending on anything else.+--+-- prop> sumFromD x0 = sumFrom x0 . delay 0+-- prop> sumFromD x0 = delay x0 . sumFrom x0+sumFromD :: (Serialize a, Num a)+ => a -- ^ initial count+ -> Auto m a a+sumFromD = accumD (+)++-- | The non-resuming/non-serializing version of 'sumFromD'.+sumFromD_ :: Num a+ => a -- ^ initial count+ -> Auto m a a+sumFromD_ = accumD_ (+)++-- | The output is the running/cumulative product of all of the inputs so+-- far, starting from an initial product.+--+-- prop> productFrom x0 = accum (*) x0+productFrom :: (Serialize a, Num a)+ => a -- ^ initial product+ -> Auto m a a+productFrom = accum (*)++-- | The non-resuming/non-serializing version of 'productFrom'.+productFrom_ :: Num a+ => a -- ^ initial product+ -> Auto m a a+productFrom_ = accum_ (*)++-- | The output is the the difference between the input and the previously+-- received input.+--+-- First result is a 'Nothing', so you can use '<|!>' or 'fromInterval' or+-- 'fromMaybe' to get a "default first value".+--+-- >>> streamAuto' deltas [1,6,3,5,8]+-- >>> [Nothing, Just 5, Just (-3), Just 2, Just 3]+--+-- Usage with '<|!>':+--+-- >>> let a = deltas <|!> pure 100+-- >>> streamAuto' (deltas <|!> pure 100) [1,6,3,5,8]+-- [100, 5, -3, 2, 3]+--+-- Usage with 'fromMaybe':+--+-- >>> streamAuto' (fromMaybe 100 <$> deltas) [1,6,3,5,8]+-- [100, 5, -3, 2, 3]+--+deltas :: (Serialize a, Num a) => Interval m a a+deltas = mkState _deltasF Nothing++-- | The non-resuming/non-serializing version of 'deltas'.+deltas_ :: Num a => Interval m a a+deltas_ = mkState_ _deltasF Nothing++_deltasF :: Num a => a -> Maybe a -> (Maybe a, Maybe a)+_deltasF x s = case s of+ Nothing -> (Nothing , Just x)+ Just prev -> (Just (x - prev), Just x)++-- | The output is the running/cumulative 'mconcat' of all of the input+-- seen so far, starting with 'mempty'.+--+-- >>> streamauto' mappender . map Last $ [Just 4, Nothing, Just 2, Just 3]+-- [Last (Just 4), Last (Just 4), Last (Just 2), Last (Just 3)]+-- >>> streamAuto' mappender ["hello","world","good","bye"]+-- ["hello","helloworld","helloworldgood","helloworldgoodbye"]+--+-- prop> mappender = accum mappend mempty+mappender :: (Serialize a, Monoid a) => Auto m a a+mappender = accum mappend mempty++-- | The non-resuming/non-serializing version of 'mappender'.+mappender_ :: Monoid a => Auto m a a+mappender_ = accum_ mappend mempty++-- | The output is the running '<>'-sum ('mappend' for 'Semigroup') of all+-- of the input values so far, starting with a given starting value.+-- Basically like 'mappender', but with a starting value.+--+-- >>> streamAuto' (mappendFrom (Max 0)) [Max 4, Max (-2), Max 3, Max 10]+-- [Max 4, Max 4, Max 4, Max 10]+--+-- prop> mappendFrom m0 = accum (<>) m0+mappendFrom :: (Serialize a, Semigroup a)+ => a -- ^ initial value+ -> Auto m a a+mappendFrom = accum (<>)++-- | The non-resuming/non-serializing version of 'mappender'.+mappendFrom_ :: Semigroup a+ => a -- ^ initial value+ -> Auto m a a+mappendFrom_ = accum_ (<>)++-- | The output is the sum of the past inputs, multiplied by a moving+-- window of weights.+--+-- For example, if the last received inputs are @[1,2,3,4]@ (from most+-- recent to oldest), and the window of weights is @[2,0.5,4]@, then the+-- output will be @1*2 + 0.5*2 + 4*3@, or @15@. (The weights are assumed+-- to be zero past the end of the weight window)+--+-- The immediately received input is counted as a part of the history.+--+-- Mathematically,+-- @y_n = w_0 * x_(n-0) + w_1 + x_(n-1) + w_2 * x_(n-1) + ...@, for all+-- @w@s in the weight window, where the first item is @w_0@. @y_n@ is the+-- @n@th output, and @x_n@ is the @n@th input.+--+-- Note that this serializes the history of the input...or at least the+-- history as far back as the entire window of weights. (A weight list of+-- five items will serialize the past five received items) If your weight+-- window is very long (or infinite), then serializing is a bad idea!+--+-- The second parameter is a list of a "starting history", or initial+-- conditions, to be used when the actual input history isn't long enough.+-- If you want all your initial conditions/starting history to be @0@, just+-- pass in @[]@.+--+-- Minus serialization, you can implement 'sumFrom' as:+--+-- @+-- sumFrom n = movingAverage (repeat 1) [n]+-- @+--+-- And you can implement a version of 'deltas' as:+--+-- @+-- deltas = movingAverage [1,-1] []+-- @+--+-- It behaves the same, except the first step outputs the initially+-- received value. So it's realy a bit like+--+-- @+-- (movingAverage [1,-1] []) == (deltas <|!> id)+-- @+--+-- Where for the first step, the actual input is used instead of the delta.+--+-- Name comes from the statistical model.+--+movingAverage :: (Num a, Serialize a)+ => [a] -- ^ weights to apply to previous inputs,+ -- from most recent+ -> [a] -- ^ starting history/initial conditions+ -> Auto m a a+movingAverage weights = mkState (_movingAverageF weights)++-- | The non-serializing/non-resuming version of 'movingAverage'.+movingAverage_ :: Num a+ => [a] -- ^ weights to apply to previous inputs,+ -- from most recent+ -> [a] -- ^ starting history/initial conditions+ -> Auto m a a+movingAverage_ weights = mkState_ (_movingAverageF weights)++_movingAverageF :: Num a => [a] -> a -> [a] -> (a, [a])+_movingAverageF weights x hist = (sum (zipWith (*) weights hist'), hist')+ where+ hist' = zipWith const (x:hist) weights++-- | Any linear time independent stream transformation can be encoded by+-- the response of the transformation when given @[1,0,0,0...]@, or @1+-- : 'repeat' 0@. So, given an "LTI" 'Auto', if you feed it @1 : 'repeat'+-- 0@, the output is what is called an "impulse response function".+--+-- For any "LTI" 'Auto', we can reconstruct the behavior of the original+-- 'Auto' given its impulse response. Give 'impulseResponse' an impulse+-- response, and it will recreate/reconstruct the original 'Auto'.+--+-- >>> let getImpulseResponse a = streamAuto' a (1 : repeat 0)+-- >>> let sumFromImpulseResponse = getImpulseResponse (sumFrom 0)+-- >>> streamAuto' (sumFrom 0) [1..10]+-- [1,3,6,10,15,21,28,36,45,55]+-- >>> streamAuto' (impulseResponse sumFromImpulseResponse) [1..10]+-- [1,3,6,10,15,21,28,36,45,55]+--+-- Use this function to create an LTI system when you know its impulse+-- response.+--+-- >>> take 10 . streamAuto' (impulseResponse (map (2**) [0,-1..])) $ repeat 1+-- [1.0,1.5,1.75,1.875,1.9375,1.96875,1.984375,1.9921875,1.99609375,1.998046875]+--+-- All impulse response after the end of the given list is assumed to be+-- zero.+--+-- Mathematically,+-- @y_n = h_0 * x_(n-0) + h_1 + x_(n-1) + h_2 * x_(n-1) + ...@, for all+-- @h_n@ in the input response, where the first item is @h_0@.+--+-- Note that when this is serialized, it must serialize a number of input+-- elements equal to the length of the impulse response list...so if you give+-- an infinite impulse response, you might want to use 'impulseResponse_',+-- or not serialize.+--+-- By the way, @'impulseResponse' ir == 'movingAverage' ir []@.+--+impulseResponse :: (Num a, Serialize a)+ => [a] -- ^ the impulse response function+ -> Auto m a a+impulseResponse weights = movingAverage weights []++-- | The non-serializing/non-resuming version of 'impulseResponse'.+impulseResponse_ :: Num a+ => [a] -- ^ the impulse response function+ -> Auto m a a+impulseResponse_ weights = movingAverage_ weights []++-- | The output is the sum of the past outputs, multiplied by a moving+-- window of weights. Ignores all input.+--+-- For example, if the last outputs are @[1,2,3,4]@ (from most recent to+-- oldest), and the window of weights is @[2,0.5,4]@, then the output will+-- be @1*2 + 0.5*2 + 4*3@, or @15@. (The weights are assumed to be zero+-- past the end of the weight window)+--+-- Mathematically, @y_n = w_1 * y_(n-1) + w_2 * y_(n-2) + ...@, for all @w@+-- in the weight window, where the first item is @w_1@.+--+-- Note that this serializes the history of the outputs...or at least the+-- history as far back as the entire window of weights. (A weight list of+-- five items will serialize the past five outputted items) If your weight+-- window is very long (or infinite), then serializing is a bad idea!+--+-- The second parameter is a list of a "starting history", or initial+-- conditions, to be used when the actual output history isn't long enough.+-- If you want all your initial conditions/starting history to be @0@, just+-- pass in @[]@.+--+-- You can use this to implement any linear recurrence relationship, like+-- he fibonacci sequence:+--+-- >>> evalAutoN' 10 (autoRegression [1,1] [1,1]) ()+-- [2,3,5,8,13,21,34,55,89,144]+-- >>> evalAutoN' 10 (fromList [1,1] --> autoRegression [1,1] [1,1]) ()+-- [1,1,2,3,5,8,13,21,34,55]+--+-- Which is 1 times the previous value, plus one times the value before+-- that.+--+-- You can create a series that doubles by having it be just twice the+-- previous value:+--+-- >>> evalAutoN' 10 (autoRegression [2] [1]) ()+-- [2,,4,8,16,32,64,128,256,512,1024]+--+-- Name comes from the statistical model.+--+autoRegression :: (Num b, Serialize b)+ => [b] -- ^ weights to apply to previous outputs,+ -- from most recent+ -> [b] -- ^ starting history/initial conditions+ -> Auto m a b+autoRegression weights = mkState (const (_autoRegressionF weights))++-- | The non-serializing/non-resuming version of 'autoRegression'.+autoRegression_ :: Num b+ => [b] -- ^ weights to apply to previous outputs,+ -- from most recent+ -> [b] -- ^ starting history/initial conditions+ -> Auto m a b+autoRegression_ weights = mkState_ (const (_autoRegressionF weights))++_autoRegressionF :: Num b => [b] -> [b] -> (b, [b])+_autoRegressionF weights hist = (result, hist')+ where+ result = sum (zipWith (*) weights hist)+ hist' = zipWith const (result:hist) weights++-- | A combination of 'autoRegression' and 'movingAverage'. Inspired by+-- the statistical model.+--+-- Mathematically:+--+-- @+-- y_n = wm_0 * x_(n-0) + wm_1 * x_(n-1) + wm_2 * x_(n-2) + ...+-- + wa_1 * y_(n-1) + wa_2 * y_(n-1) + ...+-- @+--+-- Where @wm_n@s are all of the "moving average" weights, where the first+-- weight is @wm_0@, and @wa_n@s are all of the "autoregression" weights,+-- where the first weight is @wa_1@.+arma :: (Num a, Serialize a)+ => [a] -- ^ weights for the "auto-regression" components+ -> [a] -- ^ weights for the "moving average" components+ -> [a] -- ^ an "initial history" of outputs, recents first+ -> [a] -- ^ an "initial history" of inputs, recents first+ -> Auto m a a+arma arWeights maWeights arHist maHist =+ mkState (_armaF arWeights maWeights) (arHist, maHist)++-- | The non-serializing/non-resuming version of 'arma'.+arma_ :: Num a+ => [a] -- ^ weights for the "auto-regression" components+ -> [a] -- ^ weights for the "moving average" components+ -> [a] -- ^ an "initial history" of outputs, recents first+ -> [a] -- ^ an "initial history" of inputs, recents first+ -> Auto m a a+arma_ arWeights maWeights arHist maHist =+ mkState_ (_armaF arWeights maWeights) (arHist, maHist)++_armaF :: Num a => [a] -> [a] -> a -> ([a], [a]) -> (a, ([a], [a]))+_armaF arWeights maWeights x (arHist, maHist) = (y, (arHist', maHist'))+ where+ maHist' = zipWith const (x:maHist) maWeights+ ma = sum (zipWith (*) maWeights maHist')++ ar = sum (zipWith (*) arWeights arHist)++ y = ar + ma++ arHist' = zipWith const (y:arHist) arWeights++
+ src/Control/Auto/Process/Random.hs view
@@ -0,0 +1,427 @@+-- |+-- Module : Control.Auto.Process.Random+-- Description : Entropy generationg 'Auto's.+-- Copyright : (c) Justin Le 2015+-- License : MIT+-- Maintainer : justin@jle.im+-- Stability : unstable+-- Portability : portable+--+-- This module provides 'Auto's (purely) generating entropy in the form of+-- random or noisy processes. Note that every 'Auto' here is completely+-- deterministic --- given the same initial seed, one would expect the same+-- stream of outputs on every run. Furthermore, if a serializable 'Auto'+-- is serialized and resumed, it will continue along the deterministic path+-- dictated by the /original/ seed given.+--+-- All of these 'Auto's come in three flavors: one serializing one that+-- works with any serializable 'RandomGen' instance, one serializing one+-- that works specifically with 'StdGen' from "System.Random", and one that+-- takes any 'RandomGen' (including 'StdGen') and runs it without the+-- ability to serialize and resume deterministically.+--+-- The reason why there's a specialized 'StdGen' version for all of these+-- is that 'StdGen' actually doesn't have a 'Serialize' instance, so a+-- rudimentary serialization process is provded with the 'StdGen' versions.+--+-- The first class of generators take arbitrary @g -> (b, g)@ functions:+-- "Generate a random @b@, using the given function, and replace the seed+-- with the resulting seed". Most "random" functions follow this pattern,+-- including 'random' and 'randomR', and if you are using something from+-- <http://hackage.haskell.org/package/MonadRandom MonadRandom>,+-- then you can use the 'runRand' function to turn a @'Rand' g b@ into a @g+-- -> (b, g)@, as well:+--+-- @+-- 'runRand' :: 'RandomGen' g => 'Rand' g b -> (g -> (b, g))+-- @+--+-- These are useful for generating noise...a new random value at every+-- stoep. They are entropy sources.+--+-- Alternatively, if you want to give up parallelizability and determinism+-- and have your entire 'Auto' be sequential, you can make your entire+-- 'Auto' run under 'Rand' or 'RandT' as its internal monad, from+-- <http://hackage.haskell.org/package/MonadRandom MonadRandom>.+--+-- @+-- 'Auto' ('Rand' g) a b+-- 'Auto' ('RandT' g m) a b+-- @+--+-- In this case, if you wanted to pull a random number, you could do:+--+-- @+-- 'effect' 'random' :: ('Random' r, 'RandomGen' g) => 'Auto' ('Rand' g) a r+-- 'effect' 'random' :: ('Random' r, 'RandomGen' g) => 'Auto' ('RandT' g m) a r+-- @+--+-- Which pulls a random @r@ from "thin air" (from the internal 'Rand'+-- monad).+--+-- However, you lose a great deal of determinism from this method, as your+-- 'Auto's are no longer deterministic with a given seed...and resumability+-- becomes dependent on starting everything with the same seed every time+-- you re-load your 'Auto'. Also, 'Auto''s are parallelizable, while+-- @'Auto' ('Rand' g)@s are not.+--+-- As a compromise, you can then "seal" away the stateful part with+-- 'sealState' and 'hoistA':+--+-- @+-- sealRandom :: 'Monad' m => 'Auto' ('RandT' g m) a b -> g -> 'Auto' m a b+-- sealRandom a0 = 'sealState' . 'hoistA' ('StateT' . 'runRandT')+--+-- sealRandom' :: 'Auto' ('Rand' g) a b -> g -> 'Auto'' a b+-- sealRandom' = sealRandom+-- @+--+-- Where 'hoistA' turns an @'Auto' ('RandT' g m)@ into an @'Auto' m@.+--+-- In this way, you can run any 'Auto' under 'Rand' or 'RandT' as if it was+-- a normal 'Auto' "without" underlying randomness. (These functions+-- aren't given here so that this library doesn't incurr a dependency on+-- /MonadRandom/). This lets you compose your sequential/non-parallel parts+-- in 'Rand' and use it as a part of an 'Auto''.+--+-- The other generators given are for useful random processes you might run+-- into. The first is a 'Blip' stream that emits at random times with the+-- given frequency/probability. The second works /Interval/ semantics from+-- "Control.Auto.Interval", and is a stream that is "on" or "off", chunks+-- at a time, for random lengths. The average length of each on or off+-- period is controlled by the parameter you pass in.+--++module Control.Auto.Process.Random (+ -- * Streams of random values from random generators+ rands+ , stdRands+ , rands_+ , randsM+ , stdRandsM+ , randsM_+ -- * Lifting/wrapping random functions+ , arrRand+ , arrRandM+ , arrRandStd+ , arrRandStdM+ , arrRand_+ , arrRandM_+ -- * Random processes+ -- ** Bernoulli (on/off) processes+ , bernoulli+ , stdBernoulli+ , bernoulli_+ -- ** Random-length intervals+ , randIntervals+ , stdRandIntervals+ , randIntervals_+ ) where++import Control.Applicative+import Control.Auto.Blip+import Control.Auto.Blip.Internal+import Control.Auto.Core+import Control.Auto.Interval+import Control.Category+import Data.Bits+import Data.Serialize+import Data.Tuple+import Prelude hiding (id, (.), concat, concatMap, sum)+import System.Random++-- | Given a seed-consuming generating function of form @g -> (b, g)@+-- (where @g@ is the seed, and @b@ is the result) and an initial seed,+-- return an 'Auto' that continually generates random values using the+-- given generating funcion.+--+-- You'll notice that most of the useful functions from "System.Random" fit+-- this form:+--+-- @+-- 'random' :: 'RandomGen' g => g -> (b, g)+-- 'randomR' :: 'RandomGen' g => (b, b) -> (g -> (b, g))+-- @+--+-- If you are using something from <http://hackage.haskell.org/package/MonadRandom MonadRandom>,+-- then you can use the 'runRand' function to turn a @'Rand' g b@ into a @g+-- -> (b, g)@:+--+-- @+-- 'runRand' :: 'RandomGen' g => 'Rand' g b -> (g -> (b, g))+-- @+--+--+-- Here is an example using 'stdRands' (for 'StdGen'), but 'rands' works+-- exactly the same way, I promise!+--+-- >>> let g = mkStdGen 8675309+-- >>> let a = stdRands (randomR (1,100)) g :: Auto' a Int+-- >>> let (res, _) = stepAutoN' 10 a ()+-- >>> res+-- [67, 15, 97, 13, 55, 12, 34, 86, 57, 42]+--+--+-- Yeah, if you are using 'StdGen' from "System.Random", you'll notice that+-- 'StdGen' has no 'Serialize' instance, so you can't use it with this; you+-- have to either use 'stdRands' or 'rands_' (if you don't want+-- serialization/resumability).+--+-- In the context of these generators, resumability basically means+-- deterministic behavior over re-loads...if "reloading", it'll ignore the+-- seed you pass in, and use the original seed given when originally saved.+--+rands :: (Serialize g, RandomGen g)+ => (g -> (b, g)) -- ^ random generating function+ -> g -- ^ initial generator+ -> Auto m a b+rands r = mkState (\_ g -> g `seq` r g)+{-# INLINE rands #-}++-- | Like 'rands', but specialized for 'StdGen' from "System.Random", so+-- that you can serialize and resume. This is needed because 'StdGen'+-- doesn't have a 'Serialize' instance.+--+-- See the documentation of 'rands' for more information.+--+stdRands :: (StdGen -> (b, StdGen)) -- ^ random generating function+ -> StdGen -- ^ initial generator+ -> Auto m a b+stdRands r = mkState' (read <$> get) (put . show) (\_ g -> r g)+{-# INLINE stdRands #-}+++-- | The non-serializing/non-resuming version of 'rands'.+rands_ :: RandomGen g+ => (g -> (b, g)) -- ^ random generating function+ -> g -- ^ initial generator+ -> Auto m a b+rands_ r = mkState_ (\_ g -> r g)+{-# INLINE rands_ #-}++-- | Like 'rands', except taking a "monadic" random seed function @g ->+-- m (b, g)@, instead of @g -> (b, g)@. Your random generating function+-- has access to the underlying monad.+--+-- If you are using something from+-- <http://hackage.haskell.org/package/MonadRandom MonadRandom>, then you+-- can use the 'runRandT' function to turn a @'RandT' g m b@ into a @g ->+-- m (b, g)@:+--+-- @+-- 'runRandT' :: ('Monad' m, 'RandomGen' g)+-- => 'RandT' g m b -> (g -> m (b, g))+-- @+--+randsM :: (Serialize g, RandomGen g, Monad m)+ => (g -> m (b, g))+ -> g+ -> Auto m a b+randsM r = mkStateM (\_ g -> r g)+{-# INLINE randsM #-}++-- | Like 'randsM', but specialized for 'StdGen' from "System.Random", so+-- that you can serialize and resume. This is needed because 'StdGen'+-- doesn't have a 'Serialize' instance.+--+-- See the documentation of 'randsM' for more information.+--+stdRandsM :: Monad m+ => (StdGen -> m (b, StdGen))+ -> StdGen+ -> Auto m a b+stdRandsM r = mkStateM' (read <$> get) (put . show) (\_ g -> r g)+{-# INLINE stdRandsM #-}++-- | The non-serializing/non-resuming version of 'randsM'.+randsM_ :: (RandomGen g, Monad m)+ => (g -> m (b, g))+ -> g+ -> Auto m a b+randsM_ r = mkStateM_ (\_ g -> r g)+{-# INLINE randsM_ #-}++-- | Takes a "random function", or "random arrow" --- a function taking an+-- input value and a starting seed/entropy generator and returning a result+-- and an ending seed/entropy generator --- and turns it into an 'Auto'+-- that feeds its input into such a function and outputs the result, with+-- a new seed every time.+--+-- >>> let f x = randomR (0 :: Int, x)+-- >>> streamAuto' (arrRandStd f (mkStdGen 782065)) [1..10]+-- -- [1,2,3,4,5,6,7,8,9,10] <- upper bounds+-- [1,2,0,1,5,3,7,6,8,10] -- random number from 0 to upper bound+--+-- If you are using something from+-- <http://hackage.haskell.org/package/MonadRandom MonadRandom>, then you+-- can use the @('runRand' .)@ function to turn a @a -> 'Rand' g b@ into+-- a @a -> g -> (b, g)@:+--+-- @+-- ('runRand' .) :: 'RandomGen' g => (a -> 'Rand' g b) -> (a -> g -> (b, g))+-- @+--+-- (This is basically 'mkState', specialized.)+arrRand :: (Serialize g, RandomGen g)+ => (a -> g -> (b, g))+ -> g+ -> Auto m a b+arrRand = mkState++-- | Like 'arrRand', except the result is the result of a monadic action.+-- Your random arrow function has access to the underlying monad.+--+-- If you are using something from+-- <http://hackage.haskell.org/package/MonadRandom MonadRandom>, then you+-- can use the @('runRandT' .)@ function to turn a @a -> 'RandT' m g b@+-- into a @a -> g -> m (b, g)@:+--+-- @+-- ('runRandT' .) :: 'RandomGen' g => (a -> 'RandT' g b) -> (a -> g -> m (b, g))+-- @+arrRandM :: (Monad m, Serialize g, RandomGen g)+ => (a -> g -> m (b, g))+ -> g+ -> Auto m a b+arrRandM = mkStateM++-- | Like 'arrRand', but specialized for 'StdGen' from "System.Random", so+-- that you can serialize and resume. This is needed because 'StdGen'+-- doesn't have a 'Serialize' instance.+--+-- See the documentation of 'arrRand' for more information.+--+arrRandStd :: (a -> StdGen -> (b, StdGen))+ -> StdGen+ -> Auto m a b+arrRandStd = mkState' (read <$> get) (put . show)++-- | Like 'arrRandM', but specialized for 'StdGen' from "System.Random", so+-- that you can serialize and resume. This is needed because 'StdGen'+-- doesn't have a 'Serialize' instance.+--+-- See the documentation of 'arrRandM' for more information.+--+arrRandStdM :: (a -> StdGen -> m (b, StdGen))+ -> StdGen+ -> Auto m a b+arrRandStdM = mkStateM' (read <$> get) (put . show)++-- | The non-serializing/non-resuming version of 'arrRand'.+arrRand_ :: RandomGen g+ => (a -> g -> (b, g))+ -> g+ -> Auto m a b+arrRand_ = mkState_++-- | The non-serializing/non-resuming version of 'arrRandM'.+arrRandM_ :: RandomGen g+ => (a -> g -> m (b, g))+ -> g+ -> Auto m a b+arrRandM_ = mkStateM_+++-- | Simulates a <http://en.wikipedia.org/wiki/Bernoulli_process Bernoulli Process>:+-- a process of sequential independent trials each with a success of+-- probability @p@.+--+-- Implemented here is an 'Auto' producing a blip stream that emits+-- whenever the bernoulli process succeeds with the value of the received+-- input of the 'Auto', with its probability of succuss per each trial as+-- the 'Double' parameter.+--+-- It is expected that, for probability @p@, the stream will emit a value+-- on average once every @1/p@ ticks.+--+bernoulli :: (Serialize g, RandomGen g)+ => Double -- ^ probability of success per step+ -> g -- ^ initial seed+ -> Auto m a (Blip a)+bernoulli p = mkState (_bernoulliF p)++-- | Like 'bernoulli', but specialized for 'StdGen' from "System.Random",+-- so that you can serialize and resume. This is needed because 'StdGen'+-- doesn't have a 'Serialize' instance.+--+-- See the documentation of 'bernoulli' for more information.+--+stdBernoulli :: Double -- ^ probability of any step emitting+ -> StdGen -- ^ initial seed+ -> Auto m a (Blip a)+stdBernoulli p = mkState' (read <$> get) (put . show) (_bernoulliF p)++-- | The non-serializing/non-resuming version of 'bernoulli'.+bernoulli_ :: RandomGen g+ => Double -- ^ probability of any step emitting+ -> g -- ^ initial seed+ -> Auto m a (Blip a)+bernoulli_ p = mkState_ (_bernoulliF p)++_bernoulliF :: RandomGen g+ => Double+ -> a+ -> g+ -> (Blip a, g)+_bernoulliF p x g = (outp, g')+ where+ (roll, g') = randomR (0, 1 :: Double) g+ outp | roll <= p = Blip x+ | otherwise = NoBlip++-- | An 'Interval' that is "on" and "off" for contiguous but random+-- intervals of time...when "on", allows values to pass as "on" ('Just'),+-- but when "off", suppresses all incoming values (outputing 'Nothing').+--+-- You provide a 'Double', an @l@ parameter, representing the+-- average/expected length of each on/off interval.+--+-- The distribution of interval lengths follows+-- a <http://en.wikipedia.org/wiki/Geometric_distribution Geometric Distribution>.+-- This distribution is, as we call it in maths, "memoryless", which means+-- that the "time left" that the 'Auto' will be "on" or "off" at any given+-- time is going to be, on average, the given @l@ parameter.+--+-- Internally, the "toggling" events follow a bernoulli process with a @p@+-- parameter of @1 / l@.+--+randIntervals :: (Serialize g, RandomGen g)+ => Double+ -> g+ -> Interval m a a+randIntervals l = mkState (_randIntervalsF (1/l)) . swap . random++-- | Like 'randIntervals', but specialized for 'StdGen' from+-- "System.Random", so that you can serialize and resume. This is needed+-- because 'StdGen' doesn't have a 'Serialize' instance.+--+-- See the documentation of 'randIntervals' for more information.+--+stdRandIntervals :: Double+ -> StdGen+ -> Interval m a a+stdRandIntervals l = mkState' (read <$> get)+ (put . show)+ (_randIntervalsF (1/l))+ . swap . random++-- | The non-serializing/non-resuming version of 'randIntervals'.+randIntervals_ :: RandomGen g+ => Double+ -> g+ -> Interval m a a+randIntervals_ l = mkState_ (_randIntervalsF (1/l)) . swap . random++_randIntervalsF :: RandomGen g+ => Double+ -> a+ -> (g, Bool)+ -> (Maybe a, (g, Bool))+_randIntervalsF thresh x (g, onoff) = (outp, (g', onoff'))+ where+ (roll, g') = randomR (0, 1 :: Double) g+ onoff' = onoff `xor` (roll <= thresh)+ outp | onoff = Just x+ | otherwise = Nothing+ -- should this be onoff' ?+
+ src/Control/Auto/Run.hs view
@@ -0,0 +1,476 @@+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module : Control.Auto.Run+-- Description : Various utilities for running and unrolling 'Auto's, both+-- interactively and non-interactively.+-- Copyright : (c) Justin Le 2015+-- License : MIT+-- Maintainer : justin@jle.im+-- Stability : unstable+-- Portability : portable+--+-- This module provides utilities for "running" and "unrolling" 'Auto's.+-- You'll find "enhanced" versions of 'stepAuto', mechanisms for running+-- 'Auto's "interactively" inside 'IO', monadic and non-monadic+-- "self-runners" (provide the handlers, and the 'Auto' just recursively+-- runs intself), and finally, ways of "unrolling" the underlying 'Monad'+-- of 'Auto's into more manageable and composable and easy to work with+-- forms.+--++module Control.Auto.Run (+ -- * Special 'stepAuto' versions.+ -- ** Streaming over lists+ streamAuto+ , streamAuto'+ , overList+ , overList'+ -- ** Running over one item repetitively+ , stepAutoN+ , stepAutoN'+ , evalAutoN+ , evalAutoN'+ -- * Running "interactively"+ , interactAuto+ , interactRS+ , interactM+ -- ** Helpers+ , duringRead+ , bindRead+ -- * Generalized "self-runners"+ , run+ , runM+ -- * Running on concurrent channels+ , runOnChan+ , runOnChanM+ ) where++import Control.Applicative+import Control.Auto.Core+import Control.Auto.Interval+import Control.Concurrent+import Control.Monad hiding (mapM, mapM_)+import Data.Functor.Identity+import Data.Maybe+import Data.Profunctor+import Prelude hiding (interact, mapM, mapM_)+import Text.Read++-- | Streams the 'Auto' over a list of inputs; that is, "unwraps" the @[a]+-- -> m [b]@ inside. Streaming is done in the context of the underlying+-- monad; when done consuming the list, the result is the list of outputs+-- updated/next 'Auto' in the context of the underlying monad.+--+-- Basically just steps the 'Auto' by feeding in every item in the list and+-- pops out the list of results and the updated/next 'Auto', monadically+-- chaining the steppings.+--+-- See 'overList'' for a simpler example; the following example uses+-- effects from 'IO' to demonstrate the monadic features of 'overList'.+--+-- >>> let a = arrM print *> sumFrom 0 :: Auto IO Int Int+-- >>> (ys, a') <- overList a [1..5]+-- 1 -- IO effects+-- 2+-- 3+-- 4+-- 5+-- >>> ys+-- [1,3,6,10,15]+-- >>> (ys', _) <- overList a' [11..15]+-- 11 -- IO effects+-- 12+-- 13+-- 14+-- 15+-- >>> ys'+-- [26,38,51,65,80]+--+-- @a@ is like @'sumFrom' 0@, except at every step, prints the input item+-- to stdout as a side-effect. Note that in executing we get the updated+-- @a'@, which ends up with an accumulator of 15. Now, when we stream+-- @a'@, we pick up were we left off (from 15) on the results.+--+overList :: Monad m+ => Auto m a b -- ^ the 'Auto' to run+ -> [a] -- ^ list of inputs to step the 'Auto' with+ -> m ([b], Auto m a b) -- ^ list of outputs and the updated 'Auto'+overList a [] = return ([], a)+overList a (x:xs) = do+ (y, a') <- stepAuto a x+ (ys, a'') <- overList a' xs+ return (y:ys, a'')++-- | Streams an 'Auto'' over a list of inputs; that is, "unwraps" the @[a]+-- -> [b]@ inside. When done comsuming the list, returns the outputs and+-- the updated/next 'Auto''.+--+-- >>> let (ys, updatedSummer) = overList' (sumFrom 0) [1..5]+-- >>> ys+-- [1, 3, 6, 10, 15]+-- >>> let (ys', _) = streamAuto' updatedSummer [1..5]+-- >>> ys'+-- [16, 18, 21, 25, 30]+--+-- If you wanted to stream over an infinite list then you don't care about+-- the 'Auto'' at the end, and probably want 'streamAuto''.+--+overList' :: Auto' a b -- ^ the 'Auto'' to run+ -> [a] -- ^ list of inputs to step the 'Auto'' with+ -> ([b], Auto' a b) -- ^ list of outputs and the updated 'Auto''+overList' a [] = ([], a)+overList' a (x:xs) = let (y, a') = stepAuto' a x+ (ys, a'') = overList' a' xs+ in (y:ys, a'')++-- | Stream an 'Auto' over a list, returning the list of results. Does+-- this "lazily" (over the Monad), so with most Monads, this should work+-- fine with infinite lists.+--+-- Note that, conceptually, this turns an @'Auto' m a b@ into an @[a] ->+-- m [b]@.+--+-- See 'streamAuto'' for a simpler example; here is one taking advantage of+-- monadic effects:+--+-- >>> let a = arrM print *> sumFrom 0 :: Auto IO Int Int+-- >>> ys <- streamAuto a [1..5]+-- 1 -- IO effects+-- 2+-- 3+-- 4+-- 5+-- >>> ys+-- [1,3,6,10,15] -- the result+--+-- @a@ here is like @'sumFrom' 0@, except at every step, prints the input+-- item to stdout as a side-effect.+--+streamAuto :: Monad m+ => Auto m a b -- ^ 'Auto' to stream+ -> [a] -- ^ input stream+ -> m [b] -- ^ output stream+streamAuto _ [] = return []+streamAuto a (x:xs) = do+ (y, a') <- stepAuto a x+ ys <- streamAuto a' xs+ return (y:ys)++-- | Stream an 'Auto'' over a list, returning the list of results. Does+-- this lazily, so this should work fine with (and is actually somewhat+-- designed for) infinite lists.+--+-- Note that conceptually this turns an @'Auto'' a b@ into an @[a] -> [b]@+--+-- >>> streamAuto' (arr (+3)) [1..10]+-- [4,5,6,7,8,9,10,11,12,13]+-- >>> streamAuto' (sumFrom 0) [1..5]+-- [1,3,6,10,15]+-- >>> streamAuto' (productFrom 1) . streamAuto' (sumFrom 0) $ [1..5]+-- [1,3,18,180,2700]+-- >>> streamAuto' (productFrom 1 . sumFrom 0) $ [1..5]+-- [1,3,18,180,2700]+-- >>> streamAuto' id [1..5]+-- [1,2,3,4,5]+--+streamAuto' :: Auto' a b -- ^ 'Auto'' to stream+ -> [a] -- ^ input stream+ -> [b] -- ^ output stream+streamAuto' _ [] = []+streamAuto' a (x:xs) = let (y, a') = stepAuto' a x+ ys = streamAuto' a' xs+ in y:ys++-- | Streams (in the context of the underlying monad) the given 'Auto' with+-- a stream of constant values as input, a given number of times. After+-- the given number of inputs, returns the list of results and the+-- next/updated 'Auto', in the context of the underlying monad.+--+-- prop> stepAutoN n a0 x = overList a0 (replicate n x)+--+-- See 'stepAutoN'' for a simpler example; here is one taking advantage of+-- monadic effects:+--+-- >>> let a = arrM print *> sumFrom 0 :: Auto IO Int Int+-- >>> (ys, a') <- stepAutoN 5 a 3+-- 3 -- IO effects+-- 3+-- 3+-- 3+-- 3+-- >>> ys+-- [3,6,9,12,15] -- the result+-- >>> (ys'', _) <- stepAutoN 5 a' 5+-- 5 -- IO effects+-- 5+-- 5+-- 5+-- 5+-- >>> ys''+-- [20,25,30,35,50] -- the result+--+-- @a@ here is like @'sumFrom' 0@, except at every step, prints the input+-- item to stdout as a side-effect.+--+stepAutoN :: Monad m+ => Int -- ^ number of times to step the 'Auto'+ -> Auto m a b -- ^ the 'Auto' to run+ -> a -- ^ the repeated input+ -> m ([b], Auto m a b) -- ^ list of outputs and the updated 'Auto'+stepAutoN n a0 x = go (max n 0) a0+ where+ go 0 a = return ([], a)+ go i a = do+ (y , a') <- stepAuto a x+ (ys, a'') <- go (i - 1) a'+ return (y:ys, a'')++-- | Streams the given 'Auto'' with a stream of constant values as input,+-- a given number of times. After the given number of inputs, returns the+-- list of results and the next/updated 'Auto'.+--+-- prop> stepAutoN' n a0 x = overList' a0 (replicate n x)+--+-- >>> let (ys, a') = stepAutoN' 5 (sumFrom 0) 3+-- >>> ys+-- [3,6,9,12,15]+-- >>> let (ys', _) = stepAutoN' 5 a' 5+-- >>> ys'+-- [20,25,30,35,40]+--+stepAutoN' :: Int -- ^ number of times to step the 'Auto''+ -> Auto' a b -- ^ the 'Auto'' to run+ -> a -- ^ the repeated input+ -> ([b], Auto' a b) -- ^ list of outputs and the updated 'Auto''+stepAutoN' n a0 x = runIdentity (stepAutoN n a0 x)++-- | Streams (in the context of the underlying monad) the given 'Auto' with+-- a stream of constant values as input, a given number of times. After+-- the given number of inputs, returns the list of results in the context+-- of the underlying monad.+--+-- Like 'stepAutoN', but drops the "next 'Auto'". Only returns the list+-- of results.+--+-- >>> let a = arrM print *> sumFrom 0 :: Auto IO Int Int+-- >>> ys <- evalAutoN 5 a 3+-- 3 -- IO effects+-- 3+-- 3+-- 3+-- 3+-- >>> ys+-- [3,6,9,12,15] -- the result+--+-- @a@ here is like @'sumFrom' 0@, except at every step, prints the input+-- item to stdout as a side-effect.+evalAutoN :: Monad m+ => Int -- ^ number of times to step the 'Auto'+ -> Auto m a b -- ^ the 'Auto' to run+ -> a -- ^ the repeated input+ -> m [b] -- ^ list of outputs+evalAutoN n a0 = liftM fst . stepAutoN n a0++-- | Streams the given 'Auto'' with a stream of constant values as input,+-- a given number of times. After the given number of inputs, returns the+-- list of results and the next/updated 'Auto'.+--+-- Like 'stepAutoN'', but drops the "next 'Auto''". Only returns the list+-- of results.+--+-- >>> evalAutoN' 5 (sumFrom 0) 3+-- [3,6,9,12,15]+--+evalAutoN' :: Int -- ^ number of times to step the 'Auto''+ -> Auto' a b -- ^ the 'Auto'' to run+ -> a -- ^ the repeated input+ -> [b] -- ^ list of outputs and the updated 'Auto''+evalAutoN' n a0 = fst . stepAutoN' n a0++-- execAutoN :: Monad m+-- => Int+-- -> Auto m a b+-- -> a+-- -> m (Auto m a b)+-- execAutoN n a0 = liftM snd . stepAutoN n a0++-- execAutoN' :: Int+-- -> Auto' a b+-- -> a+-- -> Auto' a b+-- execAutoN' n a0 = snd . stepAutoN' n a0++-- | Heavy duty abstraction for "self running" an 'Auto'. Give a starting+-- input action, a (possibly side-effecting) function from an output to+-- the next input to feed in, and the 'Auto', and you get a feedback+-- loop that constantly feeds back in the result of the function applied to+-- the previous output. "Stops" when the "next input" function returns+-- 'Nothing'.+--+-- Note that the none of the results are actually returned from the loop.+-- Instead, if you want to process the results, they must be utilized in+-- the "side-effects' of the "next input" function. (ie, a write to+-- a file, or an accumulation to a state).+--+run :: Monad m+ => m a -- ^ action to retrieve starting input+ -> (b -> m (Maybe a)) -- ^ handling output and next input in @m@+ -> Auto m a b -- ^ 'Auto'+ -> m (Auto m a b) -- ^ return the ran/updated 'Auto' in @m@+run = runM id++-- | A generalized version of 'run' where the 'Monad' you are "running" the+-- 'Auto' in is different than the 'Monad' underneath the 'Auto'. You just+-- need to provide the natural transformation.+runM :: (Monad m, Monad m')+ => (forall c. m' c -> m c) -- ^ natural transformation from @m'@ (the Auto monad) to @m@ (the running monad)+ -> m a -- ^ action to retrieve starting input+ -> (b -> m (Maybe a)) -- ^ handling output and next input in @m@+ -> Auto m' a b -- ^ 'Auto' in monad @m'@+ -> m (Auto m' a b) -- ^ return the resulting/run Auto in @m@+runM nt x0 f a = do+ (y, a') <- nt . stepAuto a =<< x0+ x1 <- f y+ case x1 of+ -- TODO: optimize for no return x+ Just x -> runM nt (return x) f a'+ Nothing -> return a'++-- | Run an 'Auto'' "interactively". Every step grab a string from stdin,+-- and feed it to the 'Interval''. If the 'Interval'' is "off", ends the+-- session; if it is "on", then prints the output value to stdout and+-- repeat all over again.+--+-- If your 'Auto' outputs something other than a 'String', you can use+-- 'fmap' to transform the output into a 'String' en-route (like @'fmap'+-- 'show'@).+--+-- If your 'Auto' takes in something other than a 'String', you can 'lmap'+-- a function to convert the input 'String' to whatever intput your 'Auto'+-- expects.+--+-- You can use 'duringRead' or 'bindRead' if you have an 'Auto'' or+-- 'Interval'' that takes something 'read'able, to chug along until you+-- find something non-readable; there's also 'interactRS' which handles+-- most of that for you.+--+-- Outputs the final 'Interval'' when the interaction terminates.+interactAuto :: Interval' String String -- ^ 'Interval'' to run interactively+ -> IO (Interval' String String) -- ^ final 'Interval'' after it all+interactAuto = interactM (return . runIdentity) f+ where+ f (Just str) = True <$ putStrLn str+ f Nothing = return False++-- | Like 'interact', but instead of taking @'Interval'' 'String'+-- 'String'@, takes any @'Interval'' a b@ as long as @a@ is 'Read' and @b@+-- is 'Show'.+--+-- Will "stop" if either (1) the input is not 'read'-able or (2) the+-- 'Interval'' turns off.+--+-- Outputs the final 'Auto'' when the interaction terminates.+interactRS :: (Read a, Show b)+ => Interval' a b -- ^ 'Interval'' to run interactively+ -> IO (Interval' String String) -- ^ final 'Interval'' after it all+interactRS = interactAuto . bindRead . fmap (fmap show)+++-- | Like 'interact', but much more general. You can run it with an 'Auto'+-- of any underlying 'Monad', as long as you provide the natural+-- transformation from that 'Monad' to 'IO'.+--+-- The 'Auto' can any @'Maybe' b@; you have to provide+-- a function to "handle" it yourself; a @b -> 'IO' 'Bool'@. You can print+-- the result, or write the result to a file, etc.; the 'Bool' parameter+-- determines whether or not to "continue running", or to stop and return+-- the final updated 'Auto'.+interactM :: Monad m+ => (forall c. m c -> IO c) -- ^ natural transformation from the underlying 'Monad' of the 'Auto' to 'IO'+ -> (b -> IO Bool) -- ^ function to "handle" each succesful 'Auto' output+ -> Auto m String b -- ^ 'Auto' to run "interactively"+ -> IO (Auto m String b) -- ^ final 'Auto' after it all+interactM nt f = runM nt getLine f'+ where+ f' y = do+ cont <- f y+ if cont+ then Just <$> getLine+ else return Nothing+++-- | Turn an 'Auto' that takes a "readable" @a@ and outputs a @b@ into an+-- 'Auto' that takes a 'String' and outputs a @'Maybe' b@. When the+-- 'String' is successfuly readable as the @a@, it steps the 'Auto' and+-- outputs a succesful 'Just' result; when it isn't, it outputs a 'Nothing'+-- on that step.+--+-- >>> let a0 = duringRead (accum (+) (0 :: Int))+-- >>> let (y1, a1) = stepAuto' a0 "12"+-- >>> y1+-- Just 12+-- >>> let (y2, a2) = stepAuto' a1 "orange"+-- >>> y2+-- Nothing+-- >>> let (y3, _ ) = stepAuto' a2 "4"+-- >>> y3+-- Just 16+--+-- See 'interact' for neat use cases.+duringRead :: (Monad m, Read a)+ => Auto m a b -- ^ 'Auto' taking in a readable @a@, outputting @b@+ -> Interval m String b -- ^ 'Auto' taking in 'String', outputting @'Maybe' b@+duringRead = lmap readMaybe . during++-- | Like 'duringRead', but the original 'Auto' would output a @'Maybe' b@+-- instead of a @b@. Returns 'Nothing' if either the 'String' fails to+-- parse or if the original 'Auto' returned 'Nothing'; returns 'Just' if+-- the 'String' parses and the original 'Auto' returned 'Just'.+--+-- See 'interact' for neat use cases.+bindRead :: (Monad m, Read a)+ => Interval m a b -- ^ 'Auto' taking in a readable @a@, outputting @'Maybe' b@+ -> Interval m String b -- ^ 'Auto' taking in 'String', outputting @'Maybe' b@+bindRead = lmap readMaybe . bindI++-- | A generalized version of 'runOnChan' that can run on any @'Auto' m@;+-- all that is required is a natural transformation from the underyling+-- 'Monad' @m@ to 'IO'.+runOnChanM :: Monad m+ => (forall c. m c -> IO c) -- ^ natural transformation from the+ -- underling 'Monad' of the+ -- 'Auto' to 'IO'+ -> (b -> IO Bool) -- ^ function to "handle" each+ -- succesful 'Auto' output;+ -- result is whether or not to+ -- continue.+ -> Chan a -- ^ 'Chan' queue to pull input from.+ -> Auto m a b -- ^ 'Auto' to run+ -> IO (Auto m a b) -- ^ final 'Auto' after it all, when+ -- the handle resturns 'False'+runOnChanM nt f chan = go+ where+ go a0 = do+ x <- readChan chan+ (y, a1) <- nt $ stepAuto a0 x+ cont <- f y+ if cont+ then go a1+ else return a1++-- | Runs the 'Auto'' in IO with inputs read from a 'Chan' queue, from+-- "Control.Concurrency.Chan". It'll block until the 'Chan' has a new+-- input, run the 'Auto' with the received input, process the output with+-- the given handling function, and start over if the handling function+-- returns 'True'.+runOnChan :: (b -> IO Bool) -- ^ function to "handle" each+ -- succesful 'Auto' output;+ -- result is whether or not to+ -- continue.+ -> Chan a -- ^ 'Chan' queue to pull input from.+ -> Auto' a b -- ^ 'Auto'' to run+ -> IO (Auto' a b) -- ^ final 'Auto' after it all, when+ -- the handle resturns 'False'+runOnChan = runOnChanM (return . runIdentity)
+ src/Control/Auto/Serialize.hs view
@@ -0,0 +1,430 @@+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module : Control.Auto.Serialize+-- Description : Serializing and deserializing 'Auto's to and from disk,+-- and also 'Auto' transformers focused around serialization.+-- Copyright : (c) Justin Le 2015+-- License : MIT+-- Maintainer : justin@jle.im+-- Stability : unstable+-- Portability : portable+--+-- This module provides tools for working with the automatically derived+-- serializability and resumability of 'Auto's. The first half contains+-- boring wrappers around encoding and decoding to and from binary,+-- filepaths on disk, etc.+--+-- The second half contains 'Auto' transformers that "imbue" an 'Auto' with+-- IO serialization abilities. Note that these all require an underlying+-- 'Monad' that is an instance of 'MonadIO'.+--+-- You have "identity-like" transformers that take an 'Auto' and spit it+-- back out operationally unchanged...but every step, it might do some+-- behind-the-scenes saving or re-load itself from disk when it is first+-- stepped. Or you have some "trigger enhancers" that take normal 'Auto's+-- and give you the ability to "trigger" saving and loading events on the+-- 'Auto' using the 'Blip' mechanisms and blip stream semantics from+-- "Control.Auto.Blip".+--+-- Note that the entire 'Auto' construct is a little bit awkward when it+-- comes to performing IO effects --- it isn't exactly what they were+-- designed for originally. Hooking on effects to stepping can be+-- powerful, but as of now, not much has been looked into meaningful error+-- handling when working with IO. If you have any experience with this and+-- are willing to help, please feel free to send me an e-mail or open an+-- issue on the <https://github.com/mstksg/auto/issues issue tracker>!+--++module Control.Auto.Serialize (+ -- * Serializing and deserializing 'Auto's+ -- ** To and from "Data.Serialize" types+ saveAuto+ , resumeAuto+ -- ** To and from binary+ , encodeAuto+ , decodeAuto+ -- ** To and from disk+ , writeAuto+ , readAuto+ , readAutoDef+ -- * Imbuing 'Auto's with serialization+ -- ** Implicit automatic serialization+ , saving+ , loading'+ , loading+ , serializing'+ , serializing+ -- ** Triggered (blip stream-based) automatic serialization+ -- $onfrom+ -- *** External triggering+ , saveOnB+ , loadOnB'+ , loadOnB+ -- *** Intrinsic triggering+ , saveFromB+ , loadFromB'+ , loadFromB+ ) where++import Control.Auto.Blip.Internal+import Control.Monad.IO.Class+import Control.Monad+import Control.Exception+import Control.Applicative+import System.IO.Error+import Control.Auto.Core+import qualified Data.ByteString as B++-- | Give a 'FilePath' and an 'Auto', and 'readAuto' will attempt to resume+-- the saved state of the 'Auto' from disk, reading from the given+-- 'FilePath'. Will return 'Left' upon a decoding error, with the error,+-- and 'Right' if the decoding is succesful.+readAuto :: FilePath -- ^ filepath to read from+ -> Auto m a b -- ^ 'Auto' to resume+ -> IO (Either String (Auto m a b))+readAuto fp a = decodeAuto a <$> B.readFile fp++-- | Like 'readAuto', but will return the /original/ 'Auto' (instead of+-- a resumed one) if the file does not exist.+--+-- Useful if you want to "resume an 'Auto'" "if there is" a save state, or+-- just use it as-is if there isn't.+readAutoDef :: FilePath -- ^ filepath to read from+ -> Auto m a b -- ^ 'Auto' to resume+ -> IO (Either String (Auto m a b))+readAutoDef fp a = do+ esa <- try (readAuto fp a);+ case esa of+ Right a' -> return a'+ Left e | isDoesNotExistError e -> return (Right a)+ | otherwise -> throw e++-- | Like 'readAuto', but will throw a runtime exception on a failure to+-- decode or an IO error.+readAutoErr :: FilePath -- ^ filepath to read from+ -> Auto m a b -- ^ 'Auto' to resume+ -> IO (Auto m a b)+readAutoErr fp a = do+ esa <- readAuto fp a+ return $ case esa of+ Left e -> error $ "readAutoErr: Corrupted Auto binary -- " ++ e+ Right a' -> a'++-- | Given a 'FilePath' and an 'Auto', serialize and freeze the state of+-- the 'Auto' as binary to that 'FilePath'.+writeAuto :: FilePath -- ^ filepath to write to+ -> Auto m a b -- ^ 'Auto' to serialize+ -> IO ()+writeAuto fp a = B.writeFile fp (encodeAuto a)++-- | "Transforms" the given 'Auto' into an 'Auto' that constantly saves its+-- state to the given 'FilePath' at every "step". Requires an underlying+-- 'MonadIO'.+--+-- Note that (unless the 'Auto' depends on IO), the resulting 'Auto' is+-- meant to be operationally /identical/ in its inputs/outputs to the+-- original one.+--+saving :: MonadIO m+ => FilePath -- ^ filepath to write to+ -> Auto m a b -- ^ 'Auto' to transform+ -> Auto m a b+saving fp = interceptO $ \(y, a') -> do+ liftIO $ writeAuto fp a'+ return y++-- | "Transforms" the given 'Auto' into an 'Auto' that, when you /first/+-- try to run or step it, "loads" itself from disk at the given 'FilePath'.+--+-- Will throw a runtime exception on either an I/O error or a decoding+-- error.+--+-- Note that (unless the 'Auto' depends on IO), the resulting 'Auto' is+-- meant to be operationally /identical/ in its inputs/outputs to the+-- /fast-forwarded/ original 'Auto'.+--+loading :: MonadIO m+ => FilePath -- ^ filepath to read from+ -> Auto m a b -- ^ 'Auto' to transform+ -> Auto m a b+loading fp a0 = mkAutoM (loading fp <$> resumeAuto a0)+ (saveAuto a0)+ $ \x -> do+ a <- liftM loaded . liftIO $ readAutoErr fp a0+ stepAuto a x+ where+ loaded a = mkAutoM (loading' fp <$> resumeAuto a)+ (saveAuto a)+ $ \x -> do+ (y, a') <- stepAuto a x+ return (y, loaded a')++++-- | Like 'loading', except silently suppresses all I/O and decoding+-- errors; if there are errors, it returns back the given 'Auto' as-is.+--+-- Useful for when you aren't sure the save state is on disk or not yet,+-- and want to resume it only in the case that it is.+loading' :: MonadIO m+ => FilePath -- ^ filepath to read from+ -> Auto m a b -- ^ 'Auto' to transform (or return unchanged)+ -> Auto m a b+loading' fp a0 = mkAutoM (loading' fp <$> resumeAuto a0)+ (saveAuto a0)+ $ \x -> do+ a <- do+ ea' <- liftIO $ readAutoDef fp a0+ case ea' of+ Right a' -> return (loaded a')+ Left _ -> return a0+ stepAuto a x+ where+ loaded a = mkAutoM (loading' fp <$> resumeAuto a)+ (saveAuto a)+ $ \x -> do+ (y, a') <- stepAuto a x+ return (y, loaded a')++-- | A combination of 'saving' and 'loading'. When the 'Auto' is first+-- run, it loads the save state from the given 'FilePath' and fast forwards+-- it. Then, subsequently, it updates the save state on disk on every+-- step.+serializing :: MonadIO m+ => FilePath -- ^ filepath to read from and write to+ -> Auto m a b -- ^ 'Auto' to transform+ -> Auto m a b+serializing fp a = loading fp (saving fp a)++-- | Like 'serializing', except suppresses all I/O and decoding errors.+--+-- Useful in the case that when the 'Auto' is first run and there is no+-- save state yet on disk (or the save state is corrupted), it'll "start+-- a new one"; if there is one, it'll load it automatically. Then, on+-- every further step in both cases, it'll update the save state.+serializing' :: MonadIO m+ => FilePath -- ^ filepath to read from and write to+ -> Auto m a b -- ^ 'Auto' to transform+ -> Auto m a b+serializing' fp a = loading' fp (saving fp a)++-- $onfrom+--+-- Note that these follow the naming conventions from+-- "Control.Auto.Switch": Something "from" a blip stream is a thing+-- triggered by the 'Auto' itself, and something "on" a blip stream is+-- a thing triggered externally, from another 'Auto'.++-- | Takes an 'Auto' that produces a blip stream with a 'FilePath' and+-- a value, and turns it into an 'Auto' that, outwardly, produces just the+-- value.+--+-- Whenever the output blip stream emits, it automatically serializes and+-- saves the state of the 'Auto' to the emitted 'FilePath'.+--+-- In practice, this allows any 'Auto' to basically control when it wants+-- to "save", by providing a blip stream.+--+-- The following is an alternative implementation of 'saving', except+-- saving every two steps instead of every step:+--+-- @+-- saving2 fp a = 'saveFromB' (a '&&&' ('every' 2 . 'pure' fp))+-- @+--+-- Or, in proc notation:+--+-- > saving2 fp a = saveFromB $ proc x -> do+-- > y <- a -< x+-- > b <- every 2 -< fp+-- > id -< (y, b)+--+-- (Recall that @'every' n@ is the "Auto" that emits the received value+-- every @n@ steps)+--+-- In useful real-world cases, you can have the 'Auto' decide whether or+-- not to save itself based on its input. Like, for example, when it+-- detects a certain user command, or when the user has reached a given+-- location.+--+-- The following takes a 'FilePath' and an 'Auto' (@a@), and turns it into+-- an 'Auto' that "saves" whenever @a@ crosses over from positive to+-- negative.+--+-- @+-- saveOnNegative fp a = saveFromB $ proc x -> do+-- y <- a -< x+-- saveNow <- 'became' (< 0) -< y+-- id -< (y, fp '<$' saveNow)+-- @+--+-- Contrast to 'saveOnB', where the saves are triggered by outside input.+-- In this case, the saves are triggered by the 'Auto' to be saved itself.+--+saveFromB :: MonadIO m+ => Auto m a (b, Blip FilePath) -- ^ 'Auto' producing a value+ -- @b@ and a blip stream+ -- with a 'FilePath' to save+ -- to+ -> Auto m a b+saveFromB = interceptO $ \((y, b), a') -> do+ case b of+ Blip p -> liftIO $ writeAuto p a'+ _ -> return ()+ return y++-- | Takes an 'Auto' that outputs a @b@ and a blip stream of 'FilePath's+-- and returns an 'Auto' that ouputs only that @b@ stream...but every time+-- the blip stream emits, it "resets/loads" itself from that 'FilePath'.+--+-- The following is a re-implementation of 'loading'...except delayed by+-- one (the second step that is run is the first "resumed" step).+--+-- @+-- loading2 fp a = 'loadFromB' $ proc x -> do+-- y <- a -< x+-- loadNow <- 'immediately' -< fp+-- 'id' -< (y, loadNow)+-- @+--+-- (the blip stream emits only once, immediately, to re-load).+--+-- In the real world, you could have the 'Auto' decide to reset or resume+-- itself based on a user command:+--+-- @+-- loadFrom = loadFromB $ proc x -> do+-- steps <- count -< ()+-- toLoad <- case words x of+-- ("load":fp:_) -> do+-- immediately -< fp+-- _ -> do+-- never -< ()+-- id -< (steps, toLoad)+-- @+--+-- This will throw a runtime error on an IO exception or parsing error.+--+loadFromB :: MonadIO m+ => Auto m a (b, Blip FilePath) -- ^ 'Auto' with an output+ -- and a blip stream to+ -- trigger re-loading+ -- itself from the given+ -- filepath+ -> Auto m a b+loadFromB a = mkAutoM (loadFromB' <$> resumeAuto a)+ (saveAuto a)+ $ \x -> do+ ((y, b), a') <- stepAuto a x+ a'' <- case b of+ Blip p -> liftIO $ readAutoErr p a'+ NoBlip -> return a'+ return (y, loadFromB' a'')++-- | Like 'loadFromB', except silently ignores errors. When a load is+-- requested, but there is an IO or parse error, the loading is skipped.+loadFromB' :: MonadIO m+ => Auto m a (b, Blip FilePath) -- ^ 'Auto' with an output+ -- and a blip stream to+ -- trigger re-loading+ -- itself from the given+ -- filepath+ -> Auto m a b+loadFromB' a0 = mkAutoM (loadFromB' <$> resumeAuto a0)+ (saveAuto a0)+ $ \x -> do+ ((y, b), a1) <- stepAuto a0 x+ a2 <- case b of+ Blip p -> do+ ea3 <- liftIO $ readAutoDef p a1+ case ea3 of+ Right a3 -> return a3+ Left _ -> return a1+ NoBlip -> return a1+ return (y, loadFromB' a2)++-- | Takes an 'Auto' and basically "wraps" it so that you can trigger saves+-- with a blip stream.+--+-- For example, we can take @'sumFrom' 0@:+--+-- @+-- 'saveOnB' ('sumFrom' 0) :: 'Auto' 'IO' ('Int', 'Blip' 'FilePath') 'Int'+-- @+--+-- It'll behave just like @'sumFrom' 0@ (with the input you pass in the+-- first field of the tuple)...and whenever the blip stream (the second+-- field of the input tuple) emits, it'll save the state of @'sumFrom' 0@+-- to disk at the given 'FilePath'.+--+-- Contrast to 'saveFromB', where the 'Auto' itself can trigger saves; in+-- this one, saves are triggered "externally".+--+-- Might be useful in similar situations as 'saveFromB', except if you want+-- to trigger the save externally.+--+saveOnB :: MonadIO m+ => Auto m a b -- ^ 'Auto' to make saveable-by-trigger+ -> Auto m (a, Blip FilePath) b+saveOnB a = mkAutoM (saveOnB <$> resumeAuto a)+ (saveAuto a)+ $ \(x, b) -> do+ case b of+ Blip p -> liftIO $ writeAuto p a+ NoBlip -> return ()+ (y, a') <- stepAuto a x+ return (y, saveOnB a')++-- | Takes an 'Auto' and basically "wraps" it so that you can trigger+-- loads/resumes from a file with a blip stream.+--+-- For example, we can take @'sumFrom' 0@:+--+-- @+-- 'loadOnB' ('sumFrom' 0) :: 'Auto' 'IO' ('Int', 'Blip' 'FilePath') 'Int'+-- @+--+-- It'll behave just like @'sumFrom' 0@ (with the input you pass in the+-- first field of the tiple)...and whenever the blip stream (the second+-- field of the input tuple) emits, it'll "reset" and "reload" the+-- @'sumFrom' 0@ from the 'FilePath' on disk.+--+-- Will throw a runtime exception if there is an IO error or a parse error.+--+-- Contrast to 'loadFromB', where the 'Auto' itself can trigger+-- reloads/resets; in this one, the loads are triggered "externally".+--+-- Might be useful in similar situations as 'loadFromB', except if you want+-- to trigger the loading externally.+--+loadOnB :: MonadIO m+ => Auto m a b -- ^ 'Auto' to make reloadable-by-trigger+ -> Auto m (a, Blip FilePath) b+loadOnB a = mkAutoM (loadOnB' <$> resumeAuto a)+ (saveAuto a)+ $ \(x, b) -> do+ a' <- case b of+ Blip p -> liftIO $ readAutoErr p a+ NoBlip -> return a+ (y, a'') <- stepAuto a' x+ return (y, loadOnB' a'')++-- | Like 'loadOnB', except silently ignores errors. When a load is+-- requested, but there is an IO or parse error, the loading is skipped.+loadOnB' :: MonadIO m+ => Auto m a b -- ^ 'Auto' to make reloadable-by-trigger+ -> Auto m (a, Blip FilePath) b+loadOnB' a0 = mkAutoM (loadOnB' <$> resumeAuto a0)+ (saveAuto a0)+ $ \(x, b) -> do+ a1 <- case b of+ Blip p -> do+ ea2 <- liftIO $ readAutoDef p a0+ case ea2 of+ Right a2 -> return a2+ Left _ -> return a0+ NoBlip -> return a0+ (y, a2) <- stepAuto a1 x+ return (y, loadOnB' a2)+
+ src/Control/Auto/Switch.hs view
@@ -0,0 +1,544 @@+-- |+-- 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 ())
+ src/Control/Auto/Time.hs view
@@ -0,0 +1,548 @@+{-# LANGUAGE ViewPatterns #-}++-- |+-- Module : Control.Auto.Time+-- Description : 'Auto's and 'Auto' transformers for observing and+-- manipulating the flow of "time".+-- Copyright : (c) Justin Le 2015+-- License : MIT+-- Maintainer : justin@jle.im+-- Stability : unstable+-- Portability : portable+--+-- This module contains various 'Auto' transformers for manipulating the+-- flow of time/stepping rate of an 'Auto'.+--+-- Many of these are 'Auto' "transformers", meaning that they take in an+-- 'Auto' and return a transformed 'Auto', with new stepping behavior.+--+-- For example, there is 'accelerate':+--+-- @+-- 'accelerate' :: 'Monad' m => 'Int' -> 'Auto' m a b -> 'Auto' m a [b]+-- @+--+-- @'accelerate' n@ turns an 'Auto' into an 'Auto' that "steps itself" @n@+-- times for every single input/step. The result is a list of the+-- results of each single step.+--+-- There are also various 'Auto's for observing the passage of time+-- ('count') and actiong as a "delay" or a way to access the previously+-- stepped values of an 'Auto'.+--++module Control.Auto.Time (+ -- * A counter+ count+ , count_+ -- * Manipulating time+ -- ** Delaying+ , lastVal+ , lastVal_+ , arrD+ , arrD_+ , delay+ , delay_+ , delayList+ , delayList_+ , delayN+ , delayN_+ -- ** "Priming"+ , priming+ -- ** Stretching+ , stretch+ , stretch_+ , stretchB+ -- ** Accelerating+ , accelerate+ , accelerateWith+ , accelOverList+ -- ** Skipping+ , skipTo+ , fastForward+ , fastForwardEither+ ) where++import Control.Applicative+import Control.Arrow+import Control.Auto.Blip.Internal+import Control.Auto.Core+import Control.Auto.Generate+import Control.Auto.Interval+import Control.Auto.Run+import Control.Category+import Control.Monad+import Control.Monad.Trans.Class+import Control.Monad.Trans.Writer+import Data.Monoid+import Data.Serialize+import Prelude hiding ((.), id)++-- | A simple 'Auto' that ignores all input; its output stream counts+-- upwards from zero.+--+-- >>> take 10 . streamAuto' count $ repeat ()+-- [0,1,2,3,4,5,6,7,8,9]+count :: (Serialize b, Num b) => Auto m a b+count = iterator (+1) 0++-- | A non-resuming/non-serializing version of 'count'.+count_ :: Num b => Auto m a b+count_ = iterator_ (+1) 0++-- | An 'Auto' that returns the last value received by it. Given an+-- "initial value" to output first.+--+-- From the signal processing world, this is known as the "lag operator"+-- /L/.+--+-- This is (potentially) a __very dangerous__ 'Auto', because its usage and+-- its very existence opens the door to breaking denotative/declarative+-- style and devolving into imperative style coding. However, when used+-- where it is supposed to be used, it is more or less invaluable, and will+-- be an essential part of many programs.+--+-- Its main usage is for dealing with recursive bindings. If you ever are+-- laying out recursive bindings in a high-level/denotative way, you need+-- to have at least one value be able to have a "initial output" without+-- depending on anything else. 'lastVal' and 'delay' allow you to do this.+--+-- See the <https://github.com/mstksg/auto-examples/blob/master/src/Recursive.hs recursive>+-- example for more information on the appropriate usage of 'lastVal' and+-- 'delay'.+--+-- >>> streamAuto' (lastVal 100) [1..10]+-- [100,1,2,3,4,5,6,7,8,9]+lastVal :: Serialize a+ => a -- ^ initial value+ -> Auto m a a+lastVal = mkState $ \x s -> (s, x)+{-# INLINE lastVal #-}++-- | The non-resuming/non-serializing version of 'lastVal'.+lastVal_ :: a -- ^ initial value+ -> Auto m a a+lastVal_ = mkState_ $ \x s -> (s, x)+{-# INLINE lastVal_ #-}++-- | Like 'arr', but applies the function to the /previous value/ of the+-- input, instead of the current value. Used for the same purposes as+-- 'lastVal': to manage recursive bindings.+--+-- Warning: Don't use this to do imperative programming!+--+-- prop> arrD id == lastVal+--+-- >>> streamAuto' (arrD negate 100) [1..10]+-- [100,-1,-2,-3,-4,-5,-6,-7,-8,-9]+arrD :: Serialize b+ => (a -> b) -- ^ function to apply+ -> b -- ^ initial value+ -> Auto m a b+arrD f = mkState $ \x s -> (s, f x)++-- | The non-resuming/non-serializing version of 'arrD'.+arrD_ :: Serialize b+ => (a -> b) -- ^ function to apply+ -> b -- ^ initial value+ -> Auto m a b+arrD_ f = mkState_ $ \x s -> (s, f x)++-- | An alias for 'lastVal'; used in contexts where "delay" is more+-- a meaningful description than "last value". All of the warnings for+-- 'lastVal' still apply, so you should probably read it if you haven't :)+delay :: Serialize a+ => a -- ^ initial value+ -> Auto m a a+delay = lastVal+{-# INLINE delay #-}++-- | The non-resuming/non-serializing version of 'delay'.+delay_ :: a -- ^ initial value+ -> Auto m a a+delay_ = lastVal_+{-# INLINE delay_ #-}++-- | Like 'delay', except has as many "initial values" as the input list.+-- Outputs every item in the input list in order before returning the first+-- received value.+--+-- prop> delayList [y0] = delay y0+--+-- >>> streamAuto' (delayList [3,5,7,11]) [1..10]+-- [3,5,7,11,1,2,3,4,5,6]+delayList :: (Serialize a, Monad m)+ => [a] -- ^ items to delay with (initial values)+ -> Auto m a a+delayList = foldr (\x a -> delay x . a) id++-- | The non-resuming/non-serializing version of 'delayList'.+delayList_ :: Monad m+ => [a] -- ^ items to delay with (initial values)+ -> Auto m a a+delayList_ = foldr (\x a -> delay_ x . a) id++-- | Like 'delay', except delays the desired number of steps with the same+-- initial output value.+--+-- prop> delayN n x0 = delayList (replicate n x0)+--+-- prop> delayN 1 x0 = delay x0+--+-- >>> streamAuto' (delayN 3 0) [1..10]+-- [0,0,0,1,2,3,4,5,6,7]+delayN :: (Serialize a, Monad m)+ => Int -- ^ number of steps to delay+ -> a -- ^ initial value(s)+ -> Auto m a a+delayN n y0 = iterate (delay y0 .) id !! n++-- | The non-resuming/non-serializing version of 'delayN'+delayN_ :: Monad m+ => Int -- ^ number of steps to delay+ -> a -- ^ initial value(s)+ -> Auto m a a+delayN_ n y0 = iterate (delay_ y0 .) id !! n++-- | "stretch" an 'Auto' out, slowing time. @'stretch' n a@ will take one+-- input, repeat the same output @n@ times (ignoring input), and then take+-- another. It ignores all inputs in between.+--+-- >>> let a = stretch 2 (sumFrom 0)+-- >>> streamAuto' a [1,8,5,4,3,7,2,0]+-- [1,1,6,6,9,9,11,11]+-- -- [1,_,5,_,3,_,2 ,_ ] <-- the inputs+stretch :: (Serialize b, Monad m)+ => Int -- ^ stretching factor+ -> Auto m a b -- ^ 'Auto' to stretch+ -> Auto m a b+stretch n = go (1, undefined)+ where+ go (i, y) a = mkAutoM (go <$> get <*> resumeAuto a)+ (put (i, y) *> saveAuto a)+ $ \x ->+ if i <= 1+ then do+ (y', a') <- stepAuto a x+ return (y', go (n , y') a')+ else+ return (y , go (i - 1, y ) a )+++-- | The non-resuming/non-serializing version of 'stretch'.+stretch_ :: Monad m+ => Int -- ^ stretching factor+ -> Auto m a b -- ^ 'Auto' to stretch+ -> Auto m a b+stretch_ n = go (1, undefined)+ where+ go (i, y) a = mkAutoM_ $ \x ->+ if i <= 1+ then do+ (y', a') <- stepAuto a x+ return (y, go (n , y') a')+ else+ return (y, go (i - 1, y ) a )++-- | Like 'stretch', but instead of holding the the "stretched" outputs,+-- outputs a blip stream that emits every time the stretched 'Auto'+-- "progresses" (every @n@ ticks)+--+-- See 'stretch' for more information.+--+-- >>> let a = stretchB 2 (accum (+) 0)+-- >>> streamAuto' a [1,8,5,4,3,7,2,0]+-- [Blip 1, NoBlip, Blip 6, NoBlip, Blip 9, NoBlip, Blip 11, NoBlip]+--+stretchB :: Monad m+ => Int -- ^ stretching factor+ -> Auto m a b -- ^ 'Auto' to stretch+ -> Auto m a (Blip b)+stretchB (max 1 -> n) = go 1+ where+ go i a = mkAutoM (go <$> get <*> resumeAuto a)+ (put i *> saveAuto a)+ $ \x ->+ if i <= 1+ then do+ (y, a') <- stepAuto a x+ return (Blip y, go n a')+ else+ return (NoBlip, go (i - 1) a )++-- | "Accelerates" the 'Auto', so instead of taking an @a@ and returning+-- a @b@, it takes a list of @a@, "streams" the 'Auto' over each one, and+-- returns a list of @b@ results.+--+-- For example, if you normally feed @'sumFrom' 0@ a 1, then a 2, then a 3,+-- you'd get a 1, then a 3, then a 6. But if you feed+-- @'accelOverList' ('sumFrom' 0)@ a @[1,2]@, you'd get a @[1,3]@, and if+-- you fed it a @[3]@ after, you'd get a @[6]@.+--+-- Turns a @[a] -> [b]@ into an @[[a]] -> [[b]]@; if you "chunk up" the+-- input stream @a@s into chunks of input to feed all at once, the outputs+-- @b@ will be chunked up the same way.+--+-- >>> streamAuto' (sumFrom 0) [1,2,3,4,5,6,7,8]+-- [1,3,6,10,15,21,28,36]+-- >>> streamAuto' (accelOverList (sumFrom 0)) [[1,2],[],[3,4,5],[6],[7,8]]+-- [[1,3],[],[6,10,15],[21],[28,36]]+--+-- Mostly useful if you want to feed an 'Auto' multiple inputs in the same+-- step. Note that if you always feed in singleton lists (lists with one+-- item), you'll more or less get the same behavior as normal.+--+accelOverList :: Monad m+ => Auto m a b -- ^ 'Auto' to accelerate+ -> Auto m [a] [b]+accelOverList = go+ where+ go a0 = mkAutoM (go <$> resumeAuto a0)+ (saveAuto a0)+ $ \xs -> do+ (a1, ysEndo) <- runWriterT (wr a0 xs)+ let ys = appEndo ysEndo []+ return (ys, go a1)+ wr a0 [] = return a0+ wr a0 (x:xs) = do+ (y, a1) <- lift $ stepAuto a0 x+ tell $ Endo (y:) -- using a diff list for performace;+ -- this is basically `tell [y]`+ wr a1 xs++-- | @'accelerate' n a@ turns an 'Auto' @a@ into an "accelerated" 'Auto',+-- where every input is fed into the 'Auto' @n@ times. All of the results+-- are collected in the output.+--+-- The same input is fed repeatedly @n@ times.+--+-- >>> streamAuto' (accelerate 3 (sumFrom 0)) [2,3,4]+-- [[2,4,6],[9,12,15],[19,23,27]]+-- -- ^adding 2s ^adding 3s ^adding 4s+--+accelerate :: Monad m+ => Int -- ^ acceleration factor+ -> Auto m a b -- ^ 'Auto' to accelerate+ -> Auto m a [b]+accelerate n = go+ where+ n' = max n 1+ go a0 = mkAutoM (go <$> resumeAuto a0)+ (saveAuto a0)+ $ \x0 -> do+ yas <- flip (iterateM n') (undefined, a0)+ $ \(_, a) -> do+ (x, a') <- stepAuto a x0+ x `seq` return (x, a')+ let ys = map fst yas+ a' = snd (last yas)+ return (ys, go a')+{-# INLINE accelerate #-}++-- | @'accelerateWith' xd n a@ is like @'accelerate' n a@, except instead+-- of feeding in the input @n@ times, it feeds the input in once and+-- repeats the "filler" @xd@ for the rest of the accelerating period.+--+-- >>> streamAuto' (accelerateWith (-1) 3 (sumFrom 0)) [1,10,100]+-- [[1,0,-1],[9,8,7],[107,106,105]]+-- -- ^ feed in 1 once and -1 twice+-- -- ^ feed in 10 once and -1 twice+-- -- ^ feed in 100 once and -1 twice+accelerateWith :: Monad m+ => a -- ^ default input value, during acceleration periods+ -> Int -- ^ acceleration factor+ -> Auto m a b -- ^ 'Auto' to accelerate+ -> Auto m a [b]+accelerateWith xd n | n <= 1 = fmap (:[])+ | otherwise = go+ where+ n' = n - 1+ go a0 = mkAutoM (go <$> resumeAuto a0)+ (saveAuto a0)+ $ \x0 -> do+ (y0, a1) <- stepAuto a0 x0+ yas <- flip (iterateM n') (undefined, a1)+ $ \(_, a) -> do+ (x, a') <- stepAuto a xd+ return (x, a')+ let ys = y0 : map fst yas+ a' = snd (last yas)+ return (ys, go a')++-- | Takes an 'Auto' that produces @(b, 'Blip' c)@, and turns it into an+-- 'Auto' that produces @([b], c)@.+--+-- Basically, the new 'Auto' "squishes together" the periods of output+-- between each time the blip stream emits. All outputs between each+-- emitted value are accumulated and returned in the resulting @[b]@.+--+-- It "does this" in the same manner as 'accelerateWith' and 'fastForward':+-- first feed the input, then step repeatedly with the default input value.+--+-- >>> let a :: Auto' Int (Int, Blip String)+-- a = proc i -> do+-- sums <- sumFrom 0 -< i+-- blp <- every 3 -< i -- emits every 3 ticks.+-- id -< (sums, sums <& blp) -- replace emitted value+-- -- with the running sum+-- >>> let skipA :: Auto' Int ([Int], String)+-- skipA = skipTo (-1) a+-- >>> let (res1, skipA') = stepAuto' skipA 8+-- >>> res1+-- ([8,7,6], 6) -- fed 8 first, then (-1) repeatedly+-- >>> let (res2, _ ) = evalAuto skipA' 5+-- >>> res2+-- ([11,10,9], 9) -- fed 5 first, then (-1) repeatedly+--+-- If the blip stream never emits then stepping this and getting the result+-- or the next/updated 'Auto' never terminates...so watch out!+--+skipTo :: Monad m+ => a -- ^ default input value, during+ -- skipping periods+ -> Auto m a (b, Blip c) -- ^ 'Auto' to skip over, until each time+ -- the blip stream emits+ -> Auto m a ([b], c)+skipTo x0 = go+ where+ -- go :: Auto m a (b, Blip c)+ -- -> Auto m a ([b], c)+ go a0 = mkAutoM (go <$> resumeAuto a0)+ (saveAuto a0)+ $ \x -> do+ ((ys, z), a1) <- skipOut a0 x []+ return ((reverse ys, z), go a1)+ -- skipOut :: Auto m a (b, Blip c)+ -- -> a+ -- -> [b]+ -- -> m (([b], c), Auto m a (b, Blip c))+ skipOut a0 x ys = do+ ((y, bz), a1) <- stepAuto a0 x+ let ys' = y:ys+ case bz of+ Blip z -> return ((ys', z), a1)+ NoBlip -> skipOut a1 x0 ys'++-- | Turns an @'Interval' m a b@ into an @'Auto' m a b@ --- that is, an+-- @'Auto' m a (Maybe b)@ into an @'Auto' m a b@.+--+-- It does this by "skipping over" all "off"/'Nothing' input. When the+-- result "should" be a 'Nothing', it re-runs the 'Interval' over and over+-- again with the given default input until the 'Auto' turns back "on"+-- again (outputs a 'Just').+--+-- If the 'Interval' reaches a point where it will never be "on" again,+-- stepping this and getting the result or the next/updated 'Auto' won't+-- terminate...so watch out!+--+-- >>> let a1 = offFor 3 . sumFrom 0+-- >>> streamAuto' a1 [1..10]+-- [Nothing, Nothing, Nothing, Just 10, Just 15, Just 21]+-- >>> streamAuto' (fastForward 0 a1) [1..6]+-- [1,3,6,10,15,21]+-- >>> streamAuto' (fastForward (-10) a1) [1..6]+-- [-29,-27,-24,-20,-15,-9]+--+-- In that last example, the first input is 1, then it inputs (-10) until+-- it is "on"/'Just' again (on the fourth step). Then continues imputing+-- 2, 3, 4 etc.+--+fastForward :: Monad m+ => a -- ^ default input+ -> Interval m a b -- ^ 'Interval' to fastforward (past each "off" period, or 'Nothing')+ -> Auto m a b+fastForward x0 = go+ where+ -- go :: Auto m a (Maybe b)+ -- -> Auto m a b+ go a0 = mkAutoM (go <$> resumeAuto a0)+ (saveAuto a0)+ (skipNothings a0)+ -- skipNothings :: Auto m a (Maybe b) -> a -> m (b, Auto m a b)+ skipNothings a0 x = do+ (my, a1) <- stepAuto a0 x+ case my of+ Nothing -> skipNothings a1 x0+ Just y -> return (y, go a1)++-- | Same behavior as 'fastForward', except accumulates all of the @'Left'+-- c@ outputs in a list.+fastForwardEither :: Monad m+ => a -- ^ default input+ -> Auto m a (Either c b) -- ^ 'Auto' to fast-forward (past each 'Left')+ -> Auto m a (b, [c])+fastForwardEither x0 = fmap (second reverse) . go+ where+ -- go :: Auto m a (Either c b)+ -- -> Auto m a (b, [c])+ go a0 = mkAutoM (go <$> resumeAuto a0)+ (saveAuto a0)+ (skipNothings a0 [])+ -- skipNothings :: Auto m a (Either c b)+ -- -> [c]+ -- -> a+ -- -> m ((b, [c]), Auto m a (b, [c]))+ skipNothings a0 zs x = do+ (ey, a1) <- stepAuto a0 x+ case ey of+ Left z -> skipNothings a1 (z:zs) x0+ Right y -> return ((y, zs), go a1)++iterateM :: Monad m => Int -> (a -> m a) -> a -> m [a]+iterateM n f = go (max n 0)+ where+ go 0 _ = return []+ go i x = do+ x' <- f x+ xs <- go (i - 1) x'+ return (x' : xs)++-- | When first asked for output, "primes" the 'Auto' first by streaming it+-- with all of the given inputs first before processing the first input.+-- Aterwards, behaves like normal.+--+-- >>> streamAuto' (priming [1,2,3] (sumFrom 0)) [1..10]+-- [7,9,12,16,21,27,34,42,51,61]+--+-- The 'Auto' behaves as if it had already "processed" the @[1,2,3]@,+-- resulting in an accumulator of 6, before it starts taking in any input.+--+-- Normally this would be silly with an 'Auto'', because the above is the+-- same as:+--+-- >>> let (_, a) = overList' (sumFrom 0) [1,2,3]+-- >>> streamAuto' a [1..10]+-- [7,9,12,16,21,27,34,42,51,61]+--+-- This becomes somewhat more useful when you have "monadic" 'Auto's, and+-- want to defer the execution until during normal stepping:+--+-- >>> _ <- streamAuto (priming [1,2,3] (arrM print)) [10,11,12]+-- 1 -- IO effects+-- 2+-- 3+-- 10+-- 11+-- 12+priming :: Monad m+ => [a] -- ^ inputs to prime with+ -> Auto m a b -- ^ 'Auto' to prime+ -> Auto m a b+priming xs a0 = mkAutoM l+ (put False)+ $ \x -> do+ (_, a1) <- overList a0 xs+ (y, a2) <- stepAuto a1 x+ return (y, primed a2)+ where+ primed a1 = mkAutoM l+ (put True *> saveAuto a1)+ $ \x -> do+ (y, a2) <- stepAuto a1 x+ return (y, primed a2)+ l = do+ flag <- get+ if flag+ then primed <$> resumeAuto a0+ else return $ priming xs a0+
+ tutorial/tutorial.md view
@@ -0,0 +1,1042 @@+Auto+====++Welcome to the tutorial for getting started with Auto!++This is actually just a basic overview of the library and some basic programs,+enough to get started, hopefully; for further information, check out+[auto-examples][] for more real-world examples, and some of my writeups on [my+blog][blog]. Up-to-date documentation is, at the moment, hosted [on+github][docs]...and the latest version of this tutorial itself can be found on+[the development branch][tutorial], normally!++[auto-examples]: https://github.com/mstksg/auto-examples+[blog]: http://blog.jle.im+[docs]: https://mstksg.github.io/auto/+[tutorial]: https://github.com/mstksg/auto/blob/develop/tutorial/tutorial.md++Auto+----++Before we start, let's remember our imports!++~~~haskell+import Control.Auto -- the main entry point+import Prelude hiding ((.), id) -- we use generalized versions from+ -- Control.Category, so we have to hide+ -- these.+~~~++### Semantic Picture++Semantically, a `Auto` describes *a relationship* between an input and an+output that is preserved over multiple steps.++In a way, you can think about `Auto`s as *stream transformers*. A stream of+sequential inputs come in one at a time, and a stream of outputs pop out one+at a time as well. You can think of `streamAuto'` as taking an `Auto' a b`+and "unwrapping" its internal `[a] -> [b]`.++An `Auto` is a relationship; the simplest relationship is probably a straight+up apply-a-function-to-each-input-to-get-each-output relationship. For that,+check out the `Auto` `arr (*2)`, where the outputs are the doubles of the+inputs:++~~~haskell+-- streamAuto' :: Auto' a b -> [a] -> [b]+-- [ 1, 2, 3, 4, 5, 6, 7, 8, 9,10... -- the inputs+ghci> take 10 $ streamAuto' (arr (*2)) [1..]+ [ 2, 4, 6, 8,10,12,14,16,18,20] -- the outputs+~~~++`streamAuto' (arr f)` is just `map f`, as you can see!++In general, the input-output relationship is allowed to depend on the history+of the inputs, as well. For example, we have the `Auto` `sumFrom 0` --- the+relationship is that the output is always the cumulative sum of the inputs+received so far:++~~~haskell+-- [ 1, 2, 3, 4, 5, 6, 7, 8, 9,10... -- the inputs+ghci> take 10 $ streamAuto' (sumFrom 0) [1..]+ [ 1, 3, 6,10,15,21,28,36,45,55] -- the outputs+~~~++A bit on types --- `sumFrom n` is `Num a => Auto m a a` ... or, if+specializing it helps, `Auto' Int Int`. You can read this as "a relationship+between two `Int`s fixed over the stream", or "a one-by-one mapping of an+`Int` stream to another `Int` stream". For `sumFrom n`, the relationship is+that the output is always the cumulative sum of the inputs.++Note that these relationships are always *causual*; the nth item of the output+can only depend on the first n items of the input. We say that they are+"real-time" stream transformers in that every time you get an input, exactly+one output pops out.++That's what they are semantically, and an `Auto` denotes exactly such an+input-output relationship that is maintained over several steps.++### Operational picture++Operationally, an `Auto` does this by acting as a "stateful function" that we+can "run" with `stepAuto`. A function with "internal state".++~~~haskell+-- stepAuto' :: Auto' a b -> a -> (b, Auto' a b)+ghci> let (x, nextAuto ) = stepAuto' (sumFrom 0) 5+ghci> x+5+ghci> let (y, nextAuto2) = stepAuto' nextAuto 3+ghci> y+8+ghci> evalAuto' nextAuto2 4+12+~~~++`stepAuto'` lets you take an `Auto' a b`, give it an `a` as an input, and+returns an `b` as the output, and a "next/updated `Auto'`", which is the+`Auto'` with an updated internal state. Running the "next `Auto'`" given will+continue along with the new updated state. (`evalAuto'` is like `stepAuto'`+but throws away the "next `Auto`") In this case, the "internal state" is an+accumulator, the sum of all received elements so far.++In practice, this is usually going to be your "main loop", or "game loop":++1. Collect input from the world (using IO, or whatever you need)+2. Step the `Auto` you have with that input.+3. Get the output from that `Auto`, and the next `Auto`+4. Show or render your output to the world however you want.+5. Repeat all again, but with the new `Auto` from step 3.++(If your program doesn't need any outside input, then you can just use+`stepAutoN` with `()`, or `streamAuto'` with an infinite list.)++There are some built-in "loops" like this in the *[Control.Auto.Run][]*+module, for running in `IO` by reading and showing inputs and ouputs+(`interactAuto`, `interactRS`) if you want to try these out!++What's in a type?+-----------------++Enough handwaving! What do these types even mean? What are the type+parameters?++An `Auto' a b` describes *a relationship* between a stream of inputs `a` and a+stream of outputs `b` that is maintained over several steps of inputs.++One way to look at it is that, with `streamAuto'` an `Auto' a b` gives you the+"unwrapped" `[a] -> [b]`.++From an operational perspective, you can think of an `Auto' a b` as a function+with internal state that, when fed an `a`, gives you a `b` and a "next/updated+`Auto`". With `stepAuto'`, an `Auto' a b` gives you an `a -> (b, Auto' a b)`.+An `Auto' a b` is basically a `a -> b` with "internal state".++The more general type is actually `Auto m a b` --- an `Auto' a b` is actaully+just a type alias for `Auto Identity a b`.++An `Auto m a b` describes *a relationship*, again, between a stream of inputs+`a` and a stream of outputs `b` maintained over several steps of inputs...and+maintains this relationship with within an underlying monadic context `m`.++If `streamAuto'` from an `Auto' a b` gives you an `[a] -> [b]`, then+`streamAuto` from an `Auto m a b` gives you the "unwrapped" `[a] -> m [b]`.++Operationally, if `Auto' a b` is a `a -> b` with internal state, then `Auto m+a b` is a `a -> m b` with internal state. If you feed it an `a`, it'll return+a `b` and a "next/updated `Auto`" in a monadic context --- with `stepAuto`,+you get a `a -> m (b, Auto m a b)`.++This monadic context means that in the process of "stepping" or "running" the+`Auto`, you can perform effects and get input from an outside world.++For the most part, real-life `Auto`s will be written parameterized over+`Monad` or some `Monad`-based typeclass:++~~~haskell+myAuto :: Monad m => Auto m Int Bool+~~~++Working with `Monad m => Auto m a b` is practically identical to working with+`Auto' a b`, so there really isn't ever a real point to actually *write* an+`Auto'`. However, specializing to `Auto'` lets us use simple "running"+functions like `streamAuto'` and `stepAuto'`.++While we're on the subject, there is another type alias for `Auto`s: an+`Interval m a b` is an `Auto m a (Maybe b)` (they're just type aliases).+Semantically, it represents an `Auto` that is "on" or "off" for durations of+steps. Similarly, `Interval' a b` is an `Auto' a (Maybe b)`. You get the+picture, I hope! We'll learn more about `Interval` later.++Building up Autos+-----------------++So of course, having simple `Auto`s like this being your whole program isn't+very reasonable...do you think I have a `chatBot` or `chessEngine` `Auto` in+the library? :)++The "magic" of this library is that you have the ability to build up complex+and intricate relationships and behaviors (and programs) by composing small+"primitive" `Auto`s. These combinators are exposed both through familiar+typeclasses we know and love, and also through functions in this library.++### Modifying and combining `Auto`s++For example, with the `Functor` instance, you can apply functions to the+"output" of an `Auto`:++~~~haskell+ghci> streamAuto' (sumFrom 0) [1..5]+[ 1 , 3 , 6 , 10 , 15 ]+ghci> streamAuto' (show <$> sumFrom 0) [1..5]+["1","3","6","10","15"]+~~~++`lmap` from `Profunctor` lets you apply functions "before" the input of the+`Auto`:++~~~haskell+-- mappender :: Monoid m => Auto' m m+ghci> streamAuto' mappender ["1","2","3"]+["1","12","123"]+ghci> streamAuto' (lmap show mappender) [1,2,3]+["1","12","123"]+~~~++(`mappender` is an `Auto` where the output is always the cumulative `mconcat`+of all of the inputs so far)++The `Applicative` instance gives you a "constant `Auto`", which ignores its+input and whose output is always a constant value:++~~~haskell+ghci> take 10 $ streamAuto' (pure 4) [1..]+[4, 4, 4, 4, 4, 4, 4, 4, 4, 4]+~~~++The `Applicative` instance also gives you the ability to "fork" the input+streams of two `Auto`s and then re-combine their output streams later:++~~~haskell+ghci> streamAuto' (sumFrom 0) [1..5]+[ 1, 3, 6, 10, 15]+ghci> streamAuto' (productFrom 1) [1..5]+[ 1, 2, 6, 24, 120]+ghci> streamAuto' (liftA2 (+) (sumFrom 0) (productFrom 1)) [1..5]+[ 2, 5, 12, 34, 135]+~~~++You can also "fork" an input stream to two `Auto`s, and then throw away the+output stream of one: (very useful for `Auto`s like `effect`, which we will+see later, where we only care about the monadic effects and not about the+actual output stream)++~~~haskell+ghci> streamAuto' (sumFrom 0 *> productFrom 1) [1..5]+[ 1, 2, 6, 24, 120]+ghci> streamAuto' (sumFrom 0 <* productFrom 1) [1..5]+[ 1, 3, 6, 10, 15]+~~~++Heck, you can even `sequenceA` several!++~~~haskell+sequenceA :: [Auto m a b] -> Auto m a [b]+~~~++It will take a list of `Auto`s and return an `Auto` that "forks" the input+stream into *all* of the original `Auto`s and aggregates together all of the+output streams. A multi-way fork.++We also have the Applicative-derived instances like `Monoid`, so any `Auto m+a b` is a `Monoid` if `b` is a `Monoid`.++~~~haskell+mconcat :: Monoid m => [Auto m a b] -> Auto m a b+~~~++A lot of times you'll have a lot of things handling the same input in+different ways, and you'll want to recombine them all at the end. Well,+`mconcat`, `sequence`, etc. are at your service!++This is the principle of "[scalable program architectures][spa]" at work!+The `mappend` of two `Auto`s is...another `Auto`!++[spa]: http://www.haskellforall.com/2014/04/scalable-program-architectures.html++Of course there the Applicative-derived `Num` (and assorted numerical+instances) too:++~~~haskell+ghci> streamAuto' (0 * sumFrom 0) [1..5]+[0, 0, 0, 0, 0,]+ghci> streamAuto' (negate (sumFrom 0)) [1..5]+[-1, -3, -6, -10, -15]+ghci> streamAuto' (10 + sumFrom 0) [1..5]+[11, 13, 16, 20, 25]+ghci> streamAuto' (sumFrom 0 + productFrom 1) [1..5]+[ 2, 5, 12, 34, 135]+~~~++Just don't go too crazy with these, okay?++Now, the `Category` instance is probably the most powerful tool at your+disposal. As a first treat, it gives you `id :: Auto m a a`, an `Auto` whose+output is always exactly the corresponding input.++But more importantly, you can "chain together" `Auto`s end-to-end. Compose+them as if they were functions.++You know how an `Auto` takes a stream and outputs a stream? Well,+"chaining"/"composing" two `Auto`s will "pipe together" the streams. `a2 .+a1` will be a new `Auto` that runs an input stream through both `a1` and `a2`.++~~~haskell+ghci> streamAuto' (sumFrom 0) [1..5]+[1,3,6,10,15]+ghci> streamAuto' (productFrom 1) [1,3,6,10,15]+[1,3,18,180,2700]+ghci> streamAuto' (productFrom 1 . sumFrom 0) [1..5]+[1,3,18,180,2700]+~~~++`sumFrom 0`'s output stream is the cumulative sum of the input stream.+`productFrom 1`'s output stream is the cumulative product of the input stream.+So their chaining/piping/composition is the cumulative product of the+cumulative sum.++~~~haskell+(.) :: Auto m b c -> Auto m a b -> Auto m a c+~~~++If you imagine an `Auto'` as an `[a] -> [b]`, then you can think of this as+"composing" the `[a] -> [b]` functions:++~~~haskell+-- streamAuto' gives us an [Int] -> [Int], so we can compose them using normal+-- function composition:+ghci> streamAuto' (productFrom 1) . streamAuto' (sumFrom 0) $ [1..5]+[1,3,18,180,2700]+-- composing `Auto`s is like composing their resulting `[a] -> [b]`s+ghci> streamAuto' (productFrom 1 . sumFrom 0) $ [1..5]+[1,3,18,180,2700]+~~~++(Math nuts might recognize this as saying that `streamAuto'` is a "category+homomorphism"...aka, a functr :) Seeing that `streamAuto' (id :: Auto' a a)+== (id :: [a] -> [a])`, of course!)++Operationally, at every "step", it passes in each input to the first `Auto`,+and gets the output of that and passes it into the second `Auto`, and uses the+output of the second `Auto` as the result, updating *each* internal state.++Another example, here we have an `Auto` that takes an input stream and and+outputs a `Blip` stream (more on that later) that emits whenever there is a+multiple of 5:++~~~haskell+ -- emitOn5s :: Auto' Int (Blip Int)+ghci> let emitOn5s = emitOn (\x -> x `mod` 5 == 0)+ghci> streamAuto' emitOn5s [1,5,9,3,10,2]+[NoBlip, Blip 5, NoBlip, NoBlip, Blip 10, NoBlip]+ghci> streamAuto' (hold . emitOn5s) [1,5,9,3,10,2]+[Nothing, Just 5, Just 5, Just 5, Just 10, Just 10]+~~~++`hold :: Auto' (Blip a) (Maybe a)` takes a stream of `Blip`s and returns a+stream that is `Maybe a`, where it is `Nothing` until the first emitted `Blip`+value, and `Just x` as the last received `Blip` value.++So here, we "chain" `hold` onto `emitOn5s`. `emitOn5s` emits on everything+that is a multiple of `5`, and `hold` "holds on" to all of the emitted values.+Neat!++This can be used in conjunction with the `Applicative` instance for great+power. In the end, your programs will really just be `(.)`-composed `Auto`s+with forks and re-cominings from `Applicative` and `Arrow` methods.++Speaking of `Arrow`, we also have a neat interface exposed by `Arrow`,+`ArrowPlus`, and `ArrowLoop`. First of all, we get `arr :: (a -> b) -> Auto m+a b`, which basically an `Auto` that is a constant, pure function (the output+is the corresponding input applied to the given function). But more+importantly, we get proc notation!++~~~haskell+foo :: Auto' Int (Int, Maybe Int)+foo = proc x -> do+ sumX <- sumFrom 0 -< x+ prodX <- productFrom 1 -< x + sumX+ lastEven <- hold . emitOn even -< x+ id -< (prodX, lastEven)+~~~++~~~haskell+ghci> streamAuto' foo [4,7,3,6,5,1]+[ ( 4, Just 4), ( 144, Just 4), ( 2448, Just 4)+, (63648, Just 6), (1909440, Just 6), (51554880, Just 6) ]+~~~++Most of what was just done could be written with the `Applicative`+instance as well...but in this way, the entire thing looks a lot like a+dependency graph, and it's pretty expressive and powerful.++#### Brief Primer on Proc Notation++An explanation on the syntax; when you see:++~~~haskell+sumX <- sumFrom 0 -< x+~~~++This reads as you are defining a binding `sumX`, and *the relationship between+sumX and x* is that `sumX` is the *cumulative sum* of `x`.++(from the first line, `foo = proc x -> do`, `x` is the input of the entire+`Auto`)++When we see:++~~~haskell+prodX <- productFrom 1 -< x + sumX+~~~++This reads as you are defining a binding `prodX`, and `prodX` is maintained as+the cumulative product of `x + sumX`.++The result of the last line of the proc block is the result of the entire+block:++~~~haskell+id -< (prodX, lastEven)+~~~++Means that the output of the entire block is just echoing the tuple `(prodX,+lastEven)`.++(Operationally, you can imagine that, at every step, `x` is "fed into"+`sumFrom 0`, and the result is named `sumX`; `x + sumX` is "fed into"+`productFrom 1`, etc.)++The power here is that it really reads like a straight-up dependency graph...a+graph of relationships to names. Lay out your relationships explicitly and+declaratively, and the library takes care of the rest! The semantic model of+an `Auto` representing a maintained relationship is made very clear in `proc`+notation.++Later on you can see that `proc` blocks can be pretty expressive --- using+if/then's and case statements, and also recursive bindings (so you can even+declare recursive graphs of concepts, and the library will figure out how to+solve it for you).++By the way, there are some "scoping" issues to be aware of. Remember that+proc more or less builds a graph of relationships between values using `Auto`s+at compile-time; the whole graph and chaining-together-of-`Auto`s is done at+compile time. So, the `Auto`s themselves have to be known at compile time.+We can't do someothing like this:++~~~haskell+foo :: Auto' Int Int+foo = proc x -> do+ y <- productFrom 1 -< x+ z <- sumFrom y -< x+ id -< y + z+~~~++We can't do `sumFrom y`, because `y` is not an actual value that we have at+"compile"/"building" time. `y` is what we're calling the result of+`productFrom 1`, at every step, so its value changes at every step, and every+`Auto` has to be a **fixed `Auto`**. Remember, `Auto` relationships are+"forever" and fixed, declaritive style. So the `Auto` where `sumFrom` is,+there, has to be a fixed thing that doesn't change at every step...but `y` is+a value that will very as the stream marches on.++You can however do something like:++~~~haskell+bar :: Int -> Auto' Int Int+bar x0 = proc x -> do+ y <- productFrom 1 -< x+ z <- sumFrom x0 -< x+ id -< y + z+~~~++Because when we are "building" `bar x0`, we *have* `x0`! It'll be `sumFrom+x0`, forever!++### Anyways!++Anyways! Those are the primary typeclass based interfaces; explore the+library for more!++### From scratch++If you have to, when creating `Auto`s from scratch, we have:++~~~haskell+pure :: b -> Auto m a b+effect :: m b -> Auto m a b+arr :: (a -> b) -> Auto m a b+arrM :: (a -> m b) -> Auto m a b+~~~++`pure` and `effect` give you "constant-producing `Auto`"s that ignore their+input; `pure x` is an `Auto` that ignores its input and always outputs `x`.+`effect m` is an `Auto` that ignores its input and executes/sequences `m` at+every "step", and outputs the result at every step. `arr` is an `Auto` that+maps every input to an output by running a pure function, and `arrM` is an+`Auto` that does the same but with a "monadic" function.++Here is a handy little summary!++~~~haskell+streamAuto' (pure x) == map (const x)+streamAuto (effect m) == mapM (const m)+streamAuto' (arr f) == map f+streamauto (arrM f) == mapM f+~~~++None of these `Auto`s have "internal state"; however, we can make our own+internally stateful `Auto`s from scratch:++~~~haskell+iterator :: (b -> b) -> b -> Auto m a b+iteratorM :: (b -> m b) -> b -> Auto m a b+accum :: (b -> a -> b) -> b -> Auto m a b+accumM :: (b -> a -> m b) -> b -> Auto m a b+mkState :: (a -> s -> (b, s)) -> s -> Auto m a b+mkStateM :: (a -> s -> m (b, s)) -> s -> Auto m a b+mkAuto_ :: (a -> (b, Auto m a b)) -> Auto m a b+mkAutoM_ :: (a -> m (b, Auto m a b)) -> Auto m a b+~~~++You can look at the documentation for all of these, but these all basically+work with "internal state" --- `iterator` ignores its input and repeatedly+applies a function to a value and pops it out at every step. `accum`+maintains that the *output* is always the result of "folding together" (a la+`foldl`) all of the inputs so far, with a starting value. `mkState` is+like a more powerful `accum`, which keeps an internal state that is updated+at every step. `mkAuto_` lets you describe an `Auto` by its behavior under+`stepAuto'`.++~~~haskell+ghci> take 10 $ streamAuto' (iterator (+1) 0) (repeat ())+[0,1,2,3,4,5,6,7,8,9]+ghci> take 10 $ streamAuto' (accum (+) 0) [1..]+[1,3,6,10,15,21,28,36,45,55]+~~~++It is recommended to only use `accum`, `mkState`, `mkAuto` only when+absolutely necessary; usually you can make what you want from combining+smaller, simple, pre-made `Auto`s. But sometimes the case does arrive.++The Big Picture+---------------++So, at this point, let's look at the "big picture". A program written with+`Auto` will involve, at every "step", gathering input, feeding into the+"master program `Auto`", getting the output, rendering it somehow, and+repeating. But how do we build our `Auto`? What is the advantage of using+`Auto` instead of `State`, etc.?++`Auto` lets you compose little meaning-bits into more complex meaning bits, by+specifying *invariant relationships* between *items of streams*. These are+"forever-relationships" --- they don't just describe step-by-step, iterative,+stateful actions --- they describe invariant relationships. And you can+create your own by composing, modifying, chaining, etc. all of the primitives.++Building a program in `Auto` is basically specifying relationships that are+maintained "forever"...and thinking about your program in that manner.++For example:++~~~haskell+sumAndProd :: Auto' Int Int+sumAndProd = proc x -> do+ sumX <- sumFrom 0 -< x+ prodX <- productFrom 1 -< x+ id -< sumX + prodX++-- sumAndProd = liftA2 (+) (sumFrom 0) (productFrom 1)+~~~++`sumX` is a "forever" quantity...and so is `x`. We say that the relationship+between `sumX` and `x` is that `sumX` is the cumulative sum (`sumFrom 0`) of+`x`. The relationship between `prodX` and `x` is that `prodX` is the+cumulative product...and the relationship between `x` and the output is that+the output is the sum of `sumX` and `prodX` at every point in time.++Operationally, you also have a huge advantage here over using something like+`State` in that each `Auto` really contains its own "internal state" that is+inaccessible by the world. For example, in that last example, `sumFrom 0`+works by maintaining its own internal state. `productFrom 1` also maintains+its own internal state.++Nobody can ever "touch" or "inspect" the internal state of `sumFrom 0` and+`prudctFrom 1`. It maintains it on its own. This is in big contrast to+`State`-based solutions, which necessarily work on "global state", and+managing global vs. local state with monad morphisms.++Note that this "composes"; we can use `sumAndProd` in another `Auto`:++~~~haskell+foo :: Auto' Int String+foo = proc x -> do+ sp <- sumAndProd -< x+ y <- blah blah -< sp + x+ id -< show y+~~~++And `sumAndProd` now is its own "internally stateful" thing...you can take it+and pop it onto any other chain. In `State`, you'd open yourself up to having+to create new sum types for extra state...whenever you combined any two+stateful operations on different states.++This locally stateful property truly allows us to "compose" ideas together and+relationships together and think of them as fixed invariants in a big picture.+Because each `Auto` "denotes" a relationship, and we build up bigger `Auto`s+by combining small denotative promitives to create bigger things that denote+more complex relationships, it really allows us to create a denotative+"language", where we declare relationships by building up smaller units of+meaning into bigger units of meaning.++Now...how do we actually implement the behavior that we want? This is a job+for the primitive `Auto`s, but also really much a big job for ... the semantic+tools that come with the library!++Semantic Tools+--------------++An `Auto` represents a relationship between an input stream and an output+stream, but in order to build more expressive programs, this library also+comes with more semantic tools to work with in characterizing your streams+with "meaning", and tools to manipulate them and compose them in powerful ways+(within this framework of meaning) to express your programs.++The two main ones are `Blip` and `Interval`.++### Blip++We say that, 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.++This isn't enforced by the type system, but almost all of the `Auto`s offered+in this library will preserve this property! And we encourage any that you+make to also preserve this property, in order to make "blip streams" *useful+in the first place*.++We saw an example earlier,++~~~haskell+ghci> let emitOn5s = emitOn (\x -> x `mod` 5 == 0)+ghci> streamAuto' emitOn5s [1,5,9,3,10,2]+[NoBlip, Blip 5, NoBlip, NoBlip, Blip 10, NoBlip]+~~~++Let's see if we can play around with it! Well, we can "tag" blip emissions:++~~~haskell+ghci> streamAuto' (tagBlips "hey" . emitOn5s) [1,5,9,3,10,2]+[NoBlip, Blip "hey", NoBlip, NoBlip, Blip "hey", NoBlip]+~~~++And with proc blocks, we can even "name" blip streams and manipulate them as+streams! Oh, also, `Blip` is a `Functor`, so you can use `fmap` and `(<$)`.++~~~haskell+blippy :: Monad m => Auto m Int String+blippy = proc x -> do+ on3s <- tagBlips "3!" . emitOn3s -< x+ on5s' <- emitOn5s -< x+ let on5s = "5!" <$ on5s -- from Data.Functor: replace all emitted+ -- values with the string "5!"+ on35s = on3s `mergeL` on5s -- merge the streams, favoring the left+ intro <- immediately -< "hello!"+ middle <- inB 6 -< "#6!"+ wut <- never -< "this should never happen!"+ id -< mergeLs [never, intro, middle, on35s] -- merge all, favoring firsts+~~~++~~~haskell+ghci> streamAuto' blippy [5,7,15,10,13,15,2]+[Blip "hello!", NoBlip, Blip "3!", Blip "5!", NoBlip, Blip "#6!", NoBlip]+-- ^ intro ^ on3s ^ on5s ^ middle+~~~++Blip streams and "blip contracts"/"blip semantics" are useful because a lot of+the other semantic abstractions in `Auto` (like switches, and `Interval`) all+work with the "idea" of a "discrete", occasional, conceptually+"non-contiguous" blip stream.++Check out all of the built-in blip stream combinators at+*[Control.Auto.Blip][]*.++### Interval++The "opposite" of `Blip` and blip streams are "intervaled" `Auto`s: `Auto`s+that are "on" or "off" for (conceptually) contiguous chunks of steps.++An `Interval' a b` represents an `Auto` that takes a stream of `a`s as input,+and outputs a stream of `b`s that is "on" or "off", at contiguous swaths.++In truth, `Interval' a b` is just a type synonym for `Auto' a (Maybe b)`, and+`Interval m a b` is just a type synonym for `Auto m a (Maybe b)`. But, if you+see a library auto with type `Interval`, or if you make an auto with type+`Interval`, it comes with "contracts". These contracts help us really use+`Interval`s in a meaningful way --- that they are supposed to represent+`Auto`s that output things that are "on" or "off" for contiguous steps.++`Blip`s are "blippy", `Interval`s are "chunky".++We've already seen an `Interval` earlier:++~~~haskell+ghci> streamAuto' (hold . emitOn5s) [1,5,9,3,10,2]+[Nothing, Just 5, Just 5, Just 5, Just 10, Just 10]+~~~++`hold :: Interval' (Blip a) a`, so it turns a blip stream into a stream of+`a`s that are on and off. In this case, it starts off "off", and is "on"+after the first emitted value, with the last emitted value.++`Interval`s are nice because you can have "choices" between two "on-off"+`Auto`s:++~~~haskell+ghci> let a1 = (onFor 3 . arr (+ 100)) <|!> whenI (> 6) <|!> arr (+ 200)+ghci> take 10 $ streamAuto' a1 [1..]+[101, 102, 203, 204, 205, 206, 7, 8, 9, 10]+ghci> let a2 = chooseInterval [offFor 8, onFor 3 . arr (+ 100)]+ghci> take 10 $ streamAuto' a2 [1..]+[Just 101, Just 102, Just 103, Nothing, Nothing, Just 6, Just 7]+~~~++(`<|!>`) forks the input into both `Interval`s, and the outputted one is the+first one that is "on". You can chain them as long as the "final" `Auto` is+an `Auto`, and not an `Interval`:++~~~haskell+(<|!>) :: Interval m a b -> Auto m a b -> Auto m a b+~~~++`onFor n` lets the input pass for `n` steps. `whenI` lets the input "pass+through" when the predicate is true (being sure to pick a meaningful predicate+based on the expected input for "chunky" output)++You can also "chain" `Interval`s with `bindI` and `compI`:++~~~haskell+ghci> streamAuto' (whenI (< 3) `compI` whenI (> 6)) [1..8]+[Just 1, Just 2, Nothing, Nothing, Nothing, Just 6, Just 7, Just 8]+ghci> streamAuto' (bindI (whenI (< 3)) . whenI (> 6)) [1..8]+[Just 1, Just 2, Nothing, Nothing, Nothing, Just 6, Just 7, Just 8]+~~~++Intervals are also used for things that want their `Auto`s to "signal" when+they are "off". `Interval` is the universal language for, "you can be done+with me", when it is needed. For example, the `interactAuto` loop takes an+`Interval String String`, and "turns off" on the first `Nothing` or "off"+value.++~~~haskell+ghci> interactAuto (onFor 4 . (++ "!!!"))+> hello+hello!!!+> how+how!!!+> are+are!!!+> you+you!!!+> today+--- (end of output)+~~~++Like with blip streams, intervals are used to great effect with switches, like+the useful `(-->)` combinator:++~~~haskell+ghci> let a1 = whileI (<= 4) --> pure 0+ghci> streamAuto' a1 [1..10]+[1, 2, 3, 4, 0, 0, 0, 0, 0, 0]+ -- look, recursion!+ghci> let a2 = (onFor 3 . pure "hi") --> (onFor 2 . pure "bye") --> a2+ghci> take 10 $ streamAuto' a2 (repeat ())+["hi", "hi", "hi", "bye", "bye", "hi", "hi", "hi", "bye", "bye"]+~~~++You can see all of the built-in `Interval` combinators in+*[Control.Auto.Interval][]*.++### More Tools++#### Switching++A powerful grab-bag of tools that can be used with intervals and blip streams+is the idea of "switching", as mentioned earlier. `Auto`s that behave like+one `Auto` for a while, and then another afterwards.++For example, `switchOn_` and `switchOnF` lets you have an `Auto` that behaves+like one `Auto`, until the blip stream it is receiving emits something ---+then, it behaves like a totally new one, based on the emitted value.++`switchFrom_` and `switchFromF` also gives you an `Auto` that behaves like one+`Auto`...except that `Auto` has the ability to "replace itself" by having its+output blip stream emit a value. The value determines what it wants to+replace itself with.++These are really useful for implementing things like "modes" --- your program+has different modes of behavior, which you can represet with a different+`Auto` for each mode...and you can switch between them with these switches!++See the documentation for thise at the *[Control.Auto.Swtich][]* module for+more information!++#### Collections++In *[Control.Auto.Collection][]*, we have a bunch of "`Auto` boxes" and+"`Auto` collections", which maintain `Auto`s that are dynamic collections of+`Auto`s.++For example, you have `zipAuto`, which takes a list of `Auto`s and returns an+`Auto` taking in a list, that feeds each item in the input list into each+corresponding `Auto`. It's like running multiple `Auto`s in parallel on+different inputs.++For example, you have `mux f :: Auto m (k, a) b`, which stores a bunch of+`Auto m a b`s indexed by a key `k`. At every step, it takes a `(k, a)`,+looks up the `Auto` at that `k`, feeds in the `a`, and outputs that output+`b`. You can use this to store several `Auto`s in parallel and really just+run the one you want at any given time.++There's also `gather f :: Auto m (k, a) (Map k b)`, which again stores a bunch+of `Auto m a b`s indexed by a key `k`. At every step, it *updates* only the+`Auto` at that key `k`, but outputs a `Map` of all the outputs so far by all+of the internal `Auto`s.++See the documentation at *[Control.Auto.Collection][]* for more!++### Recursive relationships++Not exactly a tool per se, but the *auto* library has the ability to state and+"solve" for recursive relationships.++We can define an `Auto` that "chases" its input:++~~~haskell+chaseFrom :: Num a => a -> Auto' a a+chaseFrom x0 = proc target -> do+ rec let step = signum (target - x) -- 1 if target is bigger+ -- 0 if matches+ -- -1 if smaller++ x <- sumFromD 0 -< step++ id -< x+~~~++~~~haskell+ghci> streamAuto' (chaseFrom 0) [3,3,3,3,3,-1,-1,-1,-1,-1]+ [0,1,2,3,3,3,2,1,0,-1]+-- ^ chasing 3 ^+-- ^ chasing -1+~~~++`x` is the cumulative sum of each `step` and the `step` is determined based on+the `target` and the current position `x`. So `x`'s relationship is that it+is the cumulative sum of `step`, and `step`'s relationship is that it is the+difference between `x` and `target`. It's a recursive relationship!++The *auto* library will attempt to find a "fixed point" of the recursive+relationship...sort of "solving for" the output stream that will match this+recursive relationship. However, it needs a little help. For every step, it+needs a way to get a "first value" from *something* without needing any input.+That is, at least *one* of the `Auto`s in your proc block has to be able to+pop out its *first* result without an input.++This is what `sumFromD` is for...we don't use `sumFrom`, but `sumFromD`.+`sumFromD` will always output *its original accumulator first*, before taking+into account the inputs:++~~~haskell+ghci> streamAuto' (sumFrom 0) [1..10]+[1,3,6,10,15,21,28,36,45,55]+ghci> streamAuto' (sumFromD 0) [1..10]+[0,1,3,6,10,15,21,28,36,45]+~~~++This is how the *auto* library will "tie" the loop and find the fixed point.+Have this, and everything works! Cyclic relationships and feedback loops...+just like in real life!+++Serialization+-------------++One of this library's features is that the `Auto` type offers an interface in+which you can serialize ("freeze") and "resume" an Auto, in `ByteString`+(binary) form.++You can "freeze" any `Auto` into a `ByteString` using `encodeAuto`, and you+can "resume" any `Auto` from a `ByteString` using `decodeAuto`.++Note `decodeAuto` and `loadAuto` "resume" a *given `Auto`*. That is, if+you call `decodeAuto` on a "fresh `Auto`", it'll decode a `ByteString`+into *that `Auto`, but "resumed"*. That is, it'll "fast forward" that+`Auto` into the state it was when it was saved.++For example, let's look at `sumFrom 0`. If it is fed 3 and 10, it'll have its+internal accumulator as 13, keeping track of all the numbers it has seen so+far.++~~~haskell+ghci> let a = sumFrom 0+ghci> let (_, a') = stepAuto' a 3+ghci> let (_, a'') = stepAuto' a' 10+~~~++`encodeAuto` can be used to "freeze"/"save" the `Auto` into the `ByteString`+`bs`:++~~~haskell+ghci> let bs = encodeAuto a''+~~~++`decodeAuto` can be used to "resume" from the *original* `a`. Remember, `a`+was the original `Auto`, the summer `Auto` with a starting accumulator of 0.+`decodeAuto` will "resume" it, with and resume it with its internal+accumulator at 13.++~~~haskell+ghci> let Right resumed = decodeAuto a bs+ghci> let (y, _) = stepAuto' resumed 0+13+~~~++Note that not all `Auto`s in this library can be resumed. By default, you can+assume that they *can*...while those that can't will by naming convention be+suffixed with a `_`: `sumFrom` vs. `sumFrom_`, for example. This means that+when you "save" the `Auto`, you don't really save any state...and when you+"resume" it, nothing is really resumed, and resuming is a no-op:++~~~haskell+-- sumFrom_ can't be saved/resumed, so it "goes nowhere" when resumed.+decodeAuto (sumFrom_ 0) bs = Right (sumFrom_ 0)+~~~++This feature is useful for "save states" of certain `Auto`s, or just for+serialization and resuming in general.++You can play some fun tricks with the *[Control.Auto.Serialize][]*+module...for example, `saving "foo.dat"` will turn any `Auto` into an `Auto`+that serializes itself at every step to "foo.dat"++~~~haskell+ghci> let a1 = saving "foo.dat" (sumFrom 0) :: Auto IO Int Int+ghci> streamAuto a1 [1..10] -- saves the Auto as it goes along+[ 1, 3, 6,10,15,21,28,36, 45, 55]+ghci> a2 <- readAutoErr "foo.dat" a1 :: Auto IO Int Int+ghci> streamAuto a2 [1..10] -- a2 is resumed to where a1 was last+[56,58,61,65,70,76,83,91,100,110]+~~~++If you want to make your own `Auto` combinators and transformers that work+with serialization, see the mini-tutorial at the documentation for+[mkAutoM][] in the [Control.Auto.Core][] module++### Serialization composes++The magic of implicit serialization is that the serliazation of complex+`Auto`s is preserved under combination and manipulation with the various+instances and combinators in this library. For example, serializing the+complex `blippy` example above, or a huge complex application, is all done+automatically! The overall serialization structure is implicitly built and+inferred. Think of it like the library analyzing what needs to be serialized+in your program, and coming up with a serialization and reloading strategy.++This is used to great effect in [auto-examples][], where entire applications and+chat bots are serialized..."for free". Build complex chat bots, and the+serialization is handled implicitly.++### Safecopy problem++There is one slightly drawback however...the "safecopy" problem. If you+alter the structure of your `Auto` by adding another aspect that needs to be+serialized...your `Auto` can no longer "read"/resume from the binary+serialization of its older version, because it'll expect the previous+serialization strategy, and be unable to read it. This means that, if you+publish programs, save files might become unloadable by new versions of your+`Auto`.++One solution is to *serialize individual portions* only of your program ---+portions that you know will stay fixed. You can do this by techniques in+[chatbot][], where each individual module of the chatbot is serialized to its+own place on disk using `serializing`, a variation of `saving` from above.+That way, if you add more modules to the chat bot, it can still individually+resume its smaller modules without caring about the rest.++[chatbot]: https://github.com/mstksg/auto-examples#chatbot++(I'll admit that this is not a perfect solution; more research and experiments+are continually being done. Feel free to talk to me if you have any ideas or+leads!)++Final partings+--------------++One last note before finishing up...if you ever want to implement a low-level+library, or implement a "backend", defining your own `Auto`s and working with+them has its own rules. You're a bit "on your own", in this sense; the+optimization game might take you to places that really get rid of the nice+semantic denotative ideals of this library. I plan on writing a+framework/low-level guide soon (for writing, say, a GUI framework, or hooking+on GUI).++However, one good principle is just to *separate* your "two hats" as much as+possible. There's the hat you wear when you are thinking about your program+logic, dealing with compositions of ideas ... and there's the hat you wear+when you are at the nitty-gritty interface between your system and the real+world. One goal in Haskell is always to be able to create as clear a divide as+possible...so you can really enjoy the best of both worlds. So just make sure+that the `Auto`s and API that you export behave in meaningful ways that you+can reason about...just what we expect from using `Auto` :)++Anyways, I recommend just looking over the combinators available to you in the+various modules, like *[Control.Auto.Blip][]*, *[Control.Auto.Interval][]*,+and *[Control.Auto.Switch][]*. We didn't go over anything close to all of+them in this tutorial, so it's nice for getting a good overview. The most+up-to-date documentation at this point in time is on [the github pages][docs]++A good next step too wouild be also just looking at the [auto-examples][]+directory and peruse over the examples, which each highlight a different+aspect of the library, so you can see how all of these ideas work together.+There will also be writeups on [my blog][blog] coming up too!++Help is always available on the *#haskell-auto* channel on freenode IRC; you+can also email me at <justin@jle.im>, or find me on twitter as+[mstk][twitter]. There is no mailing list or message board yet, but for now,+feel free to abuse the [github issue tracker][issues].++[twitter]: https://twitter.com/mstk+[issues]: https://github.com/mstksg/auto/issues++Now go forth and make locally stateful, denotative, declarative programs!++[Control.Auto.Blip]: http://mstksg.github.io/auto/Control-Auto-Blip.html+[Control.Auto.Collection]: http://mstksg.github.io/auto/Control-Auto-Collection.html+[Control.Auto.Interval]: http://mstksg.github.io/auto/Control-Auto-Interval.html+[Control.Auto.Run]: http://mstksg.github.io/auto/Control-Auto-Run.html+[Control.Auto.Serialize]: http://mstksg.github.io/auto/Control-Auto-Serialize.html+[Control.Auto.Switch]: http://mstksg.github.io/auto/Control-Auto-Switch.html+[Control.Auto.Core]: http://mstksg.github.io/auto/Control-Auto-Core.html+[mkAutoM]: http://mstksg.github.io/auto/Control-Auto-Core.html#v:mkAutoM