MonadPrompt (empty) → 1.0.0.0
raw patch · 5 files changed
+388/−0 lines, 5 filesdep +basedep +mtlsetup-changed
Dependencies added: base, mtl
Files
- Control/Monad/Prompt.lhs +199/−0
- LICENSE +24/−0
- MonadPrompt.cabal +23/−0
- PromptExamples.hs +140/−0
- Setup.hs +2/−0
+ Control/Monad/Prompt.lhs view
@@ -0,0 +1,199 @@+Prompt.lhs: implementation of monads that allow the computation+to "prompt" for further input.++(c) 2008 Bertram Felgenhauer & Ryan Ingram+Released as open source under a 3 clause BSD license. See the LICENSE+file in the source code distribution for further information.++MonadPrompt monads allow you to pass some object of the "prompt"+type in, and get a result of the prompt's answer type out.++> {-# LANGUAGE RankNTypes #-}+> {-# LANGUAGE FlexibleInstances #-}+> {-# LANGUAGE MultiParamTypeClasses #-}+> {-# LANGUAGE FunctionalDependencies #-}+> module Control.Monad.Prompt (+> MonadPrompt(..),+> Prompt,+> runPromptC,+> runPrompt,+> runPromptM,+> RecPrompt,+> unRecPrompt,+> PromptT,+> runPromptT,+> Lift(..),+> unPromptT,+> liftP+> ) where+> import Control.Applicative (Applicative(..))+> import Control.Monad (ap, liftM)+> import Control.Monad.Trans (MonadTrans(..))+++You can construct a monad very simply with prompt, by putting+all of its effects as terms in a GADT, like the following example:++] data PromptState s a where+] Put :: s -> PromptState s ()+] Get :: PromptState s s++You then use "prompt" to access effects:+] postIncrement :: MonadPrompt (PromptState Int) m => m Int+] postIncrement = do+] x <- prompt Get+] prompt (Put (x+1))+] return x++The advantage of Prompt over implementing effects directly:+1) Prompt is pure; it is only through the observation function+ runPromptC that you can cause effects.+2) You don't have to worry about the monad laws; they are+ correct by construction and you cannot break them.+3) You can implement several observation functions for the same+ type. See, for example, http://paste.lisp.org/display/53766+ where a guessing game is implemented with an IO observation+ function for the user, and an AI observation function that+ plays the game automatically.++In these ways Prompt is similar to Unimo, but "bind" and "return"+are inlined into the computation, whereas in Unimo they are+handled as a term calculus.+See http://sneezy.cs.nott.ac.uk/fplunch/weblog/?p=89++> class Monad m => MonadPrompt p m | m -> p where+> prompt :: p a -> m a++For any prompt p, Prompt p is an instance of MonadPrompt p.++> newtype Prompt p r = Prompt {+> runP :: forall b . (r -> b) -> (forall a . p a -> (a -> b) -> b) -> b+> }++> instance Monad (Prompt p) where+> return a = Prompt $ \done _ -> done a+> f >>= g = Prompt $ \done prm -> runP f (\x -> runP (g x) done prm) prm++> instance Functor (Prompt p) where+> fmap = liftM++> instance Applicative (Prompt p) where+> pure = return+> (<*>) = ap++> instance MonadPrompt p (Prompt p) where+> prompt p = Prompt $ \done prm -> prm p done++runPromptC is the observation function for prompts. It takes+two functions as arguments:+1) "ret" will be called with the final result of the computation,+ to convert it to the answer type.+2) "prm" will be called if there are any effects; it is passed+ a prompt and a continuation function. prm can apply+ the effect requested by the prompt and call the continuation.++In some cases prm can return the answer type directly; it+may be useful to abort the remainder of the computation, or+save off the continuation to be called later. There is a great+example of using this to implement a UI for peg solitaire in Bertram+Felgenhauer's post to Haskell-Cafe at+http://www.haskell.org/pipermail/haskell-cafe/2008-January/038301.html++> runPromptC :: forall p r b. -- prompt, computation result, answer type+> (r -> b) -- handler when there is no further computation+> -> (forall a . p a -> (a -> b) -> b)+> -- handler for prompts+> -> Prompt p r -- a prompt-based computation+> -> b -- answer+> runPromptC ret prm p = runP p ret prm++For simplicity, we also provide two simpler observation functions;+runPrompt takes a way of converting prompts to an element in a pure+fashion and calculates the result of the prompt; runPromptM is similar+but allows the computation to happen in any monad.++> runPrompt :: (forall a. p a -> a) -> Prompt p r -> r+> runPrompt prm = runPromptC id (\p cont -> cont $ prm p)++> runPromptM :: Monad m => (forall a . p a -> m a) -> Prompt p r -> m r+> runPromptM prm = runPromptC return (\p cont -> prm p >>= cont)++RecPrompt is for prompts which are dependent on the prompt monad.+For example, a MonadPlus prompt:++] data PromptPlus m a where+] PromptZero :: PromptPlus m a+] PromptPlus :: m a -> m a -> PromptPlus m a++] -- trivial MonadPlus instance+] instance MonadPlus (RecPrompt PromptPlus) where+] mzero = prompt PromptZero+] mplus x y = prompt (PromptPlus x y)++> newtype RecPrompt p r = RecPrompt {+> unRecPrompt :: Prompt (p (RecPrompt p)) r+> }++> instance Monad (RecPrompt p) where+> return = RecPrompt . return+> m >>= f = RecPrompt $ unRecPrompt m >>= (unRecPrompt . f)++> instance Functor (RecPrompt p) where+> fmap = liftM++> instance Applicative (RecPrompt p) where+> pure = return+> (<*>) = ap++> instance MonadPrompt (p (RecPrompt p)) (RecPrompt p) where+> prompt = RecPrompt . prompt++Prompt can also be used to define monad transformers.++You will notice the lack of a "Monad m" constraint; this is allowed+because Prompt doesn't use the underlying monad at all; instead+the observation function (generally implemented via runPromptT)+will have the constraint.++So, "Lift" is really just a higher-kinded "Either".++> data Lift p m a = Effect (p a) | Lift (m a)+> newtype PromptT p m a = PromptT {+> unPromptT :: Prompt (Lift p m) a+> }++> instance Monad (PromptT p m) where+> return = PromptT . return+> m >>= f = PromptT $ unPromptT m >>= (unPromptT . f)++> instance Functor (PromptT p m) where+> fmap = liftM++> instance Applicative (PromptT p m) where+> pure = return+> (<*>) = ap++> instance MonadPrompt p (PromptT p m) where+> prompt = PromptT . prompt . Effect++> instance MonadTrans (PromptT p) where+> lift = PromptT . prompt . Lift++> runPromptT :: forall p m r b.+> (r -> b) -- handler when there is no further computation+> -> (forall a . p a -> (a -> b) -> b)+> -- handler for prompts+> -> (forall a . m a -> (a -> b) -> b)+> -- handler for lifted computations+> -> PromptT p m r -- a prompt-based computation+> -> b -- answer+> runPromptT ret prm lft = runPromptC ret prm' . unPromptT where+> prm' (Effect e) = prm e+> prm' (Lift a) = lft a++You can also lift any Prompt computation into a PromptT; this is the+kind of place where the advantage of being able to use multiple+observation functions on Prompt really shows.++> liftP :: Prompt p r -> PromptT p m r+> liftP = runPromptM prompt
+ LICENSE view
@@ -0,0 +1,24 @@+* Copyright (c) 2008, Ryan Ingram & Bertram Felgenhauer +* All rights reserved. +* +* Redistribution and use in source and binary forms, with or without +* modification, are permitted provided that the following conditions are met: +* * Redistributions of source code must retain the above copyright +* notice, this list of conditions and the following disclaimer. +* * Redistributions in binary form must reproduce the above copyright +* notice, this list of conditions and the following disclaimer in the +* documentation and/or other materials provided with the distribution. +* * The names of the contributors may not be used to endorse or promote +* products derived from this software without specific prior written +* permission. +* +* THIS SOFTWARE IS PROVIDED BY MR. INGRAM & MR. FELGENHAUER ``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 MR. INGRAM OR MR. FELGENHAUER 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.
+ MonadPrompt.cabal view
@@ -0,0 +1,23 @@+name: MonadPrompt +version: 1.0.0.0 +cabal-version: >= 1.2 +build-type: Simple + +license: BSD3 +license-file: LICENSE +copyright: (c) 2008 Ryan Ingram & Bertram Felgenhauer +author: Ryan Ingram +maintainer: ryani.spam@gmail.com +stability: experimental +synopsis: MonadPrompt, implementation & examples +category: Control.Monad +-- tested-with: ghc-6.8.2 +extra-source-files: PromptExamples.hs +description: "prompting" monad that allows splitting the description + of a computation from the implementation of the effects + used in that computation. + http://www.haskell.org/pipermail/haskell-cafe/2008-January/038301.html + +library + exposed-modules: Control.Monad.Prompt + build-depends: base, mtl
+ PromptExamples.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE GADTs #-}+module PromptExamples where+import Control.Monad.Prompt+import Control.Monad.Cont (MonadCont(..))+import Control.Monad.State (MonadState(..))+import Control.Monad (MonadPlus(..))+import Control.Monad.ST (ST)+import Data.STRef (STRef, newSTRef, readSTRef, writeSTRef)+import Data.IORef (IORef, newIORef, readIORef, writeIORef)++-- Some standard monads implemented with Prompt:++-- State+data SP s a where+ Get :: SP s s+ Put :: s -> SP s ()++type PState s = Prompt (SP s)++instance MonadState s (Prompt (SP s)) where+ get = prompt Get+ put = prompt . Put++runPState :: forall r s. PState s r -> s -> (r, s)+runPState = runPromptC ret prm where+ ret :: r -> s -> (r,s)+ ret a s = (a, s)++ prm :: forall a. SP s a -> (a -> s -> (r,s)) -> s -> (r,s)+ prm Get k st = k st st+ prm (Put st) k __ = k () st++testS :: PState Int Int+testS = do x <- get+ put (x+1)+ y <- get+ return (y*2)++-- StateT using PromptT+type PStateT s = PromptT (SP s)++instance MonadState s (PromptT (SP s) m) where+ get = prompt $ Get+ put = prompt . Put++runPStateT :: forall m r s. Monad m => PStateT s m r -> s -> m (r, s)+runPStateT = runPromptT ret prm lft where+ ret :: r -> s -> m (r,s)+ ret r s = return (r,s)++ prm :: forall a. SP s a -> (a -> s -> m (r,s)) -> s -> m (r,s)+ prm Get k st = k st st+ prm (Put st) k __ = k () st++ lft :: forall a. m a -> (a -> s -> m (r,s)) -> s -> m (r,s)+ lft m k st = m >>= \a -> k a st++-- MonadPlus with observation functions for "Maybe a" and "[a]"+data PP m a where+ PZero :: PP m a+ PPlus :: m a -> m a -> PP m a+type PPlus = RecPrompt PP++instance MonadPlus (RecPrompt PP) where+ mzero = prompt PZero+ mplus x y = prompt $ PPlus x y++runPPlusL :: forall r. PPlus r -> [r]+runPPlusL = runPromptC ret prm . unRecPrompt where+ ret :: r -> [r]+ ret a = [a]++ prm :: forall a. PP PPlus a -> (a -> [r]) -> [r]+ prm PZero _ = []+ prm (PPlus x y) k = concatMap k (runPPlusL x ++ runPPlusL y)++runPPlusM :: forall r. PPlus r -> Maybe r+runPPlusM = runPromptC ret prm . unRecPrompt where+ ret :: r -> Maybe r+ ret = Just+ prm :: forall a. PP PPlus a -> (a -> Maybe r) -> Maybe r+ prm PZero _ = Nothing+ prm (PPlus x y) k = case (runPPlusM x, runPPlusM y) of+ (Just a, _) -> k a+ (_, Just a) -> k a+ _ -> Nothing++testP :: PPlus Int+testP = do x <- mplus (mplus (return 1) (return 2)) (mplus (return 3) (return 4))+ if x `div` 2 == 0 then mzero else return (x+5)++-- References, with observation functions in ST and IO+data PR ref a where+ NewRef :: a -> PR ref (ref a)+ ReadRef :: ref a -> PR ref a+ WriteRef :: ref a -> a -> PR ref ()+type PRef a = forall ref. Prompt (PR ref) a++runPRefST :: forall s r. PRef r -> ST s r+runPRefST m = runPromptM interp m where+ interp :: forall a. PR (STRef s) a -> ST s a+ interp (NewRef a) = newSTRef a+ interp (ReadRef r) = readSTRef r+ interp (WriteRef r a) = writeSTRef r a++runPRefIO :: forall r. PRef r -> IO r+runPRefIO m = runPromptM interp m where+ interp :: forall a. PR IORef a -> IO a+ interp (NewRef a) = newIORef a+ interp (ReadRef r) = readIORef r+ interp (WriteRef r a) = writeIORef r a++-- MonadCont+--+-- Implementation idea taken from the Unimo paper.+-- Is there a simpler way to do this? It seems like there+-- should be, since we are representing the computation as+-- a continuation already.+data PromptCC r m a where+ CallCC :: ((a -> m b) -> m a) -> PromptCC r m a+ Apply :: r -> PromptCC r m a+type CallCC r = RecPrompt (PromptCC r)++instance MonadCont (RecPrompt (PromptCC r)) where+ callCC = prompt . CallCC++runContP :: forall ans r. CallCC ans r -> (r -> ans) -> ans+runContP = runPromptC ret prm . unRecPrompt where+ ret :: r -> (r -> ans) -> ans+ ret r f = f r++ prm :: forall a. PromptCC ans (CallCC ans) a -> (a -> (r -> ans) -> ans)+ -> (r -> ans) -> ans+ prm (Apply r) _ _ = r+ prm (CallCC f) k k2 = runContP (f cont) (\a -> k a k2)+ where cont a = prompt $ Apply (k a k2)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple +main = defaultMain