elm-pages 3.0.0-beta.4 → 3.0.0-beta.40

package/src/Pages/Internal/Script.elm

@@ -0,0 +1,17 @@
+module Pages.Internal.Script exposing (Script(..))
+
+import BackendTask exposing (BackendTask)
+import Cli.Program as Program
+import FatalError exposing (FatalError)
+import Html exposing (Html)
+
+
+{-| -}
+type Script
+    = Script
+        ((Maybe { indent : Int, newLines : Bool }
+          -> Html Never
+          -> String
+         )
+         -> Program.Config (BackendTask FatalError ())
+        )

package/src/Pages/Internal/StaticHttpBody.elm

@@ -1,6 +1,9 @@
 module Pages.Internal.StaticHttpBody exposing (Body(..), codec, encode)
 
+import Base64
+import Bytes exposing (Bytes)
 import Codec exposing (Codec)
+import Json.Decode
 import Json.Encode as Encode
 
 
@@ -8,6 +11,7 @@ type Body
     = EmptyBody
     | StringBody String String
     | JsonBody Encode.Value
+    | BytesBody String Bytes
 
 
 encode : Body -> Encode.Value
@@ -26,6 +30,15 @@ encode body =
                 [ ( "content", content )
                 ]
 
+        BytesBody _ content ->
+            encodeWithType "bytes"
+                [ ( "content"
+                  , Base64.fromBytes content
+                        |> Maybe.withDefault ""
+                        |> Encode.string
+                  )
+                ]
+
 
 encodeWithType : String -> List ( String, Encode.Value ) -> Encode.Value
 encodeWithType typeName otherFields =
@@ -37,7 +50,7 @@ encodeWithType typeName otherFields =
 codec : Codec Body
 codec =
     Codec.custom
-        (\vEmpty vString vJson value ->
+        (\vEmpty vString vJson vBytes value ->
             case value of
                 EmptyBody ->
                     vEmpty
@@ -47,8 +60,29 @@ codec =
 
                 JsonBody body ->
                     vJson body
+
+                BytesBody contentType body ->
+                    vBytes contentType body
         )
         |> Codec.variant0 "EmptyBody" EmptyBody
         |> Codec.variant2 "StringBody" StringBody Codec.string Codec.string
         |> Codec.variant1 "JsonBody" JsonBody Codec.value
+        |> Codec.variant2 "BytesBody" BytesBody Codec.string bytesCodec
         |> Codec.buildCustom
+
+
+bytesCodec : Codec Bytes
+bytesCodec =
+    Codec.build (Base64.fromBytes >> Maybe.withDefault "" >> Encode.string)
+        (Json.Decode.string
+            |> Json.Decode.map Base64.toBytes
+            |> Json.Decode.andThen
+                (\decodedBytes ->
+                    case decodedBytes of
+                        Just bytes ->
+                            Json.Decode.succeed bytes
+
+                        Nothing ->
+                            Json.Decode.fail "Couldn't parse bytes."
+                )
+        )

package/src/Pages/Manifest.elm

@@ -2,6 +2,7 @@ module Pages.Manifest exposing
     ( Config, Icon
     , init
     , withBackgroundColor, withCategories, withDisplayMode, withIarcRatingId, withLang, withOrientation, withShortName, withThemeColor
+    , withField
     , DisplayMode(..), Orientation(..), IconPurpose(..)
     , generator
     , toJson
@@ -41,6 +42,11 @@ You pass your `Pages.Manifest.Config` record into the `Pages.application` functi
 @docs withBackgroundColor, withCategories, withDisplayMode, withIarcRatingId, withLang, withOrientation, withShortName, withThemeColor
 
 
+## Arbitrary Fields Escape Hatch
+
+@docs withField
+
+
 ## Config options
 
 @docs DisplayMode, Orientation, IconPurpose
@@ -58,9 +64,11 @@ You pass your `Pages.Manifest.Config` record into the `Pages.application` functi
 -}
 
 import ApiRoute
+import BackendTask exposing (BackendTask)
 import Color exposing (Color)
 import Color.Convert
-import DataSource exposing (DataSource)
+import Dict exposing (Dict)
+import FatalError exposing (FatalError)
 import Head
 import Json.Encode as Encode
 import LanguageTag exposing (LanguageTag, emptySubtags)
@@ -123,6 +131,7 @@ init options =
     , shortName = Nothing
     , icons = options.icons
     , lang = usEnglish
+    , otherFields = Dict.empty
     }
 
 
