elm-pages 2.1.6 → 2.1.10

package/src/Pages/StaticHttpRequest.elm

@@ -0,0 +1,320 @@
+module Pages.StaticHttpRequest exposing (Error(..), RawRequest(..), Status(..), WhatToDo(..), cacheRequestResolution, merge, resolve, resolveUrls, strippedResponsesEncode, toBuildError)
+
+import BuildError exposing (BuildError)
+import Dict exposing (Dict)
+import Internal.OptimizedDecoder
+import Json.Decode.Exploration
+import Json.Encode
+import KeepOrDiscard exposing (KeepOrDiscard)
+import List.Extra
+import OptimizedDecoder
+import Pages.Internal.ApplicationType exposing (ApplicationType)
+import Pages.StaticHttp.Request
+import RequestsAndPending exposing (RequestsAndPending)
+import Secrets
+import TerminalText as Terminal
+
+
+type RawRequest value
+    = Request (Dict String WhatToDo) ( List (Secrets.Value Pages.StaticHttp.Request.Request), KeepOrDiscard -> ApplicationType -> RequestsAndPending -> RawRequest value )
+    | RequestError Error
+    | ApiRoute (Dict String WhatToDo) value
+
+
+type WhatToDo
+    = UseRawResponse
+    | CliOnly
+    | StripResponse (OptimizedDecoder.Decoder ())
+    | DistilledResponse Json.Encode.Value
+    | Error (List BuildError)
+
+
+merge : String -> WhatToDo -> WhatToDo -> WhatToDo
+merge key whatToDo1 whatToDo2 =
+    case ( whatToDo1, whatToDo2 ) of
+        ( Error buildErrors1, Error buildErrors2 ) ->
+            Error (buildErrors1 ++ buildErrors2)
+
+        ( Error buildErrors1, _ ) ->
+            Error buildErrors1
+
+        ( _, Error buildErrors1 ) ->
+            Error buildErrors1
+
+        ( StripResponse strip1, StripResponse strip2 ) ->
+            StripResponse (OptimizedDecoder.map2 (\_ _ -> ()) strip1 strip2)
+
+        ( StripResponse strip1, _ ) ->
+            StripResponse strip1
+
+        ( _, StripResponse strip1 ) ->
+            StripResponse strip1
+
+        ( _, CliOnly ) ->
+            whatToDo1
+
+        ( CliOnly, _ ) ->
+            whatToDo2
+
+        ( DistilledResponse distilled1, DistilledResponse distilled2 ) ->
+            if Json.Encode.encode 0 distilled1 == Json.Encode.encode 0 distilled2 then
+                DistilledResponse distilled1
+
+            else
+                Error
+                    [ { title = "Non-Unique Distill Keys"
+                      , message =
+                            [ Terminal.text "I encountered DataSource.distill with two matching keys that had differing encoded values.\n\n"
+                            , Terminal.text "Look for "
+                            , Terminal.red <| "DataSource.distill"
+                            , Terminal.text " with the key "
+                            , Terminal.red <| ("\"" ++ key ++ "\"")
+                            , Terminal.text "\n\n"
+                            , Terminal.yellow <| "The first encoded value was:\n"
+                            , Terminal.text <| Json.Encode.encode 2 distilled1
+                            , Terminal.text "\n\n-------------------------------\n\n"
+                            , Terminal.yellow <| "The second encoded value was:\n"
+                            , Terminal.text <| Json.Encode.encode 2 distilled2
+                            ]
+                      , path = "" -- TODO wire in path here?
+                      , fatal = True
+                      }
+                    ]
+
+        ( DistilledResponse distilled1, _ ) ->
+            DistilledResponse distilled1
+
+        ( _, DistilledResponse distilled1 ) ->
+            DistilledResponse distilled1
+
+        ( UseRawResponse, UseRawResponse ) ->
+            UseRawResponse
+
+
+strippedResponses : ApplicationType -> RawRequest value -> RequestsAndPending -> Dict String WhatToDo
+strippedResponses =
+    strippedResponsesHelp Dict.empty
+
+
+strippedResponsesEncode : ApplicationType -> RawRequest value -> RequestsAndPending -> Result (List BuildError) (Dict String String)
+strippedResponsesEncode appType rawRequest requestsAndPending =
+    strippedResponses appType rawRequest requestsAndPending
+        |> Dict.toList
+        |> List.map
+            (\( k, whatToDo ) ->
+                (case whatToDo of
+                    UseRawResponse ->
+                        Dict.get k requestsAndPending
+                            |> Maybe.withDefault Nothing
+                            |> Maybe.withDefault ""
+                            |> Just
+                            |> Ok
+
+                    StripResponse decoder ->
+                        Dict.get k requestsAndPending
+                            |> Maybe.withDefault Nothing
+                            |> Maybe.withDefault ""
+                            |> Json.Decode.Exploration.stripString (Internal.OptimizedDecoder.jde decoder)
+                            |> Result.withDefault "ERROR"
+                            |> Just
+                            |> Ok
+
+                    CliOnly ->
+                        Nothing
+                            |> Ok
+
+                    DistilledResponse value ->
+                        value
+                            |> Json.Encode.encode 0
+                            |> Just
+                            |> Ok
+
+                    Error buildError ->
+                        Err buildError
+                )
+                    |> Result.map (Maybe.map (Tuple.pair k))
+            )
+        |> combineMultipleErrors
+        |> Result.map (List.filterMap identity)
+        |> Result.map Dict.fromList
+
+
+combineMultipleErrors : List (Result (List error) a) -> Result (List error) (List a)
+combineMultipleErrors results =
+    List.foldr
+        (\result soFarResult ->
+            case soFarResult of
+                Ok soFarOk ->
+                    case result of
+                        Ok value ->
+                            value :: soFarOk |> Ok
+
+                        Err error_ ->
+                            Err error_
+
+                Err errorsSoFar ->
+                    case result of
+                        Ok _ ->
+                            Err errorsSoFar
+
+                        Err error_ ->
+                            Err <| error_ ++ errorsSoFar
+        )
+        (Ok [])
+        results
+
+
+strippedResponsesHelp : Dict String WhatToDo -> ApplicationType -> RawRequest value -> RequestsAndPending -> Dict String WhatToDo
+strippedResponsesHelp usedSoFar appType request rawResponses =
+    case request of
+        RequestError _ ->
+            usedSoFar
+
+        Request partiallyStrippedResponses ( _, lookupFn ) ->
+            case lookupFn KeepOrDiscard.Keep appType rawResponses of
+                followupRequest ->
+                    strippedResponsesHelp
+                        (Dict.merge
+                            (\key a -> Dict.insert key a)
+                            (\key a b -> Dict.insert key (merge key a b))
+                            (\key b -> Dict.insert key b)
+                            usedSoFar
+                            partiallyStrippedResponses
+                            Dict.empty
+                        )
+                        appType
+                        followupRequest
+                        rawResponses
+
+        ApiRoute partiallyStrippedResponses _ ->
+            Dict.merge
+                (\key a -> Dict.insert key a)
+                (\key a b -> Dict.insert key (merge key a b))
+                (\key b -> Dict.insert key b)
+                usedSoFar
+                partiallyStrippedResponses
+                Dict.empty
+
+
+type Error
+    = MissingHttpResponse String (List (Secrets.Value Pages.StaticHttp.Request.Request))
+    | DecoderError String
+    | UserCalledStaticHttpFail String
+
+
+toBuildError : String -> Error -> BuildError
+toBuildError path error =
+    case error of
+        MissingHttpResponse missingKey _ ->
+            { title = "Missing Http Response"
+            , message =
+                [ Terminal.text missingKey
+                ]
+            , path = path
+            , fatal = True
+            }
+
+        DecoderError decodeErrorMessage ->
+            { title = "Static Http Decoding Error"
+            , message =
+                [ Terminal.text decodeErrorMessage
+                ]
+            , path = path
+            , fatal = True
+            }
+
+        UserCalledStaticHttpFail decodeErrorMessage ->
+            { title = "Called Static Http Fail"
+            , message =
+                [ Terminal.text <| "I ran into a call to `DataSource.fail` with message: " ++ decodeErrorMessage
+                ]
+            , path = path
+            , fatal = True
+            }
+
+
+resolve : ApplicationType -> RawRequest value -> RequestsAndPending -> Result Error value
+resolve appType request rawResponses =
+    case request of
+        RequestError error ->
+            Err error
+
+        Request _ ( _, lookupFn ) ->
+            case lookupFn KeepOrDiscard.Keep appType rawResponses of
+                nextRequest ->
+                    resolve appType nextRequest rawResponses
+
+        ApiRoute _ value ->
+            Ok value
+
+
+resolveUrls : ApplicationType -> RawRequest value -> RequestsAndPending -> List (Secrets.Value Pages.StaticHttp.Request.Request)
+resolveUrls appType request rawResponses =
+    resolveUrlsHelp appType rawResponses [] request
+
+
+resolveUrlsHelp : ApplicationType -> RequestsAndPending -> List (Secrets.Value Pages.StaticHttp.Request.Request) -> RawRequest value -> List (Secrets.Value Pages.StaticHttp.Request.Request)
+resolveUrlsHelp appType rawResponses soFar request =
+    case request of
+        RequestError error ->
+            case error of
+                MissingHttpResponse _ next ->
+                    (soFar ++ next)
+                        |> List.Extra.uniqueBy (Secrets.maskedLookup >> Pages.StaticHttp.Request.hash)
+
+                _ ->
+                    soFar
+
+        Request _ ( urlList, lookupFn ) ->
+            resolveUrlsHelp appType
+                rawResponses
+                (soFar ++ urlList)
+                (lookupFn KeepOrDiscard.Keep appType rawResponses)
+
+        ApiRoute _ _ ->
+            soFar
+
+
+cacheRequestResolution :
+    ApplicationType
+    -> RawRequest value
+    -> RequestsAndPending
+    -> Status value
+cacheRequestResolution appType request rawResponses =
+    cacheRequestResolutionHelp [] appType rawResponses request
+
+
+type Status value
+    = Incomplete (List (Secrets.Value Pages.StaticHttp.Request.Request))
+    | HasPermanentError Error
+    | Complete
+
+
+cacheRequestResolutionHelp :
+    List (Secrets.Value Pages.StaticHttp.Request.Request)
+    -> ApplicationType
+    -> RequestsAndPending
+    -> RawRequest value
+    -> Status value
+cacheRequestResolutionHelp foundUrls appType rawResponses request =
+    case request of
+        RequestError error ->
+            case error of
+                MissingHttpResponse _ _ ->
+                    -- TODO do I need to pass through continuation URLs here? -- Incomplete (urlList ++ foundUrls)
+                    Incomplete foundUrls
+
+                DecoderError _ ->
+                    HasPermanentError error
+
+                UserCalledStaticHttpFail _ ->
+                    HasPermanentError error
+
+        Request _ ( urlList, lookupFn ) ->
+            cacheRequestResolutionHelp urlList
+                appType
+                rawResponses
+                (lookupFn KeepOrDiscard.Keep appType rawResponses)
+
+        ApiRoute _ _ ->
+            Complete

