diff --git a/bin/index.js b/bin/index.js index 980ea3964..edb738d6c 100755 --- a/bin/index.js +++ b/bin/index.js @@ -294,6 +294,11 @@ const io = { this.send({ index, value: answer }); }); }, + replGetInputLineWithInitial: function (index, prompt, left, right) { + rl.question(prompt + left + right, (answer) => { + this.send({ index, value: answer }); + }); + }, procWithCreateProcess: function (index, createProcess) { // FIXME needs review, only trying to implement the minimum for repl functionality const file = tmp.fileSync(); diff --git a/src/Builder/Build.elm b/src/Builder/Build.elm index 67db812de..0fa0e130c 100644 --- a/src/Builder/Build.elm +++ b/src/Builder/Build.elm @@ -10,6 +10,9 @@ module Builder.Build exposing , fromPaths , fromRepl , getRootNames + , ignoreDocs + , keepDocs + , writeDocs ) import Builder.Elm.Details as Details @@ -142,7 +145,7 @@ fromExposed docsDecoder docsEncoder style root details docsGoal ((NE.Nonempty e docsNeed = toDocsNeed docsGoal in - Utils.mapFromKeysA (fork statusEncoder << crawlModule env mvar docsNeed) (e :: es) + Map.fromKeysA compare (fork statusEncoder << crawlModule env mvar docsNeed) (e :: es) |> IO.bind (\roots -> Utils.putMVar statusDictEncoder mvar roots @@ -1142,10 +1145,25 @@ addImportProblems results name problems = -- DOCS -type DocsGoal a - = KeepDocs - | WriteDocs FilePath - | IgnoreDocs +type DocsGoal docs + = KeepDocs (Dict ModuleName.Raw BResult -> docs) + | WriteDocs (Dict ModuleName.Raw BResult -> IO docs) + | IgnoreDocs docs + + +keepDocs : DocsGoal (Dict ModuleName.Raw Docs.Module) +keepDocs = + KeepDocs (Utils.mapMapMaybe compare toDocs) + + +writeDocs : FilePath -> DocsGoal () +writeDocs path = + WriteDocs (E.writeUgly path << Docs.encode << Utils.mapMapMaybe compare toDocs) + + +ignoreDocs : DocsGoal () +ignoreDocs = + IgnoreDocs () type DocsNeed @@ -1155,13 +1173,13 @@ type DocsNeed toDocsNeed : DocsGoal a -> DocsNeed toDocsNeed goal = case goal of - IgnoreDocs -> + IgnoreDocs _ -> DocsNeed False WriteDocs _ -> DocsNeed True - KeepDocs -> + KeepDocs _ -> DocsNeed True @@ -1181,14 +1199,15 @@ makeDocs (DocsNeed isNeeded) modul = finalizeDocs : DocsGoal docs -> Dict ModuleName.Raw BResult -> IO docs finalizeDocs goal results = - -- case goal of - -- KeepDocs -> - -- IO.pure <| Utils.mapMapMaybe toDocs results - -- WriteDocs path -> - -- E.writeUgly path <| Docs.encode <| Utils.mapMapMaybe toDocs results - -- IgnoreDocs -> - -- IO.pure () - Debug.todo "finalizeDocs" + case goal of + KeepDocs f -> + IO.pure <| f results + + WriteDocs f -> + f results + + IgnoreDocs val -> + IO.pure val toDocs : BResult -> Maybe Docs.Module diff --git a/src/Compiler/Data/Map/Utils.elm b/src/Compiler/Data/Map/Utils.elm index d969ce673..14e743d94 100644 --- a/src/Compiler/Data/Map/Utils.elm +++ b/src/Compiler/Data/Map/Utils.elm @@ -1,10 +1,13 @@ module Compiler.Data.Map.Utils exposing ( any , fromKeys + , fromKeysA , fromValues ) +import Data.IO as IO exposing (IO) import Data.Map as Dict exposing (Dict) +import Utils.Main as Utils @@ -16,6 +19,11 @@ fromKeys toValue keys = Dict.fromList compare (List.map (\k -> ( k, toValue k )) keys) +fromKeysA : (k -> k -> Order) -> (k -> IO v) -> List k -> IO (Dict k v) +fromKeysA keyComparison toValue keys = + IO.fmap (Dict.fromList keyComparison) (Utils.listTraverse (\k -> IO.fmap (Tuple.pair k) (toValue k)) keys) + + fromValues : (v -> comparable) -> List v -> Dict comparable v fromValues toKey values = Dict.fromList compare (List.map (\v -> ( toKey v, v )) values) diff --git a/src/Compiler/Elm/Docs.elm b/src/Compiler/Elm/Docs.elm index 5e13fb988..025a92388 100644 --- a/src/Compiler/Elm/Docs.elm +++ b/src/Compiler/Elm/Docs.elm @@ -356,11 +356,8 @@ chompOverview names = |> P.bind (\isDocs -> if isDocs then - let - _ = - Space.chomp E.Space - in - P.bind chompOverview (chompDocs names) + Space.chomp E.Space + |> P.bind (\_ -> P.bind chompOverview (chompDocs names)) else P.pure names diff --git a/src/Compiler/Parse/Space.elm b/src/Compiler/Parse/Space.elm index 60cc48dfc..655375f60 100644 --- a/src/Compiler/Parse/Space.elm +++ b/src/Compiler/Parse/Space.elm @@ -297,7 +297,7 @@ docComment toExpectation toSpaceError = MultiGood -> let off = - pos3 - pos + pos3 len = newPos - pos3 - 2 diff --git a/src/Compiler/Reporting/Error.elm b/src/Compiler/Reporting/Error.elm index 7c6b5a5c9..147135ee7 100644 --- a/src/Compiler/Reporting/Error.elm +++ b/src/Compiler/Reporting/Error.elm @@ -303,7 +303,7 @@ errorEncoder error = BadDocs docsErr -> Encode.object [ ( "type", Encode.string "BadDocs" ) - , ( "errs", Docs.errorEncoder docsErr ) + , ( "docsErr", Docs.errorEncoder docsErr ) ] diff --git a/src/Data/IO.elm b/src/Data/IO.elm index 01a0e7e54..a2fb91bfd 100644 --- a/src/Data/IO.elm +++ b/src/Data/IO.elm @@ -123,6 +123,7 @@ type Effect | TakeMVar Int | PutMVar Int Encode.Value | ReplGetInputLine String + | ReplGetInputLineWithInitial String ( String, String ) | HClose Handle | StateGet | ProcWithCreateProcess CreateProcess diff --git a/src/Terminal/Bump.elm b/src/Terminal/Bump.elm index a2e505f85..1bf5b1bac 100644 --- a/src/Terminal/Bump.elm +++ b/src/Terminal/Bump.elm @@ -182,7 +182,7 @@ generateDocs root (Outline.PkgOutline _ _ _ _ exposed _ _ _) = e :: es -> Task.eio Exit.BumpBadBuild <| - Build.fromExposed Docs.jsonDecoder Docs.jsonEncoder Reporting.silent root details Build.KeepDocs (NE.Nonempty e es) + Build.fromExposed Docs.jsonDecoder Docs.jsonEncoder Reporting.silent root details Build.keepDocs (NE.Nonempty e es) ) diff --git a/src/Terminal/Diff.elm b/src/Terminal/Diff.elm index 82e102b76..31e1fe044 100644 --- a/src/Terminal/Diff.elm +++ b/src/Terminal/Diff.elm @@ -215,7 +215,7 @@ generateDocs (Env maybeRoot _ _ _) = e :: es -> Task.eio Exit.DiffBadBuild <| - Build.fromExposed Docs.jsonDecoder Docs.jsonEncoder Reporting.silent root details Build.KeepDocs (NE.Nonempty e es) + Build.fromExposed Docs.jsonDecoder Docs.jsonEncoder Reporting.silent root details Build.keepDocs (NE.Nonempty e es) ) diff --git a/src/Terminal/Main.elm b/src/Terminal/Main.elm index 1e2b1f0ac..f6921f383 100644 --- a/src/Terminal/Main.elm +++ b/src/Terminal/Main.elm @@ -409,6 +409,16 @@ effectToCmd index portOut effect = ] } + IO.ReplGetInputLineWithInitial prompt ( left, right ) -> + portOut + { index = index + , value = + Encode.object + [ ( "fn", Encode.string "replGetInputLineWithInitial" ) + , ( "args", Encode.list Encode.string [ prompt, left, right ] ) + ] + } + IO.HClose (IO.Handle fd) -> portOut { index = index diff --git a/src/Terminal/Make.elm b/src/Terminal/Make.elm index 0d0a88b54..a2b942ab7 100644 --- a/src/Terminal/Make.elm +++ b/src/Terminal/Make.elm @@ -204,7 +204,7 @@ buildExposed : Reporting.Style -> FilePath -> Details.Details -> Maybe FilePath buildExposed style root details maybeDocs exposed = let docsGoal = - Maybe.maybe Build.IgnoreDocs Build.WriteDocs maybeDocs + Maybe.maybe Build.ignoreDocs Build.writeDocs maybeDocs in Task.eio Exit.MakeCannotBuild <| Build.fromExposed (Decode.succeed ()) (\_ -> Encode.object []) style root details docsGoal exposed diff --git a/src/Terminal/Publish.elm b/src/Terminal/Publish.elm index d0c4f05df..c80aa169b 100644 --- a/src/Terminal/Publish.elm +++ b/src/Terminal/Publish.elm @@ -235,7 +235,7 @@ verifyBuild root = |> Task.bind (\exposed -> Task.eio Exit.PublishBuildProblem <| - Build.fromExposed Docs.jsonDecoder Docs.jsonEncoder Reporting.silent root details Build.KeepDocs exposed + Build.fromExposed Docs.jsonDecoder Docs.jsonEncoder Reporting.silent root details Build.keepDocs exposed ) ) ) @@ -416,7 +416,7 @@ verifyZipBuild root = |> Task.bind (\exposed -> Task.eio Exit.PublishZipBuildProblem - (Build.fromExposed Docs.jsonDecoder Docs.jsonEncoder Reporting.silent root details Build.KeepDocs exposed) + (Build.fromExposed Docs.jsonDecoder Docs.jsonEncoder Reporting.silent root details Build.keepDocs exposed) |> Task.fmap (\_ -> ()) ) ) diff --git a/src/Terminal/Repl.elm b/src/Terminal/Repl.elm index 9e26280ef..14dfe4cac 100644 --- a/src/Terminal/Repl.elm +++ b/src/Terminal/Repl.elm @@ -204,24 +204,25 @@ read = readMore : Lines -> Prefill -> Utils.ReplInputT Input readMore previousLines prefill = - -- Utils.replGetInputLineWithInitial "| " ( renderPrefill prefill, "" ) - -- |> IO.bind - -- (\input -> - -- case input of - -- Nothing -> - -- IO.pure Skip - -- Just chars -> - -- let - -- lines = - -- addLine (stripLegacyBackslash chars) previousLines - -- in - -- case categorize lines of - -- Done doneInput -> - -- IO.pure doneInput - -- Continue p -> - -- readMore lines p - -- ) - Debug.todo "readMore" + Utils.replGetInputLineWithInitial "| " ( renderPrefill prefill, "" ) + |> IO.bind + (\input -> + case input of + Nothing -> + IO.pure Skip + + Just chars -> + let + lines = + addLine (stripLegacyBackslash chars) previousLines + in + case categorize lines of + Done doneInput -> + IO.pure doneInput + + Continue p -> + readMore lines p + ) @@ -269,9 +270,9 @@ type Lines = Lines String (List String) -addLine : List Char -> Lines -> Lines +addLine : String -> Lines -> Lines addLine line (Lines x xs) = - Lines (String.fromList line) (x :: xs) + Lines line (x :: xs) isBlank : Lines -> Bool diff --git a/src/Utils/Main.elm b/src/Utils/Main.elm index 30ebf9a91..0a4508acb 100644 --- a/src/Utils/Main.elm +++ b/src/Utils/Main.elm @@ -89,7 +89,6 @@ module Utils.Main exposing , mVarEncoder , mapFindMin , mapFromKeys - , mapFromKeysA , mapFromListWith , mapInsertWith , mapIntersectionWith @@ -211,11 +210,6 @@ fpAddExtension path extension = path ++ "." ++ extension -mapFromKeysA : (k -> IO v) -> List k -> IO (Dict k v) -mapFromKeysA _ _ = - Debug.todo "mapFromKeysA" - - mapFromListWith : (k -> k -> Order) -> (a -> a -> a) -> List ( k, a ) -> Dict k a mapFromListWith keyComparison f = List.foldl @@ -1224,8 +1218,8 @@ replGetInputLine prompt = replGetInputLineWithInitial : String -> ( String, String ) -> ReplInputT (Maybe String) -replGetInputLineWithInitial = - Debug.todo "replGetInputLineWithInitial" +replGetInputLineWithInitial prompt ( left, right ) = + IO.make (Decode.maybe Decode.string) (IO.ReplGetInputLineWithInitial prompt ( left, right ))