MonadPrompt-1.0.0.3/0000755000000000000000000000000011564462270012306 5ustar0000000000000000MonadPrompt-1.0.0.3/LICENSE0000644000000000000000000000302011564462270013306 0ustar0000000000000000* 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-1.0.0.3/MonadPrompt.cabal0000644000000000000000000000156611564462270015542 0ustar0000000000000000name: MonadPrompt version: 1.0.0.3 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 -- 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. library exposed-modules: Control.Monad.Prompt build-depends: base<=5, mtl MonadPrompt-1.0.0.3/PromptExamples.hs0000644000000000000000000001064711564462270015632 0ustar0000000000000000{-# 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 runPPlus :: forall r m. (MonadPlus m) => PPlus r -> m r runPPlus = runRecPromptM prm where prm :: forall a. PP PPlus a -> m a prm PZero = mzero prm (PPlus x y) = runPPlus x `mplus` runPPlus y runPPlusL :: forall r. PPlus r -> [r] runPPlusL = runRecPromptC ret prm where ret x = [x] prm :: forall a. PP PPlus a -> (a -> [r]) -> [r] prm PZero k = [] prm (PPlus x y) k = concatMap k (runPPlusL x ++ runPPlusL y) runPPlusM :: forall r. PPlus r -> Maybe r runPPlusM = runRecPromptC ret prm 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) MonadPrompt-1.0.0.3/Setup.hs0000644000000000000000000000006011564462270013736 0ustar0000000000000000import Distribution.Simple main = defaultMain MonadPrompt-1.0.0.3/Control/0000755000000000000000000000000011564462270013726 5ustar0000000000000000MonadPrompt-1.0.0.3/Control/Monad/0000755000000000000000000000000011564462270014764 5ustar0000000000000000MonadPrompt-1.0.0.3/Control/Monad/Prompt.hs0000644000000000000000000002216711564462270016611 0ustar0000000000000000{- | Implementation of monads that allow the computation to 'Control.Monad.Prompt.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. RecPromptT added by Cale Gibbard, contributed under the same license. 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, runRecPromptC, runRecPrompt, runRecPromptM, PromptT, runPromptT, Lift(..), unPromptT, liftP, RecPromptT, unRecPromptT, runRecPromptT ) 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, 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 -} 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 -} 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 {- |'runPrompt' takes a way of converting prompts to an element in a pure fashion and calculates the result of the prompt -} runPrompt :: (forall a. p a -> a) -> Prompt p r -> r runPrompt prm = runPromptC id (\p cont -> cont $ prm p) {- |'runPromptM' is similar to 'runPrompt' but allows the computation to happen in any monad. -} 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 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 {- | Runs a recursive prompt computation. This is similar to 'runPromptC', but for recursive prompt types. -} runRecPromptC :: forall p r b. -- prompt, computation result, answer type (r -> b) -- ^ handler when there is no further computation -> (forall a . p (RecPrompt p) a -> (a -> b) -> b) -- ^ handler for prompts -> RecPrompt p r -- ^ a prompt-based computation -> b -- ^ answer runRecPromptC ret prm = runPromptC ret prm . unRecPrompt {- | Run a recursive prompt computation in a pure fashion, similar to 'runPrompt'. -} runRecPrompt :: (forall a. p (RecPrompt p) a -> a) -> RecPrompt p r -> r runRecPrompt prm = runPrompt prm . unRecPrompt {- | Run a recursive prompt computation in an arbitrary monad, similar to 'runPromptM'. -} runRecPromptM :: Monad m => (forall a . p (RecPrompt p) a -> m a) -> RecPrompt p r -> m r runRecPromptM prm = runPromptM prm . unRecPrompt {- | 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. -} newtype PromptT p m a = PromptT { unPromptT :: Prompt (Lift p m) a } {- | A higher-kinded Either, used in defining 'PromptT'. -} data Lift p m a = Effect (p a) | Lift (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' runs a prompt monad transformer. -} 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 (or more generally, any appropriate MonadPrompt instance). This is the kind of place where the advantage of being able to use multiple observation functions on Prompt really shows. -} liftP :: (MonadPrompt p m) => Prompt p r -> m r liftP = runPromptM prompt {- | A recursive variant of the prompt monad transformer. -} newtype RecPromptT p m a = RecPromptT { unRecPromptT :: Prompt (Lift (p (RecPromptT p m)) m) a } instance Monad (RecPromptT p m) where return = RecPromptT . return m >>= f = RecPromptT $ unRecPromptT m >>= (unRecPromptT . f) instance Functor (RecPromptT p m) where fmap = liftM instance Applicative (RecPromptT p m) where pure = return (<*>) = ap instance MonadPrompt (p (RecPromptT p m)) (RecPromptT p m) where prompt = RecPromptT . prompt . Effect instance MonadTrans (RecPromptT p) where lift = RecPromptT . prompt . Lift {- | Run a recursive prompt monad transformer. -} runRecPromptT :: forall p r b m. (r -> b) -- ^ handler when there is no further computation -> (forall a . p (RecPromptT p m) a -> (a -> b) -> b) -- ^ handler for prompts -> (forall a . m a -> (a -> b) -> b) -- ^ handler for lifted computations -> RecPromptT p m r -- ^ a prompt-based computation -> b -- ^ answer runRecPromptT ret prm lft = runPromptC ret prm' . unRecPromptT where prm' (Effect e) = prm e prm' (Lift a) = lft a