@@ -191,6 +200,17 @@ withLang languageTag config =
     { config | lang = languageTag }
 
 
+{-| Escape hatch for specifying fields that aren't exposed through this module otherwise. The possible supported properties
+in a manifest file can change over time, so see [MDN manifest.json docs](https://developer.mozilla.org/en-US/docs/Mozilla/Add-ons/WebExtensions/manifest.json)
+for a full listing of the current supported properties.
+-}
+withField : String -> Encode.Value -> Config -> Config
+withField name value config =
+    { config
+        | otherFields = config.otherFields |> Dict.insert name value
+    }
+
+
 orientationToString : Orientation -> String
 orientationToString orientation =
     case orientation of
@@ -239,6 +259,7 @@ type alias Config =
     , shortName : Maybe String
     , icons : List Icon
     , lang : LanguageTag
+    , otherFields : Dict String Encode.Value
     }
 
 
@@ -324,16 +345,16 @@ nonEmptyList list =
 
 {-| A generator for Api.elm to include a manifest.json.
 -}
-generator : String -> DataSource Config -> ApiRoute.ApiRoute ApiRoute.Response
+generator : String -> BackendTask FatalError Config -> ApiRoute.ApiRoute ApiRoute.Response
 generator canonicalSiteUrl config =
     ApiRoute.succeed
         (config
-            |> DataSource.map (toJson canonicalSiteUrl >> Encode.encode 0)
+            |> BackendTask.map (toJson canonicalSiteUrl >> Encode.encode 0)
         )
         |> ApiRoute.literal "manifest.json"
         |> ApiRoute.single
         |> ApiRoute.withGlobalHeadTags
-            (DataSource.succeed
+            (BackendTask.succeed
                 [ Head.manifestLink "/manifest.json"
                 ]
             )
@@ -420,6 +441,10 @@ toJson canonicalSiteUrl config =
       , Encode.string "/" |> Just
       )
     ]
+        ++ (config.otherFields
+                |> Dict.toList
+                |> List.map (Tuple.mapSecond Just)
+           )
         |> encodeMaybeObject
 
 

package/src/Pages/PageUrl.elm

@@ -1,17 +1,20 @@
-module Pages.PageUrl exposing (PageUrl, toUrl)
+module Pages.PageUrl exposing
+    ( PageUrl, toUrl
+    , parseQueryParams
+    )
 
-{-| Same as a Url in `elm/url`, but slightly more structured. The path portion of the URL is parsed into a [`Path`](Path) type, and
-the query params use the [`QueryParams`](QueryParams) type which allows you to parse just the query params or access them into a Dict.
-
-Because `elm-pages` takes care of the main routing for pages in your app, the standard Elm URL parser API isn't suited
-to parsing query params individually, which is why the structure of these types is different.
+{-| Same as a Url in `elm/url`, but slightly more structured. The path portion of the URL is parsed into a `List String` representing each segment, and
+the query params are parsed into a `Dict String (List String)`.
 
 @docs PageUrl, toUrl
 
+@docs parseQueryParams
+
 -}
 
+import Dict exposing (Dict)
 import Path exposing (Path)
-import QueryParams exposing (QueryParams)
+import QueryParams
 import Url
 
 
@@ -21,7 +24,7 @@ type alias PageUrl =
     , host : String
     , port_ : Maybe Int
     , path : Path
-    , query : Maybe QueryParams
+    , query : Dict String (List String)
     , fragment : Maybe String
     }
 