package/src/Pages/Url.elm

@@ -0,0 +1,60 @@
+module Pages.Url exposing (Url, external, fromPath, toAbsoluteUrl, toString)
+
+{-| Some of the `elm-pages` APIs will take internal URLs and ensure that they have the `canonicalSiteUrl` prepended.
+
+That's the purpose for this type. If you have an external URL, like `Pages.Url.external "https://google.com"`,
+then the canonicalUrl will not be prepended when it is used in a head tag.
+
+If you refer to a local page, like `Route.Index |> Route.toPath |> Pages.Url.fromPath`, or `Pages.Url.fromPath`
+
+@docs Url, external, fromPath, toAbsoluteUrl, toString
+
+-}
+
+import Pages.Internal.String as String
+import Path exposing (Path)
+
+
+{-| -}
+type Url
+    = Internal String
+    | External String
+
+
+{-| -}
+fromPath : Path -> Url
+fromPath path =
+    path |> Path.toAbsolute |> Internal
+
+
+{-| -}
+external : String -> Url
+external externalUrl =
+    External externalUrl
+
+
+{-| -}
+toString : Url -> String
+toString path =
+    case path of
+        Internal rawPath ->
+            rawPath
+
+        External url ->
+            url
+
+
+{-| -}
+toAbsoluteUrl : String -> Url -> String
+toAbsoluteUrl canonicalSiteUrl url =
+    case url of
+        External externalUrl ->
+            externalUrl
+
+        Internal internalUrl ->
+            join canonicalSiteUrl internalUrl
+
+
+join : String -> String -> String
+join base path =
+    String.chopEnd "/" base ++ "/" ++ String.chopStart "/" path

