diff --git a/bin/index.js b/bin/index.js index 77a833577..de898e899 100755 --- a/bin/index.js +++ b/bin/index.js @@ -12,6 +12,7 @@ const AdmZip = require("adm-zip"); const which = require("which"); const tmp = require("tmp"); const { Elm } = require("./guida.js"); +const FormData = require("form-data"); const rl = readline.createInterface({ input: process.stdin, @@ -129,6 +130,24 @@ const io = { this.send({ index, value: null }); }); }, + dirRemoveFile: function (index, path) { + fs.unlink(path, (err) => { + if (err) { + console.error(err); + } else { + this.send({ index, value: null }); + } + }); + }, + dirRemoveDirectoryRecursive: function (index, path) { + fs.rm(path, { recursive: true, force: true }, (err) => { + if (err) { + console.error(err); + } else { + this.send({ index, value: null }); + } + }); + }, writeIORef: function (index, id, value) { ioRefs[id].value = value; @@ -182,6 +201,48 @@ const io = { req.end(); }, + httpUpload: function (index, urlStr, headers, parts) { + const url = new URL(urlStr); + const client = url.protocol == "https:" ? https : http; + + const form = new FormData(); + + parts.forEach((part) => { + switch (part.type) { + case "FilePart": + form.append(part.name, fs.createReadStream(part.filePath)); + break; + + case "JsonPart": + form.append(part.name, JSON.stringify(part.value), { + contentType: "application/json", + filepath: part.filePath, + }); + break; + + case "StringPart": + form.append(part.name, part.string); + break; + } + }); + + const req = client.request(url, { + method: "POST", + headers: { ...headers, ...form.getHeaders() }, + }); + + form.pipe(req); + + req.on("response", (res) => { + res.on("end", () => { + this.send({ index, value: null }); + }); + }); + + req.on("error", (err) => { + console.error(err); + }); + }, write: function (index, path, value) { this.send({ index, @@ -227,6 +288,14 @@ const io = { dirCanonicalizePath: function (index, path) { this.send({ index, value: resolve(path) }); }, + dirWithCurrentDirectory: function (index, path) { + try { + process.chdir(path); + this.send({ index, value: null }); + } catch (err) { + console.error(`chdir: ${err}`); + } + }, getArchive: function (index, method, url) { download.apply(this, [index, method, url]); }, diff --git a/package-lock.json b/package-lock.json index 44fc023e2..e29d80ed1 100644 --- a/package-lock.json +++ b/package-lock.json @@ -10,6 +10,7 @@ "license": "BSD-3-Clause", "dependencies": { "adm-zip": "^0.5.15", + "form-data": "^4.0.1", "tmp": "^0.2.3", "which": "^4.0.0" }, @@ -1590,6 +1591,12 @@ "url": "https://github.com/sponsors/ljharb" } }, + "node_modules/asynckit": { + "version": "0.4.0", + "resolved": "https://registry.npmjs.org/asynckit/-/asynckit-0.4.0.tgz", + "integrity": "sha512-Oei9OH4tRh0YqU3GxhX79dM/mwVgvbZJaSNaRk+bshkj0S5cfHcgYakreBjrHwatXKbz+IoIdYLxrKim2MjW0Q==", + "license": "MIT" + }, "node_modules/at-least-node": { "version": "1.0.0", "resolved": "https://registry.npmjs.org/at-least-node/-/at-least-node-1.0.0.tgz", @@ -2156,6 +2163,18 @@ "dev": true, "license": "MIT" }, + "node_modules/combined-stream": { + "version": "1.0.8", + "resolved": "https://registry.npmjs.org/combined-stream/-/combined-stream-1.0.8.tgz", + "integrity": "sha512-FQN4MRfuJeHf7cBbBMJFXhKSDq+2kAArBlmRBvcvFE5BB1HZKXtSFASDhdlz9zOYwxh8lDdnvmMOe/+5cdoEdg==", + "license": "MIT", + "dependencies": { + "delayed-stream": "~1.0.0" + }, + "engines": { + "node": ">= 0.8" + } + }, "node_modules/concat-map": { "version": "0.0.1", "resolved": "https://registry.npmjs.org/concat-map/-/concat-map-0.0.1.tgz", @@ -2404,6 +2423,15 @@ "url": "https://github.com/sponsors/ljharb" } }, + "node_modules/delayed-stream": { + "version": "1.0.0", + "resolved": "https://registry.npmjs.org/delayed-stream/-/delayed-stream-1.0.0.tgz", + "integrity": "sha512-ZySD7Nf91aLB0RxL4KGrKHBXl7Eds1DAmEdcoVawXnLD7SDhpNgtuII2aAkg7a7QS41jxPSZ17p4VdGnMHk3MQ==", + "license": "MIT", + "engines": { + "node": ">=0.4.0" + } + }, "node_modules/detect-newline": { "version": "3.1.0", "resolved": "https://registry.npmjs.org/detect-newline/-/detect-newline-3.1.0.tgz", @@ -3085,6 +3113,20 @@ "url": "https://github.com/sponsors/isaacs" } }, + "node_modules/form-data": { + "version": "4.0.1", + "resolved": "https://registry.npmjs.org/form-data/-/form-data-4.0.1.tgz", + "integrity": "sha512-tzN8e4TX8+kkxGPK8D5u0FNmjPUjw3lwC9lSLxxoB/+GtsJG91CO8bSWy73APlgAZzZbXEYZJuxjkHH2w+Ezhw==", + "license": "MIT", + "dependencies": { + "asynckit": "^0.4.0", + "combined-stream": "^1.0.8", + "mime-types": "^2.1.12" + }, + "engines": { + "node": ">= 6" + } + }, "node_modules/fs-extra": { "version": "9.1.0", "resolved": "https://registry.npmjs.org/fs-extra/-/fs-extra-9.1.0.tgz", @@ -4932,6 +4974,27 @@ "node": ">=8.6" } }, + "node_modules/mime-db": { + "version": "1.52.0", + "resolved": "https://registry.npmjs.org/mime-db/-/mime-db-1.52.0.tgz", + "integrity": "sha512-sPU4uV7dYlvtWJxwwxHD0PuihVNiE7TyAbQ5SWxDCB9mUYvOgroQOwYQQOKPJ8CIbE+1ETVlOoK1UC2nU3gYvg==", + "license": "MIT", + "engines": { + "node": ">= 0.6" + } + }, + "node_modules/mime-types": { + "version": "2.1.35", + "resolved": "https://registry.npmjs.org/mime-types/-/mime-types-2.1.35.tgz", + "integrity": "sha512-ZDY+bPm5zTTF+YpCrAU9nK0UgICYPT0QtT1NZWFv4s++TNkcgVaT0g6+4R2uI4MjQjzysHB1zxuWL50hzaeXiw==", + "license": "MIT", + "dependencies": { + "mime-db": "1.52.0" + }, + "engines": { + "node": ">= 0.6" + } + }, "node_modules/mimic-fn": { "version": "2.1.0", "resolved": "https://registry.npmjs.org/mimic-fn/-/mimic-fn-2.1.0.tgz", diff --git a/package.json b/package.json index de7b8f212..c7c2845fe 100644 --- a/package.json +++ b/package.json @@ -19,6 +19,7 @@ }, "dependencies": { "adm-zip": "^0.5.15", + "form-data": "^4.0.1", "tmp": "^0.2.3", "which": "^4.0.0" }, diff --git a/src/Builder/Http.elm b/src/Builder/Http.elm index c90940b9d..7da0274ae 100644 --- a/src/Builder/Http.elm +++ b/src/Builder/Http.elm @@ -109,31 +109,7 @@ type Method fetch : Method -> Manager -> String -> List Header -> (Error -> e) -> (String -> IO (Result e a)) -> IO (Result e a) -fetch methodVerb manager url headers onError onSuccess = - -- handle (handleSomeException url onError) <| - -- handle (handleHttpException url onError) <| - -- (parseUrlThrow url - -- |> IO.bind - -- (\req0 -> - -- let - -- req1 = - -- req0 - -- { method = methodVerb - -- , requestHeaders = addDefaultHeaders headers - -- } - -- in - -- withResponse req1 - -- manager - -- (\response -> - -- brConsume (responseBody response) - -- |> IO.bind - -- (\chunks -> - -- onSuccess (BS.concat chunks) - -- ) - -- ) - -- ) - -- ) - -- IO.pure (Err (onError (BadHttp url (ConnectionFailure SomeException)))) +fetch methodVerb _ url headers _ onSuccess = IO.make Decode.string (IO.HttpFetch (case methodVerb of @@ -231,52 +207,59 @@ getArchive manager url onError err onSuccess = type MultiPart - = MultiPart + = FilePart String String + | JsonPart String String Encode.Value + | StringPart String String upload : Manager -> String -> List MultiPart -> IO (Result Error ()) -upload manager url parts = - -- handle (handleSomeException url id) <| - -- handle (handleHttpException url id) <| - -- do req0 - -- <- parseUrlThrow url - -- req1 - -- <- Multi.formDataBody parts - -- <| - -- req0 - -- { method = methodPost - -- , requestHeaders = addDefaultHeaders [] - -- , responseTimeout = responseTimeoutNone - -- } - -- withResponse - -- req1 - -- manager - -- <| - -- \_ -> - -- return (Right ()) - todo "upload" +upload _ url parts = + IO.make (Decode.succeed (Ok ())) + (IO.HttpUpload url + (addDefaultHeaders []) + (Encode.list + (\part -> + case part of + FilePart name filePath -> + Encode.object + [ ( "type", Encode.string "FilePart" ) + , ( "name", Encode.string name ) + , ( "filePath", Encode.string filePath ) + ] + + JsonPart name filePath value -> + Encode.object + [ ( "type", Encode.string "JsonPart" ) + , ( "name", Encode.string name ) + , ( "filePath", Encode.string filePath ) + , ( "value", value ) + ] + + StringPart name string -> + Encode.object + [ ( "type", Encode.string "StringPart" ) + , ( "name", Encode.string name ) + , ( "string", Encode.string string ) + ] + ) + parts + ) + ) filePart : String -> String -> MultiPart filePart name filePath = - -- Multi.partFileSource (String.fromString name) filePath - todo "filePart" + FilePart name filePath jsonPart : String -> String -> Encode.Value -> MultiPart jsonPart name filePath value = - -- let - -- body = - -- Multi.RequestBodyLBS <| B.toLazyByteString <| Encode.encodeUgly value - -- in - -- Multi.partFileRequestBody (String.fromString name) filePath body - todo "jsonPart" + JsonPart name filePath value stringPart : String -> String -> MultiPart stringPart name string = - -- Multi.partBS (String.fromString name) (BS.pack string) - todo "stringPart" + StringPart name string diff --git a/src/Compiler/Json/Encode.elm b/src/Compiler/Json/Encode.elm index 54f784f33..0efa1bc10 100644 --- a/src/Compiler/Json/Encode.elm +++ b/src/Compiler/Json/Encode.elm @@ -108,7 +108,7 @@ oneOrMore encoder oneOrMore_ = type Value = Array (List Value) | Object (List ( String, Value )) - | String String + | StringVal String | Boolean Bool | Integer Int | Number Float @@ -127,12 +127,12 @@ object = string : String -> Value string str = - String ("\"" ++ str ++ "\"") + StringVal str name : String -> Value name nm = - String ("\"" ++ nm ++ "\"") + StringVal nm bool : Bool -> Value @@ -175,7 +175,7 @@ list encodeEntry entries = chars : String -> Value chars chrs = - String ("\"" ++ escape chrs ++ "\"") + StringVal (escape chrs) escape : String -> String @@ -244,8 +244,8 @@ encodeUgly value = Object entries -> "{" ++ String.join "," (List.map encodeEntryUgly entries) ++ "}" - String builder -> - builder + StringVal builder -> + "\"" ++ builder ++ "\"" Boolean boolean -> if boolean then @@ -293,8 +293,8 @@ encodeHelp indent value = Object (first :: rest) -> encodeObject indent first rest - String builder -> - builder + StringVal builder -> + "\"" ++ builder ++ "\"" Boolean boolean -> if boolean then @@ -369,7 +369,7 @@ toJsonValue value = Object obj -> Encode.object (List.map (Tuple.mapSecond toJsonValue) obj) - String builder -> + StringVal builder -> Encode.string builder Boolean boolean -> diff --git a/src/Compiler/Json/String.elm b/src/Compiler/Json/String.elm index 633ce4c73..37fdd3057 100644 --- a/src/Compiler/Json/String.elm +++ b/src/Compiler/Json/String.elm @@ -53,7 +53,7 @@ toChars = fromComment : P.Snippet -> String -fromComment (P.Snippet { fptr, offset, length }) = +fromComment ((P.Snippet { fptr, offset, length }) as snippet) = let pos = offset @@ -61,7 +61,7 @@ fromComment (P.Snippet { fptr, offset, length }) = end = pos + length in - fromChunks (chompChunks fptr pos end pos []) + fromChunks snippet (chompChunks fptr pos end pos []) chompChunks : String -> Int -> Int -> Int -> List Chunk -> List Chunk @@ -130,29 +130,30 @@ type Chunk | Escape Char -fromChunks : List Chunk -> String -fromChunks chunks = - writeChunks 0 chunks +fromChunks : P.Snippet -> List Chunk -> String +fromChunks snippet chunks = + writeChunks snippet chunks -writeChunks : Int -> List Chunk -> String -writeChunks offset chunks = +writeChunks : P.Snippet -> List Chunk -> String +writeChunks ((P.Snippet { fptr }) as snippet) chunks = case chunks of [] -> "" chunk :: chunks_ -> case chunk of - Slice _ len -> - let - newOffset = - offset + len - in - writeChunks newOffset chunks_ + Slice offset len -> + String.left len (String.dropLeft offset fptr) ++ writeChunks snippet chunks_ + + Escape 'n' -> + String.fromChar '\n' ++ writeChunks snippet chunks_ + + Escape '"' -> + String.fromChar '"' ++ writeChunks snippet chunks_ + + Escape '\\' -> + String.fromChar '\\' ++ writeChunks snippet chunks_ Escape word -> - let - newOffset = - offset + 2 - in - "\\" ++ String.fromChar word ++ writeChunks newOffset chunks_ + String.fromList [ '\\', word ] ++ writeChunks snippet chunks_ diff --git a/src/Data/IO.elm b/src/Data/IO.elm index d342a2ec6..a24b1b85f 100644 --- a/src/Data/IO.elm +++ b/src/Data/IO.elm @@ -104,6 +104,7 @@ type Effect | DirFindExecutable String | DirCreateDirectoryIfMissing Bool String | DirRemoveFile String + | DirRemoveDirectoryRecursive String | DirDoesDirectoryExist String | EnvLookupEnv String | EnvGetProgName @@ -111,10 +112,12 @@ type Effect | BinaryDecodeFileOrFail String | Read String | HttpFetch String String (List ( String, String )) + | HttpUpload String (List ( String, String )) Encode.Value | DirGetAppUserDataDirectory String | DirGetCurrentDirectory | DirGetModificationTime String | DirCanonicalizePath String + | DirWithCurrentDirectory String | GetArchive String String | LockFile String | UnlockFile String diff --git a/src/Terminal/Main.elm b/src/Terminal/Main.elm index 9047edecc..b13137325 100644 --- a/src/Terminal/Main.elm +++ b/src/Terminal/Main.elm @@ -264,6 +264,26 @@ effectToCmd index portOut effect = ] } + IO.DirRemoveFile path -> + portOut + { index = index + , value = + Encode.object + [ ( "fn", Encode.string "dirRemoveFile" ) + , ( "args", Encode.list Encode.string [ path ] ) + ] + } + + IO.DirRemoveDirectoryRecursive path -> + portOut + { index = index + , value = + Encode.object + [ ( "fn", Encode.string "dirRemoveDirectoryRecursive" ) + , ( "args", Encode.list Encode.string [ path ] ) + ] + } + IO.Read path -> portOut { index = index @@ -290,6 +310,22 @@ effectToCmd index portOut effect = ] } + IO.HttpUpload url headers parts -> + portOut + { index = index + , value = + Encode.object + [ ( "fn", Encode.string "httpUpload" ) + , ( "args" + , Encode.list identity + [ Encode.string url + , Encode.object (List.map (Tuple.mapSecond Encode.string) headers) + , parts + ] + ) + ] + } + IO.DirGetAppUserDataDirectory app -> portOut { index = index @@ -330,6 +366,16 @@ effectToCmd index portOut effect = ] } + IO.DirWithCurrentDirectory path -> + portOut + { index = index + , value = + Encode.object + [ ( "fn", Encode.string "dirWithCurrentDirectory" ) + , ( "args", Encode.list Encode.string [ path ] ) + ] + } + IO.GetArchive method url -> portOut { index = index diff --git a/src/Utils/Main.elm b/src/Utils/Main.elm index b2a99d04a..854b6ca12 100644 --- a/src/Utils/Main.elm +++ b/src/Utils/Main.elm @@ -895,8 +895,8 @@ dirRemoveFile path = dirRemoveDirectoryRecursive : FilePath -> IO () -dirRemoveDirectoryRecursive _ = - todo "dirRemoveDirectoryRecursive" +dirRemoveDirectoryRecursive path = + IO.make (Decode.succeed ()) (IO.DirRemoveDirectoryRecursive path) dirDoesDirectoryExist : FilePath -> IO Bool @@ -915,8 +915,15 @@ dirGetDirectoryContents _ = dirWithCurrentDirectory : FilePath -> IO a -> IO a -dirWithCurrentDirectory _ _ = - todo "dirWithCurrentDirectory" +dirWithCurrentDirectory dir action = + dirGetCurrentDirectory + |> IO.bind + (\currentDir -> + bracket_ + (IO.make (Decode.succeed ()) (IO.DirWithCurrentDirectory dir)) + (IO.make (Decode.succeed ()) (IO.DirWithCurrentDirectory currentDir)) + action + ) @@ -1016,9 +1023,23 @@ throw _ = todo "throw" +bracket : IO a -> (a -> IO b) -> (a -> IO c) -> IO c +bracket before after thing = + before + |> IO.bind + (\a -> + thing a + |> IO.bind + (\r -> + after a + |> IO.fmap (\_ -> r) + ) + ) + + bracket_ : IO a -> IO b -> IO c -> IO c bracket_ before after thing = - todo "bracket_" + bracket before (always after) (always thing)