@@ -33,6 +36,17 @@ toUrl url =
     , host = url.host
     , port_ = url.port_
     , path = url.path |> Path.toRelative
-    , query = url.query |> Maybe.map QueryParams.toString
+    , query =
+        if url.query |> Dict.isEmpty then
+            Nothing
+
+        else
+            url.query |> QueryParams.toString |> Just
     , fragment = url.fragment
     }
+
+
+{-| -}
+parseQueryParams : String -> Dict String (List String)
+parseQueryParams =
+    QueryParams.fromString

package/src/Pages/ProgramConfig.elm

@@ -1,13 +1,14 @@
-module Pages.ProgramConfig exposing (ProgramConfig)
+module Pages.ProgramConfig exposing (FormData, ProgramConfig)
 
 import ApiRoute
+import BackendTask exposing (BackendTask)
 import Browser.Navigation
 import Bytes exposing (Bytes)
 import Bytes.Decode
 import Bytes.Encode
-import DataSource exposing (DataSource)
 import Dict exposing (Dict)
-import Form.FormData exposing (FormData)
+import FatalError exposing (FatalError)
+import Form
 import Head
 import Html exposing (Html)
 import Http
@@ -16,15 +17,14 @@ import Json.Encode
 import PageServerResponse exposing (PageServerResponse)
 import Pages.Fetcher
 import Pages.Flags
-import Pages.FormState
 import Pages.Internal.NotFoundReason exposing (NotFoundReason)
 import Pages.Internal.Platform.ToJsPayload
 import Pages.Internal.ResponseSketch exposing (ResponseSketch)
 import Pages.Internal.RoutePattern exposing (RoutePattern)
-import Pages.Msg
 import Pages.PageUrl exposing (PageUrl)
 import Pages.SiteConfig exposing (SiteConfig)
 import Pages.Transition
+import PagesMsg exposing (PagesMsg)
 import Path exposing (Path)
 import Url exposing (Url)
 
@@ -46,14 +46,14 @@ type alias ProgramConfig userMsg userModel route pageData actionData sharedData
                 , pageUrl : Maybe PageUrl
                 }
         -> ( userModel, effect )
-    , update : Pages.FormState.PageFormState -> Dict String (Pages.Transition.FetcherState actionData) -> Maybe Pages.Transition.Transition -> sharedData -> pageData -> Maybe Browser.Navigation.Key -> userMsg -> userModel -> ( userModel, effect )
+    , update : Form.Model -> Dict String (Pages.Transition.FetcherState actionData) -> Maybe Pages.Transition.Transition -> sharedData -> pageData -> Maybe Browser.Navigation.Key -> userMsg -> userModel -> ( userModel, effect )
     , subscriptions : route -> Path -> userModel -> Sub userMsg
-    , sharedData : DataSource sharedData
-    , data : route -> DataSource (PageServerResponse pageData errorPage)
-    , action : route -> DataSource (PageServerResponse actionData errorPage)
+    , sharedData : BackendTask FatalError sharedData
+    , data : Decode.Value -> route -> BackendTask FatalError (PageServerResponse pageData errorPage)
+    , action : Decode.Value -> route -> BackendTask FatalError (PageServerResponse actionData errorPage)
     , onActionData : actionData -> Maybe userMsg
     , view :
-        Pages.FormState.PageFormState
+        Form.Model
         -> Dict String (Pages.Transition.FetcherState actionData)
         -> Maybe Pages.Transition.Transition
         ->
@@ -65,11 +65,11 @@ type alias ProgramConfig userMsg userModel route pageData actionData sharedData
         -> pageData
         -> Maybe actionData
         ->
