diff --git a/.gitignore b/.gitignore new file mode 100644 --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +/cabal.sandbox.config +/dist +/.cabal-sandbox +/tmp diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,20 @@ +0.2.0.2 +------- + + +* `dynZipF` and `dynMapF`, self-serializing dynamic collections. + + +0.2.0.1 +------- + + +* `catchA` added to `Control.Auto.Effects`, allowing explicit catching of + runtime exceptions thrown in underlying `IO`. + + +0.2.0.0 +------- + + +* First official release. No backwards-incompatible changes until 0.3.0.0. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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 +. 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 +~~~ diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/auto.cabal b/auto.cabal new file mode 100644 --- /dev/null +++ b/auto.cabal @@ -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 + ) + . + /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 + ; + you can get started by reading the tutorial, which is + also in this project directory in the `tutorial` + directory, and also incidentally online at + . + Also, check out the + + 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 diff --git a/src/Control/Auto.hs b/src/Control/Auto.hs new file mode 100644 --- /dev/null +++ b/src/Control/Auto.hs @@ -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 +-- 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 diff --git a/src/Control/Auto/Blip.hs b/src/Control/Auto/Blip.hs new file mode 100644 --- /dev/null +++ b/src/Control/Auto/Blip.hs @@ -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 , +-- 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 diff --git a/src/Control/Auto/Blip/Internal.hs b/src/Control/Auto/Blip/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Control/Auto/Blip/Internal.hs @@ -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 diff --git a/src/Control/Auto/Collection.hs b/src/Control/Auto/Collection.hs new file mode 100644 --- /dev/null +++ b/src/Control/Auto/Collection.hs @@ -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 +-- 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 +-- 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 diff --git a/src/Control/Auto/Core.hs b/src/Control/Auto/Core.hs new file mode 100644 --- /dev/null +++ b/src/Control/Auto/Core.hs @@ -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 +-- ! +-- + +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 +-- +-- 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 +-- 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 +-- . +-- +-- 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 +-- , on freenode at /#haskell/ or /#haskell-auto/, open +-- a , 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 +-- ! +-- 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 #-} diff --git a/src/Control/Auto/Effects.hs b/src/Control/Auto/Effects.hs new file mode 100644 --- /dev/null +++ b/src/Control/Auto/Effects.hs @@ -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_) diff --git a/src/Control/Auto/Generate.hs b/src/Control/Auto/Generate.hs new file mode 100644 --- /dev/null +++ b/src/Control/Auto/Generate.hs @@ -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 #-} diff --git a/src/Control/Auto/Interval.hs b/src/Control/Auto/Interval.hs new file mode 100644 --- /dev/null +++ b/src/Control/Auto/Interval.hs @@ -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 diff --git a/src/Control/Auto/Process.hs b/src/Control/Auto/Process.hs new file mode 100644 --- /dev/null +++ b/src/Control/Auto/Process.hs @@ -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 + + diff --git a/src/Control/Auto/Process/Random.hs b/src/Control/Auto/Process/Random.hs new file mode 100644 --- /dev/null +++ b/src/Control/Auto/Process/Random.hs @@ -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 +-- , +-- 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 +-- . +-- +-- @ +-- '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 , +-- 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 +-- , 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 +-- , 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 +-- , 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 : +-- 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 . +-- 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' ? + diff --git a/src/Control/Auto/Run.hs b/src/Control/Auto/Run.hs new file mode 100644 --- /dev/null +++ b/src/Control/Auto/Run.hs @@ -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) diff --git a/src/Control/Auto/Serialize.hs b/src/Control/Auto/Serialize.hs new file mode 100644 --- /dev/null +++ b/src/Control/Auto/Serialize.hs @@ -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 ! +-- + +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) + diff --git a/src/Control/Auto/Switch.hs b/src/Control/Auto/Switch.hs new file mode 100644 --- /dev/null +++ b/src/Control/Auto/Switch.hs @@ -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 . +-- +-- 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 ()) diff --git a/src/Control/Auto/Time.hs b/src/Control/Auto/Time.hs new file mode 100644 --- /dev/null +++ b/src/Control/Auto/Time.hs @@ -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 +-- 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 + diff --git a/tutorial/tutorial.md b/tutorial/tutorial.md new file mode 100644 --- /dev/null +++ b/tutorial/tutorial.md @@ -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 , 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