WIP System.IO

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) {

src/Codec/Archive/Zip.elm

@@ -1,6 +1,7 @@
 module Codec.Archive.Zip exposing
     ( Archive
     , Entry
+    , FilePath
     , eRelativePath
     , fromEntry
     , zEntries

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 () ))

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.: <https://hackage.haskell.org/package/base-4.20.0.1/docs/System-IO.html>
 
-@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)) )
 

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 <|

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 ))