elm-pages 3.0.0-beta.3 → 3.0.0-beta.30

package/src/PagesMsg.elm

@@ -0,0 +1,92 @@
+module PagesMsg exposing
+    ( PagesMsg
+    , fromMsg
+    , map, noOp
+    , onSubmit
+    )
+
+{-| In `elm-pages`, Route modules have their own `Msg` type which can be used like a normal TEA (The Elm Architecture) app.
+But the `Msg` defined in a `Route` module is wrapped in the `PagesMsg` type.
+
+@docs PagesMsg
+
+You can wrap your Route Module's `Msg` using `fromMsg`.
+
+@docs fromMsg
+
+@docs map, noOp
+
+@docs onSubmit
+
+-}
+
+import Html exposing (Attribute)
+import Pages.Internal.Msg
+
+
+{-| -}
+type alias PagesMsg userMsg =
+    Pages.Internal.Msg.Msg userMsg
+
+
+{-|
+
+    import PagesMsg exposing (PagesMsg)
+
+    type Msg
+        = ToggleMenu
+
+    view :
+        Maybe PageUrl
+        -> Shared.Model
+        -> Model
+        -> App Data ActionData RouteParams
+        -> View (PagesMsg Msg)
+    view maybeUrl sharedModel model app =
+        { title = "My Page"
+        , view =
+            [ button
+                -- we need to wrap our Route module's `Msg` here so we have a `PagesMsg Msg`
+                [ onClick (PagesMsg.fromMsg ToggleMenu) ]
+                []
+
+            -- `Form.renderHtml` gives us `Html (PagesMsg msg)`, so we don't need to wrap its Msg type
+            , logoutForm
+                |> Form.withOnSubmit (\_ -> NewItemSubmitted)
+                |> Form.renderHtml "logout" [] (\_ -> Nothing) app Nothing
+            ]
+        }
+
+-}
+fromMsg : userMsg -> PagesMsg userMsg
+fromMsg userMsg =
+    Pages.Internal.Msg.UserMsg userMsg
+
+
+{-| A Msg that is handled by the elm-pages framework and does nothing. Helpful for when you don't want to register a callback.
+
+    import Browser.Dom as Dom
+    import PagesMsg exposing (PagesMsg)
+    import Task
+
+    resetViewport : Cmd (PagesMsg msg)
+    resetViewport =
+        Dom.setViewport 0 0
+            |> Task.perform (\() -> PagesMsg.noOp)
+
+-}
+noOp : PagesMsg userMsg
+noOp =
+    Pages.Internal.Msg.NoOp
+
+
+{-| -}
+map : (a -> b) -> PagesMsg a -> PagesMsg b
+map mapFn msg =
+    Pages.Internal.Msg.map mapFn msg
+
+
+{-| -}
+onSubmit : Attribute (PagesMsg userMsg)
+onSubmit =
+    Pages.Internal.Msg.onSubmit

package/src/Path.elm

@@ -40,20 +40,25 @@ 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
+type alias Path =
+    List 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`.
+{-| Turn a Path to a relative URL.
 -}
-join : List String -> Path
+join : Path -> Path
 join parts =
     parts
         |> List.filter (\segment -> segment /= "/")
         |> List.map normalize
+
+
+{-| Turn a Path to a relative URL.
+-}
+toRelative : Path -> String
+toRelative parts =
+    join parts
         |> String.join "/"
-        |> Path
 
 
 {-| Create a Path from a path String.
@@ -66,28 +71,20 @@ join parts =
 fromString : String -> Path
 fromString path =
     path
-        |> normalize
-        |> Path
+        |> toSegments
 
 
 {-| -}
-toSegments : Path -> List String
-toSegments (Path path) =
+toSegments : String -> List String
+toSegments 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
+toAbsolute path =
+    "/" ++ toRelative path
 
 
 normalize : String -> String

package/src/QueryParams.elm

@@ -1,189 +1,38 @@
 module QueryParams exposing
     ( QueryParams
-    , Parser
-    , andThen, fail, fromResult, fromString, optionalString, parse, string, strings, succeed
-    , map2, oneOf
-    , toDict, toString
+    , fromString
+    , 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
+type alias QueryParams =
+    Dict String (List String)
 
 
 {-| -}
 toString : QueryParams -> String
-toString (QueryParams queryParams) =
+toString 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)
+        |> Dict.toList
+        |> List.concatMap
+            (\( key, values ) ->
+                values
+                    |> List.map
+                        (\value ->
+                            key ++ "=" ++ value
+                        )
+            )
+        |> String.join "&"
+
+
+{-| -}
+fromString : String -> Dict String (List String)
+fromString query =
+    List.foldr addParam Dict.empty (String.split "&" query)
 
 
 addParam : String -> Dict String (List String) -> Dict String (List String)

package/src/RequestsAndPending.elm

@@ -1,16 +1,14 @@
-module RequestsAndPending exposing (RequestsAndPending, Response(..), ResponseBody(..), batchDecoder, bodyEncoder, decoder, get)
+module RequestsAndPending exposing (RawResponse, RequestsAndPending, Response(..), ResponseBody(..), bodyEncoder, get)
 
 import Base64
 import Bytes exposing (Bytes)
-import Codec
 import Dict exposing (Dict)
 import Json.Decode as Decode exposing (Decoder)
 import Json.Encode as Encode
-import Pages.StaticHttp.Request
 
 
 type alias RequestsAndPending =
-    Dict String (Maybe Response)
+    Decode.Value
 
 
 type ResponseBody
@@ -20,18 +18,6 @@ type ResponseBody
     | WhateverBody
 
 
-batchDecoder : Decoder (List { request : Pages.StaticHttp.Request.Request, response : Response })
-batchDecoder =
-    Decode.map2 (\request response -> { request = request, response = response })
-        (Decode.field "request"
-            (Pages.StaticHttp.Request.codec
-                |> Codec.decoder
-            )
-        )
-        (Decode.field "response" decoder)
-        |> Decode.list
-
-
 decoder : Decoder Response
 decoder =
     Decode.map2 Response
@@ -117,6 +103,9 @@ responseDecoder =
 
 get : String -> RequestsAndPending -> Maybe Response
 get key requestsAndPending =
-    requestsAndPending
-        |> Dict.get key
-        |> Maybe.andThen identity
+    Decode.decodeValue
+        (Decode.field key
+            (Decode.field "response" decoder)
+        )
+        requestsAndPending
+        |> Result.toMaybe

package/src/Result/Extra.elm

@@ -0,0 +1,26 @@
+module Result.Extra exposing (combine, isOk, merge)
+
+
+isOk : Result x a -> Bool
+isOk result =
+    case result of
+        Ok _ ->
+            True
+
+        Err _ ->
+            False
+
+
+merge : Result a a -> a
+merge r =
+    case r of
+        Ok rr ->
+            rr
+
+        Err rr ->
+            rr
+
+
+combine : List (Result x a) -> Result x (List a)
+combine =
+    List.foldr (Result.map2 (::)) (Ok [])