diff --git a/IO/Runner.elm b/IO/Runner.elm index a8f2c2a..2f7e15b 100644 --- a/IO/Runner.elm +++ b/IO/Runner.elm @@ -8,25 +8,39 @@ import Trampoline import IO.IO as IO import IO.IO (IO) -data Request = Put String - | Exit Int - | Get - | WriteFile { file : String, content : String} +-- Internal Request representation +data IRequest = Put String + | Exit Int + | Get + | WriteFile { file : String, content : String} +type IResponse = Maybe String -type Response = Maybe String + +-- User-facing Request representation +type Request = JSON.Value +type Response = JSON.Value type IOState = { buffer : String } start : IOState start = { buffer = "" } -run : Signal Response -> IO () -> Signal JSON.Value +run : Signal Response -> IO () -> Signal Request run resps io = let init = (\_ -> io, start, []) - f resp (io, st, _) = step resp io st + f resp (io, st, _) = step (deserialize resp) io st third (_, _, z) = z in serialize . third <~ foldp f init resps -serialize : [Request] -> JSON.Value +deserialize : Response -> IResponse +deserialize resp = + case resp of + JSON.Object d -> + case Dict.get "Just" d of + Just (JSON.String s) -> Just s + _ -> Nothing + _ -> Nothing + +serialize : [IRequest] -> JSON.Value serialize = let mkObj = JSON.Object . Dict.fromList serReq req = @@ -44,20 +58,20 @@ serialize = ] in JSON.Array . map serReq -putS : String -> Request +putS : String -> IRequest putS = Put -exit : Int -> Request +exit : Int -> IRequest exit = Exit -getS : Request +getS : IRequest getS = Get -writeF : { file : String, content : String } -> Request +writeF : { file : String, content : String } -> IRequest writeF = WriteFile -- | Extract all of the requests that can be run now -extractRequests : IO a -> State IOState ([Request], () -> IO a) +extractRequests : IO a -> State IOState ([IRequest], () -> IO a) extractRequests io = case io of IO.Pure x -> pure ([exit 0], \_ -> IO.Pure x) @@ -73,7 +87,7 @@ extractRequests io = put ({ buffer = rest }) >>= \_ -> extractRequests (k c) -flattenReqs : [Request] -> [Request] +flattenReqs : [IRequest] -> [IRequest] flattenReqs rs = let loop rs acc n = if n >= 100 @@ -90,7 +104,7 @@ flattenReqs rs = in Trampoline.trampoline <| loop rs [] 0 -- | We send a batch job of requests, all requests until IO blocks -step : Response -> (() -> IO a) -> IOState -> (() -> IO a, IOState, [Request]) +step : IResponse -> (() -> IO a) -> IOState -> (() -> IO a, IOState, [IRequest]) step resp io st = let newST = case resp of Nothing -> st diff --git a/share/handler.js b/share/handler.js index efa4636..fdc68dd 100644 --- a/share/handler.js +++ b/share/handler.js @@ -6,6 +6,9 @@ var worker = Elm.worker(Elm.Main , {responses: null } ); + var just = function(v) { + return { 'Just': v}; + } var handle = function(request) { // Debugging: // console.log("Bleh: %j", request); @@ -29,7 +32,7 @@ handle(reqs[i]); } if (reqs.length > 0 && reqs[reqs.length - 1].ctor !== 'Get') { - worker.ports.responses.send(""); + worker.ports.responses.send(just("")); } } worker.ports.requests.subscribe(handler); @@ -38,7 +41,7 @@ stdin.on('data', function(chunk) { //console.log('Got' + chunk); stdin.pause(); - worker.ports.responses.send(chunk.toString()); + worker.ports.responses.send(just(chunk.toString())); }) // Start msg diff --git a/test/BigString.elm b/test/BigString.elm index 50bd668..cf316dd 100644 --- a/test/BigString.elm +++ b/test/BigString.elm @@ -9,7 +9,7 @@ import String hugeString () = String.concat <| repeat 100000000000 "blah " -port requests : Signal Json.Value +port requests : Signal Request port requests = Run.run responses (putStrLn "hah" >>= \_ -> putStrLn (hugeString ())) -port responses : Signal (Maybe String) +port responses : Signal Response diff --git a/test/Test.elm b/test/Test.elm index c751801..f61b0ea 100644 --- a/test/Test.elm +++ b/test/Test.elm @@ -5,6 +5,7 @@ import IO.Runner (Request, Response) import IO.Runner as Run import Json +import Maybe import String echo : IO () @@ -25,7 +26,7 @@ hello = putStrLn "Hello, Console!" >> exit 0 -- | Can't use a type alias in ports, yet :/ -port requests : Signal Json.Value +port requests : Signal Request port requests = Run.run responses hello -port responses : Signal (Maybe String) +port responses : Signal Response