-            { view : userModel -> { title : String, body : List (Html (Pages.Msg.Msg userMsg)) }
+            { view : userModel -> { title : String, body : List (Html (PagesMsg userMsg)) }
             , head : List Head.Tag
             }
-    , handleRoute : route -> DataSource (Maybe NotFoundReason)
-    , getStaticRoutes : DataSource (List route)
+    , handleRoute : route -> BackendTask FatalError (Maybe NotFoundReason)
+    , getStaticRoutes : BackendTask FatalError (List route)
     , urlToRoute : Url -> route
     , routeToPath : route -> List String
     , site : Maybe SiteConfig
@@ -88,7 +88,10 @@ type alias ProgramConfig userMsg userModel route pageData actionData sharedData
         }
         -> userMsg
     , apiRoutes :
-        (Html Never -> String)
+        (Maybe { indent : Int, newLines : Bool }
+         -> Html Never
+         -> String
+        )
         -> List (ApiRoute.ApiRoute ApiRoute.Response)
     , pathPatterns : List RoutePattern
     , basePath : List String
@@ -98,7 +101,7 @@ type alias ProgramConfig userMsg userModel route pageData actionData sharedData
     , encodeResponse : ResponseSketch pageData actionData sharedData -> Bytes.Encode.Encoder
     , encodeAction : actionData -> Bytes.Encode.Encoder
     , decodeResponse : Bytes.Decode.Decoder (ResponseSketch pageData actionData sharedData)
-    , globalHeadTags : Maybe ((Html Never -> String) -> DataSource (List Head.Tag))
+    , globalHeadTags : Maybe ((Maybe { indent : Int, newLines : Bool } -> Html Never -> String) -> BackendTask FatalError (List Head.Tag))
     , cmdToEffect : Cmd userMsg -> effect
     , perform :
         { fetchRouteData :
@@ -124,3 +127,11 @@ type alias ProgramConfig userMsg userModel route pageData actionData sharedData
     , errorPageToData : errorPage -> pageData
     , notFoundRoute : route
     }
+
+
+type alias FormData =
+    { fields : List ( String, String )
+    , method : Form.Method
+    , action : String
+    , id : Maybe String
+    }

package/src/Pages/Script.elm

@@ -0,0 +1,109 @@
+module Pages.Script exposing
+    ( Script
+    , withCliOptions, withoutCliOptions
+    , writeFile
+    , log
+    , Error(..)
+    )
+
+{-|
+
+@docs Script
+
+@docs withCliOptions, withoutCliOptions
+
+
+## File System Utilities
+
+@docs writeFile
+
+
+## Utilities
+
+@docs log
+
+
+## Errors
+
+@docs Error
+
+-}
+
+import BackendTask exposing (BackendTask)
+import BackendTask.Http
+import BackendTask.Internal.Request
+import Cli.OptionsParser as OptionsParser
+import Cli.Program as Program
+import FatalError exposing (FatalError)
+import Json.Decode as Decode
+import Json.Encode as Encode
+import Pages.Internal.Script
+
+
+{-| -}
+type alias Script =
+    Pages.Internal.Script.Script
+
+
+{-| -}
+type Error
+    = --TODO make more descriptive
+      FileWriteError
+
+
+{-| -}
+writeFile : { path : String, body : String } -> BackendTask { fatal : FatalError, recoverable : Error } ()
+writeFile { path, body } =
+    BackendTask.Internal.Request.request
+        { name = "write-file"
+        , body =
+            BackendTask.Http.jsonBody
+                (Encode.object
+                    [ ( "path", Encode.string path )
+                    , ( "body", Encode.string body )
+                    ]
+                )
+        , expect =
+            -- TODO decode possible error details here
+            BackendTask.Http.expectJson (Decode.succeed ())
+        }
+
+
+{-| -}
+log : String -> BackendTask error ()
+log message =
+    BackendTask.Internal.Request.request
+        { name = "log"
+        , body =
+            BackendTask.Http.jsonBody
+                (Encode.object
+                    [ ( "message", Encode.string message )
+                    ]
+                )
+        , expect = BackendTask.Http.expectJson (Decode.succeed ())
+        }
+
+
+{-| -}
+withoutCliOptions : BackendTask FatalError () -> Script
+withoutCliOptions execute =
+    Pages.Internal.Script.Script
+        (\_ ->
+            Program.config
+                |> Program.add
+                    (OptionsParser.build ())
+                |> Program.mapConfig
+                    (\() ->
+                        execute
+                    )
+        )
+
+
+{-| -}
+withCliOptions : Program.Config cliOptions -> (cliOptions -> BackendTask FatalError ()) -> Script
+withCliOptions config execute =
+    Pages.Internal.Script.Script
+        (\_ ->
+            config
+                |> Program.mapConfig execute
+        )

