operational-0.2.4.2/0000755000000000000000000000000007346545000012363 5ustar0000000000000000operational-0.2.4.2/CHANGELOG.md0000644000000000000000000000275507346545000014205 0ustar0000000000000000Changelog for the `operational` package --------------------------------------- **0.2.4.2** -- Maintenance release. * Compatibility with `mtl-2.3.1` **0.2.4.1** -- Maintenance release. * Restrict dependencies to ensure GHC >= 7.10. **0.2.4.0** -- Feature release. * Update to build with GHC 9.0.1. * Add utility functions `interpretWithMonadT`, `unviewT` and `mapInstr` * Add utility `Functor`, `Applicative`, and `Monad` instances for `ProgramViewT` type. **0.2.3.5** -- Maintenance release. * Update references to other packages. * Modernize `.cabal` file. **0.2.3.4** -- Maintenance release. * Restrict dependencies to ensure GHC >= 7.2. **0.2.3.3** -- Maintenance release. * Minor fixes to documentation and examples **0.2.3.2** -- Maintenance release. * Bump `mtl` dependency to allow 2.3 **0.2.3.1** -- Maintenance release. * Bump `mtl` dependency to allow 2.2 **0.2.3.0** -- Maintenance release. * added instance for `MonadReader` class * clean up documentation **0.2.2.0** -- Feature release. * add utility function `interpretWithMonad` **0.2.1.0** -- Maintenance release. * minor change: eta-reduce `Program` and `ProgramView` type synonyms **0.2.0.3** -- Maintenance release. * moved project repository to github **0.2.0.0** -- Feature release. * changed name of view type to `ProgramView` * added instances for mtl classes * new function `liftProgram` to embed `Program` in `ProgramT` * new example `TicTacToe.hs` * various documentation updates **0.1.0.0** * initial release operational-0.2.4.2/LICENSE0000644000000000000000000000267407346545000013401 0ustar0000000000000000(c) 2010 Heinrich Apfelmus All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. 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. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE 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 AUTHORS 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. ~ operational-0.2.4.2/Setup.hs0000644000000000000000000000005607346545000014020 0ustar0000000000000000import Distribution.Simple main = defaultMain operational-0.2.4.2/doc/0000755000000000000000000000000007346545000013130 5ustar0000000000000000operational-0.2.4.2/doc/Readme.md0000644000000000000000000000114007346545000014643 0ustar0000000000000000This folder contains various documentation for the `operational` package. Files:
design.md
Describes miscellanous design decisions.
examples/
Extensive code examples.
proofs.md
Proofs that the implementation is correct: monad laws, monad transformer classes.
tutorial-changes.md
Documents changes how the library API and implementation differs from the Operational Monad Tutorial.
operational-0.2.4.2/doc/design.md0000644000000000000000000000611407346545000014725 0ustar0000000000000000This 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. Lifting control operations -------------------------- The monad transformer `ProgramT` can automatically lift operations from the base monad, notably those from `MonadState` and `MonadIO`. 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! [conor]: http://www.haskell.org/pipermail/haskell-cafe/2010-April/076185.html For instance, the `MonadReader` class has a control operation `local`. The point is that it is subject to the following laws local :: MonadReader r m => (r -> r) -> m a -> m a local r (lift m) = lift (local r m) local r (return a) = return a local r (m >>= k) = local r m >>= local r . k Together with the requirement that the new instructions introduced by `ProgramT` do not interfere with the corresponding effect, local r (singleton instr) = singleton instr these laws specify a unique lifting. In other words, we can lift control operations whenever they obey laws that relate to `>>=` and `return`. `mapMonad` ---------- Limestraël [has suggested][1] that the module `Control.Monad.Operational` includes a function mapMonad :: (Monad m, Monad n) => (forall a. m a -> n a) -> ProgramT instr m a -> ProgramT instr n a which changes the base monad for the `ProgramT` monad transformer. A possible implementation is mapMonad f = id' <=< lift . f . viewT where id' (Return a) = return a id' (i :>>= k) = singleton i >>= mapMonad f . k 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. [1]: http://www.haskell.org/pipermail/haskell-cafe/2010-May/077094.html [2]: http://www.haskell.org/pipermail/haskell-cafe/2010-May/077097.html Recursive type definitions with `Program` ----------------------------------------- In the [unimo paper][unimo], the instructions carry an additional parameter that "unties" recursive type definition. For example, the instructions for `MonadPlus` are written data PlusI unimo a where Zero :: PlusI unimo a Plus :: unimo a -> unimo a -> PlusI unimo a The type constructor variable `unimo` will be tied to `Unimo PlusI`. In this library, I have opted for the conceptually simpler approach that requires the user to tie the recursion himself data PlusI a where Zero :: PlusI a Plus :: Program PlusI a -> Program PlusI a -> Plus I a 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. [unimo]: http://web.cecs.pdx.edu/~cklin/papers/unimo-143.pdf "Chuan-kai Lin. Programming Monads Operationally with Unimo." operational-0.2.4.2/doc/examples/0000755000000000000000000000000007346545000014746 5ustar0000000000000000operational-0.2.4.2/doc/examples/BreadthFirstParsing.hs0000644000000000000000000000476407346545000021222 0ustar0000000000000000{------------------------------------------------------------------------------ Control.Monad.Operational Example: A reformulation of Koen Claessen's Parallel Parsing Processes http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.19.9217 For a detailed explanation, see also http://apfelmus.nfshost.com/articles/operational-monad.html#monadic-parser-combinators ------------------------------------------------------------------------------} {-# LANGUAGE GADTs, Rank2Types, TypeSynonymInstances #-} module BreadthFirstParsing where import Control.Monad import Control.Monad.Operational {------------------------------------------------------------------------------ At their core, a parser monad consists of just three primitive instructions symbol -- fetch the next character mzero -- indicate parse failure mplus -- non-deterministic choice between two parsers and an interpreter function parse :: Parser a -> (String -> [a]) that applies a parser to a string and returns all the possible parse results. ------------------------------------------------------------------------------} data ParserInstruction a where Symbol :: ParserInstruction Char MZero :: ParserInstruction a MPlus :: Parser a -> Parser a -> ParserInstruction a type Parser = Program ParserInstruction symbol = singleton Symbol instance MonadPlus Parser where mzero = singleton $ MZero mplus x y = singleton $ MPlus x y -- apply a parser to a string -- breadth first fashion: each input character is touched only once parse :: Parser a -> String -> [a] parse p = go (expand p) where go :: [Parser a] -> String -> [a] go ps [] = [a | Return a <- map view ps] go ps (c:cs) = go [p | (Symbol :>>= is) <- map view ps, p <- expand (is c)] cs -- keep track of parsers that are run in parallel expand :: Parser a -> [Parser a] expand p = case view p of MPlus p q :>>= k -> expand (p >>= k) ++ expand (q >>= k) MZero :>>= k -> [] _ -> [p] -- example -- > parse parens "()(()())" -- [()] -- one parse -- > parse parens "()((())" -- [] -- no parse parens :: Parser () parens = return () `mplus` (enclose parens >> parens) where enclose q = char '(' >> q >> char ')' many :: Parser a -> Parser [a] many p = mzero `mplus` liftM2 (:) p (many p) satisfy :: (Char -> Bool) -> Parser Char satisfy p = do c <- symbol; if p c then return c else mzero char c = satisfy (==c) operational-0.2.4.2/doc/examples/ListT.hs0000644000000000000000000000352707346545000016350 0ustar0000000000000000{------------------------------------------------------------------------------ Control.Monad.Operational Example: List Monad Transformer ------------------------------------------------------------------------------} {-# LANGUAGE GADTs, Rank2Types, FlexibleInstances #-} module ListT where import Control.Monad import Control.Monad.Operational import Control.Monad.Trans {------------------------------------------------------------------------------ A direct implementation type ListT m a = m [a] would violate the monad laws, but we don't have that problem. ------------------------------------------------------------------------------} data MPlus m a where MZero :: MPlus m a MPlus :: ListT m a -> ListT m a -> MPlus m a type ListT m a = ProgramT (MPlus m) m a -- *sigh* I want to use type synonyms for type constructors, too; -- GHC doesn't accept MonadMPlus (ListT m) instance Monad m => MonadPlus (ProgramT (MPlus m) m) where mzero = singleton MZero mplus m n = singleton (MPlus m n) runListT :: Monad m => ListT m a -> m [a] runListT = eval <=< viewT where eval :: Monad m => ProgramViewT (MPlus m) m a -> m [a] eval (Return x) = return [x] eval (MZero :>>= k) = return [] eval (MPlus m n :>>= k) = liftM2 (++) (runListT (m >>= k)) (runListT (n >>= k)) testListT :: IO [()] testListT = runListT $ do n <- choice [1..5] lift . print $ "You've chosen the number: " ++ show n where choice = foldr1 mplus . map return -- testing the monad laws, from the Haskellwiki -- http://wiki.haskell.org/ListT_done_right#Order_of_printing a,b,c :: ListT IO () [a,b,c] = map (lift . putChar) ['a','b','c'] -- t1 and t2 have to print the same sequence of letters t1 = runListT $ ((a `mplus` a) >> b) >> c t2 = runListT $ (a `mplus` a) >> (b >> c) operational-0.2.4.2/doc/examples/LogicT.hs0000644000000000000000000000624607346545000016473 0ustar0000000000000000{------------------------------------------------------------------------------ Control.Monad.Operational Example: Oleg's LogicT monad transformer Functions to implement are taken from the corresponding paper http://okmij.org/ftp/papers/LogicT.pdf ------------------------------------------------------------------------------} {-# LANGUAGE GADTs, Rank2Types #-} module LogicT (LogicT, msplit, observe, bagOfN, interleave) where import Control.Monad import Control.Monad.Operational import Control.Monad.Trans import Data.Maybe {------------------------------------------------------------------------------ LogicT = A MonadPlus with an additional operation msplit which returns the first result and a computation to produce the remaining results. For example, the function msplit satisfies the laws msplit mzero ~> return Nothing msplit (return a `mplus` m) ~> return (Just (a,m)) It turns out that we don't have to make msplit a primitive, we can implement it by inspection on the argument. In other words, LogicT will be the same as the ListT monad transformer ------------------------------------------------------------------------------} import ListT type LogicT m a = ListT m a -- msplit is the lift of a function split in the base monad msplit :: Monad m => LogicT m a -> LogicT m (Maybe (a, LogicT m a)) msplit = lift . split -- split in the base monad split :: Monad m => LogicT m a -> m (Maybe (a, LogicT m a)) split = eval <=< viewT where -- apply the laws for msplit eval :: Monad m => ProgramViewT (MPlus m) m a -> m (Maybe (a, LogicT m a)) eval (Return v) = return (Just (v, mzero)) eval (MZero :>>= k) = return Nothing eval (MPlus m n :>>= k) = do ma <- split (m >>= k) case ma of Nothing -> split (n >>= k) Just (a,m') -> return $ Just (a, m' `mplus` (n >>= k)) -- inefficient! -- `mplus` will add another (>>= return) -- to n each time it's called. -- Curing this is not easy. -- main interpreter, section 6 in the paper -- returns the first result, if any; may fail observe :: Monad m => LogicT m a -> m a observe m = (fst . fromJust) `liftM` split m {------------------------------------------------------------------------------ Derived functions from the paper ------------------------------------------------------------------------------} -- return the first n results, section 6 bagOfN :: Monad m => Maybe Int -> LogicT m a -> LogicT m [a] bagOfN (Just n) m | n <= 0 = return [] bagOfN n m = msplit m >>= bagofN' where bagofN' Nothing = return [] bagofN' (Just (x,m')) = (x:) `liftM` bagOfN (fmap pred n) m' where pred n = n-1 -- interleave interleave :: Monad m => LogicT m a -> LogicT m a -> LogicT m a interleave m1 m2 = do r <- msplit m1 case r of Nothing -> m2 Just (a,m1') -> return a `mplus` interleave m2 m1' operational-0.2.4.2/doc/examples/PoorMansConcurrency.hs0000644000000000000000000000427107346545000021257 0ustar0000000000000000{------------------------------------------------------------------------------ Control.Monad.Operational Example: Koen Claessen's Poor Man's Concurrency Monad http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.39.8039 ------------------------------------------------------------------------------} {-# LANGUAGE GADTs, Rank2Types #-} module PoorMansConcurrency where import Control.Monad import Control.Monad.Operational import Control.Monad.Trans hiding (lift) {------------------------------------------------------------------------------ A concurrency monad runs several processes in parallel and supports two primitive operations fork -- fork a new process stop -- halt the current one We want this to be a monad transformer, so we also need a function lift This time, however, we cannot use the monad transformer version ProgramT because this will leave no room for interleaving different computations of the base monad. ------------------------------------------------------------------------------} data ProcessI m a where Lift :: m a -> ProcessI m a Stop :: ProcessI m a Fork :: Process m () -> ProcessI m () type Process m a = Program (ProcessI m) a stop = singleton Stop fork = singleton . Fork lift = singleton . Lift -- interpreter runProcess :: Monad m => Process m a -> m () runProcess m = schedule [m] where schedule :: Monad m => [Process m a] -> m () schedule [] = return () schedule (x:xs) = run (view x) xs run :: Monad m => ProgramView (ProcessI m) a -> [Process m a] -> m () run (Return _) xs = return () -- process finished run (Lift m :>>= k) xs = m >>= \a -> -- switch process schedule (xs ++ [k a]) run (Stop :>>= k) xs = schedule xs -- process halts run (Fork p :>>= k) xs = schedule (xs ++ [x2,x1]) -- fork new process where x1 = k (); x2 = p >>= k -- example -- > runProcess example -- warning: runs indefinitely example :: Process IO () example = do write "Start!" fork (loop "fish") loop "cat" write = lift . putStr loop s = write s >> loop s operational-0.2.4.2/doc/examples/Readme.md0000644000000000000000000000223607346545000016470 0ustar0000000000000000Example Code for the *operational* package ==========================================
BreadthFirstParsing.hs
An breadth-first implementation of parser combinators. As this implementation does not back-track, we avoid a common space leak.
LogicT.hs
Oleg Kiselyov's LogicT monad transformer.
ListT.hs
Correct implementation of the list monad transformer.
PoorMansConcurrency.hs
Koen Claessen's poor man's concurrency monad, implements cooperative multitasking.
State.hs
Very simple example showing how to implement the state monad.
TicTacToe.hs
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.
WebSessionState.lhs
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.
operational-0.2.4.2/doc/examples/State.hs0000644000000000000000000000336107346545000016365 0ustar0000000000000000{------------------------------------------------------------------------------ Control.Monad.Operational Example: State monad and monad transformer ------------------------------------------------------------------------------} {-# LANGUAGE GADTs, Rank2Types, FlexibleInstances #-} module State where import Control.Monad import Control.Monad.Operational import Control.Monad.Trans {------------------------------------------------------------------------------ State Monad ------------------------------------------------------------------------------} data StateI s a where Get :: StateI s s Put :: s -> StateI s () type State s a = Program (StateI s) a evalState :: State s a -> s -> a evalState = eval . view where eval :: ProgramView (StateI s) a -> (s -> a) eval (Return x) = const x eval (Get :>>= k) = \s -> evalState (k s ) s eval (Put s :>>= k) = \_ -> evalState (k ()) s put :: s -> StateT s m () put = singleton . Put get :: StateT s m s get = singleton Get testState :: Int -> Int testState = evalState $ do x <- get put (x+2) get {------------------------------------------------------------------------------ State Monad Transformer ------------------------------------------------------------------------------} type StateT s m a = ProgramT (StateI s) m a evalStateT :: Monad m => StateT s m a -> s -> m a evalStateT m = \s -> viewT m >>= \p -> eval p s where eval :: Monad m => ProgramViewT (StateI s) m a -> (s -> m a) eval (Return x) = \_ -> return x eval (Get :>>= k) = \s -> evalStateT (k s ) s eval (Put s :>>= k) = \_ -> evalStateT (k ()) s testStateT = evalStateT $ do x <- get lift $ putStrLn "Hello StateT" put (x+1) operational-0.2.4.2/doc/examples/TicTacToe.hs0000644000000000000000000001322507346545000017124 0ustar0000000000000000{------------------------------------------------------------------------------ Control.Monad.Operational Example: An implementation of the game TicTacToe. Each player (human, AI, ...) is implemented in a separate monad which are then intermingled to run the game. This resembles the PoorMansConcurrency.hs example. Many thanks to Yves Par`es and Bertram Felgenhauer http://www.haskell.org/pipermail/haskell-cafe/2010-April/076216.html ------------------------------------------------------------------------------} {-# LANGUAGE GADTs, Rank2Types #-} import Control.Monad import Control.Monad.Operational import Control.Monad.State import Data.Either import Data.List (transpose, intersperse) -- external libraries needed import System.Random {------------------------------------------------------------------------------ The Player monad for implementing players (human, AI, ...) provides two operations readBoard -- read the current board position playMove -- play a move to query the current board position and perform a move, respectively. Moreover, it's actually a monad transformer intended to be used over IO. This way, the players can perform IO computations. ------------------------------------------------------------------------------} data PlayerI a where ReadBoard :: PlayerI Board PlayMove :: Int -> PlayerI Bool type Player m a = ProgramT PlayerI m a readBoard = singleton ReadBoard playMove = singleton . PlayMove -- interpreter runGame :: Player IO () -> Player IO () -> IO () runGame player1 player2 = eval' initialGameState player1 player2 where eval' game p1 p2 = viewT p1 >>= \p1view -> eval game p1view p2 eval :: GameState -> ProgramViewT PlayerI IO () -> Player IO () -> IO () eval game (Return _) _ = return () eval game (ReadBoard :>>= p1) p2 = eval' game (p1 (board game)) p2 eval game (PlayMove mv :>>= p1) p2 = case makeMove mv game of Nothing -> eval' game (p1 False) p2 Just game' | won game' -> let p = activePlayer game in putStrLn $ "Player " ++ show p ++ " has won!" | draw game'-> putStrLn $ "It's a draw." | otherwise -> eval' game' p2 (p1 True) -- example: human vs AI main = do g <- getStdGen runGame playerHuman (playerAI g) {------------------------------------------------------------------------------ TicTacToe Board type and logic The board looks like this: +---+---+---+ some squares already played on | 1 | 2 | 3 | the empty squares are numbered +---+---+---+ | 4 | 5 |OOO| +---+---+---+ | 7 |XXX| 9 | +---+---+---+ ------------------------------------------------------------------------------} data Symbol = X | O deriving (Eq,Show) type Square = Either Int Symbol type Board = [[Square]] data GameState = Game { board :: Board, activePlayer :: Symbol } initialGameState :: GameState initialGameState = Game (map (map Left) [[1,2,3],[4,5,6],[7,8,9]]) X -- list the possible moves to play possibleMoves :: Board -> [Int] possibleMoves board = [k | Left k <- concat board] -- play a stone at a square makeMove :: Int -> GameState -> Maybe GameState makeMove k (Game board player) | not (k `elem` possibleMoves board) = Nothing -- illegal move | otherwise = Just $ Game (map (map replace) board) (switch player) where replace (Left k') | k' == k = Right player replace x = x switch X = O switch O = X -- has somebody won the game? won :: GameState -> Bool won (Game board _) = any full $ diagonals board ++ rows board ++ cols board where full [a,b,c] = a == b && b == c diagonals [[a1,_,b1], [_ ,c,_ ], [b2,_,a2]] = [[a1,c,a2],[b1,c,b2]] rows = id cols = transpose -- is the game a draw? draw :: GameState -> Bool draw (Game board _) = null (possibleMoves board) -- print the board showSquare = either (\n -> " " ++ show n ++ " ") (concat . replicate 3 . show) showBoard :: Board -> String showBoard board = unlines . surround "+---+---+---+" . map (concat . surround "|". map showSquare) $ board where surround x xs = [x] ++ intersperse x xs ++ [x] printBoard = putStr . showBoard {------------------------------------------------------------------------------ Player examples ------------------------------------------------------------------------------} -- a human player on the command line playerHuman :: Player IO () playerHuman = forever $ readBoard >>= liftIO . printBoard >> doMove where -- ask the player where to move doMove :: Player IO () doMove = do liftIO . putStrLn $ "At which number would you like to play?" n <- liftIO getLine b <- playMove (read n) unless b $ do liftIO . putStrLn $ "Position " ++ show n ++ " is already full." doMove -- a random AI, -- also demonstrates how to use a custom StateT on top -- of the Player monad playerAI :: Monad m => StdGen -> Player m () playerAI = evalStateT ai where ai :: Monad m => StateT StdGen (ProgramT PlayerI m) () ai = forever $ do board <- lift $ readBoard n <- uniform (possibleMoves board) -- select a random move lift $ playMove n where -- select one element at random uniform :: Monad m => [a] -> StateT StdGen m a uniform xs = do gen <- get let (n,gen') = randomR (1,length xs) gen put gen' return (xs !! (n-1)) operational-0.2.4.2/doc/examples/WebSessionState.lhs0000644000000000000000000000623707346545000020550 0ustar0000000000000000#!/bin/sh runghc \begin{code} {------------------------------------------------------------------------------ Control.Monad.Operational Example: A CGI script that maintains session state http://www.informatik.uni-freiburg.de/~thiemann/WASH/draft.pdf ------------------------------------------------------------------------------} {-# LANGUAGE GADTs, Rank2Types #-} module WebSessionState where import Control.Monad import Control.Monad.Operational import Control.Monad.Trans hiding (lift) import Data.Char import Data.Maybe -- external libraries needed import Text.Html as H import Network.CGI {------------------------------------------------------------------------------ This example shows a "magic" implementation of a web session that looks like it needs to be executed in a running process, while in fact it's just a CGI script. The key part is a monad, called "Web" for lack of imagination, which supports a single operation ask :: String -> Web String which sends a simple minded HTML-Form to the web user and returns his answer. How does this work? The trick is that all previous answers are logged in a hidden field of the input form. The CGI script will simply replays this log when called. In other words, the user state is stored in the input form. ------------------------------------------------------------------------------} data WebI a where Ask :: String -> WebI String type Web a = Program WebI a ask = singleton . Ask -- interpreter runWeb :: Web H.Html -> CGI CGIResult runWeb m = do -- fetch log log' <- maybe [] (read . urlDecode) `liftM` getInput "log" -- maybe append form input f <- maybe id (\answer -> (++ [answer])) `liftM` getInput "answer" let log = f log' -- run Web action and output result output . renderHtml =<< replay m log log where replay = eval . view eval :: ProgramView WebI H.Html -> [String] -> [String] -> CGI H.Html eval (Return html) log _ = return html eval (Ask question :>>= k) log (l:ls) = -- replay answer from log replay (k l) log ls eval (Ask question :>>= k) log [] = -- present HTML page to user return $ htmlQuestion log question -- HTML page with a single form htmlQuestion log question = htmlEnvelope $ p << question +++ x where x = form ! [method "post"] << (textfield "answer" +++ submit "Next" "" +++ hidden "log" (urlEncode $ show log)) htmlMessage s = htmlEnvelope $ p << s htmlEnvelope html = header << thetitle << "Web Session State demo" +++ body << html -- example example :: Web H.Html example = do haskell <- ask "What's your favorite programming language?" if map toLower haskell /= "haskell" then message "Awww." else do ghc <- ask "What's your favorite compiler?" web <- ask "What's your favorite monad?" message $ "I like " ++ ghc ++ " too, but " ++ web ++ " is debatable." where message = return . htmlMessage main = runCGI . runWeb $ example \end{code} operational-0.2.4.2/doc/proofs.md0000644000000000000000000001751507346545000014773 0ustar0000000000000000Correctness Proofs ================== This document collects correctness proofs for the `operational` library. [tutorial]: http://apfelmus.nfshost.com/articles/operational-monad.html Monad laws ---------- 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*. In particular, we say that two programs e1, e2 :: Program instr a are *equivalent*, `e1 ~ e2`, if they can be transformed into each other by applying the monad laws on the constructors. For instance, the expressions e1 = ((m `Bind` f) `Bind` g e2 = m `Bind` (\a -> f a `Bind` g) 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: e1 ~ e2 => view e1 = view e2 The `ProgramView` type is equipped with an appropriate equality relation: (Return a1) = (Return a2) iff a1 = a2 (i1 :>>= k1) = (i2 :>>= k2) iff i1 = i2 and k1 x ~ k2 x for all x ### Normal form: list of instructions 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. For simplicity, let us first focus on the pure `Program` type and postpone the case `ProgramT` for monad transformers later. We can formalize the intuition above by introducing the following types of *normal form* data NF instr a where Return' :: a -> NF instr a (:>>=') :: instr a -> (a -> NF instr b) -> NF instr b which is simply the list of instructions from the [tutorial][]. Now, we know that `NF` is a monad instance Monad (NF instr) where return = Return' (Return' a) >>= k = k a (m :>>=' g) >>= k = m :>>=' (\a -> g a >>= k) In particular, it fulfills the monad laws. (Actually we would have to prove that by using coinduction, but I leave that as an exercise.) We can now map each `Program` to its normal form normalize :: Program instr a -> NF instr a normalize (m `Bind` k) = normalize m >>= normalize k normalize (Return a) = return a normalize (Instr i) = i :>>=' return 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. e1 ~ e2 => normalize e1 = normalize e2 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 e1 ~ view e1 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 normalize (view e1) = normalize (view e2) => view e1 = view e2 (The requires a coinductive argument for the tail of instructions.) Taking these three implications together, we see that e1 ~ e2 => view e1 = view e2 as desired. ### Normal form for monad transformers 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* newtype NFT instr m a = JoinLift (m (NFT' instr m a)) data NFT' instr m a where Return' :: a -> NFT' instr m a (:>>=') :: instr a -> (a -> NFT instr m b) -> NFT' instr m b This is in very close analogy to the "effectful list" type ListT m a = m (ListT' m a) data ListT' m a = Nil | Cons a (ListT m a) For example, if the monad `m` is the state monad, then this type represents a list whose tail depends on the current state. First, we convince ourselves that the `NFT` type is indeed a monad transformer. The corresponding functions are implemented as instance Monad m => Monad (NFT instr m) where return a = JoinLift (return (Return' a)) (JoinLift m) >>= k = JoinLift (m >>= f) where f (Return' a) = k a f (i :>>=' f) = return $ i :>>= (\a -> f a >>= k) instance MonadTrans (NFT instr) where lift m = JoinLift (fmap Return' m) singleton i = JoinLift (return (i :>>=' return)) It is somewhat tedious to check the monad laws and the lifting laws, so we skip this step here. Having convinced ourselves that the normal form type `NFT` is, in fact, a monad transformer, we can define a morphism normalize :: ProgramT instr m a -> NFT instr m a normalize (Lift m) = lift m normalize (m `Bind` k) = m >>= k normalize (Instr i) = singleton i 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. Lifting monads -------------- 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`. ### Instructions and control operations Some monads only feature "algebraic" instructions which have the form instr :: a1 -> a2 -> ... -> m b 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 get :: State s s put :: s -> State s () of precisely this form. Lifting these kinds of instructions is straightforward, i.e. the `ProgramT instr State` monad is also a state monad. instance (MonadState s m) => MonadState s (ProgramT instr m) where get = lift get put = lift . put 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 mplus :: MonadPlus m => m a -> m a -> m a that combines the control flows of two monadic arguments. For more on the distinction between algebraic operation and control operation, see also a [discussion by Conor McBride][conor]. [conor]: http://www.haskell.org/pipermail/haskell-cafe/2010-April/076185.html ### MonadReader The main feature of the `MonadReader` class is an algebraic operation ask :: MonadReader m r => m r but unfortunately, it also includes a control operation local :: MonadReader m r => (r -> r) -> m r -> m r and it is not clear whether this can be lifted to the `ProgramT` transformer. We certainly expect the following law to hold local r (lift m) = lift (local f m) Fortunately, this control operation is very benign, in that it is actually a monad morphism local r (return a) = return a local r (m >>= k) = local r m >>= local r . k Imposing that the lifted control operation should also be a morphism, we can define it for normal forms as follows local :: MonadReader m r => (r -> r) -> ProgramT instr m a -> ProgramT instr m a local r (JoinLift m) = JoinLift $ local r (m >>= return . f) where f (Return' a) = return a f (i :>>=' k) = singleton i >>= local r . k 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! operational-0.2.4.2/doc/tutorial-changes.md0000644000000000000000000001207107346545000016724 0ustar0000000000000000 [tutorial]: http://apfelmus.nfshost.com/articles/operational-monad.html The `operational` library is based on ["The Operational Monad Tutorial"][tutorial], but features a slightly different API and implementation. This document describes how the library has been changed compared to the tutorial. Changes to the `Program` type ----------------------------- 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 data ProgramView instr a where Return :: a -> ProgramView instr a (:>>=) :: instr a -> (a -> Program instr b) -> ProgramView instr b 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`. To see an example of the new style, here the interpreter for the stack machine from the tutorial: interpret :: StackProgram a -> (Stack Int -> a) interpret = eval . view where eval :: ProgramView StackInstruction a -> (Stack Int -> a) eval (Push a :>>= is) stack = interpret (is ()) (a:stack) eval (Pop :>>= is) (a:stack) = interpret (is a ) stack eval (Return a) stack = a 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]. [containers]: http://hackage.haskell.org/package/containers Efficiency ---------- 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 let nestLeft :: Int -> StackProgram Int nestLeft 0 = return 0 nestLeft n = nestLeft (n-1) >>= push in interpret (nestLeft n) [] 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. However, this does *not* hold in a *persistent* setting. In particular, the example let p = nestLeft n v1 = view p v2 = view p v3 = view p in v1 `seq` v2 `seq` v3 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 `++`. Monad Transformers ------------------ Furthermore, `Program` is actually a type synonym and expressed in terms of a monad transformer `ProgramT` type Program instr a = ProgramT instr Identity a 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. 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 lift . return = return lift m >>= lift . g = lift (m >>= g) 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: data PlusI m a where Zero :: PlusI m a Plus :: ListT m a -> ListT m a -> PlusI m a type ListT m a = ProgramT (PlusI m) m a runList :: Monad m => ListT m a -> m [a] runList = eval <=< viewT where eval :: Monad m => ProgramViewT (PlusI m) m a -> m [a] eval (Return x) = return [x] eval (Zero :>>= k) = return [] eval (Plus m n :>>= k) = liftM2 (++) (runList (m >>= k)) (runList (n >>= k)) Alternatives to Monad Transformers ---------------------------------- 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 Program (StateI s :+: ExceptionI e) a data (f :+: g) a = Inl (f a) | Inr (g a) -- a fancy Either is a combination of the state monad type State a = Program (StateI s) a data StateI s a where Put :: s -> StateI s () Get :: StateI s s and the error monad type Error e a = Program (ErrorI e) a data ErrorI e a where Throw :: e -> ErrorI e () Catch :: ErrorI e a -> (e -> ErrorI e a) -> ErrorI e a 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. [a la carte]: http://www.cse.chalmers.se/~wouter/Publications/DataTypesALaCarte.pdf "Wouter Swierstra. Data types à la carte." operational-0.2.4.2/operational.cabal0000644000000000000000000000515507346545000015672 0ustar0000000000000000Name: operational Version: 0.2.4.2 Synopsis: Implementation of difficult monads made easy with operational semantics. Description: This library makes it easy to implement monads with tricky control flow. . 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. . See the project homepage for a more detailed introduction and features. . Related packages: . * MonadPrompt — . * free — . * free-operational — Category: Control, Monads License: BSD3 License-file: LICENSE Author: Heinrich Apfelmus Maintainer: Heinrich Apfelmus Copyright: (c) Heinrich Apfelmus 2010-2013 Homepage: http://wiki.haskell.org/Operational Stability: Provisional build-type: Simple cabal-version: >= 1.10 tested-with: GHC == 9.4.4 , GHC == 9.2.5 , GHC == 8.10.7 extra-source-files: CHANGELOG.md doc/*.md doc/examples/*.hs doc/examples/*.lhs doc/examples/*.md flag buildExamples description: Build example executables. default: True manual: True source-repository head type: git location: https://github.com/HeinrichApfelmus/operational.git Library default-language: Haskell2010 other-extensions: ExistentialQuantification FlexibleInstances GADTSyntax MultiParamTypeClasses Rank2Types ScopedTypeVariables UndecidableInstances hs-source-dirs: src exposed-modules: Control.Monad.Operational build-depends: base >= 4.8 && < 5 , mtl >= 1.1 && < 2.4 , transformers >=0.5.6 && <0.7 ghc-options: -Wall Executable operational-TicTacToe if !flag(buildExamples) buildable: False default-language: Haskell2010 other-extensions: GADTs Rank2Types hs-source-dirs: doc/examples main-is: TicTacToe.hs build-depends: operational, base, mtl, random == 1.* operational-0.2.4.2/src/Control/Monad/0000755000000000000000000000000007346545000015630 5ustar0000000000000000operational-0.2.4.2/src/Control/Monad/Operational.hs0000644000000000000000000003061507346545000020446 0ustar0000000000000000{-# LANGUAGE GADTSyntax, ExistentialQuantification, Rank2Types, ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances, MultiParamTypeClasses, FlexibleInstances #-} -- Search for UndecidableInstances to see why this is needed module Control.Monad.Operational ( -- * Synopsis -- $synopsis -- * Overview -- $intro -- * Monad Program, singleton, ProgramView, view, -- $example interpretWithMonad, -- * Monad transformer ProgramT, ProgramViewT(..), viewT, -- $exampleT liftProgram, mapInstr, unviewT, interpretWithMonadT, ) where import Control.Monad import Control.Monad.Identity (Identity, runIdentity) import Control.Monad.Trans (MonadTrans, lift) -- mtl classes to instantiate. -- Those commented out cannot be instantiated. For reasons see below. -- import Control.Monad.Cont.Class -- import Control.Monad.Error.Class import Control.Monad.IO.Class import Control.Monad.Reader.Class import Control.Monad.State.Class -- import Control.Monad.Writer.Class {------------------------------------------------------------------------------ Introduction ------------------------------------------------------------------------------} {-$synopsis To write a monad, use the 'Program' type. To write a monad transformer, use the 'ProgramT' type. For easier interoperability, the 'Program' type is actually a type synonym and defined in terms of 'ProgramT'. -} {-$intro The basic idea for implementing monads with this libary is to think of monads as /sequences of primitive instructions/. For instance, imagine that you want to write a web application with a custom monad that features an instruction > askUserInput :: CustomMonad UserInput which sends a form to the remote user and waits for the user to send back his input To implement this monad, you decide that this instruction is a primitive, i.e. should not be implemented in terms of other, more basic instructions. Once you have chosen your primitives, collect them in a data type @ data CustomMonadInstruction a where AskUserInput :: CustomMonadInstruction UserInput @ Then, obtain your custom monad simply by applying the 'Program' type constructor > type CustomMonad a = Program CustomMonadInstruction a The library makes sure that it is an instance of the 'Monad' class and fulfills all the required laws. Essentially, the monad you now obtained is just a fancy list of primitive instructions. In particular, you can pattern match on the first element of this "list". This is how you implement an @interpret@ or @run@ function for your monad. Note that pattern matching is done using the 'view' function @ runCustomMonad :: CustomMonad a -> IO a runCustomMonad m = case view m of Return a -> return a -- done, return the result AskUserInput :>>= k -> do b <- waitForUserInput -- wait for external user input runCustomMonad (k b) -- proceed with next instruction @ The point is that you can now proceed in any way you like: you can wait for the user to return input as shown, or you store the continuation @k@ and retrieve it when your web application receives another HTTP request, or you can keep a log of all user inputs on the client side and replay them, and so on. Moreover, you can implement different @run@ functions for one and the same custom monad, which is useful for testing. Also note that the result type of the @run@ function does not need to be a monad at all. In essence, your custom monad allows you to express your web application as a simple imperative program, while the underlying implementation can freely map this to an event-drived model or some other control flow architecture of your choice. The possibilities are endless. More usage examples can be found here: -} {------------------------------------------------------------------------------ Program ------------------------------------------------------------------------------} {-| The abstract data type @'Program' instr a@ represents programs, i.e. sequences of primitive instructions. * The /primitive instructions/ are given by the type constructor @instr :: * -> *@. * @a@ is the return type of a program. @'Program' instr@ is always a monad and automatically obeys the monad laws. -} type Program instr = ProgramT instr Identity -- | View type for inspecting the first instruction. -- It has two constructors 'Return' and @:>>=@. -- (For technical reasons, they are documented at 'ProgramViewT'.) type ProgramView instr = ProgramViewT instr Identity -- | View function for inspecting the first instruction. view :: Program instr a -> ProgramView instr a view = runIdentity . viewT -- | Utility function that extends -- a given interpretation of instructions as monadic actions -- to an interpration of 'Program's as monadic actions. -- -- This function can be useful if you are mainly interested in -- mapping a 'Program' to different standard monads, like the state monad. -- For implementing a truly custom monad, -- you should write your interpreter directly with 'view' instead. interpretWithMonad :: forall instr m b. Monad m => (forall a. instr a -> m a) -> (Program instr b -> m b) interpretWithMonad f = eval . view where eval :: forall a. ProgramView instr a -> m a eval (Return a) = return a eval (m :>>= k) = f m >>= interpretWithMonad f . k {- $example /Example usage/ Stack machine from \"The Operational Monad Tutorial\". > data StackInstruction a where > Push :: Int -> StackInstruction () > Pop :: StackInstruction Int > > type StackProgram a = Program StackInstruction a > type Stack b = [b] > > interpret :: StackProgram a -> (Stack Int -> a) > interpret = eval . view > where > eval :: ProgramView StackInstruction a -> (Stack Int -> a) > eval (Push a :>>= is) stack = interpret (is ()) (a:stack) > eval (Pop :>>= is) (a:stack) = interpret (is a ) stack > eval (Return a) stack = a In this example, the type signature for the `eval` helper function is optional. -} {------------------------------------------------------------------------------ ProgramT - monad transformer ------------------------------------------------------------------------------} {-| The abstract data type @'ProgramT' instr m a@ represents programs over a base monad @m@, i.e. sequences of primitive instructions and actions from the base monad. * The /primitive instructions/ are given by the type constructor @instr :: * -> *@. * @m@ is the base monad, embedded with 'lift'. * @a@ is the return type of a program. @'ProgramT' instr m@ is a monad transformer and automatically obeys both the monad and the lifting laws. -} data ProgramT instr m a where Lift :: m a -> ProgramT instr m a Bind :: ProgramT instr m b -> (b -> ProgramT instr m a) -> ProgramT instr m a Instr :: instr a -> ProgramT instr m a -- basic instances instance Monad m => Monad (ProgramT instr m) where return = Lift . return (>>=) = Bind instance MonadTrans (ProgramT instr) where lift = Lift instance Monad m => Functor (ProgramT instr m) where fmap = liftM instance Monad m => Applicative (ProgramT instr m) where pure = return (<*>) = ap -- | Program made from a single primitive instruction. singleton :: instr a -> ProgramT instr m a singleton = Instr -- | View type for inspecting the first instruction. -- This is very similar to pattern matching on lists. -- -- * The case @(Return a)@ means that the program contains no instructions -- and just returns the result @a@. -- -- *The case @(someInstruction :>>= k)@ means that the first instruction -- is @someInstruction@ and the remaining program is given by the function @k@. data ProgramViewT instr m a where Return :: a -> ProgramViewT instr m a (:>>=) :: instr b -> (b -> ProgramT instr m a) -> ProgramViewT instr m a instance Monad m => Functor (ProgramViewT instr m) where fmap f (Return a) = Return $ f a fmap f (instr :>>= cont) = instr :>>= (fmap f . cont) instance Monad m => Applicative (ProgramViewT instr m) where pure = return (<*>) = ap instance Monad m => Monad (ProgramViewT instr m) where return = Return Return a >>= cont = cont a (instr :>>= cont1) >>= cont2 = instr :>>= (cont1 >=> unviewT . cont2) -- | View function for inspecting the first instruction. viewT :: Monad m => ProgramT instr m a -> m (ProgramViewT instr m a) viewT (Lift m) = m >>= return . Return viewT ((Lift m) `Bind` g) = m >>= viewT . g viewT ((m `Bind` g) `Bind` h) = viewT (m `Bind` (\x -> g x `Bind` h)) viewT ((Instr i) `Bind` g) = return (i :>>= g) viewT (Instr i) = return (i :>>= return) {-| Lift a plain sequence of instructions to a sequence of instructions over a monad 'm'. This is the counterpart of the 'lift' function from 'MonadTrans'. It can be defined as follows: @ liftProgram = eval . view where eval :: ProgramView instr a -> ProgramT instr m a eval (Return a) = return a eval (i :>>= k) = singleton i >>= liftProgram . k @ -} liftProgram :: Monad m => Program instr a -> ProgramT instr m a liftProgram (Lift m) = return (runIdentity m) liftProgram (m `Bind` k) = liftProgram m `Bind` (liftProgram . k) liftProgram (Instr i) = Instr i -- | Utility function that extends -- a given interpretation of instructions as monadic actions -- to an interpration of 'ProgramT's as monadic actions. -- -- Ideally, you would not use another monad, -- but write a custom interpreter directly with `viewT`. -- See the remark at 'interpretWithMonad'. interpretWithMonadT :: Monad m => (forall x . instr x -> m x) -> ProgramT instr m a -> m a interpretWithMonadT interpreter = go where go program = do firstInstruction <- viewT program case firstInstruction of Return a -> return a instruction :>>= continuation -> interpreter instruction >>= (go . continuation) -- | Utilitiy function for mapping a 'ProgramViewT' back into a 'ProgramT'. -- -- Semantically, the function 'unviewT' is an inverse of 'viewT', -- e.g. we have -- -- @ -- viewT (singleton i) >>= unviewT = return (singleton i) -- @ unviewT :: Monad m => ProgramViewT instr m a -> ProgramT instr m a unviewT (Return a) = return a unviewT (instruction :>>= continuation) = (Instr instruction) `Bind` continuation -- | Extend a mapping of instructions to a mapping of 'ProgramT'. mapInstr :: forall instr1 instr2 m a . Monad m => (forall x . instr1 x -> instr2 x) -> ProgramT instr1 m a -> ProgramT instr2 m a mapInstr f = go where go :: forall x. ProgramT instr1 m x -> ProgramT instr2 m x go (Lift action) = Lift action go (Bind action continuation) = Bind (go action) (go . continuation) go (Instr instruction) = Instr $ f instruction {- $exampleT /Example usage/ List monad transformer. > data PlusI m a where > Zero :: PlusI m a > Plus :: ListT m a -> ListT m a -> PlusI m a > > type ListT m a = ProgramT (PlusI m) m a > > runList :: Monad m => ListT m a -> m [a] > runList = eval <=< viewT > where > eval :: Monad m => ProgramViewT (PlusI m) m a -> m [a] > eval (Return x) = return [x] > eval (Zero :>>= k) = return [] > eval (Plus m n :>>= k) = > liftM2 (++) (runList (m >>= k)) (runList (n >>= k)) In this example, the type signature for the `eval` helper function is optional. -} {------------------------------------------------------------------------------ mtl instances * All of these instances need UndecidableInstances, because they do not satisfy the coverage condition. Most of the instance in the mtl package itself have the same issue. * Lifting algebraic operations is easy, lifting control operations is more elaborate, but sometimes possible. See the design notes in `doc/design.md`. ------------------------------------------------------------------------------} instance (MonadState s m) => MonadState s (ProgramT instr m) where get = lift get put = lift . put instance (MonadIO m) => MonadIO (ProgramT instr m) where liftIO = lift . liftIO instance (MonadReader r m) => MonadReader r (ProgramT instr m) where ask = lift ask local r (Lift m) = Lift (local r m) local r (m `Bind` k) = local r m `Bind` (local r . k) local _ (Instr i) = Instr i