diff --git a/bin/index.js b/bin/index.js index 9dc1cad85..4dc659575 100755 --- a/bin/index.js +++ b/bin/index.js @@ -24,7 +24,6 @@ let nextCounter = 0; const mVars = {}; const lockedFiles = {}; const processes = {}; -let state = null; const download = function (index, method, url) { const req = https.request(url, { method }, (res) => { @@ -349,6 +348,12 @@ app.ports.sendDirWithCurrentDirectory.subscribe(function ({ index, path }) { } }); +app.ports.sendReplGetInputLineWithInitial.subscribe(function ({ index, prompt, left, right }) { + rl.question(prompt + left + right, (value) => { + app.ports.recvReplGetInputLineWithInitial.send({ index, value }); + }); +}); + // MVARS app.ports.sendNewEmptyMVar.subscribe(function (index) { diff --git a/src/Codec/Archive/Zip.elm b/src/Codec/Archive/Zip.elm index 44026563e..3ded51575 100644 --- a/src/Codec/Archive/Zip.elm +++ b/src/Codec/Archive/Zip.elm @@ -1,6 +1,7 @@ module Codec.Archive.Zip exposing ( Archive , Entry + , FilePath , eRelativePath , fromEntry , zEntries diff --git a/src/Control/Monad/State/Strict.elm b/src/Control/Monad/State/Strict.elm index fef2e975a..0bfbd4560 100644 --- a/src/Control/Monad/State/Strict.elm +++ b/src/Control/Monad/State/Strict.elm @@ -4,17 +4,22 @@ module Control.Monad.State.Strict exposing , bind , evalStateT , fmap + , get , gets , liftIO , modify , pure + , put , runStateT ) {-| Lazy state monads, passing an updatable state through a computation. -} -import System.IO as IO exposing (IO) +import Json.Decode as Decode +import Json.Encode as Encode +import System.IO as IO exposing (IO(..)) +import Utils.Crash exposing (crash) {-| newtype StateT s m a @@ -93,3 +98,22 @@ gets f = modify : (s -> s) -> StateT s () modify f = StateT (\s -> IO.pure ( (), f s )) + + +get : Decode.Decoder s -> StateT s s +get decoder = + IO + (\s -> + case Decode.decodeValue decoder s.state of + Ok value -> + ( s, IO.Pure value ) + + Err err -> + crash (Decode.errorToString err) + ) + |> liftIO + + +put : (s -> Encode.Value) -> s -> IO () +put encoder state = + IO (\s -> ( { s | state = encoder state }, IO.Pure () )) diff --git a/src/System/IO.elm b/src/System/IO.elm index 989f7ee62..a2b99038f 100644 --- a/src/System/IO.elm +++ b/src/System/IO.elm @@ -1,7 +1,7 @@ port module System.IO exposing - ( Program, run - , IO(..), ION(..), pure, apply, fmap, bind, foldrM - , Handle(..) + ( Program, Flags, Model, Msg, Next, run + , IO(..), ION(..), RealWorld, pure, apply, fmap, bind, foldrM + , FilePath, Handle(..) , stdout, stderr , withFile, IOMode(..) , hClose @@ -14,17 +14,17 @@ port module System.IO exposing {-| Ref.: -@docs Program, run +@docs Program, Flags, Model, Msg, Next, run # The IO monad -@docs IO, ION, pure, apply, fmap, bind, foldrM +@docs IO, ION, RealWorld, pure, apply, fmap, bind, foldrM # Files and handles -@docs Handle +@docs FilePath, Handle # Standard handles @@ -101,6 +101,7 @@ run app = , homedir = flags.homedir , progName = flags.progName , ioRefs = Array.empty + , state = Encode.null } , next = Dict.empty } @@ -174,6 +175,7 @@ type Next | DirRemoveFileNext (() -> IO ()) | DirRemoveDirectoryRecursiveNext (() -> IO ()) | DirWithCurrentDirectoryNext (() -> IO ()) + | ReplGetInputLineWithInitialNext (Maybe String -> IO ()) | NewEmptyMVarNext (Int -> IO ()) | ReadMVarNext (Encode.Value -> IO ()) | TakeMVarNext (Encode.Value -> IO ()) @@ -329,6 +331,9 @@ update msg model = ( newRealWorld, DirWithCurrentDirectory next path ) -> ( { model | realWorld = newRealWorld, next = Dict.insert compare index (DirWithCurrentDirectoryNext next) model.next }, sendDirWithCurrentDirectory { index = index, path = path } ) + ( newRealWorld, ReplGetInputLineWithInitial next prompt left right ) -> + ( { model | realWorld = newRealWorld, next = Dict.insert compare index (ReplGetInputLineWithInitialNext next) model.next }, sendReplGetInputLineWithInitial { index = index, prompt = prompt, left = left, right = right } ) + ( newRealWorld, NewEmptyMVar next ) -> ( { model | realWorld = newRealWorld, next = Dict.insert compare index (NewEmptyMVarNext next) model.next }, sendNewEmptyMVar index ) @@ -726,6 +731,12 @@ port sendDirWithCurrentDirectory : { index : Int, path : FilePath } -> Cmd msg port recvDirWithCurrentDirectory : (Int -> msg) -> Sub msg +port sendReplGetInputLineWithInitial : { index : Int, prompt : String, left : String, right : String } -> Cmd msg + + +port recvReplGetInputLineWithInitial : (Maybe String -> msg) -> Sub msg + + -- MVARS @@ -794,6 +805,7 @@ type ION a | DirRemoveFile (() -> IO a) FilePath | DirRemoveDirectoryRecursive (() -> IO a) FilePath | DirWithCurrentDirectory (() -> IO a) FilePath + | ReplGetInputLineWithInitial (Maybe String -> IO a) String String String type alias RealWorld = @@ -803,6 +815,7 @@ type alias RealWorld = , homedir : FilePath , progName : String , ioRefs : Array Encode.Value + , state : Encode.Value } @@ -916,6 +929,9 @@ bind f (IO ma) = ( s1, DirWithCurrentDirectory next path ) -> ( s1, DirWithCurrentDirectory (\() -> bind f (next ())) path ) + ( s1, ReplGetInputLineWithInitial next prompt left right ) -> + ( s1, ReplGetInputLineWithInitial (\value -> bind f (next value)) prompt left right ) + ( s1, NewEmptyMVar next ) -> ( s1, NewEmptyMVar (\value -> bind f (next value)) ) diff --git a/src/Terminal/Repl.elm b/src/Terminal/Repl.elm index bb5182541..5269bc1d6 100644 --- a/src/Terminal/Repl.elm +++ b/src/Terminal/Repl.elm @@ -157,7 +157,7 @@ loop env state = (\outcome -> case outcome of Loop loopState -> - Utils.liftInputT (Utils.statePut stateEncoder loopState) + Utils.liftInputT (State.put stateEncoder loopState) |> IO.bind (\_ -> loop env loopState) End exitCode -> @@ -849,7 +849,7 @@ initSettings = lookupCompletions : String -> M (List Utils.ReplCompletion) lookupCompletions string = - Utils.stateGet stateDecoder + State.get stateDecoder |> State.fmap (\(State imports types decls) -> addMatches string False decls <| diff --git a/src/Utils/Main.elm b/src/Utils/Main.elm index 1c8804584..b873499b8 100644 --- a/src/Utils/Main.elm +++ b/src/Utils/Main.elm @@ -128,8 +128,6 @@ module Utils.Main exposing , shaAndArchiveDecoder , someExceptionDecoder , someExceptionEncoder - , stateGet - , statePut , takeMVar , tupleTraverse , tupleTraverseStateT @@ -1198,8 +1196,7 @@ writeChan encoder (Chan _ writeVar) val = builderHPutBuilder : IO.Handle -> String -> IO () builderHPutBuilder handle str = - -- IO.make (Decode.succeed ()) (IO.HPutStr handle str) - Debug.todo "builderHPutBuilder" + IO (\s -> ( s, IO.HPutStr IO.pure handle str )) @@ -1267,29 +1264,7 @@ replGetInputLine prompt = replGetInputLineWithInitial : String -> ( String, String ) -> ReplInputT (Maybe String) replGetInputLineWithInitial prompt ( left, right ) = - -- IO.make (Decode.maybe Decode.string) (IO.ReplGetInputLineWithInitial prompt ( left, right )) - Debug.todo "replGetInputLineWithInitial" - - - --- Control.Monad.State.Class - - -stateGet : Decode.Decoder s -> State.StateT s s -stateGet decoder = - let - io : IO s - io = - -- IO.make decoder IO.StateGet - Debug.todo "stateGet" - in - State.StateT (\_ -> IO.fmap (\s -> ( s, s )) io) - - -statePut : (s -> Encode.Value) -> s -> IO () -statePut encoder s = - -- IO.make (Decode.succeed ()) (IO.StatePut (encoder s)) - Debug.todo "statePut" + IO (\s -> ( s, IO.ReplGetInputLineWithInitial IO.pure prompt left right ))