├── .github └── workflows │ └── build.yml ├── .gitignore ├── CHANGELOG.md ├── CONTRIBUTORS ├── LICENSE ├── Readme.md ├── Setup.hs ├── doc ├── Readme.md ├── design.md ├── examples │ ├── BreadthFirstParsing.hs │ ├── ListT.hs │ ├── LogicT.hs │ ├── PoorMansConcurrency.hs │ ├── Readme.md │ ├── State.hs │ ├── TicTacToe.hs │ └── WebSessionState.lhs ├── proofs.md └── tutorial-changes.md ├── operational.cabal └── src └── Control └── Monad └── Operational.hs /.github/workflows/build.yml: -------------------------------------------------------------------------------- 1 | name: Build 2 | on: 3 | workflow_dispatch: 4 | pull_request: 5 | types: 6 | - synchronize 7 | - opened 8 | - reopened 9 | push: 10 | branches: 11 | - master 12 | schedule: 13 | # Run once per day (at UTC 00:00) to maintain cache: 14 | - cron: 0 0 * * * 15 | jobs: 16 | build: 17 | name: ${{ matrix.os }}-ghc-${{ matrix.ghc }} 18 | runs-on: ${{ matrix.os }} 19 | strategy: 20 | matrix: 21 | os: 22 | - ubuntu-latest 23 | # - macOS-latest 24 | # - windows-latest 25 | cabal: 26 | - 3.6.2.0 27 | ghc: 28 | - 8.10.7 29 | - 9.2.8 30 | - 9.4.8 31 | - 9.6.3 32 | - 9.8.1 33 | steps: 34 | - name: Checkout 35 | uses: actions/checkout@v3 36 | 37 | - name: Environment 38 | uses: haskell/actions/setup@v2 39 | id: setup-haskell-cabal 40 | with: 41 | ghc-version: ${{ matrix.ghc }} 42 | cabal-version: ${{ matrix.cabal }} 43 | 44 | - name: Configure 45 | run: > 46 | cabal configure 47 | --enable-tests 48 | --enable-benchmarks 49 | --enable-documentation 50 | --test-show-details=direct 51 | --write-ghc-environment-files=always 52 | 53 | - name: Freeze 54 | run: | 55 | cabal freeze 56 | 57 | - name: Cache 58 | uses: actions/cache@v3 59 | with: 60 | path: ${{ steps.setup-haskell-cabal.outputs.cabal-store }} 61 | key: | 62 | ${{ runner.os }}-\ 63 | ${{ matrix.ghc }}-\ 64 | ${{ hashFiles('cabal.project.freeze') }} 65 | 66 | - name: Dependencies 67 | run: | 68 | ghc --version 69 | cabal --version 70 | cabal build all --only-dependencies 71 | 72 | - name: Build 73 | run: | 74 | cabal build all 75 | 76 | - name: Test 77 | run: | 78 | cabal test all 79 | 80 | - name: Documentation 81 | if: | 82 | false 83 | && matrix.os == 'ubuntu-latest' 84 | && matrix.ghc == '8.10.7' 85 | run: > 86 | cabal haddock 87 | --haddock-hyperlink-source 88 | --haddock-quickjump 89 | --haddock-html-location 90 | 'https://hackage.haskell.org/package/$pkg-$version/docs' 91 | 92 | mv dist-newstyle/build/*/*/*/doc/html/* gh-pages 93 | 94 | touch gh-pages/.nojekyll 95 | 96 | - name: Deploy 97 | if: | 98 | false 99 | && github.ref == 'refs/heads/master' 100 | && matrix.os == 'ubuntu-latest' 101 | && matrix.ghc == '8.10.7' 102 | uses: JamesIves/github-pages-deploy-action@v4.3.3 103 | with: 104 | branch: gh-pages 105 | folder: gh-pages 106 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | 3 | cabal.project.local 4 | dist/ 5 | dist-newstyle/ 6 | *.cabal-sandbox 7 | 8 | .stack-work/ 9 | .stack.yaml.lock 10 | 11 | *.tmproj 12 | .ghc.environment.* 13 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | Changelog for the `operational` package 2 | --------------------------------------- 3 | 4 | **0.2.4.2** -- Maintenance release. 5 | 6 | * Compatibility with `mtl-2.3.1` 7 | 8 | **0.2.4.1** -- Maintenance release. 9 | 10 | * Restrict dependencies to ensure GHC >= 7.10. 11 | 12 | **0.2.4.0** -- Feature release. 13 | 14 | * Update to build with GHC 9.0.1. 15 | * Add utility functions `interpretWithMonadT`, `unviewT` and `mapInstr` 16 | * Add utility `Functor`, `Applicative`, and `Monad` instances for `ProgramViewT` type. 17 | 18 | **0.2.3.5** -- Maintenance release. 19 | 20 | * Update references to other packages. 21 | * Modernize `.cabal` file. 22 | 23 | **0.2.3.4** -- Maintenance release. 24 | 25 | * Restrict dependencies to ensure GHC >= 7.2. 26 | 27 | **0.2.3.3** -- Maintenance release. 28 | 29 | * Minor fixes to documentation and examples 30 | 31 | **0.2.3.2** -- Maintenance release. 32 | 33 | * Bump `mtl` dependency to allow 2.3 34 | 35 | **0.2.3.1** -- Maintenance release. 36 | 37 | * Bump `mtl` dependency to allow 2.2 38 | 39 | **0.2.3.0** -- Maintenance release. 40 | 41 | * added instance for `MonadReader` class 42 | * clean up documentation 43 | 44 | **0.2.2.0** -- Feature release. 45 | 46 | * add utility function `interpretWithMonad` 47 | 48 | **0.2.1.0** -- Maintenance release. 49 | 50 | * minor change: eta-reduce `Program` and `ProgramView` type synonyms 51 | 52 | **0.2.0.3** -- Maintenance release. 53 | 54 | * moved project repository to github 55 | 56 | **0.2.0.0** -- Feature release. 57 | 58 | * changed name of view type to `ProgramView` 59 | * added instances for mtl classes 60 | * new function `liftProgram` to embed `Program` in `ProgramT` 61 | * new example `TicTacToe.hs` 62 | * various documentation updates 63 | 64 | **0.1.0.0** 65 | 66 | * initial release 67 | -------------------------------------------------------------------------------- /CONTRIBUTORS: -------------------------------------------------------------------------------- 1 | Andreas Abel 2 | Heinrich Apfelmus 3 | Manuel Bärenz 4 | Herbert Valerio Riedel 5 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | (c) 2010 Heinrich Apfelmus 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions 7 | are met: 8 | 9 | 1. Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | 2. Redistributions in binary form must reproduce the above copyright 13 | notice, this list of conditions and the following disclaimer in the 14 | documentation and/or other materials provided with the distribution. 15 | 16 | 3. Neither the name of the author nor the names of his contributors 17 | may be used to endorse or promote products derived from this software 18 | without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS 21 | OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 22 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR 24 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 25 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 26 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 27 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, 28 | STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 29 | ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 30 | POSSIBILITY OF SUCH DAMAGE. 31 | ~ 32 | -------------------------------------------------------------------------------- /Readme.md: -------------------------------------------------------------------------------- 1 | [![Hackage](https://img.shields.io/hackage/v/operational.svg)](https://hackage.haskell.org/package/operational) 2 | 3 | **Operational** is a tiny library for **implementing monads** by specifying the primitive instructions and their operational semantics. The monad laws will hold automatically. It can also be used to define monad transformers where the lifting laws hold automatically. 4 | 5 | Using operational semantics simplifies the implementation of monads with tricky control flow, such as: 6 | 7 | * web applications in sequential style 8 | * games with a uniform interface for human and AI players, and automatic replay 9 | * fast parser monads 10 | * monadic DSLs of any kind 11 | * ... 12 | 13 | Any monad and monad transformer can be implemented in this fashion. 14 | 15 | The library is based on the article [The Operational Monad Tutorial][tutorial], published in [Issue 15 of The Monad.Reader][reader]. 16 | 17 | ## Example 18 | 19 | For example, imagine that you want to write a web application where the user is guided through a sequence of tasks ("wizard"). To structure your application, you can use a custom monad that supports an instruction `askUserInput :: CustomMonad UserInput`. This command sends a web form to the user and returns a result when he submits the form. However, you don't want your server to block while waiting for the user, so you have to suspend the computation and resume it at some later point. Sounds tricky to implement? This library makes it easy: 20 | 21 | The idea is to identify a set of primitive instructions and to specify their operational semantics. Then, the library makes sure that the monad laws hold automatically. In the web application example, the primitive instruction would be `AskUserInput`. 22 | 23 | The above example is implemented in [WebSessionState.lhs](doc/examples/WebSessionState.lhs). 24 | 25 | ## Documentation 26 | 27 | [More documentation and examples are included in the `doc/` folder](doc/). 28 | 29 | 30 | ## Related 31 | 32 | Sources and inspiration for this library include 33 | 34 | * [Chuan-kai Lin's unimo paper][unimo] 35 | * J. Hughes, [The Design of a Pretty-printing Library][hughes], (1995) 36 | * [Ryan Ingram's `MonadPrompt` package][prompt]. 37 | 38 | Related packages included 39 | 40 | * [MonadPrompt](http://hackage.haskell.org/package/MonadPrompt) 41 | * [free](http://hackage.haskell.org/package/free) 42 | * [free-operational](http://hackage.haskell.org/package/free-operational) 43 | 44 | [reader]: http://themonadreader.wordpress.com/2010/01/26/issue-15/ 45 | [tutorial]: http://apfelmus.nfshost.com/articles/operational-monad.html 46 | [unimo]: http://web.cecs.pdx.edu/~cklin/papers/unimo-143.pdf "Chuan-kai Lin. Programming Monads Operationally with Unimo." 47 | [hughes]: http://citeseer.ist.psu.edu/hughes95design.html "John Hughes. The Design of a Pretty-printing Library." 48 | [prompt]: http://hackage.haskell.org/package/MonadPrompt "Ryan Ingram's Monad Prompt Package." 49 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /doc/Readme.md: -------------------------------------------------------------------------------- 1 | This folder contains various documentation for the `operational` package. 2 | 3 | Files: 4 | 5 |
6 |
design.md 7 |
Describes miscellanous design decisions. 8 |
examples/ 9 |
Extensive code examples. 10 |
proofs.md 11 |
Proofs that the implementation is correct: monad laws, monad transformer classes. 12 |
tutorial-changes.md 13 |
Documents changes how the library API and implementation differs from the Operational Monad Tutorial. 14 |
15 | 16 | -------------------------------------------------------------------------------- /doc/design.md: -------------------------------------------------------------------------------- 1 | This document discusses miscellaneous design decisions and remarks for the `operational` library. This is mainly so that I can still remember them in a couple of years. 2 | 3 | Lifting control operations 4 | -------------------------- 5 | The monad transformer `ProgramT` can automatically lift operations from the base monad, notably those from `MonadState` and `MonadIO`. 6 | 7 | Until recently, I thought that this is restricted to algebraic operations and cannot be done for control operations. (For more on this nomenclature, see a [remark by Conor McBride][conor].) However, it turns that it can actually be done for some control operations as well! 8 | 9 | [conor]: http://www.haskell.org/pipermail/haskell-cafe/2010-April/076185.html 10 | 11 | For instance, the `MonadReader` class has a control operation `local`. The point is that it is subject to the following laws 12 | 13 | local :: MonadReader r m => (r -> r) -> m a -> m a 14 | 15 | local r (lift m) = lift (local r m) 16 | local r (return a) = return a 17 | local r (m >>= k) = local r m >>= local r . k 18 | 19 | Together with the requirement that the new instructions introduced by `ProgramT` do not interfere with the corresponding effect, 20 | 21 | local r (singleton instr) = singleton instr 22 | 23 | these laws specify a unique lifting. 24 | 25 | In other words, we can lift control operations whenever they obey laws that relate to `>>=` and `return`. 26 | 27 | `mapMonad` 28 | ---------- 29 | Limestraël [has suggested][1] that the module `Control.Monad.Operational` includes a function 30 | 31 | mapMonad :: (Monad m, Monad n) 32 | => (forall a. m a -> n a) -> ProgramT instr m a -> ProgramT instr n a 33 | 34 | which changes the base monad for the `ProgramT` monad transformer. A possible implementation is 35 | 36 | mapMonad f = id' <=< lift . f . viewT 37 | where 38 | id' (Return a) = return a 39 | id' (i :>>= k) = singleton i >>= mapMonad f . k 40 | 41 | However, for the time being, I have [opted against][1] adding this function because there is no guarantee that the mapping function `forall. m a -> n a` actually preserves the argument. 42 | 43 | 44 | [1]: http://www.haskell.org/pipermail/haskell-cafe/2010-May/077094.html 45 | [2]: http://www.haskell.org/pipermail/haskell-cafe/2010-May/077097.html 46 | 47 | 48 | Recursive type definitions with `Program` 49 | ----------------------------------------- 50 | In the [unimo paper][unimo], the instructions carry an additional parameter that "unties" recursive type definition. For example, the instructions for `MonadPlus` are written 51 | 52 | data PlusI unimo a where 53 | Zero :: PlusI unimo a 54 | Plus :: unimo a -> unimo a -> PlusI unimo a 55 | 56 | The type constructor variable `unimo` will be tied to `Unimo PlusI`. 57 | 58 | In this library, I have opted for the conceptually simpler approach that requires the user to tie the recursion himself 59 | 60 | data PlusI a where 61 | Zero :: PlusI a 62 | Plus :: Program PlusI a -> Program PlusI a -> Plus I a 63 | 64 | I am not sure whether this has major consequences for composeablity; at the moment I believe that the former style can always be recovered from an implementation in the latter style. 65 | 66 | 67 | [unimo]: http://web.cecs.pdx.edu/~cklin/papers/unimo-143.pdf "Chuan-kai Lin. Programming Monads Operationally with Unimo." 68 | -------------------------------------------------------------------------------- /doc/examples/BreadthFirstParsing.hs: -------------------------------------------------------------------------------- 1 | {------------------------------------------------------------------------------ 2 | Control.Monad.Operational 3 | 4 | Example: 5 | A reformulation of Koen Claessen's Parallel Parsing Processes 6 | http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.19.9217 7 | 8 | For a detailed explanation, see also 9 | http://apfelmus.nfshost.com/articles/operational-monad.html#monadic-parser-combinators 10 | ------------------------------------------------------------------------------} 11 | {-# LANGUAGE GADTs, Rank2Types, TypeSynonymInstances #-} 12 | module BreadthFirstParsing where 13 | 14 | import Control.Monad 15 | import Control.Monad.Operational 16 | 17 | {------------------------------------------------------------------------------ 18 | At their core, a parser monad consists of just three 19 | primitive instructions 20 | 21 | symbol -- fetch the next character 22 | mzero -- indicate parse failure 23 | mplus -- non-deterministic choice between two parsers 24 | 25 | and an interpreter function 26 | 27 | parse :: Parser a -> (String -> [a]) 28 | 29 | that applies a parser to a string and returns 30 | all the possible parse results. 31 | ------------------------------------------------------------------------------} 32 | data ParserInstruction a where 33 | Symbol :: ParserInstruction Char 34 | MZero :: ParserInstruction a 35 | MPlus :: Parser a -> Parser a -> ParserInstruction a 36 | 37 | type Parser = Program ParserInstruction 38 | 39 | symbol = singleton Symbol 40 | 41 | instance MonadPlus Parser where 42 | mzero = singleton $ MZero 43 | mplus x y = singleton $ MPlus x y 44 | 45 | -- apply a parser to a string 46 | -- breadth first fashion: each input character is touched only once 47 | parse :: Parser a -> String -> [a] 48 | parse p = go (expand p) 49 | where 50 | go :: [Parser a] -> String -> [a] 51 | go ps [] = [a | Return a <- map view ps] 52 | go ps (c:cs) = go [p | (Symbol :>>= is) <- map view ps, p <- expand (is c)] cs 53 | 54 | -- keep track of parsers that are run in parallel 55 | expand :: Parser a -> [Parser a] 56 | expand p = case view p of 57 | MPlus p q :>>= k -> expand (p >>= k) ++ expand (q >>= k) 58 | MZero :>>= k -> [] 59 | _ -> [p] 60 | 61 | 62 | -- example 63 | -- > parse parens "()(()())" 64 | -- [()] -- one parse 65 | -- > parse parens "()((())" 66 | -- [] -- no parse 67 | parens :: Parser () 68 | parens = return () `mplus` (enclose parens >> parens) 69 | where 70 | enclose q = char '(' >> q >> char ')' 71 | 72 | many :: Parser a -> Parser [a] 73 | many p = mzero `mplus` liftM2 (:) p (many p) 74 | 75 | satisfy :: (Char -> Bool) -> Parser Char 76 | satisfy p = do c <- symbol; if p c then return c else mzero 77 | 78 | char c = satisfy (==c) 79 | -------------------------------------------------------------------------------- /doc/examples/ListT.hs: -------------------------------------------------------------------------------- 1 | {------------------------------------------------------------------------------ 2 | Control.Monad.Operational 3 | 4 | Example: 5 | List Monad Transformer 6 | 7 | ------------------------------------------------------------------------------} 8 | {-# LANGUAGE GADTs, Rank2Types, FlexibleInstances #-} 9 | module ListT where 10 | 11 | import Control.Monad 12 | import Control.Monad.Operational 13 | import Control.Monad.Trans 14 | 15 | {------------------------------------------------------------------------------ 16 | A direct implementation 17 | type ListT m a = m [a] 18 | would violate the monad laws, but we don't have that problem. 19 | ------------------------------------------------------------------------------} 20 | data MPlus m a where 21 | MZero :: MPlus m a 22 | MPlus :: ListT m a -> ListT m a -> MPlus m a 23 | 24 | type ListT m a = ProgramT (MPlus m) m a 25 | 26 | -- *sigh* I want to use type synonyms for type constructors, too; 27 | -- GHC doesn't accept MonadMPlus (ListT m) 28 | instance Monad m => MonadPlus (ProgramT (MPlus m) m) where 29 | mzero = singleton MZero 30 | mplus m n = singleton (MPlus m n) 31 | 32 | runListT :: Monad m => ListT m a -> m [a] 33 | runListT = eval <=< viewT 34 | where 35 | eval :: Monad m => ProgramViewT (MPlus m) m a -> m [a] 36 | eval (Return x) = return [x] 37 | eval (MZero :>>= k) = return [] 38 | eval (MPlus m n :>>= k) = 39 | liftM2 (++) (runListT (m >>= k)) (runListT (n >>= k)) 40 | 41 | testListT :: IO [()] 42 | testListT = runListT $ do 43 | n <- choice [1..5] 44 | lift . print $ "You've chosen the number: " ++ show n 45 | where 46 | choice = foldr1 mplus . map return 47 | 48 | 49 | -- testing the monad laws, from the Haskellwiki 50 | -- http://wiki.haskell.org/ListT_done_right#Order_of_printing 51 | a,b,c :: ListT IO () 52 | [a,b,c] = map (lift . putChar) ['a','b','c'] 53 | 54 | -- t1 and t2 have to print the same sequence of letters 55 | t1 = runListT $ ((a `mplus` a) >> b) >> c 56 | t2 = runListT $ (a `mplus` a) >> (b >> c) 57 | -------------------------------------------------------------------------------- /doc/examples/LogicT.hs: -------------------------------------------------------------------------------- 1 | {------------------------------------------------------------------------------ 2 | Control.Monad.Operational 3 | 4 | Example: 5 | Oleg's LogicT monad transformer 6 | 7 | Functions to implement are taken from the corresponding paper 8 | http://okmij.org/ftp/papers/LogicT.pdf 9 | 10 | ------------------------------------------------------------------------------} 11 | {-# LANGUAGE GADTs, Rank2Types #-} 12 | module LogicT (LogicT, msplit, observe, bagOfN, interleave) where 13 | 14 | import Control.Monad 15 | import Control.Monad.Operational 16 | import Control.Monad.Trans 17 | 18 | import Data.Maybe 19 | 20 | {------------------------------------------------------------------------------ 21 | LogicT 22 | = A MonadPlus with an additional operation 23 | msplit 24 | which returns the first result and a computation to 25 | produce the remaining results. 26 | 27 | 28 | For example, the function msplit satisfies the laws 29 | 30 | msplit mzero ~> return Nothing 31 | msplit (return a `mplus` m) ~> return (Just (a,m)) 32 | 33 | It turns out that we don't have to make msplit a primitive, 34 | we can implement it by inspection on the argument. In other 35 | words, LogicT will be the same as the ListT monad transformer 36 | ------------------------------------------------------------------------------} 37 | import ListT 38 | type LogicT m a = ListT m a 39 | 40 | -- msplit is the lift of a function split in the base monad 41 | msplit :: Monad m => LogicT m a -> LogicT m (Maybe (a, LogicT m a)) 42 | msplit = lift . split 43 | 44 | -- split in the base monad 45 | split :: Monad m => LogicT m a -> m (Maybe (a, LogicT m a)) 46 | split = eval <=< viewT 47 | where 48 | -- apply the laws for msplit 49 | eval :: Monad m => ProgramViewT (MPlus m) m a -> m (Maybe (a, LogicT m a)) 50 | eval (Return v) = return (Just (v, mzero)) 51 | eval (MZero :>>= k) = return Nothing 52 | eval (MPlus m n :>>= k) = do 53 | ma <- split (m >>= k) 54 | case ma of 55 | Nothing -> split (n >>= k) 56 | Just (a,m') -> return $ Just (a, m' `mplus` (n >>= k)) 57 | -- inefficient! 58 | -- `mplus` will add another (>>= return) 59 | -- to n each time it's called. 60 | -- Curing this is not easy. 61 | 62 | -- main interpreter, section 6 in the paper 63 | -- returns the first result, if any; may fail 64 | observe :: Monad m => LogicT m a -> m a 65 | observe m = (fst . fromJust) `liftM` split m 66 | 67 | {------------------------------------------------------------------------------ 68 | Derived functions from the paper 69 | ------------------------------------------------------------------------------} 70 | -- return the first n results, section 6 71 | bagOfN :: Monad m => Maybe Int -> LogicT m a -> LogicT m [a] 72 | bagOfN (Just n) m | n <= 0 = return [] 73 | bagOfN n m = msplit m >>= bagofN' 74 | where 75 | bagofN' Nothing = return [] 76 | bagofN' (Just (x,m')) = (x:) `liftM` bagOfN (fmap pred n) m' 77 | where pred n = n-1 78 | 79 | -- interleave 80 | interleave :: Monad m => LogicT m a -> LogicT m a -> LogicT m a 81 | interleave m1 m2 = do 82 | r <- msplit m1 83 | case r of 84 | Nothing -> m2 85 | Just (a,m1') -> return a `mplus` interleave m2 m1' 86 | 87 | 88 | -------------------------------------------------------------------------------- /doc/examples/PoorMansConcurrency.hs: -------------------------------------------------------------------------------- 1 | {------------------------------------------------------------------------------ 2 | Control.Monad.Operational 3 | 4 | Example: 5 | Koen Claessen's Poor Man's Concurrency Monad 6 | http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.39.8039 7 | 8 | ------------------------------------------------------------------------------} 9 | {-# LANGUAGE GADTs, Rank2Types #-} 10 | module PoorMansConcurrency where 11 | 12 | import Control.Monad 13 | import Control.Monad.Operational 14 | import Control.Monad.Trans hiding (lift) 15 | 16 | {------------------------------------------------------------------------------ 17 | A concurrency monad runs several processes in parallel 18 | and supports two primitive operations 19 | 20 | fork -- fork a new process 21 | stop -- halt the current one 22 | 23 | We want this to be a monad transformer, so we also need a function lift 24 | This time, however, we cannot use the monad transformer version ProgramT 25 | because this will leave no room for interleaving different computations 26 | of the base monad. 27 | ------------------------------------------------------------------------------} 28 | data ProcessI m a where 29 | Lift :: m a -> ProcessI m a 30 | Stop :: ProcessI m a 31 | Fork :: Process m () -> ProcessI m () 32 | 33 | 34 | type Process m a = Program (ProcessI m) a 35 | 36 | stop = singleton Stop 37 | fork = singleton . Fork 38 | lift = singleton . Lift 39 | 40 | -- interpreter 41 | runProcess :: Monad m => Process m a -> m () 42 | runProcess m = schedule [m] 43 | where 44 | schedule :: Monad m => [Process m a] -> m () 45 | schedule [] = return () 46 | schedule (x:xs) = run (view x) xs 47 | 48 | run :: Monad m => ProgramView (ProcessI m) a -> [Process m a] -> m () 49 | run (Return _) xs = return () -- process finished 50 | run (Lift m :>>= k) xs = m >>= \a -> -- switch process 51 | schedule (xs ++ [k a]) 52 | run (Stop :>>= k) xs = schedule xs -- process halts 53 | run (Fork p :>>= k) xs = schedule (xs ++ [x2,x1]) -- fork new process 54 | where x1 = k (); x2 = p >>= k 55 | 56 | -- example 57 | -- > runProcess example -- warning: runs indefinitely 58 | example :: Process IO () 59 | example = do 60 | write "Start!" 61 | fork (loop "fish") 62 | loop "cat" 63 | 64 | write = lift . putStr 65 | loop s = write s >> loop s 66 | -------------------------------------------------------------------------------- /doc/examples/Readme.md: -------------------------------------------------------------------------------- 1 | Example Code for the *operational* package 2 | ========================================== 3 | 4 |
5 |
BreadthFirstParsing.hs 6 |
An breadth-first implementation of parser combinators. 7 | As this implementation does not back-track, we avoid a common space leak. 8 |
LogicT.hs 9 |
Oleg Kiselyov's LogicT monad transformer. 10 |
ListT.hs 11 |
Correct implementation of the list monad transformer. 12 |
PoorMansConcurrency.hs 13 |
Koen Claessen's poor man's concurrency monad, implements cooperative multitasking. 14 |
State.hs 15 |
Very simple example showing how to implement the state monad. 16 |
TicTacToe.hs 17 |
The game of TicTacToe. Mix and mash humans and AI as you like; players are implemented in a special monad that looks like there is only one player playing. 18 |
WebSessionState.lhs 19 |
CGI Script that is written in a style seems to require exeution in a persistent process, but actually stores a log of the session in the client. 20 |
21 | -------------------------------------------------------------------------------- /doc/examples/State.hs: -------------------------------------------------------------------------------- 1 | {------------------------------------------------------------------------------ 2 | Control.Monad.Operational 3 | 4 | Example: 5 | State monad and monad transformer 6 | 7 | ------------------------------------------------------------------------------} 8 | {-# LANGUAGE GADTs, Rank2Types, FlexibleInstances #-} 9 | module State where 10 | 11 | import Control.Monad 12 | import Control.Monad.Operational 13 | import Control.Monad.Trans 14 | 15 | {------------------------------------------------------------------------------ 16 | State Monad 17 | ------------------------------------------------------------------------------} 18 | data StateI s a where 19 | Get :: StateI s s 20 | Put :: s -> StateI s () 21 | 22 | type State s a = Program (StateI s) a 23 | 24 | evalState :: State s a -> s -> a 25 | evalState = eval . view 26 | where 27 | eval :: ProgramView (StateI s) a -> (s -> a) 28 | eval (Return x) = const x 29 | eval (Get :>>= k) = \s -> evalState (k s ) s 30 | eval (Put s :>>= k) = \_ -> evalState (k ()) s 31 | 32 | put :: s -> StateT s m () 33 | put = singleton . Put 34 | 35 | get :: StateT s m s 36 | get = singleton Get 37 | 38 | testState :: Int -> Int 39 | testState = evalState $ do 40 | x <- get 41 | put (x+2) 42 | get 43 | 44 | {------------------------------------------------------------------------------ 45 | State Monad Transformer 46 | ------------------------------------------------------------------------------} 47 | type StateT s m a = ProgramT (StateI s) m a 48 | 49 | evalStateT :: Monad m => StateT s m a -> s -> m a 50 | evalStateT m = \s -> viewT m >>= \p -> eval p s 51 | where 52 | eval :: Monad m => ProgramViewT (StateI s) m a -> (s -> m a) 53 | eval (Return x) = \_ -> return x 54 | eval (Get :>>= k) = \s -> evalStateT (k s ) s 55 | eval (Put s :>>= k) = \_ -> evalStateT (k ()) s 56 | 57 | testStateT = evalStateT $ do 58 | x <- get 59 | lift $ putStrLn "Hello StateT" 60 | put (x+1) 61 | -------------------------------------------------------------------------------- /doc/examples/TicTacToe.hs: -------------------------------------------------------------------------------- 1 | {------------------------------------------------------------------------------ 2 | Control.Monad.Operational 3 | 4 | Example: 5 | An implementation of the game TicTacToe. 6 | 7 | Each player (human, AI, ...) is implemented in a separate monad 8 | which are then intermingled to run the game. This resembles the 9 | PoorMansConcurrency.hs example. 10 | 11 | 12 | Many thanks to Yves Par`es and Bertram Felgenhauer 13 | http://www.haskell.org/pipermail/haskell-cafe/2010-April/076216.html 14 | 15 | ------------------------------------------------------------------------------} 16 | {-# LANGUAGE GADTs, Rank2Types #-} 17 | 18 | import Control.Monad 19 | import Control.Monad.Operational 20 | import Control.Monad.State 21 | 22 | import Data.Either 23 | import Data.List (transpose, intersperse) 24 | 25 | -- external libraries needed 26 | import System.Random 27 | 28 | {------------------------------------------------------------------------------ 29 | The Player monad for implementing players (human, AI, ...) 30 | provides two operations 31 | 32 | readBoard -- read the current board position 33 | playMove -- play a move 34 | 35 | to query the current board position and perform a move, respectively. 36 | 37 | Moreover, it's actually a monad transformer intended to be used over IO. 38 | This way, the players can perform IO computations. 39 | ------------------------------------------------------------------------------} 40 | data PlayerI a where 41 | ReadBoard :: PlayerI Board 42 | PlayMove :: Int -> PlayerI Bool 43 | 44 | type Player m a = ProgramT PlayerI m a 45 | 46 | readBoard = singleton ReadBoard 47 | playMove = singleton . PlayMove 48 | 49 | -- interpreter 50 | runGame :: Player IO () -> Player IO () -> IO () 51 | runGame player1 player2 = eval' initialGameState player1 player2 52 | where 53 | eval' game p1 p2 = viewT p1 >>= \p1view -> eval game p1view p2 54 | 55 | eval :: GameState 56 | -> ProgramViewT PlayerI IO () -> Player IO () 57 | -> IO () 58 | eval game (Return _) _ = return () 59 | eval game (ReadBoard :>>= p1) p2 = eval' game (p1 (board game)) p2 60 | eval game (PlayMove mv :>>= p1) p2 = 61 | case makeMove mv game of 62 | Nothing -> eval' game (p1 False) p2 63 | Just game' 64 | | won game' -> let p = activePlayer game in 65 | putStrLn $ "Player " ++ show p ++ " has won!" 66 | | draw game'-> putStrLn $ "It's a draw." 67 | | otherwise -> eval' game' p2 (p1 True) 68 | 69 | -- example: human vs AI 70 | main = do 71 | g <- getStdGen 72 | runGame playerHuman (playerAI g) 73 | 74 | {------------------------------------------------------------------------------ 75 | TicTacToe Board type and logic 76 | 77 | The board looks like this: 78 | 79 | +---+---+---+ some squares already played on 80 | | 1 | 2 | 3 | the empty squares are numbered 81 | +---+---+---+ 82 | | 4 | 5 |OOO| 83 | +---+---+---+ 84 | | 7 |XXX| 9 | 85 | +---+---+---+ 86 | ------------------------------------------------------------------------------} 87 | data Symbol = X | O deriving (Eq,Show) 88 | type Square = Either Int Symbol 89 | type Board = [[Square]] 90 | data GameState = Game { board :: Board, activePlayer :: Symbol } 91 | 92 | initialGameState :: GameState 93 | initialGameState = Game (map (map Left) [[1,2,3],[4,5,6],[7,8,9]]) X 94 | 95 | -- list the possible moves to play 96 | possibleMoves :: Board -> [Int] 97 | possibleMoves board = [k | Left k <- concat board] 98 | 99 | -- play a stone at a square 100 | makeMove :: Int -> GameState -> Maybe GameState 101 | makeMove k (Game board player) 102 | | not (k `elem` possibleMoves board) = Nothing -- illegal move 103 | | otherwise = Just $ Game (map (map replace) board) (switch player) 104 | where 105 | replace (Left k') | k' == k = Right player 106 | replace x = x 107 | 108 | switch X = O 109 | switch O = X 110 | 111 | -- has somebody won the game? 112 | won :: GameState -> Bool 113 | won (Game board _) = any full $ diagonals board ++ rows board ++ cols board 114 | where 115 | full [a,b,c] = a == b && b == c 116 | diagonals [[a1,_,b1], 117 | [_ ,c,_ ], 118 | [b2,_,a2]] = [[a1,c,a2],[b1,c,b2]] 119 | rows = id 120 | cols = transpose 121 | 122 | -- is the game a draw? 123 | draw :: GameState -> Bool 124 | draw (Game board _) = null (possibleMoves board) 125 | 126 | -- print the board 127 | showSquare = either (\n -> " " ++ show n ++ " ") (concat . replicate 3 . show) 128 | 129 | showBoard :: Board -> String 130 | showBoard board = 131 | unlines . surround "+---+---+---+" 132 | . map (concat . surround "|". map showSquare) 133 | $ board 134 | where 135 | surround x xs = [x] ++ intersperse x xs ++ [x] 136 | 137 | printBoard = putStr . showBoard 138 | 139 | {------------------------------------------------------------------------------ 140 | Player examples 141 | ------------------------------------------------------------------------------} 142 | -- a human player on the command line 143 | playerHuman :: Player IO () 144 | playerHuman = forever $ readBoard >>= liftIO . printBoard >> doMove 145 | where 146 | -- ask the player where to move 147 | doMove :: Player IO () 148 | doMove = do 149 | liftIO . putStrLn $ "At which number would you like to play?" 150 | n <- liftIO getLine 151 | b <- playMove (read n) 152 | unless b $ do 153 | liftIO . putStrLn $ "Position " ++ show n ++ " is already full." 154 | doMove 155 | 156 | -- a random AI, 157 | -- also demonstrates how to use a custom StateT on top 158 | -- of the Player monad 159 | playerAI :: Monad m => StdGen -> Player m () 160 | playerAI = evalStateT ai 161 | where 162 | ai :: Monad m => StateT StdGen (ProgramT PlayerI m) () 163 | ai = forever $ do 164 | board <- lift $ readBoard 165 | n <- uniform (possibleMoves board) -- select a random move 166 | lift $ playMove n 167 | where 168 | -- select one element at random 169 | uniform :: Monad m => [a] -> StateT StdGen m a 170 | uniform xs = do 171 | gen <- get 172 | let (n,gen') = randomR (1,length xs) gen 173 | put gen' 174 | return (xs !! (n-1)) 175 | 176 | -------------------------------------------------------------------------------- /doc/examples/WebSessionState.lhs: -------------------------------------------------------------------------------- 1 | #!/bin/sh runghc 2 | \begin{code} 3 | {------------------------------------------------------------------------------ 4 | Control.Monad.Operational 5 | 6 | Example: 7 | A CGI script that maintains session state 8 | http://www.informatik.uni-freiburg.de/~thiemann/WASH/draft.pdf 9 | 10 | ------------------------------------------------------------------------------} 11 | {-# LANGUAGE GADTs, Rank2Types #-} 12 | module WebSessionState where 13 | 14 | import Control.Monad 15 | import Control.Monad.Operational 16 | import Control.Monad.Trans hiding (lift) 17 | 18 | import Data.Char 19 | import Data.Maybe 20 | 21 | -- external libraries needed 22 | import Text.Html as H 23 | import Network.CGI 24 | 25 | {------------------------------------------------------------------------------ 26 | This example shows a "magic" implementation of a web session that 27 | looks like it needs to be executed in a running process, 28 | while in fact it's just a CGI script. 29 | 30 | The key part is a monad, called "Web" for lack of imagination, 31 | which supports a single operation 32 | 33 | ask :: String -> Web String 34 | 35 | which sends a simple minded HTML-Form to the web user 36 | and returns his answer. 37 | 38 | How does this work? The trick is that all previous answers 39 | are logged in a hidden field of the input form. 40 | The CGI script will simply replays this log when called. 41 | In other words, the user state is stored in the input form. 42 | 43 | ------------------------------------------------------------------------------} 44 | data WebI a where 45 | Ask :: String -> WebI String 46 | 47 | type Web a = Program WebI a 48 | 49 | ask = singleton . Ask 50 | 51 | -- interpreter 52 | runWeb :: Web H.Html -> CGI CGIResult 53 | runWeb m = do 54 | -- fetch log 55 | log' <- maybe [] (read . urlDecode) `liftM` getInput "log" 56 | -- maybe append form input 57 | f <- maybe id (\answer -> (++ [answer])) `liftM` getInput "answer" 58 | let log = f log' 59 | -- run Web action and output result 60 | output . renderHtml =<< replay m log log 61 | where 62 | replay = eval . view 63 | 64 | eval :: ProgramView WebI H.Html -> [String] -> [String] -> CGI H.Html 65 | eval (Return html) log _ = return html 66 | eval (Ask question :>>= k) log (l:ls) = -- replay answer from log 67 | replay (k l) log ls 68 | eval (Ask question :>>= k) log [] = -- present HTML page to user 69 | return $ htmlQuestion log question 70 | 71 | 72 | -- HTML page with a single form 73 | htmlQuestion log question = htmlEnvelope $ p << question +++ x 74 | where 75 | x = form ! [method "post"] << (textfield "answer" 76 | +++ submit "Next" "" 77 | +++ hidden "log" (urlEncode $ show log)) 78 | 79 | htmlMessage s = htmlEnvelope $ p << s 80 | 81 | htmlEnvelope html = 82 | header << thetitle << "Web Session State demo" 83 | +++ body << html 84 | 85 | 86 | -- example 87 | example :: Web H.Html 88 | example = do 89 | haskell <- ask "What's your favorite programming language?" 90 | if map toLower haskell /= "haskell" 91 | then message "Awww." 92 | else do 93 | ghc <- ask "What's your favorite compiler?" 94 | web <- ask "What's your favorite monad?" 95 | message $ "I like " ++ ghc ++ " too, but " 96 | ++ web ++ " is debatable." 97 | where 98 | message = return . htmlMessage 99 | 100 | main = runCGI . runWeb $ example 101 | 102 | \end{code} 103 | -------------------------------------------------------------------------------- /doc/proofs.md: -------------------------------------------------------------------------------- 1 | Correctness Proofs 2 | ================== 3 | 4 | This document collects correctness proofs for the `operational` library. 5 | 6 | [tutorial]: http://apfelmus.nfshost.com/articles/operational-monad.html 7 | 8 | Monad laws 9 | ---------- 10 | 11 | For reasons of efficiency, the `Program` type is not implemented as a list of instructions as presented in the [The Operational Monad Tutorial][tutorial]. However, this means that we now have to prove that the implementations of `view` and `viewT` *respect the monad laws*. 12 | 13 | In particular, we say that two programs 14 | 15 | e1, e2 :: Program instr a 16 | 17 | are *equivalent*, `e1 ~ e2`, if they can be transformed into each other by applying the monad laws on the constructors. For instance, the expressions 18 | 19 | e1 = ((m `Bind` f) `Bind` g 20 | e2 = m `Bind` (\a -> f a `Bind` g) 21 | 22 | are equivalent for any expressions `m`, `f` and `g`. Our goal is to show that the `view` functions give the same result for equivalent expressions: 23 | 24 | e1 ~ e2 => view e1 = view e2 25 | 26 | The `ProgramView` type is equipped with an appropriate equality relation: 27 | 28 | (Return a1) = (Return a2) iff a1 = a2 29 | (i1 :>>= k1) = (i2 :>>= k2) iff i1 = i2 and k1 x ~ k2 x for all x 30 | 31 | ### Normal form: list of instructions 32 | 33 | The key observation for the proof is the following: As in the [tutorial][], the `Program` type represents a list of instructions. The representation is redundant for the purpose of efficiency, but different expressions should still correspond to the same list of instructions if they are equivalent. After all, equivalence is just about the associativity of the `Bind` operation. This also means that the first instruction, and hence the result of `view` should be unique for each equivalence class. 34 | 35 | For simplicity, let us first focus on the pure `Program` type and postpone the case `ProgramT` for monad transformers later. 36 | 37 | We can formalize the intuition above by introducing the following types of *normal form* 38 | 39 | data NF instr a where 40 | Return' :: a -> NF instr a 41 | (:>>=') :: instr a -> (a -> NF instr b) -> NF instr b 42 | 43 | which is simply the list of instructions from the [tutorial][]. Now, we know that `NF` is a monad 44 | 45 | instance Monad (NF instr) where 46 | return = Return' 47 | (Return' a) >>= k = k a 48 | (m :>>=' g) >>= k = m :>>=' (\a -> g a >>= k) 49 | 50 | In particular, it fulfills the monad laws. (Actually we would have to prove that by using coinduction, but I leave that as an exercise.) 51 | 52 | We can now map each `Program` to its normal form 53 | 54 | normalize :: Program instr a -> NF instr a 55 | normalize (m `Bind` k) = normalize m >>= normalize k 56 | normalize (Return a) = return a 57 | normalize (Instr i) = i :>>=' return 58 | 59 | In particular, note that this function is a morphism and `NF` fulfills the monad laws. Hence, equivalent programs will be mapped to the same normal form, i.e. 60 | 61 | e1 ~ e2 => normalize e1 = normalize e2 62 | 63 | 64 | How does this observation help us? Note that the `view` only uses the monad laws to rewrite a `Program`. Using a somewhat sloppy notation, we express this as 65 | 66 | e1 ~ view e1 67 | 68 | where we intepret a view `i :>>= k` as the "obvious" `Program` expression `Bind (Instr i) k` where the left argument of the `Bind` constructor is an instruction. Furthermore, we can think of the `ProgramView` type as a head normal form. In other words, applying `normalize` to an expression of the form `view e1` will not change the first instruction, which means 69 | 70 | normalize (view e1) = normalize (view e2) => view e1 = view e2 71 | 72 | (The requires a coinductive argument for the tail of instructions.) 73 | 74 | Taking these three implications together, we see that 75 | 76 | e1 ~ e2 => view e1 = view e2 77 | 78 | as desired. 79 | 80 | ### Normal form for monad transformers 81 | 82 | A similar technique can be used to show that the monad laws also hold for the monad transformer version `ProgramT`. The key observation here is that the normal form is an *effectful list of instructions* 83 | 84 | newtype NFT instr m a = JoinLift (m (NFT' instr m a)) 85 | 86 | data NFT' instr m a where 87 | Return' :: a -> NFT' instr m a 88 | (:>>=') :: instr a -> (a -> NFT instr m b) -> NFT' instr m b 89 | 90 | This is in very close analogy to the "effectful list" 91 | 92 | type ListT m a = m (ListT' m a) 93 | data ListT' m a = Nil | Cons a (ListT m a) 94 | 95 | For example, if the monad `m` is the state monad, then this type represents a list whose tail depends on the current state. 96 | 97 | First, we convince ourselves that the `NFT` type is indeed a monad transformer. The corresponding functions are implemented as 98 | 99 | instance Monad m => Monad (NFT instr m) where 100 | return a = JoinLift (return (Return' a)) 101 | 102 | (JoinLift m) >>= k = JoinLift (m >>= f) 103 | where 104 | f (Return' a) = k a 105 | f (i :>>=' f) = return $ i :>>= (\a -> f a >>= k) 106 | 107 | instance MonadTrans (NFT instr) where 108 | lift m = JoinLift (fmap Return' m) 109 | 110 | singleton i = JoinLift (return (i :>>=' return)) 111 | 112 | It is somewhat tedious to check the monad laws and the lifting laws, so we skip this step here. 113 | 114 | 115 | Having convinced ourselves that the normal form type `NFT` is, in fact, a monad transformer, we can define a morphism 116 | 117 | normalize :: ProgramT instr m a -> NFT instr m a 118 | normalize (Lift m) = lift m 119 | normalize (m `Bind` k) = m >>= k 120 | normalize (Instr i) = singleton i 121 | 122 | and obtain that equivalent programs are mapped to equal normal forms. Similar to the pure case, normalizing the result of `viewT` will not change the first instruction, and we can conclude that the result `viewT` only depends on the normal form of the argument. 123 | 124 | 125 | Lifting monads 126 | -------------- 127 | 128 | The normal forms are also useful for proving that class instances can be lifted from a base monad `m` to the monad `ProgramT instr m`. 129 | 130 | ### Instructions and control operations 131 | 132 | Some monads only feature "algebraic" instructions which have the form 133 | 134 | instr :: a1 -> a2 -> ... -> m b 135 | 136 | so that the types `a1`, `a2`, etc. of the parameters do not contain the monad `m` again. For example, the state monad has two instructions 137 | 138 | get :: State s s 139 | put :: s -> State s () 140 | 141 | of precisely this form. Lifting these kinds of instructions is straightforward, i.e. the `ProgramT instr State` monad is also a state monad. 142 | 143 | instance (MonadState s m) => MonadState s (ProgramT instr m) where 144 | get = lift get 145 | put = lift . put 146 | 147 | 148 | However, some monads feature *control operations*, which are instructions that contain the monad `m` in the argument. Essentially, they can change the *control flow*. For example, the `MonadPlus` class contains an instruction 149 | 150 | mplus :: MonadPlus m => m a -> m a -> m a 151 | 152 | that combines the control flows of two monadic arguments. 153 | 154 | For more on the distinction between algebraic operation and control operation, see also a [discussion by Conor McBride][conor]. 155 | 156 | [conor]: http://www.haskell.org/pipermail/haskell-cafe/2010-April/076185.html 157 | 158 | ### MonadReader 159 | 160 | The main feature of the `MonadReader` class is an algebraic operation 161 | 162 | ask :: MonadReader m r => m r 163 | 164 | but unfortunately, it also includes a control operation 165 | 166 | local :: MonadReader m r => (r -> r) -> m r -> m r 167 | 168 | and it is not clear whether this can be lifted to the `ProgramT` transformer. We certainly expect the following law to hold 169 | 170 | local r (lift m) = lift (local f m) 171 | 172 | Fortunately, this control operation is very benign, in that it is actually a monad morphism 173 | 174 | local r (return a) = return a 175 | local r (m >>= k) = local r m >>= local r . k 176 | 177 | Imposing that the lifted control operation should also be a morphism, we can define it for normal forms as follows 178 | 179 | local :: MonadReader m r => (r -> r) 180 | -> ProgramT instr m a -> ProgramT instr m a 181 | local r (JoinLift m) = JoinLift $ local r (m >>= return . f) 182 | where 183 | f (Return' a) = return a 184 | f (i :>>=' k) = singleton i >>= local r . k 185 | 186 | Again, it is somewhat tedious to check that this definition fulfills the lifting and morphism laws. However, we have now succeeded in lifting a control operation! 187 | 188 | 189 | 190 | 191 | -------------------------------------------------------------------------------- /doc/tutorial-changes.md: -------------------------------------------------------------------------------- 1 | 2 | [tutorial]: http://apfelmus.nfshost.com/articles/operational-monad.html 3 | 4 | The `operational` library is based on ["The Operational Monad Tutorial"][tutorial], but features a slightly different API and implementation. 5 | 6 | This document describes how the library has been changed compared to the tutorial. 7 | 8 | 9 | Changes to the `Program` type 10 | ----------------------------- 11 | For efficiency reasons, the type `Program` representing a list of instructions is now *abstract*. A function `view` is used to inspect the first instruction, it returns a type 12 | 13 | data ProgramView instr a where 14 | Return :: a -> ProgramView instr a 15 | (:>>=) :: instr a -> (a -> Program instr b) -> ProgramView instr b 16 | 17 | which is much like the old `Program` type, except that `Then` was renamed to `:>>=` and that the subsequent instructions stored in the second argument of `:>>=` are stored in the type `Program`, not `ProgramView`. 18 | 19 | To see an example of the new style, here the interpreter for the stack machine from the tutorial: 20 | 21 | interpret :: StackProgram a -> (Stack Int -> a) 22 | interpret = eval . view 23 | where 24 | eval :: ProgramView StackInstruction a -> (Stack Int -> a) 25 | eval (Push a :>>= is) stack = interpret (is ()) (a:stack) 26 | eval (Pop :>>= is) (a:stack) = interpret (is a ) stack 27 | eval (Return a) stack = a 28 | 29 | So-called "view functions" like `view` are a common way of inspecting data structures that have been made abstract for reasons of efficiency; see for example `viewL` and `viewR` in [`Data.Sequence`][containers]. 30 | 31 | [containers]: http://hackage.haskell.org/package/containers 32 | 33 | Efficiency 34 | ---------- 35 | Compared to the original type from the tutorial, `Program` now supports `>>=` in O(1) time in most use cases. This means that left-biased nesting like 36 | 37 | let 38 | nestLeft :: Int -> StackProgram Int 39 | nestLeft 0 = return 0 40 | nestLeft n = nestLeft (n-1) >>= push 41 | in 42 | interpret (nestLeft n) [] 43 | 44 | will now take O(n) time. In contrast, the old `Program` type from the tutorial would have taken O(n^2) time, similar to `++` for lists taking quadratic time in when nested to the left. 45 | 46 | However, this does *not* hold in a *persistent* setting. In particular, the example 47 | 48 | let 49 | p = nestLeft n 50 | v1 = view p 51 | v2 = view p 52 | v3 = view p 53 | in 54 | v1 `seq` v2 `seq` v3 55 | 56 | will take O(n) time for each call of `view` instead of O(n) the first time and O(1) for the other calls. But since monads are usually used ephemerally, this is much less a restriction than it would be for lists and `++`. 57 | 58 | Monad Transformers 59 | ------------------ 60 | Furthermore, `Program` is actually a type synonym and expressed in terms of a monad transformer `ProgramT` 61 | 62 | type Program instr a = ProgramT instr Identity a 63 | 64 | Likewise, `view` is a specialization of `viewT` to the identity monad. This change is transparent (except for error messages on type errors) for users who are happy with just `Program` but very convenient for those users who want to use it as a monad transformer. 65 | 66 | The key point about the transformer version `ProgramT` is that in addition to the monad laws, it automatically satisfies the lifting laws for monad transformers as well 67 | 68 | lift . return = return 69 | lift m >>= lift . g = lift (m >>= g) 70 | 71 | The corresponding view function `viewT` now returns the type `m (ViewT instr m a)`. It's not immediately apparent why this return type will do, but it's straightforward to work with, like in the following implementation of the list monad transformer: 72 | 73 | data PlusI m a where 74 | Zero :: PlusI m a 75 | Plus :: ListT m a -> ListT m a -> PlusI m a 76 | 77 | type ListT m a = ProgramT (PlusI m) m a 78 | 79 | runList :: Monad m => ListT m a -> m [a] 80 | runList = eval <=< viewT 81 | where 82 | eval :: Monad m => ProgramViewT (PlusI m) m a -> m [a] 83 | eval (Return x) = return [x] 84 | eval (Zero :>>= k) = return [] 85 | eval (Plus m n :>>= k) = 86 | liftM2 (++) (runList (m >>= k)) (runList (n >>= k)) 87 | 88 | 89 | 90 | Alternatives to Monad Transformers 91 | ---------------------------------- 92 | By the way, note that monad transformers are not the only way to build larger monads from smaller ones; a similar effect can be achieved with the direct sum of instructions sets. For instance, the monad 93 | 94 | Program (StateI s :+: ExceptionI e) a 95 | 96 | data (f :+: g) a = Inl (f a) | Inr (g a) -- a fancy Either 97 | 98 | is a combination of the state monad 99 | 100 | type State a = Program (StateI s) a 101 | 102 | data StateI s a where 103 | Put :: s -> StateI s () 104 | Get :: StateI s s 105 | 106 | and the error monad 107 | 108 | type Error e a = Program (ErrorI e) a 109 | 110 | data ErrorI e a where 111 | Throw :: e -> ErrorI e () 112 | Catch :: ErrorI e a -> (e -> ErrorI e a) -> ErrorI e a 113 | 114 | The "sum of signatures" approach and the `(:+:)` type constructor are advocated in [Wouter Swierstra's "Data Types a la carte"][a la carte]. Time will tell which has more merit; for now I have opted for a seamless interaction with monad transformers. 115 | 116 | [a la carte]: http://www.cse.chalmers.se/~wouter/Publications/DataTypesALaCarte.pdf "Wouter Swierstra. Data types à la carte." 117 | -------------------------------------------------------------------------------- /operational.cabal: -------------------------------------------------------------------------------- 1 | Name: operational 2 | Version: 0.2.4.2 3 | Synopsis: Implementation of difficult monads made easy 4 | with operational semantics. 5 | Description: 6 | This library makes it easy to implement monads with tricky control flow. 7 | . 8 | This is useful for: writing web applications in a sequential style, programming games with a uniform interface for human and AI players and easy replay capababilities, implementing fast parser monads, designing monadic DSLs, etc. 9 | . 10 | Related packages: 11 | . 12 | * MonadPrompt — 13 | . 14 | * free — 15 | . 16 | * free-operational — 17 | 18 | Category: Control, Monads 19 | License: BSD3 20 | License-file: LICENSE 21 | Author: Heinrich Apfelmus 22 | Maintainer: Heinrich Apfelmus 23 | Copyright: (c) Heinrich Apfelmus 2010-2023 24 | Homepage: https://github.com/HeinrichApfelmus/operational 25 | Stability: Provisional 26 | 27 | build-type: Simple 28 | cabal-version: >= 1.10 29 | tested-with: 30 | GHC == 8.10.7 31 | , GHC == 9.2.8 32 | , GHC == 9.4.8 33 | , GHC == 9.6.3 34 | , GHC == 9.8.1 35 | extra-source-files: CHANGELOG.md 36 | Readme.md 37 | doc/*.md 38 | doc/examples/*.hs 39 | doc/examples/*.lhs 40 | doc/examples/*.md 41 | 42 | flag buildExamples 43 | description: Build example executables. 44 | default: True 45 | manual: True 46 | 47 | source-repository head 48 | type: git 49 | location: https://github.com/HeinrichApfelmus/operational.git 50 | 51 | Library 52 | default-language: Haskell2010 53 | other-extensions: ExistentialQuantification 54 | FlexibleInstances 55 | GADTSyntax 56 | MultiParamTypeClasses 57 | Rank2Types 58 | ScopedTypeVariables 59 | UndecidableInstances 60 | 61 | hs-source-dirs: src 62 | exposed-modules: Control.Monad.Operational 63 | 64 | build-depends: base >= 4.8 && < 5 65 | , mtl >= 1.1 && < 2.4 66 | , transformers >=0.5.6 && <0.7 67 | ghc-options: -Wall 68 | 69 | Executable operational-TicTacToe 70 | if !flag(buildExamples) 71 | buildable: False 72 | 73 | default-language: Haskell2010 74 | other-extensions: GADTs 75 | Rank2Types 76 | 77 | hs-source-dirs: doc/examples 78 | main-is: TicTacToe.hs 79 | 80 | build-depends: operational, base, mtl, random == 1.* 81 | -------------------------------------------------------------------------------- /src/Control/Monad/Operational.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTSyntax, ExistentialQuantification, Rank2Types, ScopedTypeVariables #-} 2 | {-# LANGUAGE UndecidableInstances, MultiParamTypeClasses, FlexibleInstances #-} 3 | -- Search for UndecidableInstances to see why this is needed 4 | 5 | module Control.Monad.Operational ( 6 | -- * Synopsis 7 | -- $synopsis 8 | 9 | -- * Overview 10 | -- $intro 11 | 12 | -- * Monad 13 | Program, singleton, ProgramView, view, 14 | -- $example 15 | interpretWithMonad, 16 | 17 | -- * Monad transformer 18 | ProgramT, ProgramViewT(..), viewT, 19 | -- $exampleT 20 | liftProgram, mapInstr, 21 | unviewT, interpretWithMonadT, 22 | 23 | ) where 24 | 25 | import Control.Monad 26 | import Control.Monad.Identity (Identity, runIdentity) 27 | import Control.Monad.Trans (MonadTrans, lift) 28 | 29 | -- mtl classes to instantiate. 30 | -- Those commented out cannot be instantiated. For reasons see below. 31 | -- import Control.Monad.Cont.Class 32 | -- import Control.Monad.Error.Class 33 | import Control.Monad.IO.Class 34 | import Control.Monad.Reader.Class 35 | import Control.Monad.State.Class 36 | -- import Control.Monad.Writer.Class 37 | 38 | {------------------------------------------------------------------------------ 39 | Introduction 40 | ------------------------------------------------------------------------------} 41 | {-$synopsis 42 | To write a monad, use the 'Program' type. 43 | 44 | To write a monad transformer, use the 'ProgramT' type. 45 | 46 | For easier interoperability, 47 | the 'Program' type is actually a type synonym 48 | and defined in terms of 'ProgramT'. 49 | -} 50 | 51 | {-$intro 52 | 53 | The basic idea for implementing monads with this libary 54 | is to think of monads as /sequences of primitive instructions/. 55 | For instance, imagine that you want to write a web application 56 | with a custom monad that features an instruction 57 | 58 | > askUserInput :: CustomMonad UserInput 59 | 60 | which sends a form to the remote user and waits for the user 61 | to send back his input 62 | 63 | To implement this monad, you decide that this instruction is 64 | a primitive, i.e. should not be implemented in terms of other, 65 | more basic instructions. 66 | Once you have chosen your primitives, collect them in a data type 67 | 68 | @ 69 | data CustomMonadInstruction a where 70 | AskUserInput :: CustomMonadInstruction UserInput 71 | @ 72 | 73 | Then, obtain your custom monad simply by applying the 'Program' 74 | type constructor 75 | 76 | > type CustomMonad a = Program CustomMonadInstruction a 77 | 78 | The library makes sure that it is an instance of the 'Monad' class 79 | and fulfills all the required laws. 80 | 81 | Essentially, the monad you now obtained is just a 82 | fancy list of primitive instructions. 83 | In particular, you can pattern match on the first element of this "list". 84 | This is how you implement an @interpret@ or @run@ function for your monad. 85 | Note that pattern matching is done using the 'view' function 86 | 87 | @ 88 | runCustomMonad :: CustomMonad a -> IO a 89 | runCustomMonad m = case view m of 90 | Return a -> return a -- done, return the result 91 | AskUserInput :>>= k -> do 92 | b <- waitForUserInput -- wait for external user input 93 | runCustomMonad (k b) -- proceed with next instruction 94 | @ 95 | 96 | The point is that you can now proceed in any way you like: 97 | you can wait for the user to return input as shown, 98 | or you store the continuation @k@ and retrieve it when 99 | your web application receives another HTTP request, 100 | or you can keep a log of all user inputs on the client side and replay them, 101 | and so on. Moreover, you can implement different @run@ functions 102 | for one and the same custom monad, which is useful for testing. 103 | Also note that the result type of the @run@ function does not need to 104 | be a monad at all. 105 | 106 | In essence, your custom monad allows you to express 107 | your web application as a simple imperative program, 108 | while the underlying implementation can freely map this to 109 | an event-drived model or some other control flow architecture 110 | of your choice. 111 | 112 | The possibilities are endless. 113 | More usage examples can be found here: 114 | 115 | 116 | -} 117 | 118 | {------------------------------------------------------------------------------ 119 | Program 120 | ------------------------------------------------------------------------------} 121 | {-| The abstract data type @'Program' instr a@ represents programs, 122 | i.e. sequences of primitive instructions. 123 | 124 | * The /primitive instructions/ are given by the type constructor @instr :: * -> *@. 125 | 126 | * @a@ is the return type of a program. 127 | 128 | @'Program' instr@ is always a monad and 129 | automatically obeys the monad laws. 130 | -} 131 | type Program instr = ProgramT instr Identity 132 | 133 | -- | View type for inspecting the first instruction. 134 | -- It has two constructors 'Return' and @:>>=@. 135 | -- (For technical reasons, they are documented at 'ProgramViewT'.) 136 | type ProgramView instr = ProgramViewT instr Identity 137 | 138 | -- | View function for inspecting the first instruction. 139 | view :: Program instr a -> ProgramView instr a 140 | view = runIdentity . viewT 141 | 142 | 143 | -- | Utility function that extends 144 | -- a given interpretation of instructions as monadic actions 145 | -- to an interpration of 'Program's as monadic actions. 146 | -- 147 | -- This function can be useful if you are mainly interested in 148 | -- mapping a 'Program' to different standard monads, like the state monad. 149 | -- For implementing a truly custom monad, 150 | -- you should write your interpreter directly with 'view' instead. 151 | interpretWithMonad :: forall instr m b. 152 | Monad m => (forall a. instr a -> m a) -> (Program instr b -> m b) 153 | interpretWithMonad f = eval . view 154 | where 155 | eval :: forall a. ProgramView instr a -> m a 156 | eval (Return a) = return a 157 | eval (m :>>= k) = f m >>= interpretWithMonad f . k 158 | 159 | {- $example 160 | 161 | /Example usage/ 162 | 163 | Stack machine from \"The Operational Monad Tutorial\". 164 | 165 | > data StackInstruction a where 166 | > Push :: Int -> StackInstruction () 167 | > Pop :: StackInstruction Int 168 | > 169 | > type StackProgram a = Program StackInstruction a 170 | > type Stack b = [b] 171 | > 172 | > interpret :: StackProgram a -> (Stack Int -> a) 173 | > interpret = eval . view 174 | > where 175 | > eval :: ProgramView StackInstruction a -> (Stack Int -> a) 176 | > eval (Push a :>>= is) stack = interpret (is ()) (a:stack) 177 | > eval (Pop :>>= is) (a:stack) = interpret (is a ) stack 178 | > eval (Return a) stack = a 179 | 180 | In this example, the type signature for the `eval` helper function is optional. 181 | 182 | -} 183 | 184 | {------------------------------------------------------------------------------ 185 | ProgramT - monad transformer 186 | ------------------------------------------------------------------------------} 187 | {-| The abstract data type @'ProgramT' instr m a@ represents programs 188 | over a base monad @m@, 189 | i.e. sequences of primitive instructions and actions from the base monad. 190 | 191 | * The /primitive instructions/ are given by the type constructor @instr :: * -> *@. 192 | 193 | * @m@ is the base monad, embedded with 'lift'. 194 | 195 | * @a@ is the return type of a program. 196 | 197 | @'ProgramT' instr m@ is a monad transformer and 198 | automatically obeys both the monad and the lifting laws. 199 | -} 200 | data ProgramT instr m a where 201 | Lift :: m a -> ProgramT instr m a 202 | Bind :: ProgramT instr m b -> (b -> ProgramT instr m a) 203 | -> ProgramT instr m a 204 | Instr :: instr a -> ProgramT instr m a 205 | 206 | -- basic instances 207 | instance Monad m => Monad (ProgramT instr m) where 208 | return = Lift . return 209 | (>>=) = Bind 210 | 211 | instance MonadTrans (ProgramT instr) where 212 | lift = Lift 213 | 214 | instance Monad m => Functor (ProgramT instr m) where 215 | fmap = liftM 216 | 217 | instance Monad m => Applicative (ProgramT instr m) where 218 | pure = return 219 | (<*>) = ap 220 | 221 | -- | Program made from a single primitive instruction. 222 | singleton :: instr a -> ProgramT instr m a 223 | singleton = Instr 224 | 225 | -- | View type for inspecting the first instruction. 226 | -- This is very similar to pattern matching on lists. 227 | -- 228 | -- * The case @(Return a)@ means that the program contains no instructions 229 | -- and just returns the result @a@. 230 | -- 231 | -- *The case @(someInstruction :>>= k)@ means that the first instruction 232 | -- is @someInstruction@ and the remaining program is given by the function @k@. 233 | data ProgramViewT instr m a where 234 | Return :: a -> ProgramViewT instr m a 235 | (:>>=) :: instr b 236 | -> (b -> ProgramT instr m a) 237 | -> ProgramViewT instr m a 238 | 239 | instance Monad m => Functor (ProgramViewT instr m) where 240 | fmap f (Return a) = Return $ f a 241 | fmap f (instr :>>= cont) = instr :>>= (fmap f . cont) 242 | 243 | instance Monad m => Applicative (ProgramViewT instr m) where 244 | pure = return 245 | (<*>) = ap 246 | 247 | instance Monad m => Monad (ProgramViewT instr m) where 248 | return = Return 249 | Return a >>= cont = cont a 250 | (instr :>>= cont1) >>= cont2 = instr :>>= (cont1 >=> unviewT . cont2) 251 | 252 | -- | View function for inspecting the first instruction. 253 | viewT :: Monad m => ProgramT instr m a -> m (ProgramViewT instr m a) 254 | viewT (Lift m) = m >>= return . Return 255 | viewT ((Lift m) `Bind` g) = m >>= viewT . g 256 | viewT ((m `Bind` g) `Bind` h) = viewT (m `Bind` (\x -> g x `Bind` h)) 257 | viewT ((Instr i) `Bind` g) = return (i :>>= g) 258 | viewT (Instr i) = return (i :>>= return) 259 | 260 | {-| Lift a plain sequence of instructions to a sequence 261 | of instructions over a monad 'm'. 262 | This is the counterpart of the 'lift' function from 'MonadTrans'. 263 | 264 | It can be defined as follows: 265 | 266 | @ 267 | liftProgram = eval . view 268 | where 269 | eval :: ProgramView instr a -> ProgramT instr m a 270 | eval (Return a) = return a 271 | eval (i :>>= k) = singleton i >>= liftProgram . k 272 | @ 273 | 274 | -} 275 | liftProgram :: Monad m => Program instr a -> ProgramT instr m a 276 | liftProgram (Lift m) = return (runIdentity m) 277 | liftProgram (m `Bind` k) = liftProgram m `Bind` (liftProgram . k) 278 | liftProgram (Instr i) = Instr i 279 | 280 | 281 | -- | Utility function that extends 282 | -- a given interpretation of instructions as monadic actions 283 | -- to an interpration of 'ProgramT's as monadic actions. 284 | -- 285 | -- Ideally, you would not use another monad, 286 | -- but write a custom interpreter directly with `viewT`. 287 | -- See the remark at 'interpretWithMonad'. 288 | interpretWithMonadT :: Monad m => (forall x . instr x -> m x) -> ProgramT instr m a -> m a 289 | interpretWithMonadT interpreter = go 290 | where 291 | go program = do 292 | firstInstruction <- viewT program 293 | case firstInstruction of 294 | Return a -> return a 295 | instruction :>>= continuation -> interpreter instruction >>= (go . continuation) 296 | 297 | -- | Utilitiy function for mapping a 'ProgramViewT' back into a 'ProgramT'. 298 | -- 299 | -- Semantically, the function 'unviewT' is an inverse of 'viewT', 300 | -- e.g. we have 301 | -- 302 | -- @ 303 | -- viewT (singleton i) >>= unviewT = return (singleton i) 304 | -- @ 305 | unviewT :: Monad m => ProgramViewT instr m a -> ProgramT instr m a 306 | unviewT (Return a) = return a 307 | unviewT (instruction :>>= continuation) = 308 | (Instr instruction) `Bind` continuation 309 | 310 | -- | Extend a mapping of instructions to a mapping of 'ProgramT'. 311 | mapInstr :: 312 | forall instr1 instr2 m a . Monad m 313 | => (forall x . instr1 x -> instr2 x) 314 | -> ProgramT instr1 m a -> ProgramT instr2 m a 315 | mapInstr f = go 316 | where 317 | go :: forall x. ProgramT instr1 m x -> ProgramT instr2 m x 318 | go (Lift action) = Lift action 319 | go (Bind action continuation) = Bind (go action) (go . continuation) 320 | go (Instr instruction) = Instr $ f instruction 321 | 322 | {- $exampleT 323 | 324 | /Example usage/ 325 | 326 | List monad transformer. 327 | 328 | > data PlusI m a where 329 | > Zero :: PlusI m a 330 | > Plus :: ListT m a -> ListT m a -> PlusI m a 331 | > 332 | > type ListT m a = ProgramT (PlusI m) m a 333 | > 334 | > runList :: Monad m => ListT m a -> m [a] 335 | > runList = eval <=< viewT 336 | > where 337 | > eval :: Monad m => ProgramViewT (PlusI m) m a -> m [a] 338 | > eval (Return x) = return [x] 339 | > eval (Zero :>>= k) = return [] 340 | > eval (Plus m n :>>= k) = 341 | > liftM2 (++) (runList (m >>= k)) (runList (n >>= k)) 342 | 343 | In this example, the type signature for the `eval` helper function is optional. 344 | 345 | -} 346 | 347 | {------------------------------------------------------------------------------ 348 | mtl instances 349 | 350 | * All of these instances need UndecidableInstances, 351 | because they do not satisfy the coverage condition. 352 | Most of the instance in the mtl package itself have the same issue. 353 | 354 | * Lifting algebraic operations is easy, 355 | lifting control operations is more elaborate, but sometimes possible. 356 | See the design notes in `doc/design.md`. 357 | ------------------------------------------------------------------------------} 358 | instance (MonadState s m) => MonadState s (ProgramT instr m) where 359 | get = lift get 360 | put = lift . put 361 | 362 | instance (MonadIO m) => MonadIO (ProgramT instr m) where 363 | liftIO = lift . liftIO 364 | 365 | instance (MonadReader r m) => MonadReader r (ProgramT instr m) where 366 | ask = lift ask 367 | 368 | local r (Lift m) = Lift (local r m) 369 | local r (m `Bind` k) = local r m `Bind` (local r . k) 370 | local _ (Instr i) = Instr i 371 | --------------------------------------------------------------------------------