package/src/Path.elm

@@ -0,0 +1,96 @@
+module Path exposing
+    ( Path, join, fromString
+    , toAbsolute, toRelative, toSegments
+    )
+
+{-| Represents the path portion of a URL (not query parameters, fragment, protocol, port, etc.).
+
+This helper lets you combine together path parts without worrying about having too many or too few slashes.
+These two examples will result in the same URL, even though the first example has trailing and leading slashes, and the
+second does not.
+
+    Path.join [ "/blog/", "/post-1/" ]
+        |> Path.toAbsolute
+    --> "/blog/post-1"
+
+    Path.join [ "blog", "post-1" ]
+        |> Path.toAbsolute
+    --> "/blog/post-1"
+
+We can also safely join Strings that include multiple path parts, a single path part per string, or a mix of the two:
+
+    Path.join [ "/articles/archive/", "1977", "06", "10", "post-1" ]
+        |> Path.toAbsolute
+    --> "/articles/archive/1977/06/10/post-1"
+
+
+## Creating Paths
+
+@docs Path, join, fromString
+
+
+## Turning Paths to String
+
+@docs toAbsolute, toRelative, toSegments
+
+-}
+
+import Pages.Internal.String exposing (chopEnd, chopStart)
+
+
+{-| The path portion of the URL, normalized to ensure that path segments are joined with `/`s in the right places (no doubled up or missing slashes).
+-}
+type Path
+    = Path String
+
+
+{-| Create a Path from multiple path parts. Each part can either be a single path segment, like `blog`, or a
+multi-part path part, like `blog/post-1`.
+-}
+join : List String -> Path
+join parts =
+    parts
+        |> List.map normalize
+        |> String.join "/"
+        |> Path
+
+
+{-| Create a Path from a path String.
+
+    Path.fromString "blog/post-1/"
+        |> Path.toAbsolute
+        |> Expect.equal "/blog/post-1"
+
+-}
+fromString : String -> Path
+fromString path =
+    path
+        |> normalize
+        |> Path
+
+
+{-| -}
+toSegments : Path -> List String
+toSegments (Path path) =
+    path |> String.split "/" |> List.filter ((/=) "")
+
+
+{-| Turn a Path to an absolute URL (with no trailing slash).
+-}
+toAbsolute : Path -> String
+toAbsolute (Path path) =
+    "/" ++ path
+
+
+{-| Turn a Path to a relative URL.
+-}
+toRelative : Path -> String
+toRelative (Path path) =
+    path
+
+
+normalize : String -> String
+normalize pathPart =
+    pathPart
+        |> chopEnd "/"
+        |> chopStart "/"

