Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Using a Monadic eDSL from the REPL

Say I have created myself an embedded domain specific language in Haskell using a monad. For example a simple language that lets you push and pop values on a stack, implemented using the state monad:

type DSL a = State [Int] a

push :: Int -> DSL ()
pop :: DSL Int

Now I can write small stack manipulation programs using do notation:

program = do
    push 10
    push 20
    a <- pop
    push (5*a)
    return a

However, I would really like to use my DSL interactively from a REPL (GHCi in particular, willing to use other if it would help).

Unfortunately having a session like:

>push 10
>pop
10
>push 100

Does not immediately work, which is probably rather reasonable. However I really think being able to do something with a similar feel to that would be cool. The way the state monad work does not lend itself easily to this. You need to build up your DSL a type and then evaluate it.

Is there a way to do something like this. Incrementally using a monad in the REPL?

I have been looking at things like operational, MonadPrompt, and MonadCont which I sort of get the feeling maybe could be used to do something like this. Unfortunately none of the examples I have seen addresses this particular problem.

like image 796
Andreas Vinter-Hviid Avatar asked May 04 '17 18:05

Andreas Vinter-Hviid


2 Answers

Another possibility is to re-simulate the whole history each time you do anything. This will work for any pure monad. Here's an extemporaneous library for it:

{-# LANGUAGE RankNTypes #-}

import Data.IORef
import Data.Proxy

newtype REPL m f = REPL { run :: forall a. m a -> IO (f a) }

newREPL :: (Monad m) => Proxy m -> (forall a. m a -> f a) -> IO (REPL m f)
newREPL _ runM = do
    accum <- newIORef (return ())
    return $ REPL (\nextAction -> do
        actions <- readIORef accum
        writeIORef accum (actions >> nextAction >> return ())
        return (runM (actions >> nextAction)))

Basically, it stores all the actions run thus far in an IORef, and each time you do something it adds to the list of actions and runs it from the top.

To create a repl, use newREPL, passing it a Proxy for the monad and a "run" function that gets you out of the monad. The reason the run function has type m a -> f a instead of m a -> a is so that you can include extra information in the output -- for example, you might want to view the current state, too, in which case you could use an f like:

data StateOutput a = StateOutput a [Int]
    deriving (Show)

But I have just used it with Identity which does nothing special.

The Proxy argument is so that ghci's defaulting doesn't bite us when we create a new repl instance.

Here's how you use it:

>>> repl <- newREPL (Proxy :: Proxy DSL) (\m -> Identity (evalState m []))
>>> run repl $ push 1
Identity ()
>>> run repl $ push 2
Identity ()
>>> run repl $ pop
Identity 2
>>> run repl $ pop
Identity 1

If the extra Identity line noise bothers you, you could use your own functor:

newtype LineOutput a = LineOutput a
instance (Show a) => Show (LineOutput a) where
    show (LineOutput x) = show x

There was one small change I had to make -- I had to change

type DSL a = State [Int] a

to

type DSL = State [Int]

because you can't use type synonyms that are not fully applied, like when I said Proxy :: DSL. The latter, I think, is more idiomatic anyway.

like image 195
luqui Avatar answered Nov 14 '22 18:11

luqui


To an extent.

I don't believe it can be done for arbitrary Monads/instruction sets, but here's something that would work for your example. I'm using operational with an IORef to back the REPL state.

data DSLInstruction a where
    Push :: Int -> DSLInstruction ()
    Pop :: DSLInstruction Int

type DSL a = Program DSLInstruction a

push :: Int -> DSL ()
push n = singleton (Push n)

pop :: DSL Int
pop = singleton Pop

-- runDslState :: DSL a -> State [Int] a
-- runDslState = ...

runDslIO :: IORef [Int] -> DSL a -> IO a
runDslIO ref m = case view m of
    Return a -> return a
    Push n :>>= k -> do
        modifyIORef ref (n :)
        runDslIO ref (k ())
    Pop :>>= k -> do
        n <- atomicModifyIORef ref (\(n : ns) -> (ns, n))
        runDslIO ref (k n)

replSession :: [Int] -> IO (Int -> IO (), IO Int)
replSession initial = do
    ref <- newIORef initial
    let pushIO n = runDslIO ref (push n)
        popIO = runDslIO ref pop
    (pushIO, popIO)

Then you can use it like:

> (push, pop) <- replSession [] -- this shadows the DSL push/pop definitions
> push 10
> pop
10
> push 100

It should be straightforward to use this technique for State/Reader/Writer/IO-based DSLs. I don't expect it to work for everything though.

like image 38
Steve Trout Avatar answered Nov 14 '22 19:11

Steve Trout