package/src/Pages/SiteConfig.elm

@@ -1,10 +1,11 @@
 module Pages.SiteConfig exposing (SiteConfig)
 
-import DataSource exposing (DataSource)
+import BackendTask exposing (BackendTask)
+import FatalError exposing (FatalError)
 import Head
 
 
 type alias SiteConfig =
     { canonicalUrl : String
-    , head : DataSource (List Head.Tag)
+    , head : BackendTask FatalError (List Head.Tag)
     }

package/src/Pages/StaticHttp/Request.elm

@@ -11,7 +11,7 @@ type alias Request =
     , method : String
     , headers : List ( String, String )
     , body : Body
-    , useCache : Bool
+    , cacheOptions : Maybe Encode.Value
     }
 
 
@@ -40,5 +40,5 @@ codec =
         |> Codec.field "method" .method Codec.string
         |> Codec.field "headers" .headers (Codec.list (Codec.tuple Codec.string Codec.string))
         |> Codec.field "body" .body StaticHttpBody.codec
-        |> Codec.field "useCache" .useCache Codec.bool
+        |> Codec.nullableField "cacheOptions" .cacheOptions Codec.value
         |> Codec.buildObject

package/src/Pages/StaticHttpRequest.elm

@@ -1,8 +1,7 @@
-module Pages.StaticHttpRequest exposing (Error(..), MockResolver, RawRequest(..), Status(..), cacheRequestResolution, mockResolve, resolve, resolveUrls, toBuildError)
+module Pages.StaticHttpRequest exposing (Error(..), MockResolver, RawRequest(..), Status(..), cacheRequestResolution, mockResolve, toBuildError)
 
 import BuildError exposing (BuildError)
-import Dict
-import List.Extra
+import Json.Encode
 import Pages.StaticHttp.Request
 import RequestsAndPending exposing (RequestsAndPending)
 import TerminalText as Terminal
@@ -13,30 +12,19 @@ type alias MockResolver =
     -> Maybe RequestsAndPending.Response
 
 
-type RawRequest value
-    = Request (List Pages.StaticHttp.Request.Request) (Maybe MockResolver -> RequestsAndPending -> RawRequest value)
-    | RequestError Error
-    | ApiRoute value
+type RawRequest error value
+    = Request (List Pages.StaticHttp.Request.Request) (Maybe MockResolver -> RequestsAndPending -> RawRequest error value)
+    | ApiRoute (Result error value)
 
 
 type Error