package/src/QueryParams.elm

@@ -0,0 +1,216 @@
+module QueryParams exposing
+    ( QueryParams
+    , Parser
+    , andThen, fail, fromResult, fromString, optionalString, parse, string, strings, succeed
+    , map2, oneOf
+    , toDict, toString
+    )
+
+{-| Represents the query portion of a URL. You can use `toDict` or `toString` to turn it into basic types, or you can
+parse it into a custom type using the other functions in this module.
+
+@docs QueryParams
+
+
+## Parsing
+
+@docs Parser
+
+@docs andThen, fail, fromResult, fromString, optionalString, parse, string, strings, succeed
+
+
+## Combining
+
+@docs map2, oneOf
+
+
+## Accessing as Built-In Types
+
+@docs toDict, toString
+
+-}
+
+import Dict exposing (Dict)
+import Url
+
+
+{-| -}
+type QueryParams
+    = QueryParams String
+
+
+{-| -}
+type Parser a
+    = Parser (Dict String (List String) -> Result String a)
+
+
+{-| -}
+succeed : a -> Parser a
+succeed value =
+    Parser (\_ -> Ok value)
+
+
+{-| -}
+fail : String -> Parser a
+fail errorMessage =
+    Parser (\_ -> Err errorMessage)
+
+
+{-| -}
+fromResult : Result String a -> Parser a
+fromResult result =
+    Parser (\_ -> result)
+
+
+{-| -}
+andThen : (a -> Parser b) -> Parser a -> Parser b
+andThen andThenFn (Parser parser) =
+    Parser
+        (\dict ->
+            case Result.map andThenFn (parser dict) of
+                Ok (Parser result) ->
+                    result dict
+
+                Err error ->
+                    Err error
+        )
+
+
+{-| -}
+oneOf : List (Parser a) -> Parser a
+oneOf parsers =
+    Parser
+        (tryParser parsers)
+
+
+{-| -}
+tryParser : List (Parser a) -> Dict String (List String) -> Result String a
+tryParser parsers dict =
+    case parsers of
+        [] ->
+            Err ""
+
+        (Parser nextParser) :: otherParsers ->
+            case nextParser dict of
+                Ok okValue ->
+                    Ok okValue
+
+                Err _ ->
+                    tryParser otherParsers dict
+
+
+{-| -}
+map2 : (a -> b -> combined) -> Parser a -> Parser b -> Parser combined
+map2 func (Parser a) (Parser b) =
+    Parser <|
+        \dict ->
+            Result.map2 func (a dict) (b dict)
+
+
+{-| -}
+optionalString : String -> Parser (Maybe String)
+optionalString key =
+    custom key
+        (\stringList ->
+            case stringList of
+                str :: _ ->
+                    Ok (Just str)
+
+                _ ->
+                    Ok Nothing
+        )
+
+
+{-| -}
+string : String -> Parser String
+string key =
+    custom key
+        (\stringList ->
+            case stringList of
+                [ str ] ->
+                    Ok str
+
+                _ ->
+                    Err ("Missing key " ++ key)
+        )
+
+
+{-| -}
+custom : String -> (List String -> Result String a) -> Parser a
+custom key customFn =
+    Parser <|
+        \dict ->
+            customFn (Maybe.withDefault [] (Dict.get key dict))
+
+
+{-| -}
+strings : String -> Parser (List String)
+strings key =
+    custom key
+        (\stringList -> Ok stringList)
+
+
+{-| -}
+fromString : String -> QueryParams
+fromString =
+    QueryParams
+
+
+{-| -}
+toString : QueryParams -> String
+toString (QueryParams queryParams) =
+    queryParams
+
+
+{-| -}
+parse : Parser a -> QueryParams -> Result String a
+parse (Parser queryParser) queryParams =
+    queryParams
+        |> toDict
+        |> queryParser
+
+
+{-| -}
+toDict : QueryParams -> Dict String (List String)
+toDict (QueryParams queryParams) =
+    prepareQuery (Just queryParams)
+
+
+prepareQuery : Maybe String -> Dict String (List String)
+prepareQuery maybeQuery =
+    case maybeQuery of
+        Nothing ->
+            Dict.empty
+
+        Just qry ->
+            List.foldr addParam Dict.empty (String.split "&" qry)
+
+
+addParam : String -> Dict String (List String) -> Dict String (List String)
+addParam segment dict =
+    case String.split "=" segment of
+        [ rawKey, rawValue ] ->
+            case Url.percentDecode rawKey of
+                Nothing ->
+                    dict
+
+                Just key ->
+                    case Url.percentDecode rawValue of
+                        Nothing ->
+                            dict
+
+                        Just value ->
+                            Dict.update key (addToParametersHelp value) dict
+
+        _ ->
+            dict
+
+
+addToParametersHelp : a -> Maybe (List a) -> Maybe (List a)
+addToParametersHelp value maybeList =
+    case maybeList of
+        Nothing ->
+            Just [ value ]
+
+        Just list ->
+            Just (value :: list)