To see how this works we're going to start by defining a monad that makes the building part simpler.
data ConversationMonad a = Ask a | Return a | Combination (ConversationMonad a) [(a -> ConversationMonad a)]
We want this monad to represent a computation that can Ask the outside world a question, and receive an answer of the same type back. The Ask constructor represents the action of asking a question, the other two constructors set up the monad structure.
What we are defining is not quite a monad, so we have to define our own interface.
class NotQuiteMonad m where
bind :: m a -> (a -> m a) -> m a
ret :: a -> m a
An m monad must have a way to build a return monad given a value, and a way to build a bigger m monad by adding a computation step to a monad. What I'm calling a computation step is a one argument function that returns a monad. The return monad is used as plumbing, it feeds a value to the next computation step and should not do anything else.
Let's provide these operations for our ConversationMonad.
instance NotQuiteMonad ConversationMonad where
bind monad computeStep = case monad of
Combination innerMonad list -> Combination innerMonad (list ++ [computeStep])
a@_ -> Combination a [computeStep]
ret k = Return k
This definition makes the Combination constructor a representation of binding and Return a representation of Return.
If you go back and read the definition of ConversationMonad, you can see that any ConversationMonad must be either an action asking a question, plumbing that passes on a value, or a combination of a ConversationMonad and a computation step.
A way to see this is that there is one basic action, Ask, a way to sequence these actions, Combination, and some plumbing for the sequencing Return.
You should also be able to see that the only thing we can do with the ConversationMonad is build different instances of it. For this monad the building is very simple. None of the computation step functions are evaluated, they are just put in a list.
Now we want to interact with the monad, so let's hook it up to the console by writing some code to run it:
runMonadString :: ConversationMonad String -> IO String
runMonadString m =
do
case m of
Ask saidString ->
do
putStrLn saidString
answer <- getLine
return answer
Return returnString ->
do
return returnString
Combination monad [] ->
runMonadString monad
Combination monad (computeStep:rest) ->
do
intermediateValue <- runMonadString monad
computeStepIntermediateValue <- runMonadString (computeStep intermediateValue)
runMonadString (Combination (Return computeStepIntermediateValue) rest
To run the Ask action, output the question and ask the user for a response. To run the return action, just return the value to pass it into the next step.
To run a ConversationMonad that was built from a bind, we have to run the 2 parts, the monad, and the list of compute steps.
- We run the monad, which will return a value that we store.
- We then apply the computation step to that value to get another ConversationMonad.
- We run the monad we got back to get another value which we use to process the rest of the list of computation steps.
Step 2 is where it is important that our computation step returns a ConversationMonad rather than another String. This is because the computation step can return a ConversationMonad built from a bind, which means it can return another computation step. This gives computation steps the power to implement looping.
By using closures you can pass values to later computation steps without going through the monad.
To see this, and test out our console hookup, let's build a ConversationMonad:
echoMonad :: ConversationMonad String
echoStep :: String -> ConversationMonad String
echoStep = (\response ->
if response == "Quit"
then Return "Quit!"
else
bind (Ask response) echoStep)
echoMonad = bind (Ask "How are you?") echoStep
echoStep is a looping computation step. It just asks whatever it got back as an answer the last time. echoStep by itself is not a ConversationMonad, so we need to bind it to one to make it one.
Everything is hooked up, let's run it:
main =
do
runMonadString echoMonad
ghc monadTutorial.hs
./a.out
How are you?
hi
hi
asdf
asdf
asdfe
asdfe
re
re
adf
adf
Quit
The implementation of the side effects of Ask is completely contained in the run function, which isn't tied to the type at all. So we can a different run function that does something else.
Let's write a run function that gets responses from a list of Strings, so instead of running it with side effects, we now run it purely functionally.
To run ConversationMonads functionally, we're going to need to store the state in some structure and update it functionally. This will work like the seed in a left fold.
data LoggingRunState = RunState {
runLog :: [String],
listOfResponses ::[String],
intermediateValue :: String,
validState :: Bool
} deriving (Show)
The state is going to be a log of what has happened in the run, a list of responses to use, the value to pass in to the next computation step and a flag indicating if the computation has failed or not.
initialRunState responseList = RunState {
runLog = [],
listOfResponses = responseList,
intermediateValue = "",
validState=True
}
Now we define the run function, it takes an state and processes the actions in the monad on that state, yielding a new state.
runMonadFunctional :: LoggingRunState -> ConversationMonad String -> LoggingRunState
{- Use the list of responses to pass answers into the monad and log these actions -}
runMonadFunctional runState (Ask saidString) =
case listOfResponses runState of
[] ->
RunState {
runLog = runLog runState,
intermediateValue="Out of messages!",
listOfResponses=[],
validState=False
}
cannedResponse:rest ->
RunState {runLog = (runLog runState) ++ ["Monad asked:" ++ saidString, "Reply " ++ cannedResponse],
intermediateValue =cannedResponse,
listOfResponses=rest,
validState=True
}
runMonadFunctional runState (Return returnString) =
runState {intermediateValue = returnString}
runMonadFunctional runState (Combination monad computeStepList) =
let intermediateState = runMonadFunctional runState monad
in runMonadFunctionalComputeSteps intermediateState computeStepList
runMonadFunctionalComputeSteps :: LoggingRunState -> [String -> ConversationMonad String] -> LoggingRunState
{- If we are out of steps to run return the currrent state -}
runMonadFunctionalComputeSteps runState [] = runState
{- Once we hit an error state, stop running the monad and just return the state -}
runMonadFunctionalComputeSteps runState (computeStep:restOfComputeSteps) =
case validState runState of
False -> runState
True ->
let monad = computeStep (intermediateValue runState)
computeStepRunState = runMonadFunctional runState monad
in
{- Run rest of compute steps and return the value -}
runMonadFunctionalComputeSteps computeStepRunState restOfComputeSteps
Let's run it:
main =
do
runMonadString echoMonad
putStrLn (show (runMonadFunctional (initialRunState ["first", "second", "third", "Quit"]) echoMonad ))
putStrLn (show (runMonadFunctional (initialRunState ["first", "second", "third" ]) echoMonad ))
./a.out
How are you?
Fine thanks and you?
Fine thanks and you?
I'm well
I'm well
That's good
That's good
Quit
RunState {runLog = ["Monad asked:How are you?","Reply first","Monad asked:first","Reply second","Monad asked:second","Reply third","Monad asked:third","Reply Quit"], listOfResponses = [], intermediateValue = "Quit!", validState = True}
RunState {runLog = ["Monad asked:How are you?","Reply first","Monad asked:first","Reply second","Monad asked:second","Reply third"], listOfResponses = [], intermediateValue = "Out of messages!", validState = False}
No comments:
Post a Comment