A: 

Require your instances of FS to be instance of MonadIO, not just Monad:

class MonadIO m => FS m where ...

Then you will have available the liftIO method to lift FS into IO:

liftIO :: MonadIO m => m a -> IO a

so you can write in the IO monad:

files <- liftIO $ children currentDir

etc. Of course, that means you will need to implement liftIO for each FS before you even write the FS instance, but for this application (without having seen the actual details) it sounds like that should be simple.

Yitz
`liftIO` is `IO a -> m a`.
sdcvvc
Given that `m` is a state monad, which means that a value of type `m a` is essentially `Filesystem -> (a, Filesystem)`, I don't see how I can possibly convert such a function to an IO action. Unless possibly you are suggesting that I put the state in an `IORef`? But then how would I know when to update the `IORef`?
Norman Ramsey
+3  A: 

What about using monad transformers? They are more or less standard way to combine monads. Here an simplistic example:

type Foo a = StateT String IO a

replT :: Foo ()
replT = do
  str   <- liftIO getLine
  state <- get
  liftIO $ putStrLn ("current state: " ++ state)
  liftIO $ putStrLn ("setting state: " ++ str)
  put str
  replT

Below are results of running replT from within ghci.

*Main> runStateT replT "Initial state"
asd
current state: Initial state
setting state: asd
zxc
current state: asd
setting state: zxc
asdasd

There are three monad transformers libs. mtl, transformers and monadLib. I cannot recommend any of them since I don't use them much.

Shimuuar
This looks promising. It's the end of the work day here, but we'll pursue it tomorrow.
Norman Ramsey
@Norman Ramsey: this is the route I settled on for what I thought of as the REPL (it didn't take user input,but did read, evaluate and print) in a Befunge interpreter I wrote. I think the code is clear and it might provide a model for at least *a way* of doing what you need. Blogged about it here: http://coder.bsimmons.name/blog/2010/01/a-befunge-93-interpreter/ ... and code is up on hackage here: http://hackage.haskell.org/package/Befunge93
jberryman
also, fwiw I used the `mtl` package and saw a performance hit when I tried to move to `transformers`. I may have been doing something wrong though.
jberryman
@jberryman you're most definitely not using it wrong, it's well known that mtl has overhead because it's bind function is not inlined, somebody needs to modify the source and sprinkle some inline pragmas however recently I read that everyone should move to the transformers library, the haskell platform will drop mtl for transformers it in the future.I've switched to transformers and my original code that was based off mtl compiled without any changes.I also recommend using a fclabels (or similar) package in-conjunction with your state monads.
snk_kid
@snk_kid My experience was that in my case `mtl` was *faster* then `transformers`. Thanks for the pointer about `fclabels`. The last time I used the State monad I decided I would have to use something like that in the future to stay sane.
jberryman
+2  A: 

I can think of two solutions here:

1) Use a monad transformer library. I can't improve on Shimuuar's reply, except in some details on the libraries. Transformers by itself doesn't provide the necessary instances; you would need to use transformers and either monads-tf or monads-fd, which offer implementations based on type families and fundeps, respectively. I prefer monads-tf if you go this route. The api is almost identical to that of mtl. I don't have experience with MonadLib, but it looks quite good also.

2) Write your main loop in IO, and for each loop iteration call runState to evaluate the state monad. Something like the following:

loop path state = do
  op <- readOp
  let ((newpath, resp), newstate) = runState (step path op) state
  print resp
  loop newpath newstate

This should work, but it's far less idiomatic than using monad transformers.

John
Funny that is almost the exact same answer I was going to post last night :DJust to add to this, nothing stops you from escaping/(re-)entering a state monad any number of times.
snk_kid
+4  A: 

Disclaimer: I can't promise the following is a good way to go about it, but working through it sounds fun. Let's take it for a spin, shall we?.


A few obligatory imports

First, let's toss some data types out there. I'm going to fill in some details and tweak things a bit, in order to define a simple "file system" that we can actually interact with.

type Path = String
type Response = Maybe String
type Contents = [String]

data Operation = Cd Path 
               | Ls 
               | MkDir Path
               | Quit
    deriving (Read, Show)

Next, we'll do something a bit edgy... strip out all the monads. What? This is madness! Perhaps, but sometimes all the hidden plumbing that >>= provides hides things just a bit too much.

For the file system itself, we'll just store the current working directory and a map from paths to their children. We'll also need a handful of functions to interact with it.

data Filesystem = Filesystem { wd :: Path, files :: M.Map Path Contents }
    deriving Show

newFS = Filesystem "/" (M.singleton "/" [])

isDirectory p fs = M.member p $ files fs
children p fs = fromMaybe [] . M.lookup p $ files fs
cd p fs = fs { wd = p }
create p fs = let newPath = wd fs ++ p ++ "/"
                  addPath = M.insert newPath [] . M.adjust (p:) (wd fs)
              in (newPath, fs { files = addPath $ files fs })

Now for a monad-less version of the step function. It needs to take an Operation and a Filesystem, and return a Response and a (possibly modified) Filesystem:

step :: Operation -> Filesystem -> (Response, Filesystem)
step (Cd d) fs = (Just "Ok\n", cd d fs)
step (MkDir d) fs = first (\d -> Just $ "Created " ++ d ++ "\n") $ create d fs
step Ls fs = let files = children (wd fs) fs
             in (Just $ unlines files, fs)
step Quit fs = (Nothing, fs)

...hmm, that type signature already looks a lot like the guts of a State monad. Oh well, just ignore it for now, and charge blindly onward.

Now, what we want is a function that will provide a general-purpose interface to a Filesystem interpreter. Particularly, we want the interface to be at least somewhat self-contained so that whatever uses the interface doesn't have to step through manually, yet we want the interface to be sufficiently oblivious to the code using it that we can wire it up to the IO monad, some other Monad, or even no monad at all.

What this tells us primarily is that we'll need to interleave the external code with the interpreter in some fashion, rather than having either part be in control. Now, Haskell is a functional language, so that means that using lots of higher-order functions is good, right? Sounds plausible to me, so here's the strategy we'll use: If a function doesn't know what to do next, we'll hand it another function that we assume does. Repeat until everybody knows what's going on. A flawless plan, no?

The heart of it all is the step function, so we'll start by just calling that.

interp1 :: Operation -> Filesystem -> (Response, Filesystem)
interp1 op fs = step op fs

...well, it's a start. I guess. But wait, where is the Operation coming from? We need the external code to provide that, but we can't just ask for it without getting all mixed up with unsavory characters like IO. So we get another function to do the dirty work for us:

interp2 :: ((Operation -> (Response, Filesystem)) -> t) -> Filesystem -> t
interp2 inp fs = inp (\op -> step op fs)

Of course, now all we have is some stupid t that we don't even know what it is. We know it has to have a Response and a Filesystem in it somewhere, but we can't do anything with it, so we'll hand it back to another function, along with some instructions on how to proceed... which will of course involve passing in yet more functions. It's functions all the way down, you know.

interp3 :: ((Operation -> (Response, Filesystem)) -> a)
           -> (a -> ((Response, Filesystem) -> b) -> c)
           -> (Filesystem -> b)
           -> (String -> Filesystem -> b) 
           -> Filesystem 
           -> c
interp3 inp check done out fs = check (inp (\op -> step op fs)) test
    where test (Nothing, fs) = done fs
          test (Just s, fs)  = out s fs

...well that's pretty ugly. But don't worry, all is going according to plan. We can make a couple observations next:

  • The type a only exists between inp and check, so in hindsight, we might as well combine them ahead of time and just pass the composed function to the interpreter.
  • When we call done, it ought to mean exactly what it says on the tin. So the return type for done should be the same as the whole interpreter, meaning b and c ought to be the same type.

Now, if done ends the whole thing, what's out? As the name none-too-subtly implies, it's providing output to the external code, but where does it go after that? It needs to loop back into the interpreter somehow, and we might note that our interpreter is not yet recursive. The way forward is clear--the interpreter, like Jormungand, thus seizes its own tail; looping back around indefinitely till the interpretation finishes (or until Ragnarök, whichever comes first).

interp4 :: ((Operation -> (Response, Filesystem)) 
               -> ((Response, Filesystem) -> r) -> r)
           -> (Filesystem -> r)
           -> (String -> Filesystem -> (Filesystem -> r) -> r)
           -> Filesystem
           -> r
interp4 checkInp done out fs = checkInp (\op -> step op fs) test
    where loop = interp4 checkInp done out
          test (Nothing, fs) = done fs
          test (Just s, fs)  = out s fs loop

...oh, did I mention that it works now? No, seriously!

Here's some IO code to use the interface:

ioIn f k = putStr "> " >> (k . f =<< readLn)
ioDone fs = putStrLn "Done" >> return fs 
ioOut x fs k = putStr x >> k fs

ioInterp :: IO Filesystem
ioInterp = interp4 ioIn ioDone ioOut newFS

And here's code that runs a list of commands, producing a list of output strings:

scriptIn f k (x:xs) = k (f x) xs
scriptDone fs xs = ["Done\n"]
scriptOut r fs k xs = r : k fs xs

scriptInterp :: [Operation] -> [String]
scriptInterp = interp4 scriptIn scriptDone scriptOut newFS

Examples of running both in GHCi here, if just the code doesn't tickle your imagination sufficiently.


Well, that's that. Or is it? Frankly, that interpreter is code only a mother could love. Is there something that would tie it all together elegantly? Something to reveal the underlying structure of the code?

...okay, so it's pretty obvious where this leads. The overall design of functions tail-calling each other in circles looks an awful lot like continuation-passing style, and not once but twice in the interpreter's type signature can be found the characteristic pattern (foo -> r) -> r, better known as the continuation monad.

Unfortunately, even after all that, continuations make my head hurt and I'm not sure how best to disentangle the very ad-hoc structure of the interpreter into a computation running in a MonadCont.

camccann