-    = MissingHttpResponse String (List Pages.StaticHttp.Request.Request)
-    | DecoderError String
+    = 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 =
@@ -49,107 +37,43 @@ toBuildError path error =
         UserCalledStaticHttpFail decodeErrorMessage ->
             { title = "Called Static Http Fail"
             , message =
-                [ Terminal.text <| "I ran into a call to `DataSource.fail` with message: " ++ decodeErrorMessage
+                [ Terminal.text <| "I ran into a call to `BackendTask.fail` with message: " ++ decodeErrorMessage
                 ]
             , path = path
             , fatal = True
             }
 
 
-resolve : RawRequest value -> RequestsAndPending -> Result Error value
-resolve request rawResponses =
-    case request of
-        RequestError error ->
-            Err error
-
-        Request _ lookupFn ->
-            case lookupFn Nothing rawResponses of
-                nextRequest ->
-                    resolve nextRequest rawResponses
-
-        ApiRoute value ->
-            Ok value
-
-
-mockResolve : RawRequest value -> MockResolver -> Result Error value
+mockResolve : RawRequest error value -> MockResolver -> Result error value
 mockResolve request mockResolver =
     case request of
-        RequestError error ->
-            Err error
-
         Request _ lookupFn ->
-            case lookupFn (Just mockResolver) Dict.empty of
+            case lookupFn (Just mockResolver) (Json.Encode.object []) of
                 nextRequest ->
                     mockResolve nextRequest mockResolver
 
         ApiRoute value ->
-            Ok value
-
-
-resolveUrls : RawRequest value -> RequestsAndPending -> List Pages.StaticHttp.Request.Request
-resolveUrls request rawResponses =
-    resolveUrlsHelp rawResponses [] request
-
-
-resolveUrlsHelp : RequestsAndPending -> List Pages.StaticHttp.Request.Request -> RawRequest value -> List Pages.StaticHttp.Request.Request
-resolveUrlsHelp rawResponses soFar request =
-    case request of
-        RequestError error ->
-            case error of
-                MissingHttpResponse _ next ->
-                    (soFar ++ next)
-                        |> List.Extra.uniqueBy Pages.StaticHttp.Request.hash
-
-                _ ->
-                    soFar
-
-        Request urlList lookupFn ->
-            resolveUrlsHelp
-                rawResponses
-                (soFar ++ urlList)
-                (lookupFn Nothing rawResponses)
-
-        ApiRoute _ ->
-            soFar
+            value
 
 
 cacheRequestResolution :
-    RawRequest value
+    RawRequest error value
     -> RequestsAndPending
-    -> Status value
+    -> Status error value
 cacheRequestResolution request rawResponses =
-    cacheRequestResolutionHelp [] rawResponses request
-
-
-type Status value
-    = Incomplete (List Pages.StaticHttp.Request.Request)
-    | HasPermanentError Error
-    | Complete
-
-
-cacheRequestResolutionHelp :
-    List Pages.StaticHttp.Request.Request
-    -> RequestsAndPending
-    -> RawRequest value
-    -> Status value
-cacheRequestResolutionHelp foundUrls 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
+        Request urlList lookupFn ->
+            if List.isEmpty urlList then
+                cacheRequestResolution (lookupFn Nothing rawResponses) rawResponses
 
-                DecoderError _ ->
-                    HasPermanentError error
+            else
+                Incomplete urlList (Request [] lookupFn)
 
-                UserCalledStaticHttpFail _ ->
-                    HasPermanentError error
+        ApiRoute value ->
+            Complete value
 
-        Request urlList lookupFn ->
-            cacheRequestResolutionHelp urlList
-                rawResponses
-                (lookupFn Nothing rawResponses)
 
-        ApiRoute _ ->
-            Complete
+type Status error value
+    = Incomplete (List Pages.StaticHttp.Request.Request) (RawRequest error value)
+    | HasPermanentError Error
+    | Complete (Result error value)

package/src/Pages/Transition.elm

@@ -1,11 +1,11 @@
 module Pages.Transition exposing
-    ( Transition(..), LoadingState(..), map
+    ( Transition(..), LoadingState(..), map, FormData
     , FetcherState, FetcherSubmitStatus(..)
     )
 
 {-|
 
-@docs Transition, LoadingState, map
+@docs Transition, LoadingState, map, FormData
 
 
 ## Fetchers
@@ -14,11 +14,20 @@ module Pages.Transition exposing
 
 -}
 
-import Form.FormData exposing (FormData)
+import Form
 import Path exposing (Path)
 import Time
 
 
+{-| -}
+type alias FormData =
+    { fields : List ( String, String )
+    , method : Form.Method
+    , action : String
+    , id : Maybe String
+    }
+
+
 {-| -}
 type Transition
     = Submitting FormData