From 4968f045fdb95ef4af87111a3b023af711ab47ad Mon Sep 17 00:00:00 2001 From: Decio Ferreira Date: Fri, 25 Oct 2024 23:52:53 +0100 Subject: [PATCH] fix some elm-review failures --- bin/index.js | 17 +- elm.json | 7 +- review/src/ReviewConfig.elm | 4 +- src/Builder/Deps/Website.elm | 3 +- src/Builder/Elm/Details.elm | 10 +- src/Builder/Elm/Outline.elm | 1 - src/Builder/File.elm | 14 - src/Builder/Http.elm | 70 +-- src/Builder/Reporting/Exit.elm | 163 ++--- src/Builder/Reporting/Exit/Help.elm | 4 +- src/Builder/Reporting/Task.elm | 17 - src/Builder/Stuff.elm | 10 - src/Compiler/Data/Bag.elm | 38 -- src/Compiler/Data/Map/Utils.elm | 8 +- src/Compiler/Data/NonEmptyList.elm | 12 - src/Compiler/Elm/Compiler/Type/Extract.elm | 6 - src/Compiler/Elm/Constraint.elm | 28 - src/Compiler/Elm/Interface.elm | 1 - src/Compiler/Elm/Licenses.elm | 4 +- src/Compiler/Elm/Magnitude.elm | 6 - src/Compiler/Elm/ModuleName.elm | 1 - src/Compiler/Elm/Package.elm | 14 - src/Compiler/Generate/JavaScript.elm | 8 +- src/Compiler/Generate/JavaScript/Builder.elm | 12 +- src/Compiler/Json/Decode.elm | 29 +- src/Compiler/Json/Encode.elm | 1 - src/Compiler/Json/String.elm | 18 +- src/Compiler/Nitpick/Debug.elm | 4 +- src/Compiler/Optimize/DecisionTree.elm | 1 - src/Compiler/Optimize/Names.elm | 12 - src/Compiler/Parse/Number.elm | 1 - src/Compiler/Parse/Primitives.elm | 50 -- src/Compiler/Reporting/Annotation.elm | 6 - src/Compiler/Reporting/Doc.elm | 34 +- src/Compiler/Reporting/Error/Json.elm | 7 - src/Compiler/Type/Type.elm | 6 +- src/Data/Graph.elm | 626 ------------------- src/Data/IO.elm | 18 - src/Data/Maybe.elm | 7 - src/Terminal/Bump.elm | 2 +- src/Terminal/Diff.elm | 2 +- src/Terminal/Make.elm | 3 +- src/Terminal/Terminal/Chomp.elm | 4 +- src/Utils/Main.elm | 160 ++++- 44 files changed, 286 insertions(+), 1163 deletions(-) delete mode 100644 src/Data/Graph.elm delete mode 100644 src/Data/Maybe.elm diff --git a/bin/index.js b/bin/index.js index 41cc26080..0f84b6442 100755 --- a/bin/index.js +++ b/bin/index.js @@ -8,6 +8,7 @@ const http = require("node:http"); const https = require("node:https"); const resolve = require("node:path").resolve; const zlib = require("node:zlib"); +const crypto = require("node:crypto"); const AdmZip = require("adm-zip"); const which = require("which"); const tmp = require("tmp"); @@ -27,24 +28,28 @@ const processes = {}; let state = null; const download = function (index, method, url) { - const req = https.request(url, { method: method }, (res) => { + const req = https.request(url, { method }, (res) => { if (res.statusCode >= 200 && res.statusCode < 300) { - let data = []; + let chunks = []; + res.on("data", (chunk) => { - data.push(chunk); + chunks.push(chunk); }); res.on("end", () => { - const zip = new AdmZip(Buffer.concat(data)); + const buffer = Buffer.concat(chunks); + const zip = new AdmZip(buffer); + + const sha = crypto.createHash("sha1").update(buffer).digest("hex"); - const jsonData = zip.getEntries().map(function (entry) { + const archive = zip.getEntries().map(function (entry) { return { eRelativePath: entry.entryName, eData: zip.readAsText(entry), }; }); - this.send({ index, value: jsonData }); + this.send({ index, value: { sha, archive } }); }); } else if (res.headers.location) { download.apply(this, [index, method, res.headers.location]); diff --git a/elm.json b/elm.json index aca5f64c0..d72a71c19 100644 --- a/elm.json +++ b/elm.json @@ -16,15 +16,16 @@ "elm-community/list-extra": "8.7.0", "elm-community/maybe-extra": "5.3.0", "guida-lang/glsl": "1.0.0", + "guida-lang/graph": "1.0.0", "rtfeldman/elm-hex": "1.0.0", - "the-sett/elm-pretty-printer": "3.1.0", - "zwilias/elm-rosetree": "1.5.0" + "the-sett/elm-pretty-printer": "3.1.0" }, "indirect": { "andre-dietrich/parser-combinators": "4.1.0", "elm/regex": "1.0.0", "fredcy/elm-parseint": "2.0.1", - "pilatch/flip": "1.0.0" + "pilatch/flip": "1.0.0", + "zwilias/elm-rosetree": "1.5.0" } }, "test-dependencies": { diff --git a/review/src/ReviewConfig.elm b/review/src/ReviewConfig.elm index 7fedd25d0..a6ca4c0a7 100644 --- a/review/src/ReviewConfig.elm +++ b/review/src/ReviewConfig.elm @@ -35,8 +35,8 @@ import Simplify config : List Rule config = - [ -- Docs.ReviewAtDocs.rule - NoConfusingPrefixOperator.rule + [ Docs.ReviewAtDocs.rule + , NoConfusingPrefixOperator.rule , NoDebug.Log.rule -- , NoDebug.TodoOrToString.rule diff --git a/src/Builder/Deps/Website.elm b/src/Builder/Deps/Website.elm index ac4852e4b..716804684 100644 --- a/src/Builder/Deps/Website.elm +++ b/src/Builder/Deps/Website.elm @@ -1,6 +1,5 @@ module Builder.Deps.Website exposing - ( domain - , metadata + ( metadata , route ) diff --git a/src/Builder/Elm/Details.elm b/src/Builder/Elm/Details.elm index 9c5ce37e6..70a48c418 100644 --- a/src/Builder/Elm/Details.elm +++ b/src/Builder/Elm/Details.elm @@ -13,7 +13,6 @@ module Builder.Elm.Details exposing , loadObjects , localDecoder , localEncoder - , statusDecoder , verifyInstall ) @@ -1061,10 +1060,11 @@ downloadPackage cache manager pkg vsn = Ok ( endpoint, expectedHash ) -> Http.getArchive manager endpoint Exit.PP_BadArchiveRequest (Exit.PP_BadArchiveContent endpoint) <| \( sha, archive ) -> - -- TODO (IMPORTANT) if expectedHash == Http.shaToChars sha then - IO.fmap Ok (File.writePackage (Stuff.package cache pkg vsn) archive) - -- else - -- IO.pure (Err (Exit.PP_BadArchiveHash endpoint expectedHash (Http.shaToChars sha))) + if expectedHash == Http.shaToChars sha then + IO.fmap Ok (File.writePackage (Stuff.package cache pkg vsn) archive) + + else + IO.pure (Err (Exit.PP_BadArchiveHash endpoint expectedHash (Http.shaToChars sha))) ) diff --git a/src/Builder/Elm/Outline.elm b/src/Builder/Elm/Outline.elm index 9aadb8e7d..b7b6b952a 100644 --- a/src/Builder/Elm/Outline.elm +++ b/src/Builder/Elm/Outline.elm @@ -7,7 +7,6 @@ module Builder.Elm.Outline exposing , SrcDir(..) , decoder , defaultSummary - , encode , flattenExposed , read , srcDirDecoder diff --git a/src/Builder/File.elm b/src/Builder/File.elm index 3d72ffb0c..8920feddd 100644 --- a/src/Builder/File.elm +++ b/src/Builder/File.elm @@ -5,7 +5,6 @@ module Builder.File exposing , readBinary , readUtf8 , remove - , removeDir , timeDecoder , timeEncoder , writeBinary @@ -184,19 +183,6 @@ remove path = ) -removeDir : FilePath -> IO () -removeDir path = - Utils.dirDoesFileExist path - |> IO.bind - (\exists_ -> - if exists_ then - Utils.dirRemoveDirectoryRecursive path - - else - IO.pure () - ) - - -- ENCODERS and DECODERS diff --git a/src/Builder/Http.elm b/src/Builder/Http.elm index 63569d4b5..95b92e488 100644 --- a/src/Builder/Http.elm +++ b/src/Builder/Http.elm @@ -1,7 +1,6 @@ module Builder.Http exposing ( Error(..) , Header - , HttpExceptionContent(..) , Manager , MultiPart , Sha @@ -28,7 +27,7 @@ import Data.IO as IO exposing (IO) import Json.Decode as Decode import Json.Encode as Encode import Url.Builder -import Utils.Main as Utils exposing (HTTPResponse, SomeException) +import Utils.Main as Utils exposing (SomeException) @@ -145,16 +144,10 @@ accept mime = type Error = BadUrl String String - | BadHttp String HttpExceptionContent + | BadHttp String Utils.HttpExceptionContent | BadMystery String SomeException -type HttpExceptionContent - = StatusCodeException (HTTPResponse ()) String - | TooManyRedirects (List (HTTPResponse ())) - | ConnectionFailure SomeException - - -- SHA @@ -173,13 +166,9 @@ shaToChars = getArchive : Manager -> String -> (Error -> e) -> e -> (( Sha, Utils.ZipArchive ) -> IO (Result e a)) -> IO (Result e a) -getArchive manager url onError err onSuccess = - IO.make Utils.zipArchiveDecoder (IO.GetArchive "GET" url) - |> IO.bind - (\archive -> - -- TODO review the need to use `readArchive...` - onSuccess ( "SHA-TODO", archive ) - ) +getArchive _ url _ _ onSuccess = + IO.make Utils.shaAndArchiveDecoder (IO.GetArchive "GET" url) + |> IO.bind (\shaAndArchive -> onSuccess shaAndArchive) @@ -260,7 +249,7 @@ errorEncoder error = Encode.object [ ( "type", Encode.string "BadHttp" ) , ( "url", Encode.string url ) - , ( "httpExceptionContent", httpExceptionContentEncoder httpExceptionContent ) + , ( "httpExceptionContent", Utils.httpExceptionContentEncoder httpExceptionContent ) ] BadMystery url someException -> @@ -285,7 +274,7 @@ errorDecoder = "BadHttp" -> Decode.map2 BadHttp (Decode.field "url" Decode.string) - (Decode.field "httpExceptionContent" httpExceptionContentDecoder) + (Decode.field "httpExceptionContent" Utils.httpExceptionContentDecoder) "BadMystery" -> Decode.map2 BadMystery @@ -295,48 +284,3 @@ errorDecoder = _ -> Decode.fail ("Failed to decode Error's type: " ++ type_) ) - - -httpExceptionContentEncoder : HttpExceptionContent -> Encode.Value -httpExceptionContentEncoder httpExceptionContent = - case httpExceptionContent of - StatusCodeException response body -> - Encode.object - [ ( "type", Encode.string "StatusCodeException" ) - , ( "response", Utils.httpResponseEncoder response ) - , ( "body", Encode.string body ) - ] - - TooManyRedirects responses -> - Encode.object - [ ( "type", Encode.string "TooManyRedirects" ) - , ( "responses", Encode.list Utils.httpResponseEncoder responses ) - ] - - ConnectionFailure someException -> - Encode.object - [ ( "type", Encode.string "ConnectionFailure" ) - , ( "someException", Utils.someExceptionEncoder someException ) - ] - - -httpExceptionContentDecoder : Decode.Decoder HttpExceptionContent -httpExceptionContentDecoder = - Decode.field "type" Decode.string - |> Decode.andThen - (\type_ -> - case type_ of - "StatusCodeException" -> - Decode.map2 StatusCodeException - (Decode.field "response" Utils.httpResponseDecoder) - (Decode.field "body" Decode.string) - - "TooManyRedirects" -> - Decode.map TooManyRedirects (Decode.field "responses" (Decode.list Utils.httpResponseDecoder)) - - "ConnectionFailure" -> - Decode.map ConnectionFailure (Decode.field "someException" Utils.someExceptionDecoder) - - _ -> - Decode.fail ("Failed to decode HttpExceptionContent's type: " ++ type_) - ) diff --git a/src/Builder/Reporting/Exit.elm b/src/Builder/Reporting/Exit.elm index 0391a5ff3..489ed2bbc 100644 --- a/src/Builder/Reporting/Exit.elm +++ b/src/Builder/Reporting/Exit.elm @@ -14,7 +14,6 @@ module Builder.Reporting.Exit exposing , OutlineProblem(..) , PackageProblem(..) , Publish(..) - , Reactor(..) , RegistryProblem(..) , Repl(..) , Solver(..) @@ -31,13 +30,11 @@ module Builder.Reporting.Exit exposing , makeToReport , newPackageOverview , publishToReport - , reactorToReport , registryProblemDecoder , registryProblemEncoder , replToReport , toJson , toStderr - , toString ) import Builder.File as File @@ -63,19 +60,13 @@ import Data.IO exposing (IO) import Data.Map as Dict exposing (Dict) import Json.Decode as CoreDecode import Json.Encode as CoreEncode -import Utils.Crash exposing (todo) -import Utils.Main as Utils exposing (FilePath, HTTPResponse) +import Utils.Main as Utils exposing (FilePath) -- RENDERERS -toString : Help.Report -> String -toString report = - Help.toString (Help.reportToDoc report) - - toStderr : Help.Report -> IO () toStderr report = Help.toStderr (Help.reportToDoc report) @@ -159,7 +150,7 @@ type Diff | DiffNoExposed | DiffUnpublished | DiffUnknownPackage Pkg.Name (List Pkg.Name) - | DiffUnknownVersion Pkg.Name V.Version (List V.Version) + | DiffUnknownVersion V.Version (List V.Version) | DiffDocsProblem V.Version DocsProblem | DiffMustHaveLatestRegistry RegistryProblem | DiffBadDetails Details @@ -212,7 +203,7 @@ diffToReport diff = , D.fromChars "But check to see all possibilities!" ] - DiffUnknownVersion _ vsn realVersions -> + DiffUnknownVersion vsn realVersions -> Help.docReport "UNKNOWN VERSION" Nothing (D.fillSep <| @@ -274,7 +265,7 @@ type Bump | BumpApplication | BumpUnexpectedVersion V.Version (List V.Version) | BumpMustHaveLatestRegistry RegistryProblem - | BumpCannotFindDocs Pkg.Name V.Version DocsProblem + | BumpCannotFindDocs V.Version DocsProblem | BumpBadDetails Details | BumpNoExposed | BumpBadBuild BuildProblem @@ -375,7 +366,7 @@ bumpToReport bump = toRegistryProblemReport "PROBLEM UPDATING PACKAGE LIST" problem <| "I need the latest list of published packages before I can bump any versions" - BumpCannotFindDocs _ version problem -> + BumpCannotFindDocs version problem -> toDocsProblemReport problem <| "I need the docs for " ++ V.toChars version @@ -792,35 +783,37 @@ publishToReport publish = ] PublishCannotGetTag version httpError -> - -- case httpError of - -- Http.BadHttp _ (HTTP.StatusCodeException response _) -> - -- if HTTP.statusCode (HTTP.responseStatus response) == 404 then - -- let - -- vsn = - -- V.toChars version - -- in - -- Help.report "NO TAG ON GITHUB" - -- Nothing - -- ("You have version " ++ vsn ++ " tagged locally, but not on GitHub.") - -- [ D.reflow - -- "Run the following command to make this tag available on GitHub:" - -- , D.indent 4 <| - -- D.dullyellow <| - -- D.fromChars <| - -- "git push origin " - -- ++ vsn - -- , D.reflow - -- "This will make it possible to find your code online based on the version number." - -- ] - -- else - -- toHttpErrorReport "PROBLEM VERIFYING TAG" - -- httpError - -- "I need to check that the version tag is registered on GitHub" - -- _ -> - -- toHttpErrorReport "PROBLEM VERIFYING TAG" - -- httpError - -- "I need to check that the version tag is registered on GitHub" - todo "PublishCannotGetTag" + case httpError of + Http.BadHttp _ (Utils.StatusCodeException response _) -> + if Utils.httpStatusCode (Utils.httpResponseStatus response) == 404 then + let + vsn : String + vsn = + V.toChars version + in + Help.report "NO TAG ON GITHUB" + Nothing + ("You have version " ++ vsn ++ " tagged locally, but not on GitHub.") + [ D.reflow + "Run the following command to make this tag available on GitHub:" + , D.indent 4 <| + D.dullyellow <| + D.fromChars <| + "git push origin " + ++ vsn + , D.reflow + "This will make it possible to find your code online based on the version number." + ] + + else + toHttpErrorReport "PROBLEM VERIFYING TAG" + httpError + "I need to check that the version tag is registered on GitHub" + + _ -> + toHttpErrorReport "PROBLEM VERIFYING TAG" + httpError + "I need to check that the version tag is registered on GitHub" PublishCannotGetTagData version url body -> Help.report "PROBLEM VERIFYING TAG" @@ -1313,7 +1306,7 @@ type OutlineProblem | OP_BadModuleName Row Col | OP_BadModuleHeaderTooLong | OP_BadDependencyName Row Col - | OP_BadLicense String (List String) + | OP_BadLicense (List String) | OP_BadSummaryTooLong | OP_NoSrcDirs @@ -1741,7 +1734,7 @@ toOutlineProblemReport path source _ region problem = ] ) - OP_BadLicense _ suggestions -> + OP_BadLicense suggestions -> toSnippet "UNKNOWN LICENSE" Nothing ( D.reflow <| @@ -2176,11 +2169,11 @@ toHttpErrorReport title err context = Http.BadHttp url httpExceptionContent -> case httpExceptionContent of - Http.StatusCodeException response body -> - -- let - -- (HTTP.Status code message) = - -- HTTP.responseStatus response - -- in + Utils.StatusCodeException response body -> + let + (Utils.HttpStatus code message) = + Utils.httpResponseStatus response + in toHttpReport (context ++ ", so I tried to fetch:") url [ D.fillSep <| @@ -2189,35 +2182,31 @@ toHttpErrorReport title err context = , D.fromChars "came" , D.fromChars "back" , D.fromChars "as" - - -- , D.red (D.fromInt code) - , D.fromChars "(TODO)" + , D.red (D.fromInt code) ] - - -- ++ map D.fromChars (String.words message) + ++ List.map D.fromChars (String.words message) , D.indent 4 <| D.reflow <| body , D.reflow <| "This may mean some online endpoint changed in an unexpected way, so if does not seem like something on your side is causing this (e.g. firewall) please report this to https://github.com/elm/compiler/issues with your operating system, Elm version, the command you ran, the terminal output, and any additional information that can help others reproduce the error!" ] - Http.TooManyRedirects responses -> + Utils.TooManyRedirects responses -> toHttpReport (context ++ ", so I tried to fetch:") url [ D.reflow <| "But I gave up after following these " - -- ++ show (length responses) - ++ "(TODO)" + ++ String.fromInt (List.length responses) ++ " redirects:" , D.indent 4 <| D.vcat <| List.map toRedirectDoc responses , D.reflow <| "Is it possible that your internet connection intercepts certain requests? That sometimes causes problems for folks in schools, businesses, airports, hotels, and certain countries. Try asking for help locally or in a community forum!" ] - otherException -> + _ -> toHttpReport (context ++ ", so I tried to fetch:") url [ D.reflow <| "But my HTTP library is giving me the following error message:" - , D.indent 4 <| D.fromChars (Debug.toString otherException) + , D.indent 4 <| D.fromChars "TODO" , D.reflow <| "Are you somewhere with a slow internet connection? Or no internet? Does the link I am trying to fetch work in your browser? Maybe the site is down? Does your internet connection have a firewall that blocks certain domains? It is usually something like that!" ] @@ -2232,18 +2221,18 @@ toHttpErrorReport title err context = ] -toRedirectDoc : HTTPResponse body -> D.Doc +toRedirectDoc : Utils.HttpResponse body -> D.Doc toRedirectDoc response = - -- let - -- (HTTP.Status code message) = - -- HTTP.responseStatus response - -- in - -- case List.lookup HTTP.hLocation (HTTP.responseHeaders response) of - -- Just loc -> - -- D.red (D.fromInt code) |> D.a (D.fromChars " - ") |> D.a (D.fromChars (BS_UTF8.toString loc)) - -- Nothing -> - -- D.red (D.fromInt code) |> D.a (D.fromChars " - ") |> D.a (D.fromChars (BS_UTF8.toString message)) - todo "toRedirectDoc" + let + (Utils.HttpStatus code message) = + Utils.httpResponseStatus response + in + case Utils.listLookup Utils.httpHLocation (Utils.httpResponseHeaders response) of + Just loc -> + D.red (D.fromInt code) |> D.a (D.fromChars " - ") |> D.a (D.fromChars loc) + + Nothing -> + D.red (D.fromInt code) |> D.a (D.fromChars " - ") |> D.a (D.fromChars message) @@ -2793,38 +2782,6 @@ corruptCacheReport = --- REACTOR - - -type Reactor - = ReactorNoOutline - | ReactorBadDetails Details - | ReactorBadBuild BuildProblem - | ReactorBadGenerate Generate - - -reactorToReport : Reactor -> Help.Report -reactorToReport problem = - case problem of - ReactorNoOutline -> - Help.report "NEW PROJECT?" - Nothing - "Are you trying to start a new project? Try this command in the terminal:" - [ D.indent 4 <| D.green (D.fromChars "elm init") - , D.reflow "It will help you get started!" - ] - - ReactorBadDetails details -> - toDetailsReport details - - ReactorBadBuild buildProblem -> - toBuildProblemReport buildProblem - - ReactorBadGenerate generate -> - toGenerateReport generate - - - -- REPL diff --git a/src/Builder/Reporting/Exit/Help.elm b/src/Builder/Reporting/Exit/Help.elm index 849993246..f3d6df3a1 100644 --- a/src/Builder/Reporting/Exit/Help.elm +++ b/src/Builder/Reporting/Exit/Help.elm @@ -15,7 +15,7 @@ import Compiler.Json.Encode as E import Compiler.Reporting.Doc as D import Compiler.Reporting.Error as Error import Data.IO as IO exposing (IO) -import Data.Maybe as Maybe +import Maybe.Extra as Maybe @@ -101,7 +101,7 @@ reportToJson report_ = Report title maybePath message -> E.object [ ( "type", E.string "error" ) - , ( "path", Maybe.maybe E.null E.string maybePath ) + , ( "path", Maybe.unwrap E.null E.string maybePath ) , ( "title", E.string title ) , ( "message", D.encode message ) ] diff --git a/src/Builder/Reporting/Task.elm b/src/Builder/Reporting/Task.elm index 5ccc52988..8d5af1129 100644 --- a/src/Builder/Reporting/Task.elm +++ b/src/Builder/Reporting/Task.elm @@ -1,6 +1,5 @@ module Builder.Reporting.Task exposing ( Task - , apply , bind , eio , fmap @@ -88,22 +87,6 @@ pure a = Task (IO.pure (Ok a)) -apply : Task x a -> Task x (a -> b) -> Task x b -apply (Task taskArg) (Task taskFunc) = - Task - (IO.bind - (\funcRes -> - case funcRes of - Ok func -> - IO.fmap (Result.map func) taskArg - - Err err -> - IO.pure (Err err) - ) - taskFunc - ) - - bind : (a -> Task x b) -> Task x a -> Task x b bind callback (Task taskA) = Task diff --git a/src/Builder/Stuff.elm b/src/Builder/Stuff.elm index 914f509ef..edd4cb3ce 100644 --- a/src/Builder/Stuff.elm +++ b/src/Builder/Stuff.elm @@ -14,7 +14,6 @@ module Builder.Stuff exposing , packageCacheEncoder , prepublishDir , registry - , temp , withRegistryLock , withRootLock ) @@ -83,15 +82,6 @@ toArtifactPath root name ext = --- TEMP - - -temp : String -> String -> String -temp root ext = - stuff root ++ "/temp." ++ ext - - - -- ROOT diff --git a/src/Compiler/Data/Bag.elm b/src/Compiler/Data/Bag.elm index 802973124..c4513e32a 100644 --- a/src/Compiler/Data/Bag.elm +++ b/src/Compiler/Data/Bag.elm @@ -2,8 +2,6 @@ module Compiler.Data.Bag exposing ( Bag(..) , append , empty - , fromList - , map , one , toList ) @@ -45,23 +43,6 @@ append left right = --- MAP - - -map : (a -> b) -> Bag a -> Bag b -map func bag = - case bag of - Empty -> - Empty - - One a -> - One (func a) - - Two left right -> - Two (map func left) (map func right) - - - -- TO LIST @@ -81,22 +62,3 @@ toListHelp bag list = Two a b -> toListHelp a (toListHelp b list) - - - --- FROM LIST - - -fromList : (a -> b) -> List a -> Bag b -fromList func list = - case list of - [] -> - Empty - - first :: rest -> - List.foldl (add func) (One (func first)) rest - - -add : (a -> b) -> a -> Bag b -> Bag b -add func value bag = - Two (One (func value)) bag diff --git a/src/Compiler/Data/Map/Utils.elm b/src/Compiler/Data/Map/Utils.elm index 14e743d94..3a6b495f5 100644 --- a/src/Compiler/Data/Map/Utils.elm +++ b/src/Compiler/Data/Map/Utils.elm @@ -2,7 +2,6 @@ module Compiler.Data.Map.Utils exposing ( any , fromKeys , fromKeysA - , fromValues ) import Data.IO as IO exposing (IO) @@ -24,15 +23,10 @@ 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) - - -- ANY -any : (v -> Bool) -> Dict comparable v -> Bool +any : (v -> Bool) -> Dict k v -> Bool any isGood dict = Dict.foldl (\_ v acc -> isGood v || acc) False dict diff --git a/src/Compiler/Data/NonEmptyList.elm b/src/Compiler/Data/NonEmptyList.elm index f28002fbe..3977d5f94 100644 --- a/src/Compiler/Data/NonEmptyList.elm +++ b/src/Compiler/Data/NonEmptyList.elm @@ -1,8 +1,6 @@ module Compiler.Data.NonEmptyList exposing ( Nonempty(..) , cons - , foldl - , foldl1 , foldr , map , singleton @@ -46,16 +44,6 @@ foldr step state (Nonempty x xs) = List.foldr step state (x :: xs) -foldl : (a -> b -> b) -> b -> Nonempty a -> b -foldl step state (Nonempty x xs) = - List.foldl step state (x :: xs) - - -foldl1 : (a -> a -> a) -> Nonempty a -> a -foldl1 step (Nonempty x xs) = - List.foldl step x xs - - -- SORT BY diff --git a/src/Compiler/Elm/Compiler/Type/Extract.elm b/src/Compiler/Elm/Compiler/Type/Extract.elm index da35c1d52..9655c861b 100644 --- a/src/Compiler/Elm/Compiler/Type/Extract.elm +++ b/src/Compiler/Elm/Compiler/Type/Extract.elm @@ -1,7 +1,6 @@ module Compiler.Elm.Compiler.Type.Extract exposing ( Types(..) , Types_ - , fromAnnotation , fromDependencyInterface , fromInterface , fromMsg @@ -33,11 +32,6 @@ import Utils.Main as Utils -- EXTRACTION -fromAnnotation : Can.Annotation -> T.Type -fromAnnotation (Can.Forall _ astType) = - fromType astType - - fromType : Can.Type -> T.Type fromType astType = Tuple.second (run (extract astType)) diff --git a/src/Compiler/Elm/Constraint.elm b/src/Compiler/Elm/Constraint.elm index 847df6e16..731e08fac 100644 --- a/src/Compiler/Elm/Constraint.elm +++ b/src/Compiler/Elm/Constraint.elm @@ -2,12 +2,10 @@ module Compiler.Elm.Constraint exposing ( Constraint , Error(..) , anything - , check , decoder , defaultElm , encode , exactly - , expand , goodElm , intersect , satisfies @@ -94,20 +92,6 @@ isLess op = V.compare lower upper /= GT -check : Constraint -> V.Version -> Order -check constraint version = - case constraint of - Range lower lowerOp upperOp upper -> - if not (isLess lowerOp lower version) then - LT - - else if not (isLess upperOp version upper) then - GT - - else - EQ - - -- INTERSECT @@ -192,18 +176,6 @@ untilNextMinor version = Range version LessOrEqual Less (V.bumpMinor version) -expand : Constraint -> V.Version -> Constraint -expand ((Range lower lowerOp upperOp upper) as constraint) version = - if V.compare version lower == LT then - Range version LessOrEqual upperOp upper - - else if V.compare version upper == GT then - Range lower lowerOp Less (V.bumpMajor version) - - else - constraint - - -- JSON diff --git a/src/Compiler/Elm/Interface.elm b/src/Compiler/Elm/Interface.elm index cdc9b842f..40e9e3bb9 100644 --- a/src/Compiler/Elm/Interface.elm +++ b/src/Compiler/Elm/Interface.elm @@ -16,7 +16,6 @@ module Compiler.Elm.Interface exposing , public , toPublicAlias , toPublicUnion - , unionDecoder ) import Compiler.AST.Canonical as Can diff --git a/src/Compiler/Elm/Licenses.elm b/src/Compiler/Elm/Licenses.elm index a20abaa42..bca8fd253 100644 --- a/src/Compiler/Elm/Licenses.elm +++ b/src/Compiler/Elm/Licenses.elm @@ -29,7 +29,7 @@ encode (License code) = E.string code -decoder : (String -> List String -> x) -> D.Decoder x License +decoder : (List String -> x) -> D.Decoder x License decoder toError = D.string |> D.bind @@ -39,7 +39,7 @@ decoder toError = D.pure license Err suggestions -> - D.failure (toError str suggestions) + D.failure (toError suggestions) ) diff --git a/src/Compiler/Elm/Magnitude.elm b/src/Compiler/Elm/Magnitude.elm index ac21d0fd2..1bbf54904 100644 --- a/src/Compiler/Elm/Magnitude.elm +++ b/src/Compiler/Elm/Magnitude.elm @@ -2,7 +2,6 @@ module Compiler.Elm.Magnitude exposing ( Magnitude(..) , compare , toChars - , toString ) -- MAGNITUDE @@ -27,11 +26,6 @@ toChars magnitude = "MAJOR" -toString : Magnitude -> String -toString = - toChars - - compare : Magnitude -> Magnitude -> Order compare m1 m2 = let diff --git a/src/Compiler/Elm/ModuleName.elm b/src/Compiler/Elm/ModuleName.elm index fbbe91071..f50d51aa9 100644 --- a/src/Compiler/Elm/ModuleName.elm +++ b/src/Compiler/Elm/ModuleName.elm @@ -17,7 +17,6 @@ module Compiler.Elm.ModuleName exposing , list , matrix4 , maybe - , parser , platform , rawDecoder , rawEncoder diff --git a/src/Compiler/Elm/Package.elm b/src/Compiler/Elm/Package.elm index 9fc1e48e3..1e077bedf 100644 --- a/src/Compiler/Elm/Package.elm +++ b/src/Compiler/Elm/Package.elm @@ -1,6 +1,5 @@ module Compiler.Elm.Package exposing ( Author - , Canonical(..) , Name(..) , Project , browser @@ -10,7 +9,6 @@ module Compiler.Elm.Package exposing , dummyName , encode , html - , http , isKernel , json , kernel @@ -22,16 +20,13 @@ module Compiler.Elm.Package exposing , parser , suggestions , toChars - , toFilePath , toJsonString , toString , toUrl - , url , virtualDom , webgl ) -import Compiler.Elm.Version as V import Compiler.Json.Decode as D import Compiler.Json.Encode as E import Compiler.Parse.Primitives as P exposing (Col, Row) @@ -75,10 +70,6 @@ type alias Project = String -type Canonical - = Canonical Name V.Version - - -- HELPERS @@ -98,11 +89,6 @@ toUrl (Name author project) = author ++ "/" ++ project -toFilePath : Name -> String -toFilePath (Name author project) = - author ++ "/" ++ project - - toJsonString : Name -> String toJsonString (Name author project) = String.join "/" [ author, project ] diff --git a/src/Compiler/Generate/JavaScript.elm b/src/Compiler/Generate/JavaScript.elm index 137a987ce..c830c9514 100644 --- a/src/Compiler/Generate/JavaScript.elm +++ b/src/Compiler/Generate/JavaScript.elm @@ -21,9 +21,9 @@ import Compiler.Reporting.Doc as D import Compiler.Reporting.Render.Type as RT import Compiler.Reporting.Render.Type.Localizer as L import Data.Map as Dict exposing (Dict) -import Data.Maybe as Maybe import Data.Set as EverySet exposing (EverySet) import Json.Encode as Encode +import Maybe.Extra as Maybe import Utils.Crash exposing (crash) import Utils.Main as Utils @@ -143,7 +143,7 @@ generateForReplEndpoint localizer (Opt.GlobalGraph graph _) home maybeName (Can. let name : Name.Name name = - Maybe.maybe Name.replValueToPrint identity maybeName + Maybe.unwrap Name.replValueToPrint identity maybeName mode : Mode.Mode mode = @@ -167,7 +167,7 @@ postMessage localizer home maybeName tipe = let name : Name.Name name = - Maybe.maybe Name.replValueToPrint identity maybeName + Maybe.unwrap Name.replValueToPrint identity maybeName value : JsName.Name value = @@ -186,7 +186,7 @@ postMessage localizer home maybeName tipe = "\"" ++ n ++ "\"" in "self.postMessage({\n name: " - ++ Maybe.maybe "null" toName maybeName + ++ Maybe.unwrap "null" toName maybeName ++ ",\n value: " ++ toString ++ "(true, " diff --git a/src/Compiler/Generate/JavaScript/Builder.elm b/src/Compiler/Generate/JavaScript/Builder.elm index a26992067..e43d311c7 100644 --- a/src/Compiler/Generate/JavaScript/Builder.elm +++ b/src/Compiler/Generate/JavaScript/Builder.elm @@ -16,7 +16,7 @@ module Compiler.Generate.JavaScript.Builder exposing import Compiler.Generate.JavaScript.Name as Name import Compiler.Json.Encode as Json -import Data.Maybe as Maybe +import Maybe.Extra as Maybe @@ -41,7 +41,6 @@ type Expr | ExprFloat String | ExprInt Int | ExprBool Bool - | ExprNull | ExprJson Json.Value | ExprArray (List Expr) | ExprObject (List ( Name.Name, Expr )) @@ -58,7 +57,6 @@ type Expr type LValue = LRef Name.Name - | LDot Expr Name.Name | LBracket Expr Expr @@ -389,9 +387,6 @@ fromExpr ((Level indent nextLevel) as level) grouping expression = "false" ) - ExprNull -> - ( One, "null" ) - ExprJson json -> ( One, Json.encodeUgly json ) @@ -510,7 +505,7 @@ fromExpr ((Level indent nextLevel) as level) grouping expression = ExprFunction maybeName args stmts -> ( Many , "function " - ++ Maybe.maybe "" identity maybeName + ++ Maybe.unwrap "" identity maybeName ++ "(" ++ commaSep args ++ ") {\n" @@ -545,9 +540,6 @@ fromLValue level lValue = LRef name -> ( One, name ) - LDot expr field -> - makeDot level expr field - LBracket expr bracketedExpr -> makeBracketed level expr bracketedExpr diff --git a/src/Compiler/Json/Decode.elm b/src/Compiler/Json/Decode.elm index 5a911cd79..410ac99b6 100644 --- a/src/Compiler/Json/Decode.elm +++ b/src/Compiler/Json/Decode.elm @@ -9,7 +9,6 @@ module Compiler.Json.Decode exposing , apply , assocListDict , bind - , bool , customString , dict , everySet @@ -156,7 +155,6 @@ type DecodeExpectation = TObject | TArray | TString - | TBool | TInt | TObjectWith String | TArrayPair Int @@ -231,25 +229,6 @@ customString parser toBadEnd = --- BOOL - - -bool : Decoder x Bool -bool = - Decoder <| - \(A.At region ast) -> - case ast of - TRUE -> - Ok True - - FALSE -> - Ok False - - _ -> - Err (Expecting region TBool) - - - -- INT @@ -665,7 +644,7 @@ pArray = |> P.bind (\entry -> spaces - |> P.bind (\_ -> pArrayHelp 1 [ entry ]) + |> P.bind (\_ -> pArrayHelp [ entry ]) ) , P.word1 ']' ArrayEnd |> P.fmap (\_ -> Array []) @@ -673,8 +652,8 @@ pArray = ) -pArrayHelp : Int -> List AST -> Parser AST_ -pArrayHelp len revEntries = +pArrayHelp : List AST -> Parser AST_ +pArrayHelp revEntries = P.oneOf ArrayEnd [ P.word1 ',' ArrayEnd |> P.bind (\_ -> spaces) @@ -682,7 +661,7 @@ pArrayHelp len revEntries = |> P.bind (\entry -> spaces - |> P.bind (\_ -> pArrayHelp (len + 1) (entry :: revEntries)) + |> P.bind (\_ -> pArrayHelp (entry :: revEntries)) ) , P.word1 ']' ArrayEnd |> P.fmap (\_ -> Array (List.reverse revEntries)) diff --git a/src/Compiler/Json/Encode.elm b/src/Compiler/Json/Encode.elm index 313eb4c8f..b60d92750 100644 --- a/src/Compiler/Json/Encode.elm +++ b/src/Compiler/Json/Encode.elm @@ -5,7 +5,6 @@ module Compiler.Json.Encode exposing , bool , chars , dict - , encode , encodeUgly , everySet , int diff --git a/src/Compiler/Json/String.elm b/src/Compiler/Json/String.elm index c113723ee..357a9c5a2 100644 --- a/src/Compiler/Json/String.elm +++ b/src/Compiler/Json/String.elm @@ -1,10 +1,8 @@ module Compiler.Json.String exposing - ( fromChars - , fromComment + ( fromComment , fromName , fromSnippet , isEmpty - , toChars ) import Compiler.Data.Name as Name @@ -24,11 +22,6 @@ isEmpty = -- FROM -fromChars : List Char -> String -fromChars = - String.fromList - - fromSnippet : P.Snippet -> String fromSnippet (P.Snippet { fptr, offset, length }) = String.slice offset (offset + length) fptr @@ -40,15 +33,6 @@ fromName = --- TO - - -toChars : String -> List Char -toChars = - String.toList - - - -- FROM COMMENT diff --git a/src/Compiler/Nitpick/Debug.elm b/src/Compiler/Nitpick/Debug.elm index 439a1f31c..85bb81dbc 100644 --- a/src/Compiler/Nitpick/Debug.elm +++ b/src/Compiler/Nitpick/Debug.elm @@ -1,6 +1,7 @@ module Compiler.Nitpick.Debug exposing (hasDebugUses) import Compiler.AST.Optimized as Opt +import Compiler.Data.Map.Utils as Map import Data.Map as Dict @@ -10,8 +11,7 @@ import Data.Map as Dict hasDebugUses : Opt.LocalGraph -> Bool hasDebugUses (Opt.LocalGraph _ graph _) = - Dict.values graph - |> List.any nodeHasDebug + Map.any nodeHasDebug graph nodeHasDebug : Opt.Node -> Bool diff --git a/src/Compiler/Optimize/DecisionTree.elm b/src/Compiler/Optimize/DecisionTree.elm index 51d7911af..e142f6357 100644 --- a/src/Compiler/Optimize/DecisionTree.elm +++ b/src/Compiler/Optimize/DecisionTree.elm @@ -2,7 +2,6 @@ module Compiler.Optimize.DecisionTree exposing ( DecisionTree(..) , Path(..) , Test(..) - , compareTest , compile , pathDecoder , pathEncoder diff --git a/src/Compiler/Optimize/Names.elm b/src/Compiler/Optimize/Names.elm index 58d6e80e4..4f464ed39 100644 --- a/src/Compiler/Optimize/Names.elm +++ b/src/Compiler/Optimize/Names.elm @@ -1,6 +1,5 @@ module Compiler.Optimize.Names exposing ( Tracker - , apply , bind , fmap , generate @@ -188,17 +187,6 @@ pure value = Tracker (\n d f -> TResult n d f value) -apply : Tracker a -> Tracker (a -> b) -> Tracker b -apply (Tracker kv) (Tracker kf) = - Tracker <| - \n d f -> - case kf n d f of - TResult n1 d1 f1 func -> - case kv n1 d1 f1 of - TResult n2 d2 f2 value -> - TResult n2 d2 f2 (func value) - - bind : (a -> Tracker b) -> Tracker a -> Tracker b bind callback (Tracker k) = Tracker <| diff --git a/src/Compiler/Parse/Number.elm b/src/Compiler/Parse/Number.elm index 0d3271a54..5dd0c087d 100644 --- a/src/Compiler/Parse/Number.elm +++ b/src/Compiler/Parse/Number.elm @@ -2,7 +2,6 @@ module Compiler.Parse.Number exposing ( Number(..) , Outcome(..) , chompHex - , chompInt , number , precedence ) diff --git a/src/Compiler/Parse/Primitives.elm b/src/Compiler/Parse/Primitives.elm index 88522a147..0b7464475 100644 --- a/src/Compiler/Parse/Primitives.elm +++ b/src/Compiler/Parse/Primitives.elm @@ -9,21 +9,17 @@ module Compiler.Parse.Primitives exposing , Status(..) , addEnd , addLocation - , apply , bind , fmap , fromByteString , fromSnippet , getCharWidth - , getCol - , getIndent , getPosition , inContext , isWord , oneOf , oneOfWithFallback , pure - , setIndent , snippetDecoder , snippetEncoder , specialize @@ -90,26 +86,6 @@ fmap f (Parser parser) = --- APPLICATIVE - - -apply : Parser x a -> Parser x (a -> b) -> Parser x b -apply (Parser parserArg) (Parser parserFunc) = - Parser <| - \state -> - Result.andThen - (\(POk _ func s1) -> - case parserArg s1 of - Ok (POk status arg s2) -> - Ok (POk status (func arg) s2) - - Err err -> - Err err - ) - (parserFunc state) - - - -- ONE OF @@ -251,13 +227,6 @@ fromSnippet (Parser parser) toBadEnd (Snippet { fptr, offset, length, offRow, of -- POSITION -getCol : Parser x Int -getCol = - Parser <| - \((State _ _ _ _ _ col) as state) -> - Ok (POk Empty col state) - - getPosition : Parser x A.Position getPosition = Parser <| @@ -288,25 +257,6 @@ addEnd start value = -- INDENT -getIndent : Parser x Int -getIndent = - Parser <| - \((State _ _ _ indent _ _) as state) -> - Ok (POk Empty indent state) - - -setIndent : Int -> Parser x () -setIndent indent = - Parser <| - \(State src pos end _ row col) -> - let - newState : State - newState = - State src pos end indent row col - in - Ok (POk Empty () newState) - - withIndent : Parser x a -> Parser x a withIndent (Parser parser) = Parser <| diff --git a/src/Compiler/Reporting/Annotation.elm b/src/Compiler/Reporting/Annotation.elm index 295e73bf4..7781c6d10 100644 --- a/src/Compiler/Reporting/Annotation.elm +++ b/src/Compiler/Reporting/Annotation.elm @@ -5,7 +5,6 @@ module Compiler.Reporting.Annotation exposing , at , locatedDecoder , locatedEncoder - , map , merge , mergeRegions , one @@ -30,11 +29,6 @@ type Located a = At Region a -- PERF see if unpacking region is helpful -map : (a -> b) -> Located a -> Located b -map f (At region a) = - At region (f a) - - traverse : (a -> IO b) -> Located a -> IO (Located b) traverse func (At region value) = IO.fmap (At region) (func value) diff --git a/src/Compiler/Reporting/Doc.elm b/src/Compiler/Reporting/Doc.elm index c3f7c8f44..da72c7617 100644 --- a/src/Compiler/Reporting/Doc.elm +++ b/src/Compiler/Reporting/Doc.elm @@ -1,21 +1,36 @@ module Compiler.Reporting.Doc exposing ( Doc - , plus, append + , plus, append, a , align, cat, empty, fill, fillSep, hang , hcat, hsep, indent, sep, vcat - , red, cyan, magenta, green, blue, black, yellow + , Color(..) + , red, cyan, green, blue, black, yellow , dullred, dullcyan, dullyellow - , Color(..), a, args, commaSep, cycle, encode, fancyLink, fromChars, fromInt, fromName, fromPackage, fromVersion, intToOrdinal, link, makeLink, makeNakedLink, moreArgs, ordinal, reflow, reflowLink, stack, toAnsi, toFancyHint, toFancyNote, toLine, toSimpleHint, toSimpleNote, toString + , fromChars, fromName, fromVersion, fromPackage, fromInt + , toAnsi, toString, toLine + , encode + , stack, reflow, commaSep + , toSimpleNote, toFancyNote, toSimpleHint, toFancyHint + , link, fancyLink, reflowLink, makeLink, makeNakedLink + , args, moreArgs, ordinal, intToOrdinal, cycle ) {-| @docs Doc -@docs plus, append +@docs plus, append, a @docs align, cat, empty, fill, fillSep, hang @docs hcat, hsep, indent, sep, vcat -@docs red, cyan, magenta, green, blue, black, yellow +@docs Color +@docs red, cyan, green, blue, black, yellow @docs dullred, dullcyan, dullyellow +@docs fromChars, fromName, fromVersion, fromPackage, fromInt +@docs toAnsi, toString, toLine +@docs encode +@docs stack, reflow, commaSep +@docs toSimpleNote, toFancyNote, toSimpleHint, toFancyHint +@docs link, fancyLink, reflowLink, makeLink, makeNakedLink +@docs args, moreArgs, ordinal, intToOrdinal, cycle -} @@ -25,7 +40,7 @@ import Compiler.Elm.Package as Pkg import Compiler.Elm.Version as V import Compiler.Json.Encode as E import Data.IO exposing (Handle, IO) -import Data.Maybe as Maybe +import Maybe.Extra as Maybe import Prelude import System.Console.Ansi as Ansi import Text.PrettyPrint.ANSI.Leijen as P @@ -475,7 +490,7 @@ encodeChunks (Style bold underline color) revChunks = E.object [ ( "bold", E.bool bold ) , ( "underline", E.bool underline ) - , ( "color", Maybe.maybe E.null encodeColor color ) + , ( "color", Maybe.unwrap E.null encodeColor color ) , ( "string", E.chars chars ) ] @@ -621,11 +636,6 @@ cyan = P.cyan -magenta : Doc -> Doc -magenta = - P.magenta - - green : Doc -> Doc green = P.green diff --git a/src/Compiler/Reporting/Error/Json.elm b/src/Compiler/Reporting/Error/Json.elm index 09bc0cd16..f25ec40c2 100644 --- a/src/Compiler/Reporting/Error/Json.elm +++ b/src/Compiler/Reporting/Error/Json.elm @@ -441,13 +441,6 @@ expectationToReport path source context (A.Region start end) expectation reason |> D.a (D.fromChars ".") ] - TBool -> - toSnippet "EXPECTING BOOL" - [ D.fromChars "a" - , D.green (D.fromChars "BOOLEAN") - |> D.a (D.fromChars ".") - ] - TInt -> toSnippet "EXPECTING INT" [ D.fromChars "an" diff --git a/src/Compiler/Type/Type.elm b/src/Compiler/Type/Type.elm index d01c6145a..c2b945315 100644 --- a/src/Compiler/Type/Type.elm +++ b/src/Compiler/Type/Type.elm @@ -38,7 +38,7 @@ import Compiler.Type.Error as ET import Compiler.Type.UnionFind as UF import Data.IO as IO exposing (IO) import Data.Map as Dict exposing (Dict) -import Data.Maybe as Maybe +import Maybe.Extra as Maybe import Utils.Crash exposing (crash) import Utils.Main as Utils @@ -244,14 +244,14 @@ nameToFlex : Name -> IO UF.Variable nameToFlex name = UF.fresh <| makeDescriptor <| - Maybe.maybe UF.FlexVar UF.FlexSuper (toSuper name) (Just name) + Maybe.unwrap UF.FlexVar UF.FlexSuper (toSuper name) (Just name) nameToRigid : Name -> IO UF.Variable nameToRigid name = UF.fresh <| makeDescriptor <| - Maybe.maybe UF.RigidVar UF.RigidSuper (toSuper name) name + Maybe.unwrap UF.RigidVar UF.RigidSuper (toSuper name) name toSuper : Name -> Maybe UF.SuperType diff --git a/src/Data/Graph.elm b/src/Data/Graph.elm deleted file mode 100644 index 11761efd8..000000000 --- a/src/Data/Graph.elm +++ /dev/null @@ -1,626 +0,0 @@ -module Data.Graph exposing - ( Array - , Bounds - , Edge - , Graph - , SCC(..) - , Table - , Vertex - , buildG - , dff - , dfs - , edges - , flattenSCC - , flattenSCCs - , graphFromEdges - , graphFromEdges_ - , indegree - , outdegree - , scc - , stronglyConnComp - , stronglyConnCompR - , transposeG - , vertices - ) - -import Basics.Extra exposing (flip) -import Data.Map as Dict exposing (Dict) -import Set exposing (Set) -import Tree exposing (Tree) -import Utils.Main as Utils - - - -------------------------------------------------------------------------- --- - --- Arrays --- - -------------------------------------------------------------------------- - - -type Array i e - = Array Int Int (Dict Int e) - - -find : Int -> Array i e -> e -find i (Array _ _ arr) = - Utils.find i arr - - -bounds : Array i e -> ( Int, Int ) -bounds (Array l u _) = - ( l, u ) - - -indices : Array i e -> List Int -indices (Array l u _) = - List.repeat ((u + 1) - l) () - |> List.indexedMap (\i _ -> l + i) - - -assocs : Array i e -> List ( Int, e ) -assocs arr = - indices arr - |> List.map (\i -> ( i, find i arr )) - - -array : ( Int, Int ) -> List ( Int, e ) -> Array i e -array ( l, u ) = - List.filter (\( i, _ ) -> i >= l && i <= u + 1) - >> Dict.fromList compare - >> Array l u - - -accumArray : (e -> a -> e) -> e -> ( Int, Int ) -> List ( Int, a ) -> Array i e -accumArray f initial ( l, u ) ies = - let - initialArr : Dict Int e - initialArr = - List.repeat ((u + 1) - l) () - |> List.indexedMap (\i _ -> ( l + i, initial )) - |> Dict.fromList compare - in - List.foldl - (\( i, a ) acc -> - Dict.update compare i (Maybe.map (\v -> f v a)) acc - ) - initialArr - ies - |> Dict.toList - |> array ( l, u ) - - - -------------------------------------------------------------------------- --- - --- Strongly Connected Components --- - -------------------------------------------------------------------------- - - -{-| Strongly connected component. --} -type SCC vertex - = AcyclicSCC vertex - | CyclicSCC (List vertex) - - -{-| The vertices of a list of strongly connected components. --} -flattenSCCs : List (SCC a) -> List a -flattenSCCs = - List.concatMap flattenSCC - - -{-| The vertices of a strongly connected component. --} -flattenSCC : SCC vertex -> List vertex -flattenSCC component = - case component of - AcyclicSCC v -> - [ v ] - - CyclicSCC vs -> - vs - - -stronglyConnComp : List ( node, comparable, List comparable ) -> List (SCC node) -stronglyConnComp edges0 = - List.map - (\edge0 -> - case edge0 of - AcyclicSCC ( n, _, _ ) -> - AcyclicSCC n - - CyclicSCC triples -> - CyclicSCC (List.map (\( n, _, _ ) -> n) triples) - ) - (stronglyConnCompR edges0) - - -stronglyConnCompR : List ( node, comparable, List comparable ) -> List (SCC ( node, comparable, List comparable )) -stronglyConnCompR edges0 = - case edges0 of - [] -> - [] - - _ -> - let - ( graph, vertexFn, _ ) = - graphFromEdges edges0 - - forest : List (Tree Vertex) - forest = - scc graph - - decode : Tree Vertex -> SCC ( node, comparable, List comparable ) - decode tree = - let - v : Vertex - v = - Tree.label tree - in - case Tree.children tree of - [] -> - if mentionsItself v then - CyclicSCC [ vertexFn v ] - - else - AcyclicSCC (vertexFn v) - - ts -> - CyclicSCC (vertexFn v :: List.foldr dec [] ts) - - dec : Tree Vertex -> List ( node, comparable, List comparable ) -> List ( node, comparable, List comparable ) - dec node vs = - vertexFn (Tree.label node) :: List.foldr dec vs (Tree.children node) - - mentionsItself : Int -> Bool - mentionsItself v = - List.member v (find v graph) - in - List.map decode forest - - - -------------------------------------------------------------------------- --- - --- Graphs --- - -------------------------------------------------------------------------- - - -{-| Abstract representation of vertices. --} -type alias Vertex = - Int - - -{-| Table indexed by a contiguous set of vertices. --} -type alias Table a = - Array Vertex a - - -{-| Adjacency list representation of a graph, mapping each vertex to its -list of successors. --} -type alias Graph = - Array Vertex (List Vertex) - - -{-| The bounds of an @Array@. --} -type alias Bounds = - ( Vertex, Vertex ) - - -{-| An edge from the first vertex to the second. --} -type alias Edge = - ( Vertex, Vertex ) - - -{-| (O(V)). Returns the list of vertices in the graph. - -==== **Examples** - -> vertices (buildG (0,-1) []) == [] - -> vertices (buildG (0,2) [(0,1),(1,2)]) == [0,1,2] - --} -vertices : Graph -> List Vertex -vertices = - indices - - -{-| (O(V+E)). Returns the list of edges in the graph. - -==== **Examples** - -> edges (buildG (0,-1) []) == [] - -> edges (buildG (0,2) [(0,1),(1,2)]) == [(0,1),(1,2)] - --} -edges : Graph -> List Edge -edges g = - List.concatMap (\v -> List.map (Tuple.pair v) (find v g)) (vertices g) - - -{-| (O(V+E)). Build a graph from a list of edges. - -Warning: This function will cause a runtime exception if a vertex in the edge -list is not within the given @Bounds@. - -==== **Examples** - -> buildG (0,-1) [] == array (0,-1) [] -> buildG (0,2) [(0,1), (1,2)] == array (0,1) [(0,[1]),(1,[2])] -> buildG (0,2) [(0,1), (0,2), (1,2)] == array (0,2) [(0,[2,1]),(1,[2]),(2,[])] - --} -buildG : Bounds -> List Edge -> Graph -buildG = - accumArray (flip (::)) [] - - -{-| (O(V+E)). The graph obtained by reversing all edges. - -==== **Examples** - -> transposeG (buildG (0,2) [(0,1), (1,2)]) == array (0,2) [(0,[]),(1,[0]),(2,[1])] - --} -transposeG : Graph -> Graph -transposeG g = - buildG (bounds g) (reverseE g) - - -reverseE : Graph -> List Edge -reverseE g = - List.map (\( v, w ) -> ( w, v )) (edges g) - - -{-| (O(V+E)). A table of the count of edges from each node. - -==== **Examples** - -> outdegree (buildG (0,-1) []) == array (0,-1) [] - -> outdegree (buildG (0,2) [(0,1), (1,2)]) == array (0,2) [(0,1),(1,1),(2,0)] - --} -outdegree : Graph -> Array Vertex Int -outdegree (Array l u arr) = - -- This is bizarrely lazy. We build an array filled with thunks, instead - -- of actually calculating anything. This is the historical behavior, and I - -- suppose someone *could* be relying on it, but it might be worth finding - -- out. Note that we *can't* be so lazy with indegree. - Array l u (Dict.map (\_ -> List.length) arr) - - -{-| (O(V+E)). A table of the count of edges into each node. - -==== **Examples** - -> indegree (buildG (0,-1) []) == array (0,-1) [] - -> indegree (buildG (0,2) [(0,1), (1,2)]) == array (0,2) [(0,0),(1,1),(2,1)] - --} -indegree : Graph -> Array Vertex Int -indegree g = - accumArray (+) 0 (bounds g) <| - List.concatMap (\( _, outs ) -> List.map (\v -> ( v, 1 )) outs) (assocs g) - - -{-| (O((V+E) \\log V)). Identical to 'graphFromEdges', except that the return -value does not include the function which maps keys to vertices. This -version of 'graphFromEdges' is for backwards compatibility. --} -graphFromEdges_ : List ( node, comparable, List comparable ) -> ( Graph, Vertex -> ( node, comparable, List comparable ) ) -graphFromEdges_ x = - let - ( a, b, _ ) = - graphFromEdges x - in - ( a, b ) - - -{-| (O((V+E) \\log V)). Build a graph from a list of nodes uniquely identified -by keys, with a list of keys of nodes this node should have edges to. - -This function takes an adjacency list representing a graph with vertices of -type @key@ labeled by values of type @node@ and produces a @Graph@-based -representation of that list. The @Graph@ result represents the /shape/ of the -graph, and the functions describe a) how to retrieve the label and adjacent -vertices of a given vertex, and b) how to retrieve a vertex given a key. - -@(graph, nodeFromVertex, vertexFromKey) = graphFromEdges edgeList@ - - - @graph :: Graph@ is the raw, array based adjacency list for the graph. - - @nodeFromVertex :: Vertex -> (node, key, [key])@ returns the node - associated with the given 0-based @Int@ vertex; see /warning/ below. This - runs in (O(1)) time. - - @vertexFromKey :: key -> Maybe Vertex@ returns the @Int@ vertex for the - key if it exists in the graph, @Nothing@ otherwise. This runs in - (O(\\log V)) time. - -To safely use this API you must either extract the list of vertices directly -from the graph or first call @vertexFromKey k@ to check if a vertex -corresponds to the key @k@. Once it is known that a vertex exists you can use -@nodeFromVertex@ to access the labelled node and adjacent vertices. See below -for examples. - -Note: The out-list may contain keys that don't correspond to nodes of the -graph; they are ignored. - -Warning: The @nodeFromVertex@ function will cause a runtime exception if the -given @Vertex@ does not exist. - -==== **Examples** - -An empty graph. - -> (graph, nodeFromVertex, vertexFromKey) = graphFromEdges [] -> graph = array (0,-1) [] - -A graph where the out-list references unspecified nodes (@'c'@), these are -ignored. - -> (graph, _, _) = graphFromEdges [("a", 'a', ['b']), ("b", 'b', ['c'])] -> array (0,1) [(0,[1]),(1,[])] - -A graph with 3 vertices: ("a") -> ("b") -> ("c") - -> (graph, nodeFromVertex, vertexFromKey) = graphFromEdges [("a", 'a', ['b']), ("b", 'b', ['c']), ("c", 'c', [])] -> graph == array (0,2) [(0,[1]),(1,[2]),(2,[])] -> nodeFromVertex 0 == ("a",'a',"b") -> vertexFromKey 'a' == Just 0 - -Get the label for a given key. - -> let getNodePart (n, _, _) = n -> (graph, nodeFromVertex, vertexFromKey) = graphFromEdges [("a", 'a', ['b']), ("b", 'b', ['c']), ("c", 'c', [])] -> getNodePart . nodeFromVertex <$> vertexFromKey 'a' == Just "A" - --} -graphFromEdges : List ( node, comparable, List comparable ) -> ( Graph, Vertex -> ( node, comparable, List comparable ), comparable -> Maybe Vertex ) -graphFromEdges edges0 = - let - maxV : Int - maxV = - List.length edges0 - 1 - - bounds0 : ( number, Int ) - bounds0 = - ( 0, maxV ) - - sortedEdges : List ( node, comparable, List comparable ) - sortedEdges = - List.sortWith (\( _, k1, _ ) ( _, k2, _ ) -> compare k1 k2) edges0 - - edges1 : List ( Int, ( node, comparable, List comparable ) ) - edges1 = - List.map2 Tuple.pair - (List.indexedMap (\i _ -> i) (List.repeat (List.length sortedEdges) ())) - sortedEdges - - graph : Array i (List Int) - graph = - edges1 - |> List.map (\( v, ( _, _, ks ) ) -> ( v, List.filterMap keyVertex ks )) - |> array bounds0 - - keyMap : Array i comparable - keyMap = - edges1 - |> List.map (\( v, ( _, k, _ ) ) -> ( v, k )) - |> array bounds0 - - vertexMap : Array i ( node, comparable, List comparable ) - vertexMap = - array bounds0 edges1 - - keyVertex : comparable -> Maybe Int - keyVertex k = - let - findVertex : Int -> Int -> Maybe Int - findVertex a b = - if a > b then - Nothing - - else - let - mid : Int - mid = - a + (b - a) // 2 - in - case compare k (find mid keyMap) of - LT -> - findVertex a (mid - 1) - - EQ -> - Just mid - - GT -> - findVertex (mid + 1) b - in - findVertex 0 maxV - in - ( graph, \v -> find v vertexMap, keyVertex ) - - - -------------------------------------------------------------------------- --- - --- Depth first search --- - -------------------------------------------------------------------------- - - -{-| (O(V+E)). A spanning forest of the graph, obtained from a depth-first -search of the graph starting from each vertex in an unspecified order. --} -dff : Graph -> List (Tree Vertex) -dff g = - dfs g (vertices g) - - -{-| (O(V+E)). A spanning forest of the part of the graph reachable from the -listed vertices, obtained from a depth-first search of the graph starting at -each of the listed vertices in order. - -This function deviates from King and Launchbury's implementation by -bundling together the functions generate, prune, and chop for efficiency -reasons. - --} -dfs : Graph -> List Vertex -> List (Tree Vertex) -dfs g vs0 = - let - go : List Vertex -> SetM s (List (Tree Vertex)) - go vrtcs = - case vrtcs of - [] -> - pure [] - - v :: vs -> - contains v - |> bind - (\visited -> - if visited then - go vs - - else - include v - |> bind - (\_ -> - go (find v g) - |> bind - (\subForest -> - go vs - |> bind - (\bs -> - pure (Tree.tree v subForest :: bs) - ) - ) - ) - ) - in - run (bounds g) (go vs0) - - - --- #else /* !USE_ST_MONAD */ - - -{-| Portable implementation using IntSet. --} -type alias IntSet = - Set Int - - -type SetM s a - = SetM (IntSet -> ( a, IntSet )) - - -bind : (a -> SetM s b) -> SetM s a -> SetM s b -bind f (SetM v) = - SetM - (\s -> - let - ( x, s_ ) = - v s - in - case f x of - SetM v_ -> - v_ s_ - ) - - -fmap : (a -> b) -> SetM s a -> SetM s b -fmap f (SetM v) = - SetM - (\s -> - let - ( x, s_ ) = - v s - in - ( f x, s_ ) - ) - - -pure : a -> SetM s a -pure x = - SetM (\s -> ( x, s )) - - -apply : SetM s (a -> b) -> SetM s a -> SetM s b -apply (SetM f) (SetM v) = - SetM - (\s -> - let - ( k, s_ ) = - f s - - ( x, s__ ) = - v s_ - in - ( k x, s__ ) - ) - - -run : Bounds -> SetM s a -> a -run _ (SetM act) = - Tuple.first (act Set.empty) - - -contains : Vertex -> SetM s Bool -contains v = - SetM (\m -> ( Set.member v m, m )) - - -include : Vertex -> SetM s () -include v = - SetM (\m -> ( (), Set.insert v m )) - - - -------------------------------------------------------------------------- --- - --- Algorithms --- - -------------------------------------------------------------------------- --- ------------------------------------------------------------- --- Algorithm 2: topological sorting ------------------------------------------------------------- - - -postorder : Tree a -> List a -> List a -postorder node = - postorderF (Tree.children node) << (::) (Tree.label node) - - -postorderF : List (Tree a) -> List a -> List a -postorderF ts = - List.foldr (<<) identity <| List.map postorder ts - - -postOrd : Graph -> List Vertex -postOrd g = - postorderF (dff g) [] - - - ------------------------------------------------------------- --- Algorithm 3: connected components ------------------------------------------------------------- - - -scc : Graph -> List (Tree Vertex) -scc g = - dfs g (List.reverse (postOrd (transposeG g))) diff --git a/src/Data/IO.elm b/src/Data/IO.elm index 7a99d57e0..240954d28 100644 --- a/src/Data/IO.elm +++ b/src/Data/IO.elm @@ -5,8 +5,6 @@ module Data.IO exposing , ExitCode(..) , Handle(..) , IO(..) - , IOError - , IOException(..) , IOMode(..) , IORef(..) , Process(..) @@ -594,22 +592,6 @@ type IOMode --- IOError - - -type alias IOError = - IOException - - - --- IOException - - -type IOException - = IOException - - - -- ExitCode diff --git a/src/Data/Maybe.elm b/src/Data/Maybe.elm deleted file mode 100644 index 60d462b96..000000000 --- a/src/Data/Maybe.elm +++ /dev/null @@ -1,7 +0,0 @@ -module Data.Maybe exposing (maybe) - - -maybe : b -> (a -> b) -> Maybe a -> b -maybe defaultValue f = - Maybe.map f - >> Maybe.withDefault defaultValue diff --git a/src/Terminal/Bump.elm b/src/Terminal/Bump.elm index ca623e203..ab4766023 100644 --- a/src/Terminal/Bump.elm +++ b/src/Terminal/Bump.elm @@ -128,7 +128,7 @@ checkNewPackage root ((Outline.PkgOutline _ _ _ version _ _ _ _) as outline) = suggestVersion : Env -> Task.Task Exit.Bump () suggestVersion (Env root cache manager _ ((Outline.PkgOutline pkg _ _ vsn _ _ _ _) as outline)) = - Task.eio (Exit.BumpCannotFindDocs pkg vsn) (Diff.getDocs cache manager pkg vsn) + Task.eio (Exit.BumpCannotFindDocs vsn) (Diff.getDocs cache manager pkg vsn) |> Task.bind (\oldDocs -> generateDocs root outline diff --git a/src/Terminal/Diff.elm b/src/Terminal/Diff.elm index 4e6ec699a..189fa6526 100644 --- a/src/Terminal/Diff.elm +++ b/src/Terminal/Diff.elm @@ -149,7 +149,7 @@ getDocs (Env _ cache manager _) name (Registry.KnownVersions latest previous) ve Task.eio (Exit.DiffDocsProblem version) <| DD.getDocs cache manager name version else - Task.throw <| Exit.DiffUnknownVersion name version (latest :: previous) + Task.throw <| Exit.DiffUnknownVersion version (latest :: previous) getLatestDocs : Env -> Pkg.Name -> Registry.KnownVersions -> Task Docs.Documentation diff --git a/src/Terminal/Make.elm b/src/Terminal/Make.elm index 6a6e0e0ef..5f12f6aae 100644 --- a/src/Terminal/Make.elm +++ b/src/Terminal/Make.elm @@ -25,7 +25,6 @@ import Compiler.Data.NonEmptyList as NE import Compiler.Elm.ModuleName as ModuleName import Compiler.Generate.Html as Html import Data.IO as IO exposing (IO) -import Data.Maybe as Maybe import Json.Decode as Decode import Json.Encode as Encode import Maybe.Extra as Maybe @@ -205,7 +204,7 @@ buildExposed style root details maybeDocs exposed = let docsGoal : Build.DocsGoal () docsGoal = - Maybe.maybe Build.ignoreDocs Build.writeDocs maybeDocs + Maybe.unwrap 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/Terminal/Chomp.elm b/src/Terminal/Terminal/Chomp.elm index 37682b749..faf3bb835 100644 --- a/src/Terminal/Terminal/Chomp.elm +++ b/src/Terminal/Terminal/Chomp.elm @@ -17,7 +17,7 @@ module Terminal.Terminal.Chomp exposing import Basics.Extra exposing (flip) import Data.IO as IO exposing (IO) -import Data.Maybe as Maybe +import Maybe.Extra as Maybe import Terminal.Terminal.Internal exposing (ArgError(..), Error(..), Expectation(..), Flag(..), FlagError(..), Flags(..), Parser(..)) @@ -92,7 +92,7 @@ makeSuggestion suggest maybeUpdate = suggest Suggest index -> - Maybe.maybe suggest Suggestions (maybeUpdate index) + Maybe.unwrap suggest Suggestions (maybeUpdate index) diff --git a/src/Utils/Main.elm b/src/Utils/Main.elm index e5c453973..0c4c74ca3 100644 --- a/src/Utils/Main.elm +++ b/src/Utils/Main.elm @@ -3,7 +3,10 @@ module Utils.Main exposing , ChItem , Chan , FilePath - , HTTPResponse(..) + , HttpExceptionContent(..) + , HttpResponse(..) + , HttpResponseHeaders + , HttpStatus(..) , LockSharedExclusive(..) , MVar(..) , ReplCompletion(..) @@ -58,8 +61,12 @@ module Utils.Main exposing , fpTakeExtension , fpTakeFileName , fromException - , httpResponseDecoder - , httpResponseEncoder + , httpExceptionContentDecoder + , httpExceptionContentEncoder + , httpHLocation + , httpResponseHeaders + , httpResponseStatus + , httpStatusCode , indexedForA , indexedTraverse , indexedZipWithA @@ -122,6 +129,7 @@ module Utils.Main exposing , sequenceDictResult_ , sequenceListMaybe , sequenceNonemptyListResult + , shaAndArchiveDecoder , someExceptionDecoder , someExceptionEncoder , stateGet @@ -133,7 +141,6 @@ module Utils.Main exposing , unlines , unzip3 , writeChan - , zipArchiveDecoder , zipERelativePath , zipFromEntry , zipWithM @@ -144,6 +151,8 @@ import Basics.Extra exposing (flip) import Builder.Reporting.Task as Task exposing (Task) import Compiler.Data.Index as Index import Compiler.Data.NonEmptyList as NE +import Compiler.Json.Decode as D +import Compiler.Json.Encode as E import Compiler.Reporting.Result as R import Data.IO as IO exposing (IO(..)) import Data.Map as Dict exposing (Dict) @@ -944,6 +953,13 @@ zipArchiveDecoder = Decode.map ZipArchive (Decode.list zipEntryDecoder) +shaAndArchiveDecoder : Decode.Decoder ( String, ZipArchive ) +shaAndArchiveDecoder = + Decode.map2 Tuple.pair + (Decode.field "sha" Decode.string) + (Decode.field "archive" zipArchiveDecoder) + + zipEntryDecoder : Decode.Decoder ZipEntry zipEntryDecoder = Decode.map2 @@ -958,11 +974,48 @@ zipEntryDecoder = --- Network.HTTP.Client.Types +-- Network.HTTP.Client + + +type HttpExceptionContent + = StatusCodeException (HttpResponse ()) String + | TooManyRedirects (List (HttpResponse ())) + | ConnectionFailure SomeException + + +type HttpResponse body + = HttpResponse + { responseStatus : HttpStatus + , responseHeaders : HttpResponseHeaders + } + + +type alias HttpResponseHeaders = + List ( String, String ) + + +httpResponseStatus : HttpResponse body -> HttpStatus +httpResponseStatus (HttpResponse { responseStatus }) = + responseStatus -type HTTPResponse body - = HTTPResponse +httpStatusCode : HttpStatus -> Int +httpStatusCode (HttpStatus statusCode _) = + statusCode + + +httpResponseHeaders : HttpResponse body -> HttpResponseHeaders +httpResponseHeaders (HttpResponse { responseHeaders }) = + responseHeaders + + +httpHLocation : String +httpHLocation = + "Location" + + +type HttpStatus + = HttpStatus Int String @@ -1290,11 +1343,94 @@ someExceptionDecoder = Decode.succeed SomeException -httpResponseEncoder : HTTPResponse a -> Encode.Value -httpResponseEncoder _ = - Encode.object [ ( "type", Encode.string "HTTPResponse" ) ] +httpResponseEncoder : HttpResponse body -> Encode.Value +httpResponseEncoder (HttpResponse httpResponse) = + Encode.object + [ ( "type", Encode.string "HttpResponse" ) + , ( "responseStatus", httpStatusEncoder httpResponse.responseStatus ) + , ( "responseHeaders", httpResponseHeadersEncoder httpResponse.responseHeaders ) + ] -httpResponseDecoder : Decode.Decoder (HTTPResponse a) +httpResponseDecoder : Decode.Decoder (HttpResponse body) httpResponseDecoder = - Decode.succeed HTTPResponse + Decode.map2 + (\responseStatus responseHeaders -> + HttpResponse + { responseStatus = responseStatus + , responseHeaders = responseHeaders + } + ) + (Decode.field "responseStatus" httpStatusDecoder) + (Decode.field "responseHeaders" httpResponseHeadersDecoder) + + +httpStatusEncoder : HttpStatus -> Encode.Value +httpStatusEncoder (HttpStatus statusCode statusMessage) = + Encode.object + [ ( "type", Encode.string "HttpStatus" ) + , ( "statusCode", Encode.int statusCode ) + , ( "statusMessage", Encode.string statusMessage ) + ] + + +httpStatusDecoder : Decode.Decoder HttpStatus +httpStatusDecoder = + Decode.map2 HttpStatus + (Decode.field "statusCode" Decode.int) + (Decode.field "statusMessage" Decode.string) + + +httpResponseHeadersEncoder : HttpResponseHeaders -> Encode.Value +httpResponseHeadersEncoder = + Encode.list (E.jsonPair Encode.string Encode.string) + + +httpResponseHeadersDecoder : Decode.Decoder HttpResponseHeaders +httpResponseHeadersDecoder = + Decode.list (D.jsonPair Decode.string Decode.string) + + +httpExceptionContentEncoder : HttpExceptionContent -> Encode.Value +httpExceptionContentEncoder httpExceptionContent = + case httpExceptionContent of + StatusCodeException response body -> + Encode.object + [ ( "type", Encode.string "StatusCodeException" ) + , ( "response", httpResponseEncoder response ) + , ( "body", Encode.string body ) + ] + + TooManyRedirects responses -> + Encode.object + [ ( "type", Encode.string "TooManyRedirects" ) + , ( "responses", Encode.list httpResponseEncoder responses ) + ] + + ConnectionFailure someException -> + Encode.object + [ ( "type", Encode.string "ConnectionFailure" ) + , ( "someException", someExceptionEncoder someException ) + ] + + +httpExceptionContentDecoder : Decode.Decoder HttpExceptionContent +httpExceptionContentDecoder = + Decode.field "type" Decode.string + |> Decode.andThen + (\type_ -> + case type_ of + "StatusCodeException" -> + Decode.map2 StatusCodeException + (Decode.field "response" httpResponseDecoder) + (Decode.field "body" Decode.string) + + "TooManyRedirects" -> + Decode.map TooManyRedirects (Decode.field "responses" (Decode.list httpResponseDecoder)) + + "ConnectionFailure" -> + Decode.map ConnectionFailure (Decode.field "someException" someExceptionDecoder) + + _ -> + Decode.fail ("Failed to decode HttpExceptionContent's type: " ++ type_) + )