Allow IO functions to be dependency-injected; use ffi for them.
Chris Pressey
5 years ago
| 23 | 23 |
|
| 24 | 24 |
data State = State {
|
| 25 | 25 |
stack :: [Symbol],
|
| 26 | |
queue :: [Symbol]
|
|
26 |
queue :: [Symbol],
|
|
27 |
getCh :: IO Char,
|
|
28 |
putCh :: Char -> IO ()
|
| 27 | 29 |
}
|
| 28 | 30 |
|
| 29 | 31 |
instance Show State where
|
|
| 128 | 130 |
-- I/O.
|
| 129 | 131 |
--
|
| 130 | 132 |
|
| 131 | |
opInput state interpreter = do
|
| 132 | |
symbol <- getChar
|
|
133 |
opInput state@State{ getCh=getCh } interpreter = do
|
|
134 |
symbol <- getCh
|
| 133 | 135 |
do return (push state symbol, interpreter)
|
| 134 | 136 |
|
| 135 | |
opOutput state interpreter =
|
|
137 |
opOutput state@State{ putCh=putCh } interpreter =
|
| 136 | 138 |
let
|
| 137 | 139 |
(symbol, state') = pop state
|
| 138 | 140 |
in do
|
| 139 | |
putChar symbol
|
|
141 |
putCh symbol
|
| 140 | 142 |
return (state', interpreter)
|
| 141 | 143 |
|
| 142 | 144 |
--
|
|
| 293 | 295 |
]
|
| 294 | 296 |
)
|
| 295 | 297 |
|
| 296 | |
initialState = State [] []
|
|
298 |
initialState = State { stack=[], queue=[], getCh=getChar, putCh=putChar }
|
| 297 | 299 |
|
| 298 | 300 |
emmental string = do
|
| 299 | 301 |
(state, interpreter) <- execute string initialState initialInterpreter debugNop
|
| 300 | 302 |
return state
|
|
303 |
|
|
304 |
emmentalWithIO getCh putCh string =
|
|
305 |
let
|
|
306 |
i = initialState
|
|
307 |
i' = i{ getCh=getCh, putCh=putCh }
|
|
308 |
in do
|
|
309 |
(state, interpreter) <- execute string i' initialInterpreter debugNop
|
|
310 |
return state
|
| 301 | 311 |
|
| 302 | 312 |
debug string = do
|
| 303 | 313 |
(state, interpreter) <- execute string initialState initialInterpreter debugPrintState
|
|
0 |
{-# LANGUAGE OverloadedStrings #-}
|
|
1 |
|
| 0 | 2 |
module Main where
|
| 1 | 3 |
|
| 2 | 4 |
import Haste.DOM (withElems, getValue, setProp)
|
| 3 | 5 |
import Haste.Events (onEvent, MouseEvent(Click))
|
|
6 |
import Haste.Foreign (ffi)
|
| 4 | 7 |
|
| 5 | |
import Emmental
|
|
8 |
import Emmental (emmentalWithIO)
|
| 6 | 9 |
|
|
10 |
|
|
11 |
getCh :: IO Char
|
|
12 |
getCh = ffi "(function() {return 'A';})"
|
|
13 |
|
|
14 |
putCh :: Char -> IO ()
|
|
15 |
putCh = ffi "(function(c) {console.log(c);})"
|
| 7 | 16 |
|
| 8 | 17 |
main = withElems ["prog", "result", "run-button"] driver
|
| 9 | 18 |
|
| 10 | 19 |
driver [progElem, resultElem, runButtonElem] =
|
| 11 | 20 |
onEvent runButtonElem Click $ \_ -> do
|
| 12 | 21 |
Just prog <- getValue progElem
|
| 13 | |
r <- emmental prog
|
|
22 |
r <- emmentalWithIO (getCh) (putCh) prog
|
| 14 | 23 |
setProp resultElem "textContent" $ show $ r
|