mvc 1.0.2 → 1.0.3
raw patch · 5 files changed
+761/−761 lines, 5 filesdep ~transformerssetup-changedPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: transformers
API changes (from Hackage documentation)
Files
- LICENSE +24/−24
- Setup.hs +2/−2
- mvc.cabal +40/−40
- src/MVC.hs +473/−473
- src/MVC/Prelude.hs +222/−222
LICENSE view
@@ -1,24 +1,24 @@-Copyright (c) 2014 Gabriel Gonzalez-All rights reserved.--Redistribution and use in source and binary forms, with or without modification,-are permitted provided that the following conditions are met:- * Redistributions of source code must retain the above copyright notice,- this list of conditions and the following disclaimer.- * Redistributions in binary form must reproduce the above copyright notice,- this list of conditions and the following disclaimer in the documentation- and/or other materials provided with the distribution.- * Neither the name of Gabriel Gonzalez nor the names of other contributors- may be used to endorse or promote products derived from this software- without specific prior written permission.--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED-WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE-DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR-ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES-(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;-LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON-ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS-SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+Copyright (c) 2014 Gabriel Gonzalez +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, +are permitted provided that the following conditions are met: + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + * Neither the name of Gabriel Gonzalez nor the names of other contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON +ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple-main = defaultMain+import Distribution.Simple +main = defaultMain
mvc.cabal view
@@ -1,40 +1,40 @@-Name: mvc-Version: 1.0.2-Cabal-Version: >=1.8.0.2-Build-Type: Simple-License: BSD3-License-File: LICENSE-Copyright: 2014 Gabriel Gonzalez-Author: Gabriel Gonzalez-Maintainer: Gabriel439@gmail.com-Bug-Reports: https://github.com/Gabriel439/Haskell-MVC-Library/issues-Synopsis: Model-view-controller-Description: Use the @mvc@ library to distill concurrent programs into pure and- single-threaded programs using the @Model@-@View@-@Controller@ pattern. This- transformation lets you:- .- * replay your program deterministically,- .- * do property-based testing of your model (like @QuickCheck@), and:- .- * equationally reason about your pure core.-Category: Control, Concurrency-Source-Repository head- Type: git- Location: https://github.com/Gabriel439/Haskell-MVC-Library--Library- Hs-Source-Dirs: src- Build-Depends:- base >= 4 && < 5 ,- async >= 2.0.0 && < 2.1,- contravariant < 1.3,- managed < 1.1,- mmorph >= 1.0.2 && < 1.1,- pipes >= 4.1.0 && < 4.2,- pipes-concurrency >= 2.0.1 && < 2.1,- transformers >= 0.2.0.0 && < 0.4 - Exposed-Modules:- MVC,- MVC.Prelude- GHC-Options: -O2 -Wall+Name: mvc +Version: 1.0.3 +Cabal-Version: >=1.8.0.2 +Build-Type: Simple +License: BSD3 +License-File: LICENSE +Copyright: 2014 Gabriel Gonzalez +Author: Gabriel Gonzalez +Maintainer: Gabriel439@gmail.com +Bug-Reports: https://github.com/Gabriel439/Haskell-MVC-Library/issues +Synopsis: Model-view-controller +Description: Use the @mvc@ library to distill concurrent programs into pure and + single-threaded programs using the @Model@-@View@-@Controller@ pattern. This + transformation lets you: + . + * replay your program deterministically, + . + * do property-based testing of your model (like @QuickCheck@), and: + . + * equationally reason about your pure core. +Category: Control, Concurrency +Source-Repository head + Type: git + Location: https://github.com/Gabriel439/Haskell-MVC-Library + +Library + Hs-Source-Dirs: src + Build-Depends: + base >= 4 && < 5 , + async >= 2.0.0 && < 2.1, + contravariant < 1.3, + managed < 1.1, + mmorph >= 1.0.2 && < 1.1, + pipes >= 4.1.0 && < 4.2, + pipes-concurrency >= 2.0.1 && < 2.1, + transformers >= 0.2.0.0 && < 0.5.0.0 + Exposed-Modules: + MVC, + MVC.Prelude + GHC-Options: -O2 -Wall
src/MVC.hs view
@@ -1,473 +1,473 @@-{-| Use the `Model` - `View` - `Controller` pattern to separate impure inputs- and outputs from pure application logic so that you can:-- * Equationally reason about your model-- * Exercise your model with property-based testing (like @QuickCheck@)-- * Reproducibly replay your model-- The @mvc@ library uses the type system to statically enforce the separation- of impure `View`s and `Controller`s from the pure `Model`.-- Here's a small example program written using the @mvc@ library to illustrate- the core types and concepts:--> import MVC-> import qualified MVC.Prelude as MVC-> import qualified Pipes.Prelude as Pipes->-> external :: Managed (View String, Controller String)-> external = do-> c1 <- MVC.stdinLines-> c2 <- MVC.tick 1-> return (MVC.stdoutLines, c1 <> fmap show c2)->-> model :: Model () String String-> model = asPipe (Pipes.takeWhile (/= "quit"))-> -> main :: IO ()-> main = runMVC () model external-- This program has three components:-- * A `Controller` that interleaves lines from standard input with periodic- ticks-- * A `View` that writes lines to standard output-- * A pure `Model`, which forwards lines until the user inputs \"quit\"-- 'runMVC' connects them into a complete program, which outputs a @()@ every- second and also echoes standard input to standard output until the user- enters \"quit\":-->>> main-()-Test<Enter>-Test-()-()-42<Enter>-42-()-quit<enter>->>>-- The following sections give extended guidance for how to structure @mvc@- programs. Additionally, there is an "MVC.Prelude" module, which provides- several utilities and provides a more elaborate code example using the- @sdl@ library.--}--{-# LANGUAGE RankNTypes #-}--module MVC (- -- * Controllers- -- $controller- Controller- , asInput- , keeps-- -- * Views- -- $view- , View- , asSink- , handles-- -- * Models- -- $model- , Model- , asPipe-- -- * MVC- -- $mvc- , runMVC-- -- * Managed resources- -- $managed- , Managed- , managed-- -- *ListT- , loop- -- $listT-- -- * Re-exports- -- $reexports- , module Data.Functor.Constant- , module Data.Functor.Contravariant- , module Data.Monoid- , module Pipes- , module Pipes.Concurrent- ) where--import Control.Category (Category(..))-import Control.Monad.Managed (Managed, managed, with)-import Control.Monad.Morph (generalize)-import Control.Monad.Trans.State.Strict (State, execStateT)-import Data.Functor.Constant (Constant(Constant, getConstant))-import Data.Functor.Contravariant (Contravariant(contramap))-import Data.Monoid (Monoid(mempty, mappend, mconcat), (<>), First)-import qualified Data.Monoid as M-import Pipes-import Pipes.Concurrent--import Prelude hiding ((.), id)--{- $controller- `Controller`s represent concurrent inputs to your system. Use the `Functor`- and `Monoid` instances for `Controller` and `Managed` to unify multiple- `Managed` `Controller`s together into a single `Managed` `Controller`:--> controllerA :: Managed (Controller A)-> controllerB :: Managed (Controller B)-> controllerC :: Managed (Controller C)->-> data TotalInput = InA A | InB B | InC C->-> controllerTotal :: Managed (Controller TotalInput)-> controllerTotal =-> fmap (fmap InA) controllerA-> <> fmap (fmap InB) controllerB-> <> fmap (fmap InC) controllerC-- Combining `Controller`s interleaves their values.--}--{-| A concurrent source--> fmap f (c1 <> c2) = fmap f c1 <> fmap f c2->-> fmap f mempty = mempty--}-newtype Controller a = AsInput (Input a)--- This is just a newtype wrapper around `Input` because:------ * I want the `Controller` name to "stick" in inferred types------ * I want to restrict the API to ensure that `runMVC` is the only way to--- consume `Controller`s. This enforces strict separation of `Controller`--- logic from `Model` or `View` logic---- Deriving `Functor`-instance Functor Controller where- fmap f (AsInput i) = AsInput (fmap f i)---- Deriving `Monoid`-instance Monoid (Controller a) where- mappend (AsInput i1) (AsInput i2) = AsInput (mappend i1 i2)-- mempty = AsInput mempty---- | Create a `Controller` from an `Input`-asInput :: Input a -> Controller a-asInput = AsInput-{-# INLINABLE asInput #-}--{-| Think of the type as one of the following types:--> keeps :: Prism' a b -> Controller a -> Controller b-> keeps :: Traversal' a b -> Controller a -> Controller b-- @(keeps prism controller)@ only emits values if the @prism@ matches the- @controller@'s output.--> keeps (p1 . p2) = keeps p2 . keeps p1->-> keeps id = id--> keeps p (c1 <> c2) = keeps p c1 <> keeps p c2->-> keeps p mempty = mempty--}-keeps- :: ((b -> Constant (First b) b) -> (a -> Constant (First b) a))- -- ^- -> Controller a- -- ^- -> Controller b-keeps k (AsInput (Input recv_)) = AsInput (Input recv_')- where- recv_' = do- ma <- recv_- case ma of- Nothing -> return Nothing- Just a -> case match a of- Nothing -> recv_'- Just b -> return (Just b)- match = M.getFirst . getConstant . k (Constant . M.First . Just)-{-# INLINABLE keeps #-}--{- $view- `View`s represent outputs of your system. Use `handles` and the `Monoid`- instance of `View` to unify multiple `View`s together into a single `View`:--> viewD :: Managed (View D)-> viewE :: Managed (View E)-> viewF :: Managed (View F)->-> data TotalOutput = OutD D | OutE E | OutF F->-> makePrisms ''TotalOutput -- Generates _OutD, _OutE, and _OutF prisms->-> viewTotal :: Managed (View TotalOutput)-> viewTotal =-> fmap (handles _OutD) viewD-> <> fmap (handles _OutE) viewE-> <> fmap (handles _OutF) viewF-- Combining `View`s sequences their outputs.-- If a @lens@ dependency is too heavy-weight, then you can manually generate- `Traversal`s, which `handles` will also accept. Here is an example of how- you can generate `Traversal`s by hand with no dependencies:--> -- _OutD :: Traversal' TotalOutput D-> _OutD :: Applicative f => (D -> f D) -> (TotalOutput -> f TotalOutput)-> _OutD k (OutD d) = fmap OutD (k d)-> _OutD k t = pure t->-> -- _OutE :: Traversal' TotalOutput E-> _OutE :: Applicative f => (E -> f E) -> (TotalOutput -> f TotalOutput)-> _OutE k (OutE d) = fmap OutE (k d)-> _OutE k t = pure t->-> -- _OutF :: Traversal' TotalOutput F-> _OutF :: Applicative f => (F -> f F) -> (TotalOutput -> f TotalOutput)-> _OutF k (OutF d) = fmap OutF (k d)-> _OutF k t = pure t--}--{-| An effectful sink--> contramap f (v1 <> v2) = contramap f v1 <> contramap f v2->-> contramap f mempty = mempty--}-newtype View a = AsSink (a -> IO ())--instance Monoid (View a) where- mempty = AsSink (\_ -> return ())- mappend (AsSink write1) (AsSink write2) =- AsSink (\a -> write1 a >> write2 a)--instance Contravariant View where- contramap f (AsSink k) = AsSink (k . f)---- | Create a `View` from a sink-asSink :: (a -> IO ()) -> View a-asSink = AsSink -{-# INLINABLE asSink #-}--{-| Think of the type as one of the following types:--> handles :: Prism' a b -> View b -> View a-> handles :: Traversal' a b -> View b -> View a-- @(handles prism view)@ only runs the @view@ if the @prism@ matches the- input.--> handles (p1 . p2) = handles p1 . handles p2->-> handles id = id--> handles p (v1 <> v2) = handles p v1 <> handles p v2->-> handles p mempty = mempty--}-handles- :: ((b -> Constant (First b) b) -> (a -> Constant (First b) a))- -- ^- -> View b- -- ^- -> View a-handles k (AsSink send_) = AsSink (\a -> case match a of- Nothing -> return ()- Just b -> send_ b )- where- match = M.getFirst . getConstant . k (Constant . M.First . Just)-{-# INLINABLE handles #-}--{- $model- `Model`s are stateful streams and they sit in between `Controller`s and- `View`s.-- Use `State` to internally communicate within the `Model`.-- Read the \"ListT\" section which describes why you should prefer `ListT`- over `Pipe` when possible.-- Also, try to defer converting your `Pipe` to a `Model` until you call- `runMVC`, because the conversion is not reversible and `Pipe` is strictly- more featureful than `Model`.--}--{-| A @(Model s a b)@ converts a stream of @(a)@s into a stream of @(b)@s while- interacting with a state @(s)@--}-newtype Model s a b = AsPipe (Pipe a b (State s) ())--instance Category (Model s) where- (AsPipe m1) . (AsPipe m2) = AsPipe (m1 <-< m2)-- id = AsPipe cat--{-| Create a `Model` from a `Pipe`--> asPipe (p1 <-< p2) = asPipe p1 . asPipe p2->-> asPipe cat = id--}-asPipe :: Pipe a b (State s) () -> Model s a b-asPipe = AsPipe-{-# INLINABLE asPipe #-}--{- $mvc- Connect a `Model`, `View`, and `Controller` and an initial state- together using `runMVC` to complete your application.-- `runMVC` is the only way to consume `View`s and `Controller`s. The types- forbid you from mixing `View` and `Controller` logic with your `Model`- logic.-- Note that `runMVC` only accepts one `View` and one `Controller`. This- enforces a single entry point and exit point for your `Model` so that you- can cleanly separate your `Model` logic from your `View` logic and- `Controller` logic. The way you add more `View`s and `Controller`s to your- program is by unifying them into a single `View` or `Controller` by using- their `Monoid` instances. See the \"Controllers\" and \"Views\" sections- for more details on how to do this.--}--{-| Connect a `Model`, `View`, and `Controller` and initial state into a- complete application.--}-runMVC- :: s- -- ^ Initial state- -> Model s a b- -- ^ Program logic- -> Managed (View b, Controller a)- -- ^ Effectful output and input- -> IO s- -- ^ Returns final state-runMVC initialState (AsPipe pipe) viewController =- with viewController $ \(AsSink sink, AsInput input) ->- flip execStateT initialState $ runEffect $- fromInput input- >-> hoist (hoist generalize) pipe- >-> for cat (liftIO . sink)-{-# INLINABLE runMVC #-}--{- $managed- Use `managed` to create primitive `Managed` resources and use the `Functor`,- `Applicative`, `Monad`, and `Monoid` instances for `Managed` to bundle- multiple `Managed` resources into a single `Managed` resource.-- See the source code for the \"Utilities\" section below for several examples- of how to create `Managed` resources.--}--{-| Create a `Pipe` from a `ListT` transformation--> loop (k1 >=> k2) = loop k1 >-> loop k2->-> loop return = cat--}-loop :: Monad m => (a -> ListT m b) -> Pipe a b m r-loop k = for cat (every . k)-{-# INLINABLE loop #-}--{- $listT- `ListT` computations can be combined in more ways than `Pipe`s, so try to- program in `ListT` as much as possible and defer converting it to a `Pipe`- as late as possible using `loop`.-- You can combine `ListT` computations even if their inputs and outputs are- completely different:--> -- Independent computations->-> modelAToD :: A -> ListT (State S) D-> modelBToE :: B -> ListT (State S) E-> modelCToF :: C -> ListT (State s) F->-> modelInToOut :: TotalInput -> ListT (State S) TotalOutput-> modelInToOut totalInput = case totalInput of-> InA a -> fmap OutD (modelAToD a)-> InB b -> fmap OutE (modelAToD b)-> InC c -> fmap OutF (modelAToD c)-- Sometimes you have multiple computations that handle different inputs but- the same output, in which case you don't need to unify their outputs:--> -- Overlapping outputs->-> modelAToOut :: A -> ListT (State S) Out-> modelBToOut :: B -> ListT (State S) Out-> modelCToOut :: C -> ListT (State S) Out->-> modelInToOut :: TotalInput -> ListT (State S) TotalOutput-> modelInToOut totalInput = case totalInput of-> InA a -> modelAToOut a-> InB b -> modelBToOut b-> InC c -> modelBToOut b-- Other times you have multiple computations that handle the same input but- produce different outputs. You can unify their outputs using the `Monoid`- and `Functor` instances for `ListT`:--> -- Overlapping inputs->-> modelInToA :: TotalInput -> ListT (State S) A-> modelInToB :: TotalInput -> ListT (State S) B-> modelInToC :: TotalInput -> ListT (State S) C->-> modelInToOut :: TotalInput -> ListT (State S) TotalOutput-> modelInToOut totalInput =-> fmap OutA (modelInToA totalInput)-> <> fmap OutB (modelInToB totalInput)-> <> fmap OutC (modelInToC totalInput)-- You can also chain `ListT` computations, feeding the output of the first- computation as the input to the next computation:--> -- End-to-end->-> modelInToMiddle :: TotalInput -> ListT (State S) MiddleStep-> modelMiddleToOut :: MiddleStep -> ListT (State S) TotalOutput->-> modelInToOut :: TotalInput -> ListT (State S) TotalOutput-> modelInToOut = modelInToMiddle >=> modelMiddleToOut-- ... or you can just use @do@ notation if you prefer.-- However, the `Pipe` type is more general than `ListT` and can represent- things like termination. Therefore you should consider mixing `Pipe`s with- `ListT` when you need to take advantage of these extra features:--> -- Mix ListT with Pipes->-> pipe :: Pipe TotalInput TotalOutput (State S) ()-> pipe = Pipes.takeWhile (not . isC)) >-> loop modelInToOut-> where-> isC (InC _) = True-> isC _ = False-- So promote your `ListT` logic to a `Pipe` when you need to take advantage of- these `Pipe`-specific features.--}--{- $reexports- "Data.Functor.Constant" re-exports `Constant`-- "Data.Functor.Contravariant" re-exports `Contravariant`-- "Data.Monoid" re-exports `Monoid`, (`<>`), `mconcat`, and `First` (the type- only)-- "Pipes" re-exports everything-- "Pipes.Concurrent" re-exports everything--}+{-| Use the `Model` - `View` - `Controller` pattern to separate impure inputs + and outputs from pure application logic so that you can: + + * Equationally reason about your model + + * Exercise your model with property-based testing (like @QuickCheck@) + + * Reproducibly replay your model + + The @mvc@ library uses the type system to statically enforce the separation + of impure `View`s and `Controller`s from the pure `Model`. + + Here's a small example program written using the @mvc@ library to illustrate + the core types and concepts: + +> import MVC +> import qualified MVC.Prelude as MVC +> import qualified Pipes.Prelude as Pipes +> +> external :: Managed (View String, Controller String) +> external = do +> c1 <- MVC.stdinLines +> c2 <- MVC.tick 1 +> return (MVC.stdoutLines, c1 <> fmap show c2) +> +> model :: Model () String String +> model = asPipe (Pipes.takeWhile (/= "quit")) +> +> main :: IO () +> main = runMVC () model external + + This program has three components: + + * A `Controller` that interleaves lines from standard input with periodic + ticks + + * A `View` that writes lines to standard output + + * A pure `Model`, which forwards lines until the user inputs \"quit\" + + 'runMVC' connects them into a complete program, which outputs a @()@ every + second and also echoes standard input to standard output until the user + enters \"quit\": + +>>> main +() +Test<Enter> +Test +() +() +42<Enter> +42 +() +quit<enter> +>>> + + The following sections give extended guidance for how to structure @mvc@ + programs. Additionally, there is an "MVC.Prelude" module, which provides + several utilities and provides a more elaborate code example using the + @sdl@ library. +-} + +{-# LANGUAGE RankNTypes #-} + +module MVC ( + -- * Controllers + -- $controller + Controller + , asInput + , keeps + + -- * Views + -- $view + , View + , asSink + , handles + + -- * Models + -- $model + , Model + , asPipe + + -- * MVC + -- $mvc + , runMVC + + -- * Managed resources + -- $managed + , Managed + , managed + + -- *ListT + , loop + -- $listT + + -- * Re-exports + -- $reexports + , module Data.Functor.Constant + , module Data.Functor.Contravariant + , module Data.Monoid + , module Pipes + , module Pipes.Concurrent + ) where + +import Control.Category (Category(..)) +import Control.Monad.Managed (Managed, managed, with) +import Control.Monad.Morph (generalize) +import Control.Monad.Trans.State.Strict (State, execStateT) +import Data.Functor.Constant (Constant(Constant, getConstant)) +import Data.Functor.Contravariant (Contravariant(contramap)) +import Data.Monoid (Monoid(mempty, mappend, mconcat), (<>), First) +import qualified Data.Monoid as M +import Pipes +import Pipes.Concurrent + +import Prelude hiding ((.), id) + +{- $controller + `Controller`s represent concurrent inputs to your system. Use the `Functor` + and `Monoid` instances for `Controller` and `Managed` to unify multiple + `Managed` `Controller`s together into a single `Managed` `Controller`: + +> controllerA :: Managed (Controller A) +> controllerB :: Managed (Controller B) +> controllerC :: Managed (Controller C) +> +> data TotalInput = InA A | InB B | InC C +> +> controllerTotal :: Managed (Controller TotalInput) +> controllerTotal = +> fmap (fmap InA) controllerA +> <> fmap (fmap InB) controllerB +> <> fmap (fmap InC) controllerC + + Combining `Controller`s interleaves their values. +-} + +{-| A concurrent source + +> fmap f (c1 <> c2) = fmap f c1 <> fmap f c2 +> +> fmap f mempty = mempty +-} +newtype Controller a = AsInput (Input a) +-- This is just a newtype wrapper around `Input` because: +-- +-- * I want the `Controller` name to "stick" in inferred types +-- +-- * I want to restrict the API to ensure that `runMVC` is the only way to +-- consume `Controller`s. This enforces strict separation of `Controller` +-- logic from `Model` or `View` logic + +-- Deriving `Functor` +instance Functor Controller where + fmap f (AsInput i) = AsInput (fmap f i) + +-- Deriving `Monoid` +instance Monoid (Controller a) where + mappend (AsInput i1) (AsInput i2) = AsInput (mappend i1 i2) + + mempty = AsInput mempty + +-- | Create a `Controller` from an `Input` +asInput :: Input a -> Controller a +asInput = AsInput +{-# INLINABLE asInput #-} + +{-| Think of the type as one of the following types: + +> keeps :: Prism' a b -> Controller a -> Controller b +> keeps :: Traversal' a b -> Controller a -> Controller b + + @(keeps prism controller)@ only emits values if the @prism@ matches the + @controller@'s output. + +> keeps (p1 . p2) = keeps p2 . keeps p1 +> +> keeps id = id + +> keeps p (c1 <> c2) = keeps p c1 <> keeps p c2 +> +> keeps p mempty = mempty +-} +keeps + :: ((b -> Constant (First b) b) -> (a -> Constant (First b) a)) + -- ^ + -> Controller a + -- ^ + -> Controller b +keeps k (AsInput (Input recv_)) = AsInput (Input recv_') + where + recv_' = do + ma <- recv_ + case ma of + Nothing -> return Nothing + Just a -> case match a of + Nothing -> recv_' + Just b -> return (Just b) + match = M.getFirst . getConstant . k (Constant . M.First . Just) +{-# INLINABLE keeps #-} + +{- $view + `View`s represent outputs of your system. Use `handles` and the `Monoid` + instance of `View` to unify multiple `View`s together into a single `View`: + +> viewD :: Managed (View D) +> viewE :: Managed (View E) +> viewF :: Managed (View F) +> +> data TotalOutput = OutD D | OutE E | OutF F +> +> makePrisms ''TotalOutput -- Generates _OutD, _OutE, and _OutF prisms +> +> viewTotal :: Managed (View TotalOutput) +> viewTotal = +> fmap (handles _OutD) viewD +> <> fmap (handles _OutE) viewE +> <> fmap (handles _OutF) viewF + + Combining `View`s sequences their outputs. + + If a @lens@ dependency is too heavy-weight, then you can manually generate + `Traversal`s, which `handles` will also accept. Here is an example of how + you can generate `Traversal`s by hand with no dependencies: + +> -- _OutD :: Traversal' TotalOutput D +> _OutD :: Applicative f => (D -> f D) -> (TotalOutput -> f TotalOutput) +> _OutD k (OutD d) = fmap OutD (k d) +> _OutD k t = pure t +> +> -- _OutE :: Traversal' TotalOutput E +> _OutE :: Applicative f => (E -> f E) -> (TotalOutput -> f TotalOutput) +> _OutE k (OutE d) = fmap OutE (k d) +> _OutE k t = pure t +> +> -- _OutF :: Traversal' TotalOutput F +> _OutF :: Applicative f => (F -> f F) -> (TotalOutput -> f TotalOutput) +> _OutF k (OutF d) = fmap OutF (k d) +> _OutF k t = pure t +-} + +{-| An effectful sink + +> contramap f (v1 <> v2) = contramap f v1 <> contramap f v2 +> +> contramap f mempty = mempty +-} +newtype View a = AsSink (a -> IO ()) + +instance Monoid (View a) where + mempty = AsSink (\_ -> return ()) + mappend (AsSink write1) (AsSink write2) = + AsSink (\a -> write1 a >> write2 a) + +instance Contravariant View where + contramap f (AsSink k) = AsSink (k . f) + +-- | Create a `View` from a sink +asSink :: (a -> IO ()) -> View a +asSink = AsSink +{-# INLINABLE asSink #-} + +{-| Think of the type as one of the following types: + +> handles :: Prism' a b -> View b -> View a +> handles :: Traversal' a b -> View b -> View a + + @(handles prism view)@ only runs the @view@ if the @prism@ matches the + input. + +> handles (p1 . p2) = handles p1 . handles p2 +> +> handles id = id + +> handles p (v1 <> v2) = handles p v1 <> handles p v2 +> +> handles p mempty = mempty +-} +handles + :: ((b -> Constant (First b) b) -> (a -> Constant (First b) a)) + -- ^ + -> View b + -- ^ + -> View a +handles k (AsSink send_) = AsSink (\a -> case match a of + Nothing -> return () + Just b -> send_ b ) + where + match = M.getFirst . getConstant . k (Constant . M.First . Just) +{-# INLINABLE handles #-} + +{- $model + `Model`s are stateful streams and they sit in between `Controller`s and + `View`s. + + Use `State` to internally communicate within the `Model`. + + Read the \"ListT\" section which describes why you should prefer `ListT` + over `Pipe` when possible. + + Also, try to defer converting your `Pipe` to a `Model` until you call + `runMVC`, because the conversion is not reversible and `Pipe` is strictly + more featureful than `Model`. +-} + +{-| A @(Model s a b)@ converts a stream of @(a)@s into a stream of @(b)@s while + interacting with a state @(s)@ +-} +newtype Model s a b = AsPipe (Pipe a b (State s) ()) + +instance Category (Model s) where + (AsPipe m1) . (AsPipe m2) = AsPipe (m1 <-< m2) + + id = AsPipe cat + +{-| Create a `Model` from a `Pipe` + +> asPipe (p1 <-< p2) = asPipe p1 . asPipe p2 +> +> asPipe cat = id +-} +asPipe :: Pipe a b (State s) () -> Model s a b +asPipe = AsPipe +{-# INLINABLE asPipe #-} + +{- $mvc + Connect a `Model`, `View`, and `Controller` and an initial state + together using `runMVC` to complete your application. + + `runMVC` is the only way to consume `View`s and `Controller`s. The types + forbid you from mixing `View` and `Controller` logic with your `Model` + logic. + + Note that `runMVC` only accepts one `View` and one `Controller`. This + enforces a single entry point and exit point for your `Model` so that you + can cleanly separate your `Model` logic from your `View` logic and + `Controller` logic. The way you add more `View`s and `Controller`s to your + program is by unifying them into a single `View` or `Controller` by using + their `Monoid` instances. See the \"Controllers\" and \"Views\" sections + for more details on how to do this. +-} + +{-| Connect a `Model`, `View`, and `Controller` and initial state into a + complete application. +-} +runMVC + :: s + -- ^ Initial state + -> Model s a b + -- ^ Program logic + -> Managed (View b, Controller a) + -- ^ Effectful output and input + -> IO s + -- ^ Returns final state +runMVC initialState (AsPipe pipe) viewController = + with viewController $ \(AsSink sink, AsInput input) -> + flip execStateT initialState $ runEffect $ + fromInput input + >-> hoist (hoist generalize) pipe + >-> for cat (liftIO . sink) +{-# INLINABLE runMVC #-} + +{- $managed + Use `managed` to create primitive `Managed` resources and use the `Functor`, + `Applicative`, `Monad`, and `Monoid` instances for `Managed` to bundle + multiple `Managed` resources into a single `Managed` resource. + + See the source code for the \"Utilities\" section below for several examples + of how to create `Managed` resources. +-} + +{-| Create a `Pipe` from a `ListT` transformation + +> loop (k1 >=> k2) = loop k1 >-> loop k2 +> +> loop return = cat +-} +loop :: Monad m => (a -> ListT m b) -> Pipe a b m r +loop k = for cat (every . k) +{-# INLINABLE loop #-} + +{- $listT + `ListT` computations can be combined in more ways than `Pipe`s, so try to + program in `ListT` as much as possible and defer converting it to a `Pipe` + as late as possible using `loop`. + + You can combine `ListT` computations even if their inputs and outputs are + completely different: + +> -- Independent computations +> +> modelAToD :: A -> ListT (State S) D +> modelBToE :: B -> ListT (State S) E +> modelCToF :: C -> ListT (State s) F +> +> modelInToOut :: TotalInput -> ListT (State S) TotalOutput +> modelInToOut totalInput = case totalInput of +> InA a -> fmap OutD (modelAToD a) +> InB b -> fmap OutE (modelAToD b) +> InC c -> fmap OutF (modelAToD c) + + Sometimes you have multiple computations that handle different inputs but + the same output, in which case you don't need to unify their outputs: + +> -- Overlapping outputs +> +> modelAToOut :: A -> ListT (State S) Out +> modelBToOut :: B -> ListT (State S) Out +> modelCToOut :: C -> ListT (State S) Out +> +> modelInToOut :: TotalInput -> ListT (State S) TotalOutput +> modelInToOut totalInput = case totalInput of +> InA a -> modelAToOut a +> InB b -> modelBToOut b +> InC c -> modelBToOut b + + Other times you have multiple computations that handle the same input but + produce different outputs. You can unify their outputs using the `Monoid` + and `Functor` instances for `ListT`: + +> -- Overlapping inputs +> +> modelInToA :: TotalInput -> ListT (State S) A +> modelInToB :: TotalInput -> ListT (State S) B +> modelInToC :: TotalInput -> ListT (State S) C +> +> modelInToOut :: TotalInput -> ListT (State S) TotalOutput +> modelInToOut totalInput = +> fmap OutA (modelInToA totalInput) +> <> fmap OutB (modelInToB totalInput) +> <> fmap OutC (modelInToC totalInput) + + You can also chain `ListT` computations, feeding the output of the first + computation as the input to the next computation: + +> -- End-to-end +> +> modelInToMiddle :: TotalInput -> ListT (State S) MiddleStep +> modelMiddleToOut :: MiddleStep -> ListT (State S) TotalOutput +> +> modelInToOut :: TotalInput -> ListT (State S) TotalOutput +> modelInToOut = modelInToMiddle >=> modelMiddleToOut + + ... or you can just use @do@ notation if you prefer. + + However, the `Pipe` type is more general than `ListT` and can represent + things like termination. Therefore you should consider mixing `Pipe`s with + `ListT` when you need to take advantage of these extra features: + +> -- Mix ListT with Pipes +> +> pipe :: Pipe TotalInput TotalOutput (State S) () +> pipe = Pipes.takeWhile (not . isC)) >-> loop modelInToOut +> where +> isC (InC _) = True +> isC _ = False + + So promote your `ListT` logic to a `Pipe` when you need to take advantage of + these `Pipe`-specific features. +-} + +{- $reexports + "Data.Functor.Constant" re-exports `Constant` + + "Data.Functor.Contravariant" re-exports `Contravariant` + + "Data.Monoid" re-exports `Monoid`, (`<>`), `mconcat`, and `First` (the type + only) + + "Pipes" re-exports everything + + "Pipes.Concurrent" re-exports everything +-}
src/MVC/Prelude.hs view
@@ -1,222 +1,222 @@-{-| Simple utilities-- The \"Example\" section at the bottom of this module contains an extended- example of how to interact with the @sdl@ library using the @mvc@ library--}--module MVC.Prelude (- -- * Controllers- producer- , stdinLines- , inLines- , inRead- , tick-- -- * Views- , consumer- , stdoutLines- , outLines- , outShow-- -- * Handles- , inHandle- , outHandle-- -- * Example- -- $example- ) where--import Control.Applicative (pure, (<*))-import Control.Concurrent.Async (withAsync)-import Control.Concurrent (threadDelay)-import Data.IORef (newIORef, readIORef, writeIORef)-import MVC-import Pipes.Internal (Proxy(..), closed)-import qualified Pipes.Prelude as Pipes-import qualified System.IO as IO--{-| Create a `Controller` from a `Producer`, using the given `Buffer`-- If you're not sure what `Buffer` to use, try `Single`--}-producer :: Buffer a -> Producer a IO () -> Managed (Controller a)-producer buffer prod = managed $ \k -> do- (o, i, seal) <- spawn' buffer- let io = do- runEffect $ prod >-> toOutput o- atomically seal- withAsync io $ \_ -> k (asInput i) <* atomically seal-{-# INLINABLE producer #-}---- | Read lines from standard input-stdinLines :: Managed (Controller String)-stdinLines = producer Single Pipes.stdinLn-{-# INLINABLE stdinLines #-}---- | Read lines from a file-inLines :: FilePath -> Managed (Controller String)-inLines filePath = do- handle <- inHandle filePath- producer Single (Pipes.fromHandle handle)-{-# INLINABLE inLines #-}---- | 'read' values from a file, one value per line, skipping failed parses-inRead :: Read a => FilePath -> Managed (Controller a)-inRead filePath = fmap (keeps parsed) (inLines filePath)- where- parsed k str = case reads str of- [(a, "")] -> Constant (getConstant (k a))- _ -> pure str-{-# INLINABLE inRead #-}---- | Emit empty values spaced by a delay in seconds-tick :: Double -> Managed (Controller ())-tick n = producer Single $ lift (threadDelay (truncate (n * 1000000))) >~ cat-{-# INLINABLE tick #-}---- | Create a `View` from a `Consumer`-consumer :: Consumer a IO () -> Managed (View a)-consumer cons0 = managed $ \k -> do- mf0 <- nextRequest cons0- ref <- newIORef mf0- k $ asSink $ \a -> do- mf <- readIORef ref- case mf of- Nothing -> return ()- Just f -> do- mf' <- nextRequest (f a)- writeIORef ref mf'- where- nextRequest :: Consumer a IO () -> IO (Maybe (a -> Consumer a IO ()))- nextRequest cons = case cons of- Request () fa -> return (Just fa)- Respond v _ -> closed v- M m -> m >>= nextRequest- Pure () -> return Nothing-{-# INLINABLE consumer #-}- --- | Write lines to standard output-stdoutLines :: View String-stdoutLines = asSink putStrLn-{-# INLINABLE stdoutLines #-}---- | Write lines to a file-outLines :: FilePath -> Managed (View String)-outLines filePath = do- handle <- outHandle filePath- return (asSink (IO.hPutStrLn handle))-{-# INLINABLE outLines #-}---- | 'show' values to a file, one value per line-outShow :: Show a => FilePath -> Managed (View a)-outShow filePath = fmap (contramap show) (outLines filePath)-{--outShow filePath = do- handle <- outHandle filePath- return (asSink (IO.hPrint handle))--}-{-# INLINABLE outShow #-}---- | Read from a `FilePath` using a `Managed` `IO.Handle`-inHandle :: FilePath -> Managed IO.Handle-inHandle filePath = managed (IO.withFile filePath IO.ReadMode)-{-# INLINABLE inHandle #-}---- | Write to a `FilePath` using a `Managed` `IO.Handle`-outHandle :: FilePath -> Managed IO.Handle-outHandle filePath = managed (IO.withFile filePath IO.WriteMode)-{-# INLINABLE outHandle #-}--{- $example- The following example distils a @sdl@-based program into pure and impure- components. This program will draw a white rectangle between every two- mouse clicks.-- The first half of the program contains all the concurrent and impure logic.- The `View` and `Controller` must be `Managed` together since they both share- the same initialization logic:--> import Control.Monad (join)-> import Graphics.UI.SDL as SDL-> import Lens.Family.Stock (_Left, _Right) -- from `lens-family-core`-> import MVC-> import MVC.Prelude-> import qualified Pipes.Prelude as Pipes-> -> data Done = Done deriving (Eq, Show)-> -> sdl :: Managed (View (Either Rect Done), Controller Event)-> sdl = join $ managed $ \k -> withInit [InitVideo, InitEventthread] $ do-> surface <- setVideoMode 640 480 32 [SWSurface]-> white <- mapRGB (surfaceGetPixelFormat surface) 255 255 255-> -> let done :: View Done-> done = asSink (\Done -> SDL.quit)-> -> drawRect :: View Rect-> drawRect = asSink $ \rect -> do-> _ <- fillRect surface (Just rect) white-> SDL.flip surface-> -> totalOut :: View (Either Rect Done)-> totalOut = handles _Left drawRect <> handles _Right done-> -> k $ do-> totalIn <- producer Single (lift waitEvent >~ cat)-> return (totalOut, totalIn)-- Note the `Control.Monad.join` surrounding the `managed` block. This is- because the type before `Control.Monad.join` is:--> Managed (Managed (View (Either Rect Done), Controller Event))-- More generally, note that `Managed` is a `Monad`, so you can use @do@- notation to combine multiple `Managed` resources into a single `Managed`- resource.-- The second half of the program contains the pure logic.--> pipe :: Monad m => Pipe Event (Either Rect Done) m ()-> pipe = do-> Pipes.takeWhile (/= Quit) >-> (click >~ rectangle >~ Pipes.map Left)-> yield (Right Done)-> -> rectangle :: Monad m => Consumer' (Int, Int) m Rect-> rectangle = do-> (x1, y1) <- await-> (x2, y2) <- await-> let x = min x1 x2-> y = min y1 y2-> w = abs (x1 - x2)-> h = abs (y1 - y2)-> return (Rect x y w h)-> -> click :: Monad m => Consumer' Event m (Int, Int)-> click = do-> e <- await-> case e of-> MouseButtonDown x y ButtonLeft ->-> return (fromIntegral x, fromIntegral y)-> _ -> click-> -> main :: IO ()-> main = runMVC () (asPipe pipe) sdl-- Run the program to verify that clicks create rectangles.-- The more logic you move into the pure core the more you can exercise your- program purely, either manually:-->>> let leftClick (x, y) = MouseButtonDown x y ButtonLeft->>> Pipes.toList (each [leftClick (10, 10), leftClick (15, 16), Quit] >-> pipe)-[Left (Rect {rectX = 10, rectY = 10, rectW = 5, rectH = 6}),Right Done]-- ... or automatically using property-based testing (such as @QuickCheck@):-->>> import Test.QuickCheck->>> quickCheck $ \xs -> length (Pipes.toList (each (map leftClick xs) >-> pipe)) == length xs `div` 2-+++ OK, passed 100 tests.-- Equally important, you can formally prove properties about your model using- equational reasoning because the model is `IO`-free and concurrency-free.--}+{-| Simple utilities + + The \"Example\" section at the bottom of this module contains an extended + example of how to interact with the @sdl@ library using the @mvc@ library +-} + +module MVC.Prelude ( + -- * Controllers + producer + , stdinLines + , inLines + , inRead + , tick + + -- * Views + , consumer + , stdoutLines + , outLines + , outShow + + -- * Handles + , inHandle + , outHandle + + -- * Example + -- $example + ) where + +import Control.Applicative (pure, (<*)) +import Control.Concurrent.Async (withAsync) +import Control.Concurrent (threadDelay) +import Data.IORef (newIORef, readIORef, writeIORef) +import MVC +import Pipes.Internal (Proxy(..), closed) +import qualified Pipes.Prelude as Pipes +import qualified System.IO as IO + +{-| Create a `Controller` from a `Producer`, using the given `Buffer` + + If you're not sure what `Buffer` to use, try `Single` +-} +producer :: Buffer a -> Producer a IO () -> Managed (Controller a) +producer buffer prod = managed $ \k -> do + (o, i, seal) <- spawn' buffer + let io = do + runEffect $ prod >-> toOutput o + atomically seal + withAsync io $ \_ -> k (asInput i) <* atomically seal +{-# INLINABLE producer #-} + +-- | Read lines from standard input +stdinLines :: Managed (Controller String) +stdinLines = producer Single Pipes.stdinLn +{-# INLINABLE stdinLines #-} + +-- | Read lines from a file +inLines :: FilePath -> Managed (Controller String) +inLines filePath = do + handle <- inHandle filePath + producer Single (Pipes.fromHandle handle) +{-# INLINABLE inLines #-} + +-- | 'read' values from a file, one value per line, skipping failed parses +inRead :: Read a => FilePath -> Managed (Controller a) +inRead filePath = fmap (keeps parsed) (inLines filePath) + where + parsed k str = case reads str of + [(a, "")] -> Constant (getConstant (k a)) + _ -> pure str +{-# INLINABLE inRead #-} + +-- | Emit empty values spaced by a delay in seconds +tick :: Double -> Managed (Controller ()) +tick n = producer Single $ lift (threadDelay (truncate (n * 1000000))) >~ cat +{-# INLINABLE tick #-} + +-- | Create a `View` from a `Consumer` +consumer :: Consumer a IO () -> Managed (View a) +consumer cons0 = managed $ \k -> do + mf0 <- nextRequest cons0 + ref <- newIORef mf0 + k $ asSink $ \a -> do + mf <- readIORef ref + case mf of + Nothing -> return () + Just f -> do + mf' <- nextRequest (f a) + writeIORef ref mf' + where + nextRequest :: Consumer a IO () -> IO (Maybe (a -> Consumer a IO ())) + nextRequest cons = case cons of + Request () fa -> return (Just fa) + Respond v _ -> closed v + M m -> m >>= nextRequest + Pure () -> return Nothing +{-# INLINABLE consumer #-} + +-- | Write lines to standard output +stdoutLines :: View String +stdoutLines = asSink putStrLn +{-# INLINABLE stdoutLines #-} + +-- | Write lines to a file +outLines :: FilePath -> Managed (View String) +outLines filePath = do + handle <- outHandle filePath + return (asSink (IO.hPutStrLn handle)) +{-# INLINABLE outLines #-} + +-- | 'show' values to a file, one value per line +outShow :: Show a => FilePath -> Managed (View a) +outShow filePath = fmap (contramap show) (outLines filePath) +{- +outShow filePath = do + handle <- outHandle filePath + return (asSink (IO.hPrint handle)) +-} +{-# INLINABLE outShow #-} + +-- | Read from a `FilePath` using a `Managed` `IO.Handle` +inHandle :: FilePath -> Managed IO.Handle +inHandle filePath = managed (IO.withFile filePath IO.ReadMode) +{-# INLINABLE inHandle #-} + +-- | Write to a `FilePath` using a `Managed` `IO.Handle` +outHandle :: FilePath -> Managed IO.Handle +outHandle filePath = managed (IO.withFile filePath IO.WriteMode) +{-# INLINABLE outHandle #-} + +{- $example + The following example distils a @sdl@-based program into pure and impure + components. This program will draw a white rectangle between every two + mouse clicks. + + The first half of the program contains all the concurrent and impure logic. + The `View` and `Controller` must be `Managed` together since they both share + the same initialization logic: + +> import Control.Monad (join) +> import Graphics.UI.SDL as SDL +> import Lens.Family.Stock (_Left, _Right) -- from `lens-family-core` +> import MVC +> import MVC.Prelude +> import qualified Pipes.Prelude as Pipes +> +> data Done = Done deriving (Eq, Show) +> +> sdl :: Managed (View (Either Rect Done), Controller Event) +> sdl = join $ managed $ \k -> withInit [InitVideo, InitEventthread] $ do +> surface <- setVideoMode 640 480 32 [SWSurface] +> white <- mapRGB (surfaceGetPixelFormat surface) 255 255 255 +> +> let done :: View Done +> done = asSink (\Done -> SDL.quit) +> +> drawRect :: View Rect +> drawRect = asSink $ \rect -> do +> _ <- fillRect surface (Just rect) white +> SDL.flip surface +> +> totalOut :: View (Either Rect Done) +> totalOut = handles _Left drawRect <> handles _Right done +> +> k $ do +> totalIn <- producer Single (lift waitEvent >~ cat) +> return (totalOut, totalIn) + + Note the `Control.Monad.join` surrounding the `managed` block. This is + because the type before `Control.Monad.join` is: + +> Managed (Managed (View (Either Rect Done), Controller Event)) + + More generally, note that `Managed` is a `Monad`, so you can use @do@ + notation to combine multiple `Managed` resources into a single `Managed` + resource. + + The second half of the program contains the pure logic. + +> pipe :: Monad m => Pipe Event (Either Rect Done) m () +> pipe = do +> Pipes.takeWhile (/= Quit) >-> (click >~ rectangle >~ Pipes.map Left) +> yield (Right Done) +> +> rectangle :: Monad m => Consumer' (Int, Int) m Rect +> rectangle = do +> (x1, y1) <- await +> (x2, y2) <- await +> let x = min x1 x2 +> y = min y1 y2 +> w = abs (x1 - x2) +> h = abs (y1 - y2) +> return (Rect x y w h) +> +> click :: Monad m => Consumer' Event m (Int, Int) +> click = do +> e <- await +> case e of +> MouseButtonDown x y ButtonLeft -> +> return (fromIntegral x, fromIntegral y) +> _ -> click +> +> main :: IO () +> main = runMVC () (asPipe pipe) sdl + + Run the program to verify that clicks create rectangles. + + The more logic you move into the pure core the more you can exercise your + program purely, either manually: + +>>> let leftClick (x, y) = MouseButtonDown x y ButtonLeft +>>> Pipes.toList (each [leftClick (10, 10), leftClick (15, 16), Quit] >-> pipe) +[Left (Rect {rectX = 10, rectY = 10, rectW = 5, rectH = 6}),Right Done] + + ... or automatically using property-based testing (such as @QuickCheck@): + +>>> import Test.QuickCheck +>>> quickCheck $ \xs -> length (Pipes.toList (each (map leftClick xs) >-> pipe)) == length xs `div` 2 ++++ OK, passed 100 tests. + + Equally important, you can formally prove properties about your model using + equational reasoning because the model is `IO`-free and concurrency-free. +-}