From 2b43d1bb9e3be4f4db8f67f547005ee884281c90 Mon Sep 17 00:00:00 2001 From: Matt McHenry Date: Mon, 27 Jul 2020 21:34:08 -0400 Subject: [PATCH] Update from Elm 0.18's Navigation.program to Elm 0.19's Browser.application * adapt to the new Browser.application API in the following ways: * mirror the two-phase handling of URL changes in Browser.application's 'onUrlRequest' and 'onUrlChange' by bifurcating the RouterMsg variant of WrappedMsg into RouterMsgOnUrlChange and RouterMsgOnUrlRequestInternal variants. * add a slot to RouterModel to store the new Browser.Navigation.Key, and in the update function, use it to invoke Browser.Navigation.pushUrl in response to a urlRequestInternal. * create a new 'onExternalUrlRequest' function for the user to implement, since RouteUrl can handle internal requests for the user, but can't do anything sensible with external requests (as suggested by @basti1302). * eliminate the distinction between App and AppWithFlags, and all related duplication, as there is no variant of the new Browser.application that doesn't support flags. * make UrlChange more strongly typed, mirroring the structure of the Url.Url record type from elm/url, and rework the way UrlChanges are converted to Cmds with a new 'apply : Url -> UrlChange -> Url' function. * update all examples to work with the new API and 0.19 generally * include work-arounds for a couple of elm/url bugs (https://github.com/elm/url/issues/37 and https://github.com/elm/url/issues/17) * store the base path in ExampleViewer.Model to illustrate absolute path requirement of UrlChange * build the examples with '--debug' so users can get an idea for how they work under the hood * update README * remove references to complementary packages that aren't compatible with 0.19 (which is all of them) * remove the RouteUrl.Builder module and the use of the sporto/erl package, as this functionality is now largely provided by elm/url. * remove the older RouteHash module, as it was only present to ease the transition from elm-route-hash to elm-route-url. also remove example code illustrating its use. --- README.md | 75 +-- elm-package.json | 23 - elm.json | 21 + .../Example1/Counter.elm | 91 +-- .../Example2/Counter.elm | 90 +-- .../Example2/CounterPair.elm | 89 +-- .../Example3/Counter.elm | 20 +- .../Example3/CounterList.elm | 103 ++- .../Example4/Counter.elm | 22 +- .../Example4/CounterList.elm | 97 ++- .../Example5/RandomGif.elm | 110 ++-- .../Example6/RandomGif.elm | 72 +-- .../Example6/RandomGifPair.elm | 132 ++-- .../Example7/RandomGif.elm | 49 +- .../Example7/RandomGifList.elm | 164 ++--- .../Example8/SpinSquare.elm | 97 +-- .../Example8/SpinSquarePair.elm | 143 ++--- .../ExampleViewer.elm | 511 ++++++++------- .../MainWithFullUrl.elm | 7 +- .../MainWithJustHash.elm | 7 +- .../MainWithOldAPI.elm | 18 - examples/elm-architecture-tutorial/README.md | 14 +- examples/elm-architecture-tutorial/compile.sh | 5 +- .../elm-package.json | 24 - examples/elm-architecture-tutorial/elm.json | 32 + run-tests.sh | 2 +- src/RouteHash.elm | 384 ----------- src/RouteUrl.elm | 606 ++++++++---------- src/RouteUrl/Builder.elm | 436 ------------- tests/BuilderTest.elm | 179 ------ tests/elm-package.json | 22 - 31 files changed, 1120 insertions(+), 2525 deletions(-) delete mode 100644 elm-package.json create mode 100644 elm.json delete mode 100644 examples/elm-architecture-tutorial/MainWithOldAPI.elm delete mode 100644 examples/elm-architecture-tutorial/elm-package.json create mode 100644 examples/elm-architecture-tutorial/elm.json delete mode 100644 src/RouteHash.elm delete mode 100644 src/RouteUrl/Builder.elm delete mode 100644 tests/BuilderTest.elm delete mode 100644 tests/elm-package.json diff --git a/README.md b/README.md index 0e396e6..c998045 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ # elm-route-url This is a module for routing single-page-apps in Elm, building on the -[`elm-lang/navigation`](http://package.elm-lang.org/packages/elm-lang/navigation/latest) +[`elm/browser`](https://package.elm-lang.org/packages/elm/browser/latest) package. ## Rationale @@ -18,30 +18,18 @@ So, there are two things going on here: * Mapping changes in the browser's location to changes in our app's state. Now, you can already arrange for these things to happen using -[`elm-lang/navigation`](http://package.elm-lang.org/packages/elm-lang/navigation/latest). -Furthermore, there are already a wealth of complementary packages, -such as: - -* [evancz/url-parser](http://package.elm-lang.org/packages/evancz/url-parser/latest) -* [Bogdanp/elm-combine](http://package.elm-lang.org/packages/Bogdanp/elm-combine/latest) -* [Bogdanp/elm-route](http://package.elm-lang.org/packages/Bogdanp/elm-route/latest) -* [etaque/elm-route-parser](http://package.elm-lang.org/packages/etaque/elm-route-parser/latest) -* [poyang/elm-router](http://package.elm-lang.org/packages/poying/elm-router/latest) -* [pzingg/elm-navigation-extra](http://package.elm-lang.org/packages/pzingg/elm-navigation-extra/latest) -* [sporto/erl](http://package.elm-lang.org/packages/sporto/erl/latest) -* [sporto/hop](http://package.elm-lang.org/packages/sporto/hop/latest) - +[`elm/browser`](http://package.elm-lang.org/packages/elm/browser/latest). So, what does elm-route-url do differently than the others? First, I'll address this practically, then philosophically. ### Mapping changes in the app state to a possible location change -If you were using [`elm-lang/navigation`](http://package.elm-lang.org/packages/elm-lang/navigation/latest) +If you were using [`elm/browser`](https://package.elm-lang.org/packages/elm/browser/latest) directly, then you would make changes to the URL with ordinary commands. So, as you write your `update` function, you would possibly return a command, -using [`modifyUrl`](http://package.elm-lang.org/packages/elm-lang/navigation/1.0.0/Navigation#modifyUrl) -or [`newUrl`](http://package.elm-lang.org/packages/elm-lang/navigation/1.0.0/Navigation#newUrl). +using [`replaceUrl`](https://package.elm-lang.org/packages/elm/browser/latest/Browser-Navigation#replaceUrl) +or [`pushUrl`](https://package.elm-lang.org/packages/elm/browser/latest/Browser-Navigation#pushUrl). Now, you can make this work, of course. However, the `update` function isn't really the perfect place to do this. Your update function looks like this: @@ -89,11 +77,13 @@ use elm-route-url, you don't have to. ### Mapping location changes to messages our app can respond to -If you use the official [navigation](http://package.elm-lang.org/packages/elm-lang/navigation/latest) -package in Elm 0.18 directly, you react to location changes by providing -an argument to `Navigation.program` which converts a `Location` to a message -your app can deal with. Those messages are then fed into your `update` function -as the `Location` changes. +If you use the official [browser](https://package.elm-lang.org/packages/elm/browser/latest/) +package in Elm 0.19 directly, you react to location changes by providing +two arguments to `Browser.application`: `onUrlRequest`, which converts a +`UrlRequest` to a message your app can use to decide whether to permit the +requested URL change; and `onUrlChange`, which converts a new `Url` to a +message your app can deal with. Those messages are then fed into your +`update` function as the `Url` changes. On the surface, elm-route-url works in a similar manner, except that it asks you to implement a function which returns a list of messages. @@ -108,8 +98,8 @@ location2messages : Location -> List Message `location2messages` will also be called when your `init` function is invoked, so you will also get access to the very first `Location`. -So, that is similar to how `Navigation` works. The difference is that -`Navigation` will send you a message even when you programmatically change +So, that is similar to how `Browser` works. The difference is that +`Browser` will send you a message even when you programmatically change the URL. By contrast, elm-route-url only sends you messsages for **external** changes to the URL -- for instance, the user clicking on a link, opening a bookmark, or typing in the address bar. You won't get a message when you've @@ -133,40 +123,21 @@ by Amitai Burstein, under the heading ## API -For the detailed API, see the documentation for `RouteUrl` and `RouteHash` -(there are links to the right, if you're looking at the Elm package site). - -The `RouteUrl` module is now the "primary" module. It gives you access to the -whole `Location` object, and allows you to use the path, query and/or hash, as -you wish. +For the detailed API, see the documentation for `RouteUrl` (there's a link to +the right, if you're looking at the Elm package site). The main thing that elm-route-url handles is making sure that your `location2messages` and `delta2url` functions are called at the appropriate -moment. How you parse the `Location` (and construct a `UrlChange`) is pretty -much up to you. Now, I have included a `RouteUrl.Builder` module that could -help with those tasks. However, you don't need to use it -- many other -approaches would be possible, and there are links to helpful packages above. -For my own part, I've been using [evancz/url-parser](http://package.elm-lang.org/packages/evancz/url-parser/latest) -recently to implement `location2messages`. - -The `RouteHash` module attempts to match the old API of elm-route-hash as -closely as possible. You should be able to re-use your old `delta2update` and -`location2action` functions without any changes. What will need to change is -the code in your `main` module that initializes your app. The `RouteHash` -module will probably be removed in a future version of elm-route-url, so you -should migrate to using `RouteUrl` at an appropriate moment. +moment. How you parse the `Url` (and construct a `UrlChange`) is pretty +much up to you. You can use [`elm/url`](https://package.elm-lang.org/packages/elm/url/latest/) +to help with those tasks. ## Examples I've included [example code](https://github.com/rgrempel/elm-route-hash/tree/master/examples/elm-architecture-tutorial) -which turns the old Elm Architecture Tutorial (upgraded to Elm 0.18) into -a single-page app. I've included three variations: - -* Using the new `RouteUrl` API with the full path. -* Using the new `RouteUrl` API with the hash only. -* Using the old `RouteHash` API. +which turns the old Elm Architecture Tutorial (upgraded to Elm 0.19) into +a single-page app. I've included two variations: -Note that the example code makes heavy use of the `RouteUrl.Builder` module. -However, as noted above, you don't necessarily need to use that -- a variety -of alternative approaches are possible. +* Using the `RouteUrl` API with the full path. +* Using the `RouteUrl` API with the hash only. \ No newline at end of file diff --git a/elm-package.json b/elm-package.json deleted file mode 100644 index cc86620..0000000 --- a/elm-package.json +++ /dev/null @@ -1,23 +0,0 @@ -{ - "version": "4.0.0", - "summary": "Router for single-page-apps in Elm", - "repository": "https://github.com/rgrempel/elm-route-url.git", - "license": "MIT", - "source-directories": [ - "src" - ], - "exposed-modules": [ - "RouteUrl", - "RouteHash", - "RouteUrl.Builder" - ], - "dependencies": { - "ccapndave/elm-update-extra": "2.3.1 <= v < 4.0.0", - "elm-lang/core": "5.0.0 <= v < 6.0.0", - "elm-lang/html": "2.0.0 <= v < 3.0.0", - "elm-lang/http": "1.0.0 <= v < 2.0.0", - "elm-lang/navigation": "2.0.0 <= v < 3.0.0", - "sporto/erl": "11.0.0 <= v < 14.0.0" - }, - "elm-version": "0.18.0 <= v < 0.19.0" -} diff --git a/elm.json b/elm.json new file mode 100644 index 0000000..2d00763 --- /dev/null +++ b/elm.json @@ -0,0 +1,21 @@ +{ + "type": "package", + "name": "rgrempel/elm-route-url", + "summary": "Router for single-page-apps in Elm", + "license": "MIT", + "version": "5.0.0", + "exposed-modules": [ + "RouteUrl" + ], + "elm-version": "0.19.0 <= v < 0.20.0", + "dependencies": { + "ccapndave/elm-update-extra": "4.0.0 <= v < 5.0.0", + "elm/browser": "1.0.0 <= v < 2.0.0", + "elm/core": "1.0.0 <= v < 2.0.0", + "elm/html": "1.0.0 <= v < 2.0.0", + "elm/http": "1.0.0 <= v < 2.0.0", + "elm/regex": "1.0.0 <= v < 2.0.0", + "elm/url": "1.0.0 <= v < 2.0.0" + }, + "test-dependencies": {} +} diff --git a/examples/elm-architecture-tutorial/Example1/Counter.elm b/examples/elm-architecture-tutorial/Example1/Counter.elm index a6ceaab..fa6393d 100644 --- a/examples/elm-architecture-tutorial/Example1/Counter.elm +++ b/examples/elm-architecture-tutorial/Example1/Counter.elm @@ -3,9 +3,10 @@ module Example1.Counter exposing (..) import Html exposing (..) import Html.Attributes exposing (style) import Html.Events exposing (onClick) -import RouteHash exposing (HashUpdate) -import RouteUrl.Builder exposing (Builder, builder, path, replacePath) +import RouteUrl exposing (HistoryEntry(..), UrlChange(..)) import String exposing (toInt) +import Url exposing (Url) + -- MODEL @@ -56,20 +57,19 @@ view : Model -> Html Action view model = div [] [ button [ onClick Decrement ] [ text "-" ] - , div [ countStyle ] [ text (toString model) ] + , div countStyle [ text (String.fromInt model) ] , button [ onClick Increment ] [ text "+" ] ] -countStyle : Attribute any +countStyle : List (Attribute any) countStyle = - style - [ ( "font-size", "20px" ) - , ( "font-family", "monospace" ) - , ( "display", "inline-block" ) - , ( "width", "50px" ) - , ( "text-align", "center" ) - ] + [ style "font-size" "20px" + , style "font-family" "monospace" + , style "display" "inline-block" + , style "width" "50px" + , style "text-align" "center" + ] {-| We add a separate function to get a title, which the ExampleViewer uses to @@ -83,61 +83,32 @@ title = --- Routing (Old API) +-- Routing (New API) -{-| For delta2update, we provide our state as the value for the URL. --} -delta2update : Model -> Model -> Maybe HashUpdate -delta2update previous current = - Just <| - RouteHash.set [ toString current ] - +delta2builder : Model -> Model -> Maybe UrlChange +delta2builder previous current = + Just <| NewPath NewEntry <| { path = String.fromInt current, query = Nothing, fragment = Nothing } -{-| For location2action, we generate an action that will restore our state. --} -location2action : List String -> List Action -location2action list = - case list of - first :: rest -> - case toInt first of - Ok value -> - [ Set value ] - - Err _ -> - -- If it wasn't an integer, then no action ... we could - -- show an error instead, of course. - [] - _ -> - -- If nothing provided for this part of the URL, return empty list +builder2messages : (Url -> Maybe String) -> Url -> List Action +builder2messages extractPath url = + case extractPath url of + Nothing -> [] + Just path -> + case String.split "/" path of + first :: rest -> + case toInt first of + Just value -> + [ Set value ] + Nothing -> + -- If it wasn't an integer, then no action ... we could + -- show an error instead, of course. + [] --- Routing (New API) - - -delta2builder : Model -> Model -> Maybe Builder -delta2builder previous current = - builder - |> replacePath [ toString current ] - |> Just - - -builder2messages : Builder -> List Action -builder2messages builder = - case path builder of - first :: rest -> - case toInt first of - Ok value -> - [ Set value ] - - Err _ -> - -- If it wasn't an integer, then no action ... we could - -- show an error instead, of course. + _ -> + -- If nothing provided for this part of the URL, return empty list [] - - _ -> - -- If nothing provided for this part of the URL, return empty list - [] diff --git a/examples/elm-architecture-tutorial/Example2/Counter.elm b/examples/elm-architecture-tutorial/Example2/Counter.elm index 2ad7e94..7649fba 100644 --- a/examples/elm-architecture-tutorial/Example2/Counter.elm +++ b/examples/elm-architecture-tutorial/Example2/Counter.elm @@ -1,23 +1,20 @@ -module Example2.Counter - exposing - ( Model - , init - , Action - , update - , view - , delta2update - , location2action - , delta2fragment - , fragment2messages - ) +module Example2.Counter exposing + ( Action + , Model + , delta2fragment + , fragment2messages + , init + , update + , view + ) import Html exposing (..) import Html.Attributes exposing (style) import Html.Events exposing (onClick) -import RouteHash exposing (HashUpdate) import String exposing (toInt) + -- MODEL @@ -64,51 +61,19 @@ view : Model -> Html Action view model = div [] [ button [ onClick Decrement ] [ text "-" ] - , div [ countStyle ] [ text (toString model) ] + , div countStyle [ text (String.fromInt model) ] , button [ onClick Increment ] [ text "+" ] ] -countStyle : Attribute any +countStyle : List (Attribute any) countStyle = - style - [ ( "font-size", "20px" ) - , ( "font-family", "monospace" ) - , ( "display", "inline-block" ) - , ( "width", "50px" ) - , ( "text-align", "center" ) - ] - - - --- Routing (Old API) - - -{-| For delta2update, we provide our state as the value for the URL --} -delta2update : Model -> Model -> Maybe HashUpdate -delta2update previous current = - Just <| - RouteHash.set [ toString current ] - - -{-| For location2action, we generate an action that will restore our state --} -location2action : List String -> List Action -location2action list = - case list of - first :: rest -> - case toInt first of - Ok value -> - [ Set value ] - - Err _ -> - -- If it wasn't an integer, then no action - [] - - _ -> - -- If nothing provided for this part of the URL, return empty list - [] + [ style "font-size" "20px" + , style "font-family" "monospace" + , style "display" "inline-block" + , style "width" "50px" + , style "text-align" "center" + ] @@ -119,16 +84,21 @@ location2action list = -} delta2fragment : Model -> Model -> String delta2fragment previous current = - toString current + String.fromInt current {-| We'll just take a string -} -fragment2messages : String -> List Action -fragment2messages fragment = - case toInt fragment of - Ok value -> - [ Set value ] +fragment2messages : Maybe String -> List Action +fragment2messages mFragment = + case mFragment of + Just fragment -> + case toInt fragment of + Just value -> + [ Set value ] + + Nothing -> + [] - Err _ -> + Nothing -> [] diff --git a/examples/elm-architecture-tutorial/Example2/CounterPair.elm b/examples/elm-architecture-tutorial/Example2/CounterPair.elm index 0c86074..83b75cc 100644 --- a/examples/elm-architecture-tutorial/Example2/CounterPair.elm +++ b/examples/elm-architecture-tutorial/Example2/CounterPair.elm @@ -4,8 +4,12 @@ import Example2.Counter as Counter import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) -import RouteHash exposing (HashUpdate) -import RouteUrl.Builder exposing (Builder, builder, insertQuery, getQuery) +import RouteUrl exposing (HistoryEntry(..), UrlChange(..)) +import Url exposing (Url) +import Url.Builder exposing (relative, string) +import Url.Parser exposing (parse, query) +import Url.Parser.Query exposing (map2) + -- MODEL @@ -77,65 +81,42 @@ title = --- Routing (Old API) - - -{-| To encode state in the URL, we'll just delegate & concatenate -This will produce partial URLs like /6/7 --} -delta2update : Model -> Model -> Maybe HashUpdate -delta2update previous current = - -- The implementation is not especially elegant ... perhaps - -- we need a few more HashUpdate helpers, to help combining them? - [ Counter.delta2update previous.topCounter current.topCounter - , Counter.delta2update previous.bottomCounter current.bottomCounter - ] - |> List.map (Maybe.withDefault [] << Maybe.map RouteHash.extract) - |> List.concat - |> RouteHash.set - |> Just - - -location2action : List String -> List Action -location2action list = - case list of - -- We're expecting two things that we can delegate down ... - top :: bottom :: rest -> - List.concat - [ List.map Top <| Counter.location2action [ top ] - , List.map Bottom <| Counter.location2action [ bottom ] - ] - - -- If we don't have what we expect, then no actions - _ -> - [] - - - -- Routing (New API) {-| We'll put the two counters in the query parameters, just for fun -} -delta2builder : Model -> Model -> Maybe Builder +delta2builder : Model -> Model -> Maybe UrlChange delta2builder previous current = - builder - |> insertQuery "top" (Counter.delta2fragment previous.topCounter current.topCounter) - |> insertQuery "bottom" (Counter.delta2fragment previous.bottomCounter current.bottomCounter) - |> Just + Just <| + NewQuery NewEntry <| + { query = + -- work around https://github.com/elm/url/issues/37 + String.dropLeft 1 <| + relative [] + [ string "top" (Counter.delta2fragment previous.topCounter current.topCounter) + , string "bottom" (Counter.delta2fragment previous.bottomCounter current.bottomCounter) + ] + , fragment = Nothing + } -builder2messages : Builder -> List Action -builder2messages builder = +builder2messages : Url -> List Action +builder2messages url = let - left = - getQuery "top" builder - |> List.concatMap Counter.fragment2messages - |> List.map Top - - right = - getQuery "bottom" builder - |> List.concatMap Counter.fragment2messages - |> List.map Bottom + workaroundUrl = + -- https://github.com/elm/url/issues/17 + { url | path = "" } + + parseQuery = + query <| + map2 List.append + (Url.Parser.Query.map (List.map Top << Counter.fragment2messages) <| Url.Parser.Query.string "top") + (Url.Parser.Query.map (List.map Bottom << Counter.fragment2messages) <| Url.Parser.Query.string "bottom") in - List.append left right + case parse parseQuery workaroundUrl of + Nothing -> + [] + + Just actions -> + actions diff --git a/examples/elm-architecture-tutorial/Example3/Counter.elm b/examples/elm-architecture-tutorial/Example3/Counter.elm index 0efc18a..fd69b6b 100644 --- a/examples/elm-architecture-tutorial/Example3/Counter.elm +++ b/examples/elm-architecture-tutorial/Example3/Counter.elm @@ -1,10 +1,11 @@ -module Example3.Counter exposing (Model, init, Action, update, view) +module Example3.Counter exposing (Action, Model, init, update, view) import Html exposing (..) import Html.Attributes exposing (style) import Html.Events exposing (onClick) + -- MODEL @@ -44,17 +45,16 @@ view : Model -> Html Action view model = div [] [ button [ onClick Decrement ] [ text "-" ] - , div [ countStyle ] [ text (toString model) ] + , div countStyle [ text (String.fromInt model) ] , button [ onClick Increment ] [ text "+" ] ] -countStyle : Attribute any +countStyle : List (Attribute any) countStyle = - style - [ ( "font-size", "20px" ) - , ( "font-family", "monospace" ) - , ( "display", "inline-block" ) - , ( "width", "50px" ) - , ( "text-align", "center" ) - ] + [ style "font-size" "20px" + , style "font-family" "monospace" + , style "display" "inline-block" + , style "width" "50px" + , style "text-align" "center" + ] diff --git a/examples/elm-architecture-tutorial/Example3/CounterList.elm b/examples/elm-architecture-tutorial/Example3/CounterList.elm index 8d3d905..ecef16c 100644 --- a/examples/elm-architecture-tutorial/Example3/CounterList.elm +++ b/examples/elm-architecture-tutorial/Example3/CounterList.elm @@ -4,10 +4,11 @@ import Example3.Counter as Counter import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) -import RouteHash exposing (HashUpdate) -import RouteUrl.Builder exposing (Builder, builder, path, replacePath) -import Result.Extra +import Maybe.Extra +import RouteUrl exposing (HistoryEntry(..), UrlChange(..)) import String +import Url exposing (Url) + -- MODEL @@ -55,10 +56,10 @@ update action model = newCounters = model.counters ++ [ newCounter ] in - { model - | counters = newCounters - , nextID = model.nextID + 1 - } + { model + | counters = newCounters + , nextID = model.nextID + 1 + } Remove -> { model | counters = List.drop 1 model.counters } @@ -68,10 +69,11 @@ update action model = updateCounter ( counterID, counterModel ) = if counterID == id then ( counterID, Counter.update counterAction counterModel ) + else ( counterID, counterModel ) in - { model | counters = List.map updateCounter model.counters } + { model | counters = List.map updateCounter model.counters } Set list -> let @@ -82,9 +84,9 @@ update action model = ) list in - { counters = counters - , nextID = List.length counters - } + { counters = counters + , nextID = List.length counters + } @@ -103,7 +105,7 @@ view model = insert = button [ onClick Insert ] [ text "Add" ] in - div [] ([ remove, insert ] ++ counters) + div [] ([ remove, insert ] ++ counters) viewCounter : ( ID, Counter.Model ) -> Html Action @@ -122,63 +124,38 @@ title = --- Routing (Old API) - - -{-| You could do this in a variety of ways. We'll ignore the ID's, and just -encode the value of each Counter in the list -- so we'll end up with -something like /0/1/5 or whatever. When we recreate that, we won't -necessarily have the same IDs, but that doesn't matter for this example. -If it mattered, we'd have to do this a different way. --} -delta2update : Model -> Model -> Maybe HashUpdate -delta2update previous current = - -- We'll take advantage of the fact that we know that the counter - -- is just an Int ... no need to be super-modular here. - List.map (toString << Tuple.second) current.counters - |> RouteHash.set - |> Just - - -location2action : List String -> List Action -location2action list = - let - result = - List.map String.toInt list - |> Result.Extra.combine - in - case result of - Ok ints -> - [ Set ints ] - - Err _ -> - [] - - - -- Routing (New API) -delta2builder : Model -> Model -> Maybe Builder +delta2builder : Model -> Model -> Maybe UrlChange delta2builder previous current = -- We'll take advantage of the fact that we know that the counter -- is just an Int ... no need to be super-modular here. - builder - |> replacePath (List.map (toString << Tuple.second) current.counters) - |> Just + Just <| + NewPath NewEntry + { path = String.concat <| List.intersperse "/" <| List.map (String.fromInt << Tuple.second) current.counters + , query = Nothing + , fragment = Nothing + } -builder2messages : Builder -> List Action -builder2messages builder = - let - result = - path builder - |> List.map String.toInt - |> Result.Extra.combine - in - case result of - Ok ints -> - [ Set ints ] +builder2messages : (Url -> Maybe String) -> Url -> List Action +builder2messages extractPath url = + case extractPath url of + Nothing -> + [] + + Just path -> + let + result = + path + |> String.split "/" + |> List.map String.toInt + |> Maybe.Extra.combine + in + case result of + Just ints -> + [ Set ints ] - Err _ -> - [] + Nothing -> + [] diff --git a/examples/elm-architecture-tutorial/Example4/Counter.elm b/examples/elm-architecture-tutorial/Example4/Counter.elm index 065893b..898719a 100644 --- a/examples/elm-architecture-tutorial/Example4/Counter.elm +++ b/examples/elm-architecture-tutorial/Example4/Counter.elm @@ -1,10 +1,11 @@ -module Example4.Counter exposing (Model, init, Action, update, view, viewWithRemoveButton, Context) +module Example4.Counter exposing (Action, Context, Model, init, update, view, viewWithRemoveButton) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) + -- MODEL @@ -44,7 +45,7 @@ view : Model -> Html Action view model = div [] [ button [ onClick Decrement ] [ text "-" ] - , div [ countStyle ] [ text (toString model) ] + , div countStyle [ text (String.fromInt model) ] , button [ onClick Increment ] [ text "+" ] ] @@ -59,19 +60,18 @@ viewWithRemoveButton : Context super -> Model -> Html super viewWithRemoveButton context model = div [] [ Html.map context.modify (button [ onClick Decrement ] [ text "-" ]) - , div [ countStyle ] [ text (toString model) ] + , div countStyle [ text (String.fromInt model) ] , Html.map context.modify (button [ onClick Increment ] [ text "+" ]) - , div [ countStyle ] [] + , div countStyle [] , button [ onClick context.remove ] [ text "X" ] ] -countStyle : Attribute any +countStyle : List (Attribute any) countStyle = - style - [ ( "font-size", "20px" ) - , ( "font-family", "monospace" ) - , ( "display", "inline-block" ) - , ( "width", "50px" ) - , ( "text-align", "center" ) + [ style "font-size" "20px" + , style "font-family" "monospace" + , style "display" "inline-block" + , style "width" "50px" + , style "text-align" "center" ] diff --git a/examples/elm-architecture-tutorial/Example4/CounterList.elm b/examples/elm-architecture-tutorial/Example4/CounterList.elm index 20bb129..c6ff8e7 100644 --- a/examples/elm-architecture-tutorial/Example4/CounterList.elm +++ b/examples/elm-architecture-tutorial/Example4/CounterList.elm @@ -4,10 +4,11 @@ import Example4.Counter as Counter import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) -import RouteHash exposing (HashUpdate) -import RouteUrl.Builder exposing (Builder, builder, path, replacePath) -import Result.Extra +import Maybe.Extra +import RouteUrl exposing (HistoryEntry(..), UrlChange(..)) import String +import Url exposing (Url) + -- MODEL @@ -62,10 +63,11 @@ update action model = updateCounter ( counterID, counterModel ) = if counterID == id then ( counterID, Counter.update counterAction counterModel ) + else ( counterID, counterModel ) in - { model | counters = List.map updateCounter model.counters } + { model | counters = List.map updateCounter model.counters } Set list -> let @@ -76,9 +78,9 @@ update action model = ) list in - { counters = counters - , nextID = List.length counters - } + { counters = counters + , nextID = List.length counters + } @@ -91,7 +93,7 @@ view model = insert = button [ onClick Insert ] [ text "Add" ] in - div [] (insert :: List.map viewCounter model.counters) + div [] (insert :: List.map viewCounter model.counters) viewCounter : ( ID, Counter.Model ) -> Html Action @@ -100,7 +102,7 @@ viewCounter ( id, model ) = context = Counter.Context (Modify id) (Remove id) in - Counter.viewWithRemoveButton context model + Counter.viewWithRemoveButton context model {-| We add a separate function to get a title, which the ExampleViewer uses to @@ -115,63 +117,38 @@ title = --- Routing (Old API) - - -{-| You could do this in a variety of ways. We'll ignore the ID's, and just -encode the value of each Counter in the list -- so we'll end up with -something like /0/1/5 or whatever. When we recreate that, we won't -necessarily have the same IDs, but that doesn't matter for this example. -If it mattered, we'd have to do this a different way. --} -delta2update : Model -> Model -> Maybe HashUpdate -delta2update previous current = - -- We'll take advantage of the fact that we know that the counter - -- is just an Int ... no need to be super-modular here. - List.map (toString << Tuple.second) current.counters - |> RouteHash.set - |> Just - - -location2action : List String -> List Action -location2action list = - let - result = - List.map String.toInt list - |> Result.Extra.combine - in - case result of - Ok ints -> - [ Set ints ] - - Err _ -> - [] - - - -- Routing (New API) -delta2builder : Model -> Model -> Maybe Builder +delta2builder : Model -> Model -> Maybe UrlChange delta2builder previous current = -- We'll take advantage of the fact that we know that the counter -- is just an Int ... no need to be super-modular here. - builder - |> replacePath (List.map (toString << Tuple.second) current.counters) - |> Just + Just <| + NewPath NewEntry <| + { path = String.concat <| List.intersperse "/" <| List.map (String.fromInt << Tuple.second) current.counters + , query = Nothing + , fragment = Nothing + } -builder2messages : Builder -> List Action -builder2messages builder = - let - result = - path builder - |> List.map String.toInt - |> Result.Extra.combine - in - case result of - Ok ints -> - [ Set ints ] +builder2messages : (Url -> Maybe String) -> Url -> List Action +builder2messages extractPath url = + case extractPath url of + Nothing -> + [] + + Just path -> + let + result = + path + |> String.split "/" + |> List.map String.toInt + |> Maybe.Extra.combine + in + case result of + Just ints -> + [ Set ints ] - Err _ -> - [] + Nothing -> + [] diff --git a/examples/elm-architecture-tutorial/Example5/RandomGif.elm b/examples/elm-architecture-tutorial/Example5/RandomGif.elm index 414f3cf..9ff4fc6 100644 --- a/examples/elm-architecture-tutorial/Example5/RandomGif.elm +++ b/examples/elm-architecture-tutorial/Example5/RandomGif.elm @@ -3,11 +3,12 @@ module Example5.RandomGif exposing (..) import Html exposing (..) import Html.Attributes exposing (style) import Html.Events exposing (onClick) -import Http +import Http exposing (expectJson) import Json.Decode as Json +import RouteUrl exposing (HistoryEntry(..), UrlChange(..)) import Task -import RouteHash exposing (HashUpdate) -import RouteUrl.Builder exposing (Builder, builder, path, replacePath) +import Url exposing (Url) + -- MODEL @@ -100,37 +101,31 @@ update action model = -- VIEW -(=>) = - (,) - - view : Model -> Html Action view model = - div [ style [ "width" => "200px" ] ] - [ h2 [ headerStyle ] [ text model.topic ] - , div [ imgStyle model.gifUrl ] [] + div [ style "width" "200px" ] + [ h2 headerStyle [ text model.topic ] + , div (imgStyle model.gifUrl) [] , button [ onClick RequestMore ] [ text "More Please!" ] ] -headerStyle : Attribute any +headerStyle : List (Attribute any) headerStyle = - style - [ "width" => "200px" - , "text-align" => "center" - ] + [ style "width" "200px" + , style "text-align" "center" + ] -imgStyle : String -> Attribute any +imgStyle : String -> List (Attribute any) imgStyle url = - style - [ "display" => "inline-block" - , "width" => "200px" - , "height" => "200px" - , "background-position" => "center center" - , "background-size" => "cover" - , "background-image" => ("url('" ++ url ++ "')") - ] + [ style "display" "inline-block" + , style "width" "200px" + , style "height" "200px" + , style "background-position" "center center" + , style "background-size" "cover" + , style "background-image" ("url('" ++ url ++ "')") + ] @@ -154,20 +149,19 @@ queryPair ( key, value ) = queryEscape : String -> String queryEscape string = - String.join "+" (String.split "%20" (Http.encodeUri string)) + String.join "+" (String.split "%20" (Url.percentEncode string)) getRandomGif : String -> Cmd Action getRandomGif topic = - Http.send NewGif <| - Http.get (randomUrl topic) decodeUrl + Http.get { url = randomUrl topic, expect = expectJson NewGif decodeUrl } randomUrl : String -> String randomUrl topic = urlWithArgs "http://api.giphy.com/v1/gifs/random" - [ "api_key" => "dc6zaTOxFJmzC" - , "tag" => topic + [ ( "api_key", "dc6zaTOxFJmzC" ) + , ( "tag", topic ) ] @@ -188,56 +182,34 @@ title = --- Routing (Old API) - - -{-| We'll generate URLs like "/gifUrl" --} -delta2update : Model -> Model -> Maybe HashUpdate -delta2update previous current = - if current.gifUrl == (Tuple.first init).gifUrl then - -- If we're waiting for the first random gif, don't generate an entry ... - -- wait for the gif to arrive. - Nothing - else - Just (RouteHash.set [ current.gifUrl ]) - - -location2action : List String -> List Action -location2action list = - case list of - -- If we have a gifUrl, then use it - gifUrl :: rest -> - [ NewGifFromLocation gifUrl ] - - -- Otherwise, do nothing - _ -> - [] - - - -- Routing (New API) -delta2builder : Model -> Model -> Maybe Builder +delta2builder : Model -> Model -> Maybe UrlChange delta2builder previous current = if current.gifUrl == (Tuple.first init).gifUrl then -- If we're waiting for the first random gif, don't generate an entry ... -- wait for the gif to arrive. Nothing + else - builder - |> replacePath [ current.gifUrl ] + NewPath NewEntry + { path = current.gifUrl, query = Nothing, fragment = Nothing } |> Just -builder2messages : Builder -> List Action -builder2messages builder = - case path builder of - -- If we have a gifUrl, then use it - gifUrl :: rest -> - [ NewGifFromLocation gifUrl ] - - -- Otherwise, do nothing - _ -> +builder2messages : (Url -> Maybe String) -> Url -> List Action +builder2messages extractPath url = + case extractPath url of + Nothing -> [] + + Just path -> + case String.split "/" path of + -- If we have a gifUrl, then use it + gifUrl :: rest -> + [ NewGifFromLocation gifUrl ] + + -- Otherwise, do nothing + _ -> + [] diff --git a/examples/elm-architecture-tutorial/Example6/RandomGif.elm b/examples/elm-architecture-tutorial/Example6/RandomGif.elm index e6f5871..55d6b5d 100644 --- a/examples/elm-architecture-tutorial/Example6/RandomGif.elm +++ b/examples/elm-architecture-tutorial/Example6/RandomGif.elm @@ -3,11 +3,12 @@ module Example6.RandomGif exposing (..) import Html exposing (..) import Html.Attributes exposing (style) import Html.Events exposing (onClick) -import Http +import Http exposing (expectJson) import Json.Decode as Json +import RouteUrl exposing (HistoryEntry(..), UrlChange(..)) import Task -import RouteHash exposing (HashUpdate) -import RouteUrl.Builder exposing (Builder, builder, appendToPath) +import Url + -- MODEL @@ -97,37 +98,31 @@ update action model = -- VIEW -(=>) = - (,) - - view : Model -> Html Action view model = - div [ style [ "width" => "200px" ] ] - [ h2 [ headerStyle ] [ text model.topic ] - , div [ imgStyle model.gifUrl ] [] + div [ style "width" "200px" ] + [ h2 headerStyle [ text model.topic ] + , div (imgStyle model.gifUrl) [] , button [ onClick RequestMore ] [ text "More Please!" ] ] -headerStyle : Attribute any +headerStyle : List (Attribute any) headerStyle = - style - [ "width" => "200px" - , "text-align" => "center" - ] + [ style "width" "200px" + , style "text-align" "center" + ] -imgStyle : String -> Attribute any +imgStyle : String -> List (Attribute any) imgStyle url = - style - [ "display" => "inline-block" - , "width" => "200px" - , "height" => "200px" - , "background-position" => "center center" - , "background-size" => "cover" - , "background-image" => ("url('" ++ url ++ "')") - ] + [ style "display" "inline-block" + , style "width" "200px" + , style "height" "200px" + , style "background-position" "center center" + , style "background-size" "cover" + , style "background-image" ("url('" ++ url ++ "')") + ] @@ -151,20 +146,19 @@ queryPair ( key, value ) = queryEscape : String -> String queryEscape string = - String.join "+" (String.split "%20" (Http.encodeUri string)) + String.join "+" (String.split "%20" (Url.percentEncode string)) getRandomGif : String -> Cmd Action getRandomGif topic = - Http.send NewGif <| - Http.get (randomUrl topic) decodeUrl + Http.get { url = randomUrl topic, expect = expectJson NewGif decodeUrl } randomUrl : String -> String randomUrl topic = urlWithArgs "http://api.giphy.com/v1/gifs/random" - [ "api_key" => "dc6zaTOxFJmzC" - , "tag" => topic + [ ( "api_key", "dc6zaTOxFJmzC" ) + , ( "tag", topic ) ] @@ -177,29 +171,15 @@ decodeUrl = -- Routing -{-| We'll generate URLs like "/gifUrl". Note that this treats the topic as an -invariant, which it is here ... it can only be supplied on initialization. -If it weren't invariant, we'd need to do something more complex. --} -delta2update : Model -> Model -> Maybe HashUpdate -delta2update previous current = - if current.gifUrl == "assets/waiting.gif" then - -- If we're waiting for the first random gif, don't generate an entry ... - -- wait for the gif to arrive. - Nothing - else - Just (RouteHash.set [ current.gifUrl ]) - - -delta2builder : Model -> Model -> Maybe Builder +delta2builder : Model -> Model -> Maybe String delta2builder previous current = if current.gifUrl == "assets/waiting.gif" then -- If we're waiting for the first random gif, don't generate an entry ... -- wait for the gif to arrive. Nothing + else - builder - |> appendToPath [ current.gifUrl ] + current.gifUrl |> Just diff --git a/examples/elm-architecture-tutorial/Example6/RandomGifPair.elm b/examples/elm-architecture-tutorial/Example6/RandomGifPair.elm index 7efc850..e848f7d 100644 --- a/examples/elm-architecture-tutorial/Example6/RandomGifPair.elm +++ b/examples/elm-architecture-tutorial/Example6/RandomGifPair.elm @@ -1,10 +1,11 @@ module Example6.RandomGifPair exposing (..) +import Example6.RandomGif as RandomGif import Html exposing (..) import Html.Attributes exposing (..) -import RouteHash exposing (HashUpdate) -import RouteUrl.Builder exposing (Builder, path, appendToPath) -import Example6.RandomGif as RandomGif +import RouteUrl exposing (HistoryEntry(..), UrlChange(..)) +import Url exposing (Url) + -- MODEL @@ -33,12 +34,12 @@ init = ( right, rightFx ) = RandomGif.init rightTopic in - ( Model left right - , Cmd.batch - [ Cmd.map Left leftFx - , Cmd.map Right rightFx - ] - ) + ( Model left right + , Cmd.batch + [ Cmd.map Left leftFx + , Cmd.map Right rightFx + ] + ) @@ -58,18 +59,18 @@ update action model = ( left, fx ) = RandomGif.update act model.left in - ( Model left model.right - , Cmd.map Left fx - ) + ( Model left model.right + , Cmd.map Left fx + ) Right act -> let ( right, fx ) = RandomGif.update act model.right in - ( Model model.left right - , Cmd.map Right fx - ) + ( Model model.left right + , Cmd.map Right fx + ) @@ -78,7 +79,7 @@ update action model = view : Model -> Html Action view model = - div [ style [ ( "display", "flex" ) ] ] + div [ style "display" "flex" ] [ Html.map Left (RandomGif.view model.left) , Html.map Right (RandomGif.view model.right) ] @@ -96,55 +97,10 @@ title = --- Routing (Old API) - - -delta2update : Model -> Model -> Maybe HashUpdate -delta2update previous current = - let - left = - Maybe.map RouteHash.extract <| - RandomGif.delta2update previous.left current.left - - right = - Maybe.map RouteHash.extract <| - RandomGif.delta2update previous.right current.right - in - -- Essentially, we want to combine left and right. I should think about - -- how to improve the API for this. We can simplify in this case because - -- we happen to know that both sides will be lists of length 1. If the - -- lengths could vary, we'd have to do something more complex. - left - |> Maybe.andThen - (\l -> - right - |> Maybe.andThen - (\r -> Just (l ++ r)) - ) - |> Maybe.map RouteHash.set - - -location2action : List String -> List Action -location2action list = - -- This is simplified because we know that each sub-module will supply a - -- list with one element ... otherwise, we'd have to do something more - -- complex. - case list of - left :: right :: rest -> - List.concat - [ List.map Left <| RandomGif.location2action [ left ] - , List.map Right <| RandomGif.location2action [ right ] - ] - - _ -> - [] - - - -- Routing (New API) -delta2builder : Model -> Model -> Maybe Builder +delta2builder : Model -> Model -> Maybe UrlChange delta2builder previous current = let left = @@ -153,29 +109,31 @@ delta2builder previous current = right = RandomGif.delta2builder previous.right current.right in - -- Essentially, we want to combine left and right. - left - |> Maybe.andThen - (\l -> - right - |> Maybe.andThen - (\r -> - Just <| appendToPath (path r) l - ) - ) - - -builder2messages : Builder -> List Action -builder2messages builder = - -- This is simplified because we know that each sub-module will supply a - -- list with one element ... otherwise, we'd have to do something more - -- complex. - case path builder of - left :: right :: rest -> - List.concat - [ List.map Left <| RandomGif.location2action [ left ] - , List.map Right <| RandomGif.location2action [ right ] - ] - - _ -> + -- Essentially, we want to combine left and right. + left + |> Maybe.andThen + (\l -> + right + |> Maybe.andThen + (\r -> + Just <| NewPath NewEntry { path = l ++ "/" ++ r, query = Nothing, fragment = Nothing } + ) + ) + + +builder2messages : (Url -> Maybe String) -> Url -> List Action +builder2messages extractPath url = + case extractPath url of + Nothing -> [] + + Just path -> + case String.split "/" path of + left :: right :: rest -> + List.concat + [ List.map Left <| RandomGif.location2action [ left ] + , List.map Right <| RandomGif.location2action [ right ] + ] + + _ -> + [] diff --git a/examples/elm-architecture-tutorial/Example7/RandomGif.elm b/examples/elm-architecture-tutorial/Example7/RandomGif.elm index 397db23..e8aa14c 100644 --- a/examples/elm-architecture-tutorial/Example7/RandomGif.elm +++ b/examples/elm-architecture-tutorial/Example7/RandomGif.elm @@ -3,9 +3,11 @@ module Example7.RandomGif exposing (..) import Html exposing (..) import Html.Attributes exposing (style) import Html.Events exposing (onClick) -import Http +import Http exposing (expectJson) import Json.Decode as Json import Task +import Url + -- MODEL @@ -30,6 +32,7 @@ init topic gifUrl = ( Model topic gifUrl , if gifUrl == Nothing then getRandomGif topic + else Cmd.none ) @@ -64,36 +67,30 @@ update action model = -- VIEW -(=>) = - (,) - - view : Model -> Html Action view model = - div [ style [ "width" => "200px" ] ] - [ h2 [ headerStyle ] [ text model.topic ] - , div [ imgStyle (Maybe.withDefault "assets/waiting.gif" model.gifUrl) ] [] + div [ style "width" "200px" ] + [ h2 headerStyle [ text model.topic ] + , div ( imgStyle (Maybe.withDefault "assets/waiting.gif" model.gifUrl) ) [] , button [ onClick RequestMore ] [ text "More Please!" ] ] -headerStyle : Attribute any +headerStyle : List (Attribute any) headerStyle = - style - [ "width" => "200px" - , "text-align" => "center" + [ style "width" "200px" + , style "text-align" "center" ] -imgStyle : String -> Attribute any +imgStyle : String -> List (Attribute any) imgStyle url = - style - [ "display" => "inline-block" - , "width" => "200px" - , "height" => "200px" - , "background-position" => "center center" - , "background-size" => "cover" - , "background-image" => ("url('" ++ url ++ "')") + [ style "display" "inline-block" + , style "width" "200px" + , style "height" "200px" + , style "background-position" "center center" + , style "background-size" "cover" + , style "background-image" ("url('" ++ url ++ "')") ] @@ -118,20 +115,19 @@ queryPair ( key, value ) = queryEscape : String -> String queryEscape string = - String.join "+" (String.split "%20" (Http.encodeUri string)) + String.join "+" (String.split "%20" (Url.percentEncode string)) getRandomGif : String -> Cmd Action getRandomGif topic = - Http.send NewGif <| - Http.get (randomUrl topic) decodeUrl + Http.get { url = randomUrl topic, expect = expectJson NewGif decodeUrl } randomUrl : String -> String randomUrl topic = urlWithArgs "http://api.giphy.com/v1/gifs/random" - [ "api_key" => "dc6zaTOxFJmzC" - , "tag" => topic + [ ("api_key", "dc6zaTOxFJmzC") + , ("tag", topic) ] @@ -150,8 +146,9 @@ case a little. encodeLocation : Model -> Maybe (List String) encodeLocation model = -- Don't encode if there's no gifUrl - if (model.gifUrl == Nothing) then + if model.gifUrl == Nothing then Nothing + else Just [ model.topic diff --git a/examples/elm-architecture-tutorial/Example7/RandomGifList.elm b/examples/elm-architecture-tutorial/Example7/RandomGifList.elm index 3725683..1a41aa8 100644 --- a/examples/elm-architecture-tutorial/Example7/RandomGifList.elm +++ b/examples/elm-architecture-tutorial/Example7/RandomGifList.elm @@ -1,12 +1,13 @@ module Example7.RandomGifList exposing (..) +import Example7.RandomGif as RandomGif import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) import Json.Decode as Json -import RouteHash exposing (HashUpdate) -import RouteUrl.Builder exposing (Builder, builder, path, replacePath) -import Example7.RandomGif as RandomGif +import RouteUrl exposing (HistoryEntry(..), UrlChange(..)) +import Url exposing (Url) + -- MODEL @@ -56,9 +57,9 @@ update message model = newModel = Model "" (model.gifList ++ [ ( model.uid, newRandomGif ) ]) (model.uid + 1) in - ( newModel - , Cmd.map (SubMsg model.uid) fx - ) + ( newModel + , Cmd.map (SubMsg model.uid) fx + ) SubMsg msgId msg -> let @@ -68,9 +69,10 @@ update message model = ( newRandomGif, fx ) = RandomGif.update msg randomGif in - ( ( id, newRandomGif ) - , Cmd.map (SubMsg id) fx - ) + ( ( id, newRandomGif ) + , Cmd.map (SubMsg id) fx + ) + else ( entry, Cmd.none ) @@ -79,9 +81,9 @@ update message model = |> List.map subUpdate |> List.unzip in - ( { model | gifList = newGifList } - , Cmd.batch fxList - ) + ( { model | gifList = newGifList } + , Cmd.batch fxList + ) Set list -> let @@ -104,38 +106,33 @@ update message model = ( models, effects ) = List.unzip modelsAndEffects in - ( { model - | gifList = models - , uid = List.length models - } - , Cmd.batch effects - ) + ( { model + | gifList = models + , uid = List.length models + } + , Cmd.batch effects + ) -- VIEW -(=>) = - (,) - - view : Model -> Html Action view model = div [] [ input - [ placeholder "What kind of gifs do you want?" - , value model.topic - , onEnter Create - , onInput Topic - , inputStyle - ] + ([ placeholder "What kind of gifs do you want?" + , value model.topic + , onEnter Create + , onInput Topic + ] + ++ inputStyle + ) [] , div - [ style - [ "display" => "flex" - , "flex-wrap" => "wrap" - ] + [ style "display" "flex" + , style "flex-wrap" "wrap" ] (List.map elementView model.gifList) ] @@ -146,15 +143,14 @@ elementView ( id, model ) = Html.map (SubMsg id) (RandomGif.view model) -inputStyle : Attribute any +inputStyle : List (Attribute any) inputStyle = - style - [ ( "width", "100%" ) - , ( "height", "40px" ) - , ( "padding", "10px 0" ) - , ( "font-size", "2em" ) - , ( "text-align", "center" ) - ] + [ style "width" "100%" + , style "height" "40px" + , style "padding" "10px 0" + , style "font-size" "2em" + , style "text-align" "center" + ] onEnter : Action -> Attribute Action @@ -169,6 +165,7 @@ is13 : Int -> Json.Decoder () is13 code = if code == 13 then Json.succeed () + else Json.fail "not the right key code" @@ -185,34 +182,40 @@ title = --- Routing (Old API) +-- Routing (New API) -{-| We record each thing in the gifList. Note that we don't track the ID's, -since in this app there isn't any need to preserve them ... of course, we -could track them if it mattered. --} -delta2update : Model -> Model -> Maybe HashUpdate -delta2update previous current = - current.gifList - |> List.filterMap (Tuple.second >> RandomGif.encodeLocation) - |> List.concat - |> RouteHash.set +delta2builder : Model -> Model -> Maybe UrlChange +delta2builder previous current = + let + path = + current.gifList + |> List.filterMap (Tuple.second >> RandomGif.encodeLocation) + |> List.concat + in + NewPath NewEntry + { path = String.concat <| List.intersperse "/" path, query = Nothing, fragment = Nothing } |> Just -location2action : List String -> List Action -location2action list = - [ Set <| - List.map - (\( topic, url ) -> - if url == "" then - ( topic, Nothing ) - else - ( topic, Just url ) - ) - (inTwos list) - ] +builder2messages : (Url -> Maybe String) -> Url -> List Action +builder2messages extractPath url = + case extractPath url of + Nothing -> + [] + + Just path -> + [ Set <| + List.map + (\( topic, u ) -> + if u == "" then + ( topic, Nothing ) + + else + ( topic, Just u ) + ) + (inTwos (String.split "/" path)) + ] inTwos : List a -> List ( a, a ) @@ -226,36 +229,5 @@ inTwos list = _ -> result in - List.reverse <| - step list [] - - - --- Routing (New API) - - -delta2builder : Model -> Model -> Maybe Builder -delta2builder previous current = - let - path = - current.gifList - |> List.filterMap (Tuple.second >> RandomGif.encodeLocation) - |> List.concat - in - builder - |> replacePath path - |> Just - - -builder2messages : Builder -> List Action -builder2messages builder = - [ Set <| - List.map - (\( topic, url ) -> - if url == "" then - ( topic, Nothing ) - else - ( topic, Just url ) - ) - (inTwos (path builder)) - ] + List.reverse <| + step list [] diff --git a/examples/elm-architecture-tutorial/Example8/SpinSquare.elm b/examples/elm-architecture-tutorial/Example8/SpinSquare.elm index be4c892..6048f70 100644 --- a/examples/elm-architecture-tutorial/Example8/SpinSquare.elm +++ b/examples/elm-architecture-tutorial/Example8/SpinSquare.elm @@ -1,14 +1,14 @@ -module Example8.SpinSquare exposing (Model, Action, init, update, view, delta2update, location2action, subscriptions) +module Example8.SpinSquare exposing (Action, Model, delta2update, init, location2action, subscriptions, update, view) +import Browser.Events exposing (onAnimationFrameDelta) import Ease exposing (outBounce) import Html exposing (Html) -import Svg exposing (svg, rect, g, text, text_) +import String +import Svg exposing (g, rect, svg, text, text_) import Svg.Attributes exposing (..) import Svg.Events exposing (onClick) -import Time exposing (Time, second) -import RouteHash exposing (HashUpdate) -import AnimationFrame -import String +import Time exposing (Posix, millisToPosix, posixToMillis) + -- MODEL @@ -21,7 +21,7 @@ type alias Model = type alias AnimationState = - { elapsedTime : Time + { elapsedTime : Float , step : Float } @@ -38,7 +38,7 @@ rotateStep = duration = - second + 60 * 1000 @@ -49,7 +49,7 @@ duration = -} type Action = Spin - | Tick Time + | Tick Float | SetAngle Float @@ -57,7 +57,7 @@ subscriptions : Model -> Sub Action subscriptions model = case model.animationState of Just _ -> - AnimationFrame.diffs Tick + onAnimationFrameDelta Tick Nothing -> Sub.none @@ -93,22 +93,23 @@ update msg model = newElapsedTime = animation.elapsedTime + diff in - if newElapsedTime > duration then - -- The animation is finished, so actually update the - -- model by changing the angle. - ( { angle = model.angle + animation.step - , animationState = Nothing - } - , Cmd.none - ) - else - -- We're still animating, so update the time and let - -- the view take care of drawing. - ( { angle = model.angle - , animationState = Just { animation | elapsedTime = newElapsedTime } - } - , Cmd.none - ) + if newElapsedTime > duration then + -- The animation is finished, so actually update the + -- model by changing the angle. + ( { angle = model.angle + animation.step + , animationState = Nothing + } + , Cmd.none + ) + + else + -- We're still animating, so update the time and let + -- the view take care of drawing. + ( { angle = model.angle + , animationState = Just { animation | elapsedTime = newElapsedTime } + } + , Cmd.none + ) SetAngle angle -> ( { model @@ -133,7 +134,7 @@ toOffset animationState = 0 Just animation -> - (outBounce (animation.elapsedTime / duration)) * animation.step + outBounce (animation.elapsedTime / duration) * animation.step view : Model -> Html Action @@ -142,25 +143,25 @@ view model = angle = model.angle + toOffset model.animationState in - svg - [ width "200", height "200", viewBox "0 0 200 200" ] - [ g - [ transform ("translate(100, 100) rotate(" ++ toString angle ++ ")") - , onClick Spin - ] - [ rect - [ x "-50" - , y "-50" - , width "100" - , height "100" - , rx "15" - , ry "15" - , style "fill: #60B5CC;" - ] - [] - , text_ [ fill "white", textAnchor "middle" ] [ text "Click me!" ] + svg + [ width "200", height "200", viewBox "0 0 200 200" ] + [ g + [ transform ("translate(100, 100) rotate(" ++ String.fromFloat angle ++ ")") + , onClick Spin + ] + [ rect + [ x "-50" + , y "-50" + , width "100" + , height "100" + , rx "15" + , ry "15" + , style "fill: #60B5CC;" ] + [] + , text_ [ fill "white", textAnchor "middle" ] [ text "Click me!" ] ] + ] @@ -175,13 +176,13 @@ delta2update current = -- we don't want to set the history for every animation step if current.animationState == Nothing then Just <| - toString current.angle + String.fromFloat current.angle + else Nothing -location2action : String -> Maybe Action +location2action : Maybe String -> Maybe Action location2action location = Maybe.map SetAngle <| - Result.toMaybe <| - String.toFloat location + Maybe.andThen String.toFloat location diff --git a/examples/elm-architecture-tutorial/Example8/SpinSquarePair.elm b/examples/elm-architecture-tutorial/Example8/SpinSquarePair.elm index 9160485..895c6a1 100644 --- a/examples/elm-architecture-tutorial/Example8/SpinSquarePair.elm +++ b/examples/elm-architecture-tutorial/Example8/SpinSquarePair.elm @@ -1,10 +1,15 @@ module Example8.SpinSquarePair exposing (..) +import Example8.SpinSquare as SpinSquare import Html exposing (..) import Html.Attributes exposing (..) -import Example8.SpinSquare as SpinSquare -import RouteHash exposing (HashUpdate) -import RouteUrl.Builder as Builder exposing (Builder, builder, insertQuery, getQuery) +import Maybe.Extra +import RouteUrl exposing (HistoryEntry(..), UrlChange(..)) +import Url exposing (Url) +import Url.Builder exposing (relative, string) +import Url.Parser exposing (parse, query) +import Url.Parser.Query exposing (map2) + -- MODEL @@ -25,12 +30,12 @@ init = ( right, rightFx ) = SpinSquare.init in - ( Model left right - , Cmd.batch - [ Cmd.map Left leftFx - , Cmd.map Right rightFx - ] - ) + ( Model left right + , Cmd.batch + [ Cmd.map Left leftFx + , Cmd.map Right rightFx + ] + ) @@ -58,31 +63,27 @@ update action model = ( left, fx ) = SpinSquare.update act model.left in - ( Model left model.right - , Cmd.map Left fx - ) + ( Model left model.right + , Cmd.map Left fx + ) Right act -> let ( right, fx ) = SpinSquare.update act model.right in - ( Model model.left right - , Cmd.map Right fx - ) + ( Model model.left right + , Cmd.map Right fx + ) -- VIEW -(=>) = - (,) - - view : Model -> Html Action view model = - div [ style [ "display" => "flex" ] ] + div [ style "display" "flex" ] [ Html.map Left (SpinSquare.view model.left) , Html.map Right (SpinSquare.view model.right) ] @@ -101,48 +102,10 @@ title = -- Routing --- Old `RouteHash` API - - -delta2update : Model -> Model -> Maybe HashUpdate -delta2update previous current = - let - left = - SpinSquare.delta2update current.left - - right = - SpinSquare.delta2update current.right - in - left - |> Maybe.andThen - (\l -> - right - |> Maybe.andThen - (\r -> - Just <| - RouteHash.set [ l, r ] - ) - ) - - -location2action : List String -> List Action -location2action list = - case list of - left :: right :: rest -> - List.filterMap identity - [ Maybe.map Left <| SpinSquare.location2action left - , Maybe.map Right <| SpinSquare.location2action right - ] - - _ -> - [] - - - -- New `RouteUrl` API -delta2builder : Model -> Model -> Maybe Builder +delta2builder : Model -> Model -> Maybe UrlChange delta2builder previous current = let left : Maybe String @@ -153,33 +116,43 @@ delta2builder previous current = right = SpinSquare.delta2update current.right in - left - |> Maybe.andThen - (\l -> - right - |> Maybe.andThen - (\r -> - -- Since we can, why not use the query parameters? - Just - (builder - |> insertQuery "left" l - |> insertQuery "right" r - ) - ) - ) - - -builder2messages : Builder -> List Action -builder2messages builder = + left + |> Maybe.andThen + (\l -> + right + |> Maybe.andThen + (\r -> + -- Since we can, why not use the query parameters? + Just <| + NewQuery NewEntry + { query = + -- work around https://github.com/elm/url/issues/37 + String.dropLeft 1 <| + relative [] [ string "left" l, string "right" r ] + , fragment = Nothing + } + ) + ) + + +builder2messages : Url -> List Action +builder2messages url = -- Remember that you can parse as you like ... this is just -- an example, and there are better ways. let - left = - getQuery "left" builder - |> List.filterMap (Maybe.map Left << SpinSquare.location2action) - - right = - getQuery "right" builder - |> List.filterMap (Maybe.map Right << SpinSquare.location2action) + workaroundUrl = + -- https://github.com/elm/url/issues/17 + { url | path = "" } + + parseQuery = + query <| + map2 List.append + (Url.Parser.Query.map (List.map Left << Maybe.Extra.toList << SpinSquare.location2action) <| Url.Parser.Query.string "left") + (Url.Parser.Query.map (List.map Right << Maybe.Extra.toList << SpinSquare.location2action) <| Url.Parser.Query.string "right") in - List.append left right + case parse parseQuery workaroundUrl of + Nothing -> + [] + + Just actions -> + actions diff --git a/examples/elm-architecture-tutorial/ExampleViewer.elm b/examples/elm-architecture-tutorial/ExampleViewer.elm index 75ef62f..2e9e405 100644 --- a/examples/elm-architecture-tutorial/ExampleViewer.elm +++ b/examples/elm-architecture-tutorial/ExampleViewer.elm @@ -1,16 +1,9 @@ module ExampleViewer exposing (..) -import Html exposing (Html, div, p, text, table, tr, td, map) -import Html.Attributes exposing (style) -import Html.Events exposing (onClick) -import RouteHash exposing (HashUpdate) -import RouteUrl exposing (UrlChange) -import RouteUrl.Builder as Builder exposing (Builder) -import Navigation exposing (Location) - - -- Note that I'm renaming these locally for simplicity. +import Browser exposing (Document, UrlRequest) +import Browser.Navigation exposing (Key) import Example1.Counter as Example1 import Example2.CounterPair as Example2 import Example3.CounterList as Example3 @@ -19,6 +12,12 @@ import Example5.RandomGif as Example5 import Example6.RandomGifPair as Example6 import Example7.RandomGifList as Example7 import Example8.SpinSquarePair as Example8 +import Html exposing (Html, div, map, p, table, td, text, tr) +import Html.Attributes exposing (style) +import Html.Events exposing (onClick) +import RouteUrl exposing (HistoryEntry, UrlChange(..)) +import Url exposing (Url) + -- MODEL @@ -63,13 +62,16 @@ type alias Model = -- And, we need to track which example we're actually showing , currentExample : Example + + -- And as discussed in the documentation for UrlChange, we need to track the original path + , originalPath : Maybe (List String) } {-| Now, to init our model, we have to collect each examples init -} -init : ( Model, Cmd Action ) -init = +init : () -> Key -> ( Model, Cmd Action ) +init _ _ = let model = { example1 = Example1.init @@ -81,6 +83,7 @@ init = , example7 = Tuple.first Example7.init , example8 = Tuple.first Example8.init , currentExample = Example1 + , originalPath = Nothing } effects = @@ -93,7 +96,7 @@ init = , Cmd.map Example8Action <| Tuple.second Example8.init ] in - ( model, effects ) + ( model, effects ) @@ -112,7 +115,8 @@ subscriptions model = type Action - = Example1Action Example1.Action + = SetOriginalPath (List String) + | Example1Action Example1.Action | Example2Action Example2.Action | Example3Action Example3.Action | Example4Action Example4.Action @@ -121,6 +125,7 @@ type Action | Example7Action Example7.Action | Example8Action Example8.Action | ShowExample Example + | ExternalUrlRequested String | NoOp @@ -130,6 +135,9 @@ update action model = NoOp -> ( model, Cmd.none ) + SetOriginalPath paths -> + ( { model | originalPath = Just paths }, Cmd.none ) + ShowExample example -> ( { model | currentExample = example } , Cmd.none @@ -160,48 +168,54 @@ update action model = result = Example5.update subaction model.example5 in - ( { model | example5 = Tuple.first result } - , Cmd.map Example5Action <| Tuple.second result - ) + ( { model | example5 = Tuple.first result } + , Cmd.map Example5Action <| Tuple.second result + ) Example6Action subaction -> let result = Example6.update subaction model.example6 in - ( { model | example6 = Tuple.first result } - , Cmd.map Example6Action <| Tuple.second result - ) + ( { model | example6 = Tuple.first result } + , Cmd.map Example6Action <| Tuple.second result + ) Example7Action subaction -> let result = Example7.update subaction model.example7 in - ( { model | example7 = Tuple.first result } - , Cmd.map Example7Action <| Tuple.second result - ) + ( { model | example7 = Tuple.first result } + , Cmd.map Example7Action <| Tuple.second result + ) Example8Action subaction -> let result = Example8.update subaction model.example8 in - ( { model | example8 = Tuple.first result } - , Cmd.map Example8Action <| Tuple.second result - ) + ( { model | example8 = Tuple.first result } + , Cmd.map Example8Action <| Tuple.second result + ) + + ExternalUrlRequested _ -> + --none of the anchors we produce in our `view` function are external, + --so we can ignore this + ( model, Cmd.none ) -- VIEW -(=>) = - (,) +view : Model -> Document Action +view model = + { title = "Example", body = [ viewImpl model ] } -view : Model -> Html Action -view model = +viewImpl : Model -> Html Action +viewImpl model = let viewExample = case model.currentExample of @@ -233,12 +247,13 @@ view model = let styleList = if example == model.currentExample then - [ "font-weight" => "bold" + [ style "font-weight" "bold" ] + else - [ "font-weight" => "normal" - , "color" => "blue" - , "cursor" => "pointer" + [ style "font-weight" "normal" + , style "color" "blue" + , style "cursor" "pointer" ] -- Note that we compose the full title out of some information the @@ -247,7 +262,7 @@ view model = fullTitle = text <| "Example " - ++ (toString index) + ++ String.fromInt index ++ ": " ++ title @@ -255,11 +270,12 @@ view model = clickAction = if example == model.currentExample then [] + else [ onClick (ShowExample example) ] in - p (style styleList :: clickAction) - [ fullTitle ] + p (styleList ++ clickAction) + [ fullTitle ] toc = div [] <| @@ -274,265 +290,262 @@ view model = , ( 8, Example8, Example8.title ) ] in - table [] - [ tr [] - [ td - [ style - [ "vertical-align" => "top" - , "width" => "25%" - , "padding" => "8px" - , "margin" => "8px" - ] - ] - [ toc ] - , td - [ style - [ "vertical-align" => "top" - , "width" => "75%" - , "padding" => "8px" - , "margin" => "8px" - , "border" => "1px dotted black" - ] - ] - [ viewExample ] + table [] + [ tr [] + [ td + [ style "vertical-align" "top" + , style "width" "25%" + , style "padding" "8px" + , style "margin" "8px" ] + [ toc ] + , td + [ style "vertical-align" "top" + , style "width" "75%" + , style "padding" "8px" + , style "margin" "8px" + , style "border" "1px dotted black" + ] + [ viewExample ] ] + ] -- ROUTING -- --- I've include demo code here for the old API, as well as the new API --- using the full URL or just using the hash. Just to be completely clear, --- you don't need all of these in practice ... you just pick one! --- --------------------- --- Old RouteHash API --------------------- -{-| If you have existing code using elm-route-hash, your `delta2update` function -should not require any changes. +{-| This is an example of the API, if using the whole URL -} -delta2update : Model -> Model -> Maybe HashUpdate -delta2update previous current = - case current.currentExample of - Example1 -> - -- First, we ask the submodule for a HashUpdate. Then, we use - -- `map` to prepend something to the URL. - RouteHash.map ((::) "example-1") <| - Example1.delta2update previous.example1 current.example1 - - Example2 -> - RouteHash.map ((::) "example-2") <| - Example2.delta2update previous.example2 current.example2 - - Example3 -> - RouteHash.map ((::) "example-3") <| - Example3.delta2update previous.example3 current.example3 - - Example4 -> - RouteHash.map ((::) "example-4") <| - Example4.delta2update previous.example4 current.example4 - - Example5 -> - RouteHash.map ((::) "example-5") <| - Example5.delta2update previous.example5 current.example5 - - Example6 -> - RouteHash.map ((::) "example-6") <| - Example6.delta2update previous.example6 current.example6 - - Example7 -> - RouteHash.map ((::) "example-7") <| - Example7.delta2update previous.example7 current.example7 - - Example8 -> - RouteHash.map ((::) "example-8") <| - Example8.delta2update previous.example8 current.example8 - - -{-| Here, we basically do the reverse of what delta2update does. If you -have existing code using elm-route-hash, your `location2action` function -should not require any changes. --} -location2action : List String -> List Action -location2action list = - case list of - "example-1" :: rest -> - -- We give the Example1 module a chance to interpret the rest of - -- the URL, and then we prepend an action for the part we - -- interpreted. - (ShowExample Example1) :: List.map Example1Action (Example1.location2action rest) - - "example-2" :: rest -> - (ShowExample Example2) :: List.map Example2Action (Example2.location2action rest) - - "example-3" :: rest -> - (ShowExample Example3) :: List.map Example3Action (Example3.location2action rest) - - "example-4" :: rest -> - (ShowExample Example4) :: List.map Example4Action (Example4.location2action rest) - - "example-5" :: rest -> - (ShowExample Example5) :: List.map Example5Action (Example5.location2action rest) - - "example-6" :: rest -> - (ShowExample Example6) :: List.map Example6Action (Example6.location2action rest) +delta2url : Model -> Model -> Maybe UrlChange +delta2url previous current = + -- You can construct a `UrlChange` however you like. + delta2builder identity previous current - "example-7" :: rest -> - (ShowExample Example7) :: List.map Example7Action (Example7.location2action rest) - "example-8" :: rest -> - (ShowExample Example8) :: List.map Example8Action (Example8.location2action rest) +{-| An example of the API, if just using the hash +-} +delta2hash : Model -> Model -> Maybe UrlChange +delta2hash previous current = + -- TODO Here, we're re-using the Path-oriented code, but stuffing everything + -- into the hash (rather than actually using the full URL). + let + movePathToFragment urlChange = + case urlChange of + NewPath historyEntry origNewPath -> + let + fragment = + Just origNewPath.path + in + NewPath historyEntry { origNewPath | path = "", fragment = fragment } + + NewQuery _ _ -> + urlChange + + NewFragment _ _ -> + urlChange + in + delta2builder movePathToFragment previous current - _ -> - -- Normally, you'd want to show an error of some kind here. - -- But, for the moment, I'll just default to example1 - [ ShowExample Example1 ] +{-| This is the common code that we rely on above. +-} +delta2builder : (UrlChange -> UrlChange) -> Model -> Model -> Maybe UrlChange +delta2builder mungePath previous current = + let + submoduleChange = + case current.currentExample of + Example1 -> + -- First, we ask the submodule for a `Maybe UrlChange`. Then, we use + -- `map` to prepend something to the path. + Example1.delta2builder previous.example1 current.example1 + |> Maybe.map (prependToPath [ "example-1" ]) + |> Maybe.map mungePath + Example2 -> + Example2.delta2builder previous.example2 current.example2 + |> Maybe.map (prependToPath [ "example-2" ]) + |> Maybe.map mungePath -------------------- --- New RouteUrl API -------------------- + Example3 -> + Example3.delta2builder previous.example3 current.example3 + |> Maybe.map (prependToPath [ "example-3" ]) + |> Maybe.map mungePath + Example4 -> + Example4.delta2builder previous.example4 current.example4 + |> Maybe.map (prependToPath [ "example-4" ]) + |> Maybe.map mungePath -{-| This is an example of the new API, if using the whole URL --} -delta2url : Model -> Model -> Maybe UrlChange -delta2url previous current = - -- We're using a `Builder` to build up the possible change. You don't - -- have to do that ... you can construct a `UrlChange` however you like. - -- - -- So, as the last step, we map our possible `Builder` to a `UrlChange`. - Maybe.map Builder.toUrlChange <| - delta2builder previous current + Example5 -> + Example5.delta2builder previous.example5 current.example5 + |> Maybe.map (prependToPath [ "example-5" ]) + |> Maybe.map mungePath + Example6 -> + Example6.delta2builder previous.example6 current.example6 + |> Maybe.map (prependToPath [ "example-6" ]) + |> Maybe.map mungePath -{-| An example of the new API, if just using the hash --} -delta2hash : Model -> Model -> Maybe UrlChange -delta2hash previous current = - -- Here, we're re-using the Builder-oriented code, but stuffing everything - -- into the hash (rather than actually using the full URL). - Maybe.map Builder.toHashChange <| - delta2builder previous current + Example7 -> + Example7.delta2builder previous.example7 current.example7 + |> Maybe.map (prependToPath [ "example-7" ]) + |> Maybe.map mungePath + Example8 -> + Example8.delta2builder previous.example8 current.example8 + |> Maybe.map (prependToPath [ "example-8" ]) + |> Maybe.map mungePath -{-| This is the common code that we rely on above. Again, you don't have to use -a `Builder` if you don't want to ... it's just one way to construct a `UrlChange`. --} -delta2builder : Model -> Model -> Maybe Builder -delta2builder previous current = - case current.currentExample of - Example1 -> - -- First, we ask the submodule for a `Maybe Builder`. Then, we use - -- `map` to prepend something to the path. - Example1.delta2builder previous.example1 current.example1 - |> Maybe.map (Builder.prependToPath [ "example-1" ]) + originalPath = + Maybe.withDefault [] current.originalPath + in + Maybe.map (prependToPathImpl "/" originalPath) submoduleChange - Example2 -> - Example2.delta2builder previous.example2 current.example2 - |> Maybe.map (Builder.prependToPath [ "example-2" ]) - Example3 -> - Example3.delta2builder previous.example3 current.example3 - |> Maybe.map (Builder.prependToPath [ "example-3" ]) +prependToPath : List String -> UrlChange -> UrlChange +prependToPath = + prependToPathImpl "" - Example4 -> - Example4.delta2builder previous.example4 current.example4 - |> Maybe.map (Builder.prependToPath [ "example-4" ]) - Example5 -> - Example5.delta2builder previous.example5 current.example5 - |> Maybe.map (Builder.prependToPath [ "example-5" ]) +prependToPathImpl : String -> List String -> UrlChange -> UrlChange +prependToPathImpl prefix path u = + let + pathStr = + String.concat <| List.intersperse "/" path + in + case u of + NewPath entry pData -> + let + newPath = + case pData.path of + "" -> + pathStr - Example6 -> - Example6.delta2builder previous.example6 current.example6 - |> Maybe.map (Builder.prependToPath [ "example-6" ]) + _ -> + pathStr ++ "/" ++ pData.path + in + NewPath entry { pData | path = prefix ++ newPath } - Example7 -> - Example7.delta2builder previous.example7 current.example7 - |> Maybe.map (Builder.prependToPath [ "example-7" ]) + NewQuery entry qData -> + NewPath entry { path = prefix ++ pathStr, query = Just qData.query, fragment = qData.fragment } - Example8 -> - Example8.delta2builder previous.example8 current.example8 - |> Maybe.map (Builder.prependToPath [ "example-8" ]) + NewFragment entry fragment -> + NewPath entry { path = prefix ++ pathStr, query = Nothing, fragment = Just fragment } {-| This is an example of a `location2messages` function ... I'm calling it `url2messages` to illustrate something that uses the full URL. -} -url2messages : Location -> List Action +url2messages : Url -> List Action url2messages location = - -- You can parse the `Location` in whatever way you want. I'm making - -- a `Builder` and working from that, but I'm sure that's not the - -- best way. There are links to a number of proper parsing packages + -- You can parse the `Url` in whatever way you want. There are links to a number of proper parsing packages -- in the README. - builder2messages (Builder.fromUrl location.href) + builder2messages Nothing (Just << .path) (\url -> \path -> { url | path = path }) location {-| This is an example of a `location2messages` function ... I'm calling it `hash2messages` to illustrate something that uses just the hash. -} -hash2messages : Location -> List Action +hash2messages : Url -> List Action hash2messages location = - -- You can parse the `Location` in whatever way you want. I'm making - -- a `Builder` and working from that, but I'm sure that's not the - -- best way. There are links to a number of proper parsing packages + -- You can parse the `Url` in whatever way you want. There are links to a number of proper parsing packages -- in the README. - builder2messages (Builder.fromHash location.href) - - -{-| Another example of a `location2messages` function, this time only using the hash. --} -builder2messages : Builder -> List Action -builder2messages builder = - -- You can parse the `Location` in whatever way you want ... there are a - -- number of parsing packages listed in the README. Here, I'm constructing - -- a `Builder` and working from that, but that's probably not the best - -- thing to do. - case Builder.path builder of - first :: rest -> - let - subBuilder = - Builder.replacePath rest builder - in - case first of - "example-1" -> - -- We give the Example1 module a chance to interpret - -- the rest of the location, and then we prepend an - -- action for the part we interpreted. - (ShowExample Example1) :: List.map Example1Action (Example1.builder2messages subBuilder) - - "example-2" -> - (ShowExample Example2) :: List.map Example2Action (Example2.builder2messages subBuilder) - - "example-3" -> - (ShowExample Example3) :: List.map Example3Action (Example3.builder2messages subBuilder) - - "example-4" -> - (ShowExample Example4) :: List.map Example4Action (Example4.builder2messages subBuilder) + let + hashMessages = + builder2messages Nothing .fragment (\url -> \path -> { url | fragment = Just path }) location - "example-5" -> - (ShowExample Example5) :: List.map Example5Action (Example5.builder2messages subBuilder) + isSetOriginalPath msg = + case msg of + SetOriginalPath _ -> + True - "example-6" -> - (ShowExample Example6) :: List.map Example6Action (Example6.builder2messages subBuilder) + _ -> + False - "example-7" -> - (ShowExample Example7) :: List.map Example7Action (Example7.builder2messages subBuilder) + pathMessages = + url2messages location + |> List.filter isSetOriginalPath + in + pathMessages ++ hashMessages - "example-8" -> - (ShowExample Example8) :: List.map Example8Action (Example8.builder2messages subBuilder) - _ -> - -- Normally, you'd want to show an error of some kind here. - -- But, for the moment, I'll just default to example1 - [ ShowExample Example1 ] +{-| A `location2messages` function that lets the caller determine how to store the location in the `Url` +-} +builder2messages : Maybe (List String) -> (Url -> Maybe String) -> (Url -> String -> Url) -> Url -> List Action +builder2messages originalPathSegments extractPath insertPath url = + -- You can parse the `Location` in whatever way you want ... there are a + -- number of parsing packages listed in the README. + case extractPath url of + Nothing -> + [] - _ -> - -- Normally, you'd want to show an error of some kind here. - -- But, for the moment, I'll just default to example1 - [ ShowExample Example1 ] + Just path -> + let + noMore = + case originalPathSegments of + Nothing -> + -- When loading the example initially, start with example 1 + [ ShowExample Example1 ] + + Just segments -> + [ SetOriginalPath segments ] + in + case String.split "/" path of + "" :: [] -> + noMore + + first :: rest -> + let + subUrl = + insertPath url <| String.concat <| List.intersperse "/" rest + in + case first of + "example-1" -> + -- We give the Example1 module a chance to interpret + -- the rest of the location, and then we prepend an + -- action for the part we interpreted. + ShowExample Example1 :: List.map Example1Action (Example1.builder2messages extractPath subUrl) + + "example-2" -> + ShowExample Example2 :: List.map Example2Action (Example2.builder2messages subUrl) + + "example-3" -> + ShowExample Example3 :: List.map Example3Action (Example3.builder2messages extractPath subUrl) + + "example-4" -> + ShowExample Example4 :: List.map Example4Action (Example4.builder2messages extractPath subUrl) + + "example-5" -> + ShowExample Example5 :: List.map Example5Action (Example5.builder2messages extractPath subUrl) + + "example-6" -> + ShowExample Example6 :: List.map Example6Action (Example6.builder2messages extractPath subUrl) + + "example-7" -> + ShowExample Example7 :: List.map Example7Action (Example7.builder2messages extractPath subUrl) + + "example-8" -> + ShowExample Example8 :: List.map Example8Action (Example8.builder2messages subUrl) + + originalPathSegment -> + let + originalPathSegmentsPlus = + Just <| + case originalPathSegment == "" of + True -> + [] + + False -> + case originalPathSegments of + Just segs -> + segs ++ [ originalPathSegment ] + + Nothing -> + [ originalPathSegment ] + in + builder2messages originalPathSegmentsPlus extractPath insertPath subUrl + + _ -> + noMore diff --git a/examples/elm-architecture-tutorial/MainWithFullUrl.elm b/examples/elm-architecture-tutorial/MainWithFullUrl.elm index e6ec19c..d42a5d1 100644 --- a/examples/elm-architecture-tutorial/MainWithFullUrl.elm +++ b/examples/elm-architecture-tutorial/MainWithFullUrl.elm @@ -1,10 +1,10 @@ -module Main exposing (..) +module MainWithFullUrl exposing (..) -import ExampleViewer exposing (Model, Action) +import ExampleViewer exposing (Action(..), Model) import RouteUrl exposing (RouteUrlProgram) -main : RouteUrlProgram Never Model Action +main : RouteUrlProgram () Model Action main = RouteUrl.program { delta2url = ExampleViewer.delta2url @@ -13,4 +13,5 @@ main = , update = ExampleViewer.update , view = ExampleViewer.view , subscriptions = ExampleViewer.subscriptions + , onExternalUrlRequest = ExternalUrlRequested } diff --git a/examples/elm-architecture-tutorial/MainWithJustHash.elm b/examples/elm-architecture-tutorial/MainWithJustHash.elm index 50006aa..9eacf20 100644 --- a/examples/elm-architecture-tutorial/MainWithJustHash.elm +++ b/examples/elm-architecture-tutorial/MainWithJustHash.elm @@ -1,10 +1,10 @@ -module Main exposing (..) +module MainWithJustHash exposing (..) -import ExampleViewer exposing (Model, Action) +import ExampleViewer exposing (Action(..), Model) import RouteUrl exposing (RouteUrlProgram) -main : RouteUrlProgram Never Model Action +main : RouteUrlProgram () Model Action main = RouteUrl.program { delta2url = ExampleViewer.delta2hash @@ -13,4 +13,5 @@ main = , update = ExampleViewer.update , view = ExampleViewer.view , subscriptions = ExampleViewer.subscriptions + , onExternalUrlRequest = ExternalUrlRequested } diff --git a/examples/elm-architecture-tutorial/MainWithOldAPI.elm b/examples/elm-architecture-tutorial/MainWithOldAPI.elm deleted file mode 100644 index 86ef09c..0000000 --- a/examples/elm-architecture-tutorial/MainWithOldAPI.elm +++ /dev/null @@ -1,18 +0,0 @@ -module Main exposing (..) - -import ExampleViewer exposing (Model, Action) -import RouteHash -import RouteUrl exposing (RouteUrlProgram) - - -main : RouteUrlProgram Never Model Action -main = - RouteHash.program - { prefix = RouteHash.defaultPrefix - , delta2update = ExampleViewer.delta2update - , location2action = ExampleViewer.location2action - , init = ExampleViewer.init - , update = ExampleViewer.update - , view = ExampleViewer.view - , subscriptions = ExampleViewer.subscriptions - } diff --git a/examples/elm-architecture-tutorial/README.md b/examples/elm-architecture-tutorial/README.md index 06ac263..0a5a2c5 100644 --- a/examples/elm-architecture-tutorial/README.md +++ b/examples/elm-architecture-tutorial/README.md @@ -1,7 +1,7 @@ # The Elm Architecture Tutorial as a single page app In order to illustrate how to use -[elm-route-url](https://github.com/rgrempel/elm-route-url), I though it might +[elm-route-url](https://github.com/rgrempel/elm-route-url), I thought it might be useful to take some familiar code and show how to turn it into a single-page app with bookmarkable URLs and a working "forward" and "back" button. @@ -21,8 +21,7 @@ best just to [look at the code](https://github.com/rgrempel/elm-route-url/blob/master/examples/elm-architecture-tutorial/ExampleViewer.elm). You'll see near the end of the `ExampleViewer` code that I've implemented -examples for the old `RouteHash` API, as well as the new `RouteUrl` API, -either using the full URL or just the hash. +the API either using the full URL or just the hash. Here are some things you can try: @@ -55,7 +54,7 @@ So, depending on how you conceive of that, there isn't necessarily a lot more in the examples that really qualifies as "view model" state. But, I did illustrate how to do multiple layers of state anyway, just so you can see how. -* Try incrementing an decrementing a counter in Example 1. Look at how the +* Try incrementing and decrementing a counter in Example 1. Look at how the URL changes. Try the forward and back buttons. Try bookmarking and activating a bookmark. Try reloading a page. In the previous example, the examples would reset, whereas now they should maintain state. @@ -70,11 +69,10 @@ I hope that helps get you started. Here are links to three variations that you can try out live. -* the [old API](http://rgrempel.github.io/elm-route-url/examples/elm-architecture-tutorial/old-api.html) from elm-route-hash (`MainWithOldAPI.elm`) -* the new API, using the [full URL](http://rgrempel.github.io/elm-route-url/examples/elm-architecture-tutorial/full-url.html) (`MainWithFullUrl.elm`) -* the new API, using the [hash only](http://rgrempel.github.io/elm-route-url/examples/elm-architecture-tutorial/just-hash.html) (`MainWithJustHash.elm`) +* a version using the [full URL](http://rgrempel.github.io/elm-route-url/examples/elm-architecture-tutorial/full-url.html) (`MainWithFullUrl.elm`) +* a version using the [hash only](http://rgrempel.github.io/elm-route-url/examples/elm-architecture-tutorial/just-hash.html) (`MainWithJustHash.elm`) -To run the code locally instead, start up `elm-reactor` in this directory. You +To run the code locally instead, start up `elm reactor` in this directory. You can then click on one of the .elm files mentioned above to see that variation of the example. diff --git a/examples/elm-architecture-tutorial/compile.sh b/examples/elm-architecture-tutorial/compile.sh index 654716a..c02e066 100644 --- a/examples/elm-architecture-tutorial/compile.sh +++ b/examples/elm-architecture-tutorial/compile.sh @@ -1,6 +1,5 @@ #! /bin/sh mkdir -p build -elm-make --yes MainWithFullUrl.elm --output build/MainWithFullUrl.html -elm-make --yes MainWithJustHash.elm --output build/MainWithJustHash.html -elm-make --yes MainWithOldAPI.elm --output build/MainWithOldAPI.html +elm make MainWithFullUrl.elm --output build/MainWithFullUrl.html --debug +elm make MainWithJustHash.elm --output build/MainWithJustHash.html --debug diff --git a/examples/elm-architecture-tutorial/elm-package.json b/examples/elm-architecture-tutorial/elm-package.json deleted file mode 100644 index 5cc6f6d..0000000 --- a/examples/elm-architecture-tutorial/elm-package.json +++ /dev/null @@ -1,24 +0,0 @@ -{ - "version": "3.0.1", - "summary": "elm-route-url example, based on the Elm Architecture Tutorial", - "repository": "https://github.com/rgrempel/elm-route-url.git", - "license": "BSD3", - "source-directories": [ - ".", - "../../src" - ], - "exposed-modules": [], - "dependencies": { - "ccapndave/elm-update-extra": "2.3.1 <= v < 4.0.0", - "elm-community/easing-functions": "1.0.2 <= v < 2.0.0", - "elm-community/result-extra": "2.0.1 <= v < 3.0.0", - "elm-lang/animation-frame": "1.0.1 <= v < 2.0.0", - "elm-lang/core": "5.0.0 <= v < 6.0.0", - "elm-lang/html": "2.0.0 <= v < 3.0.0", - "elm-lang/http": "1.0.0 <= v < 2.0.0", - "elm-lang/navigation": "2.0.0 <= v < 3.0.0", - "elm-lang/svg": "2.0.0 <= v < 3.0.0", - "sporto/erl": "13.0.0 <= v < 14.0.0" - }, - "elm-version": "0.18.0 <= v < 0.19.0" -} diff --git a/examples/elm-architecture-tutorial/elm.json b/examples/elm-architecture-tutorial/elm.json new file mode 100644 index 0000000..0a5ff84 --- /dev/null +++ b/examples/elm-architecture-tutorial/elm.json @@ -0,0 +1,32 @@ +{ + "type": "application", + "source-directories": [ + ".", + "../../src" + ], + "elm-version": "0.19.1", + "dependencies": { + "direct": { + "ccapndave/elm-update-extra": "4.0.0", + "elm/browser": "1.0.2", + "elm/core": "1.0.3", + "elm/html": "1.0.0", + "elm/http": "2.0.0", + "elm/json": "1.1.3", + "elm/svg": "1.0.1", + "elm/time": "1.0.0", + "elm/url": "1.0.0", + "elm-community/easing-functions": "2.0.0", + "elm-community/maybe-extra": "5.1.0" + }, + "indirect": { + "elm/bytes": "1.0.8", + "elm/file": "1.0.5", + "elm/virtual-dom": "1.0.2" + } + }, + "test-dependencies": { + "direct": {}, + "indirect": {} + } +} diff --git a/run-tests.sh b/run-tests.sh index eb5b981..fa47346 100755 --- a/run-tests.sh +++ b/run-tests.sh @@ -1,4 +1,4 @@ #! /bin/sh (cd examples/elm-architecture-tutorial && sh compile.sh) -elm-test + diff --git a/src/RouteHash.elm b/src/RouteHash.elm deleted file mode 100644 index 7583631..0000000 --- a/src/RouteHash.elm +++ /dev/null @@ -1,384 +0,0 @@ -module RouteHash - exposing - ( HashUpdate - , set - , replace - , apply - , map - , extract - , Config - , ConfigWithFlags - , defaultPrefix - , app - , appWithFlags - , program - , programWithFlags - ) - -{-| This module implements the old elm-route-hash API as closely as possible, -given the changes required for elm-route-url. - -To transition from elm-route-hash to elm-route-url, you should be able to -use your existing `delta2update` and `location2action` functions without -changes. The only required changes are in your `Main` module. - -Essentially, instead of using the old `start` method and sending the resulting -signal to a port, you would now use [`program`](#program) or -[`programWithFlags`](#programWithFlags), and assign the resulting `Program` -to your `main` function. - -At your leisure, you should transition to the new `RouteUrl` API, which allows -you to use the whole URL (rather than just the hash), since this old API will -be removed in a future version of elm-route-url. - - -# Configuration - -@docs Config, ConfigWithFlags, defaultPrefix - - -# Helpers for `HashUpdate` - -@docs HashUpdate, set, replace, apply, map, extract - - -# Simple Initialization - -@docs program, programWithFlags - - -# Complicated Initialization (usually not needed) - -@docs app, appWithFlags - --} - -import String exposing (uncons, split) -import Http exposing (decodeUri, encodeUri) -import Html exposing (Html) -import Navigation exposing (Location) -import RouteUrl - exposing - ( NavigationApp - , NavigationAppWithFlags - , App - , AppWithFlags - , WrappedModel - , WrappedMsg - , UrlChange - , HistoryEntry(NewEntry, ModifyEntry) - , navigationApp - , navigationAppWithFlags - , runNavigationApp - , runNavigationAppWithFlags - , RouteUrlProgram - ) - - -{-| An opaque type which represents an update to the hash portion of the -browser's location. --} -type HashUpdate - = SetPath (List String) - | ReplacePath (List String) - - -hashUpdate2urlChange : String -> HashUpdate -> UrlChange -hashUpdate2urlChange prefix hashUpdate = - case hashUpdate of - SetPath list -> - { entry = NewEntry - , url = list2hash prefix list - } - - ReplacePath list -> - { entry = ModifyEntry - , url = list2hash prefix list - } - - -{-| Returns a [`HashUpdate`](#HashUpdate) that will update the browser's -location, creating a new history entry. - -The `List String` represents the hash portion of the location. Each element of -the list will be uri-encoded, and then the list will be joined using slashes -("/"). Finally, a prefix will be applied (by [default](#defaultPrefix), "#!/", -but it is configurable). - --} -set : List String -> HashUpdate -set = - SetPath - - -{-| Returns a [`HashUpdate`](#HashUpdate) that will update the browser's -location, replacing the current history entry. - -The `List String` represents the hash portion of the location. Each element of -the list will be uri-encoded, and then the list will be joined using slashes -("/"). Finally, a prefix will be applied (by [default](#defaultPrefix), "#!/", -but it is configurable). - --} -replace : List String -> HashUpdate -replace = - ReplacePath - - -{-| Applies the supplied function to the [`HashUpdate`](#HashUpdate). --} -apply : (List String -> List String) -> HashUpdate -> HashUpdate -apply func update = - case update of - SetPath list -> - SetPath (func list) - - ReplacePath list -> - ReplacePath (func list) - - -{-| Applies the supplied function to the [`HashUpdate`](#HashUpdate). - -You might use this function when dispatching in a modular application. -For instance, your [`delta2update`](#Config) function might look something like this: - - delta2update : Model -> Model -> Maybe HashUpdate - delta2update old new = - case new.virtualPage of - PageTag1 -> - RouteHash.map ((::) "page-tag-1") PageModule1.delta2update old new - - PageTag2 -> - RouteHash.map ((::) "page-tag-2") PageModule2.delta2update old new - -Of course, your model and modules may be set up differently. However you do it, -the `map` function allows you to dispatch `delta2update` to a lower-level module, -and then modify the `Maybe HashUpdate` which it returns. - --} -map : (List String -> List String) -> Maybe HashUpdate -> Maybe HashUpdate -map = - Maybe.map << apply - - -{-| Extracts the `List String` from the [`HashUpdate`](#HashUpdate). --} -extract : HashUpdate -> List String -extract action = - case action of - SetPath list -> - list - - ReplacePath list -> - list - - -{-| Represents the configuration necessary to use this module. - - - `prefix` is the initial characters that should be stripped from the hash (if - present) when reacting to location changes, and added to the hash when - generating location changes. Normally, you'll likely want to use - [`defaultPrefix`](#defaultPrefix), which is "#!/". - - - `delta2update` is a function which takes two arguments and possibly - returns a [`HashUpdate`](#HashUpdate). The first argument is the previous - model. The second argument is the current model. - - The reason you are provided with both the previous and current models is - that sometimes the nature of the location update depends on the difference - between the two, not just on the latest model. For instance, if the user is - typing in a form, you might want to use [`replace`](#replace) rather than - [`set`](#set). Of course, in cases where you only need to consult the - current model, you can ignore the first parameter. - - This module will normalize the `List String` in the update in the following - way before setting the actual location. It will: - - - uri-encode the strings - - join them with "/" - - add the `prefix` to the beginning - - In a modular application, you may well want to use [`map`](#map) after dispatching - to a lower level -- see the example in the [`map` documentation](#map). - - Note that this module will automatically detect cases where you return - a [`HashUpdate`](#HashUpdate) which would set the same location that is - already set, and do nothing. Thus, you don't need to try to detect that - yourself. - - The content of the individual strings is up to you ... essentially it - should be something that your `location2action` function can deal with. - - - `location2action` is a function which takes a `List String` and returns - a list of actions your app can perform. - - The argument is a normalized version of the hash portion of the location. - First, the `prefix` is stripped from the hash, and then the result is - converted to a `List String` by using '/' as a delimiter. Then, each - `String` value is uri-deocded. - - Essentially, your `location2action` should return actions that are the - reverse of what your `delta2update` function produced. That is, the - `List String` you get back in `location2action` is the `List String` that - your `delta2update` used to create a [`HashUpdate`](#HashUpdate). So, - however you encoded your state in `delta2update`, you now need to interpret - that in `location2action` in order to return actions which will produce the - desired state. - - Note that the list of actions you return will often be a single action. It - is a `List action` so that you can return multiple actions, if your app is - modular in a way that requires multiple actions to produce the desired - state. - - - The remaining functions (`init`, `update`, `subscriptions` and `view`) - have the same meaning as they do in - [`Html.program`](http://package.elm-lang.org/packages/elm-lang/html/2.0.0/Html#program) - ... that is, you should provide what you normally provide to that function. - --} -type alias Config model msg = - { prefix : String - , delta2update : model -> model -> Maybe HashUpdate - , location2action : List String -> List msg - , init : ( model, Cmd msg ) - , update : msg -> model -> ( model, Cmd msg ) - , subscriptions : model -> Sub msg - , view : model -> Html msg - } - - -{-| Like [`Config`](#Config), but with flags. --} -type alias ConfigWithFlags model msg flags = - { prefix : String - , delta2update : model -> model -> Maybe HashUpdate - , location2action : List String -> List msg - , init : flags -> ( model, Cmd msg ) - , update : msg -> model -> ( model, Cmd msg ) - , subscriptions : model -> Sub msg - , view : model -> Html msg - } - - -{-| The value that you will most often want to supply as the -`prefix` in your [`Config`](#Config). It is equal to "#!/". --} -defaultPrefix : String -defaultPrefix = - "#!/" - - -location2messagesWithFlags : ConfigWithFlags model msg flags -> Location -> List msg -location2messagesWithFlags config location = - config.location2action (hash2list config.prefix location.hash) - - -delta2urlWithFlags : ConfigWithFlags model msg flags -> model -> model -> Maybe UrlChange -delta2urlWithFlags config old new = - Maybe.map - (hashUpdate2urlChange config.prefix) - (config.delta2update old new) - - -{-| Takes your configuration, and turns into into an `AppWithFlags`. - -Usually you won't need this -- you can just use [`programWithFlags`](#programWithFlags) to -go directly to a `Program` instead. - --} -appWithFlags : ConfigWithFlags model msg flags -> AppWithFlags model msg flags -appWithFlags config = - { delta2url = delta2urlWithFlags config - , location2messages = location2messagesWithFlags config - , init = config.init - , update = config.update - , subscriptions = config.subscriptions - , view = config.view - } - - -location2messages : Config model msg -> Location -> List msg -location2messages config location = - config.location2action (hash2list config.prefix location.hash) - - -delta2url : Config model msg -> model -> model -> Maybe UrlChange -delta2url config old new = - Maybe.map - (hashUpdate2urlChange config.prefix) - (config.delta2update old new) - - -{-| Takes your configuration, and turns it into an `App`. - -Usually you won't need this -- you can just use [`program`](#program) to -go directly to a `Program` instead. - --} -app : Config model msg -> App model msg -app config = - { delta2url = delta2url config - , location2messages = location2messages config - , init = config.init - , update = config.update - , subscriptions = config.subscriptions - , view = config.view - } - - -{-| Takes your configuration, and turns it into a `Program` that can be -used in your `main` function. --} -program : Config model msg -> RouteUrlProgram Never model msg -program = - runNavigationApp << navigationApp << app - - -{-| Takes your configuration, and turns it into a `Program flags` that can be -used in your `main` function. --} -programWithFlags : ConfigWithFlags model msg flags -> RouteUrlProgram flags model msg -programWithFlags = - runNavigationAppWithFlags << navigationAppWithFlags << appWithFlags - - -{-| Remove the character from the string if it is the first character --} -removeInitial : Char -> String -> String -removeInitial initial original = - case uncons original of - Just ( first, rest ) -> - if first == initial then - rest - else - original - - _ -> - original - - -{-| Remove initial characters from the string, as many as there are. - -So, for "#!/", remove # if is first, then ! if it is next, etc. - --} -removeInitialSequence : String -> String -> String -removeInitialSequence initial original = - String.foldl removeInitial original initial - - -{-| Takes a string from the location's hash, and normalize it to a list of strings -that were separated by a slash. --} -hash2list : String -> String -> List String -hash2list prefix hash = - removeInitialSequence prefix hash - |> split "/" - |> List.map (\part -> Maybe.withDefault part (decodeUri part)) - - -{-| The opposite of normalizeHash ... takes a list and turns it into a hash --} -list2hash : String -> List String -> String -list2hash prefix list = - prefix ++ String.join "/" (List.map encodeUri list) diff --git a/src/RouteUrl.elm b/src/RouteUrl.elm index 95e6cd0..a97df1f 100644 --- a/src/RouteUrl.elm +++ b/src/RouteUrl.elm @@ -1,26 +1,11 @@ -module RouteUrl - exposing - ( App - , AppWithFlags - , program - , programWithFlags - , UrlChange - , HistoryEntry(NewEntry, ModifyEntry) - , NavigationApp - , navigationApp - , runNavigationApp - , NavigationAppWithFlags - , navigationAppWithFlags - , runNavigationAppWithFlags - , WrappedModel - , unwrapModel - , mapModel - , WrappedMsg - , unwrapMsg - , wrapUserMsg - , wrapLocation - , RouteUrlProgram - ) +module RouteUrl exposing + ( App + , UrlChange(..), HistoryEntry(..) + , program, RouteUrlProgram + , NavigationApp, navigationApp, runNavigationApp + , WrappedModel, unwrapModel, mapModel + , WrappedMsg, unwrapMsg, wrapUserMsg, wrapLocation + ) {-| This module provides routing for single-page apps based on changes to the the browser's location. The routing happens in both directions @@ -31,19 +16,17 @@ the 'back' and 'forward' buttons in the browser to do useful things, and for the state of your app to be partially bookmark-able. It is, of course, possible to do something like this using -[`elm-lang/navigation`](http://package.elm-lang.org/packages/elm-lang/navigation/latest) +[`elm/browser`](https://package.elm-lang.org/packages/elm/browser/latest) by itself. For a discussion of the differences between the official module and this one, see the -[package documentation](http://package.elm-lang.org/packages/rgrempel/elm-route-url/latest). +[package documentation](https://package.elm-lang.org/packages/rgrempel/elm-route-url/latest). # Configuration -You configure this module by providing the functions set out in [`App`](#App) or -[`AppWithFlags`](#AppWithFlags), depending on what kind of `init` function you -want to use. +You configure this module by providing the functions set out in [`App`](#App). -@docs App, AppWithFlags +@docs App # URL Changes @@ -58,13 +41,12 @@ displayed in the browser's location bar. The simplest way to use this module is to do something like this: - - Define your [`App`](#App) or [`AppWithFlags`](#AppWithFlags) record. + - Define your [`App`](#App) record. - - Use [`program`](#program) or [`programWithFlags`](#programWithFlags) to - create your `main` function, instead of their homonymous equivalents in - [`Html`](http://package.elm-lang.org/packages/elm-lang/html/2.0.0/Html). + - Use [`program`](#program) to + create your `main` function, instead of [`Browser.application`](https://package.elm-lang.org/packages/elm/browser/latest/Browser#application). -@docs program, programWithFlags, RouteUrlProgram +@docs program, RouteUrlProgram # More complex initialization @@ -74,31 +56,29 @@ remaining types and function to be of interest. You won't usually need them. @docs NavigationApp, navigationApp, runNavigationApp -@docs NavigationAppWithFlags, navigationAppWithFlags, runNavigationAppWithFlags @docs WrappedModel, unwrapModel, mapModel @docs WrappedMsg, unwrapMsg, wrapUserMsg, wrapLocation -} -import Dict -import Erl exposing (Url) +import Browser exposing (..) +import Browser.Navigation exposing (..) import Html exposing (Html) -import Navigation exposing (Location) -import String exposing (startsWith) import Update.Extra exposing (sequence) +import Url exposing (..) + -- THINGS CLIENTS PROVIDE -{-| The configuration required to use this module to create a `Program`. +{-| The configuration required to use this module to create a `Browser.application`. -The `init`, `update`, `subscriptions` and `view` fields have the same meaning -as they do in [`Html.program`](http://package.elm-lang.org/packages/elm-lang/html/2.0.0/Html#program) +The `init`, `update`, `subscriptions`, and `view` fields have the same meaning +as they do in [`Browser.application`](https://package.elm-lang.org/packages/elm/browser/latest/Browser#application) -- that is, you should provide what you normally provide to that function. -So, the "special" fields are the `delta2url` function and the -`location2messages` function. +So, the "special" fields are the `delta2url`, `location2messages`, and `onExternalUrlRequest` functions. - `delta2url` will be called when your model changes. The first parameter is the model's previous value, and the second is the model's new value. @@ -115,7 +95,7 @@ So, the "special" fields are the `delta2url` function and the For instance, it might make the difference between using `NewEntry` or `ModifyEntry` to make the change. - Note that this function will *not* be called when processing messages + Note that this function will _not_ be called when processing messages returned from your `location2messages` function, since in that case the URL has already been set. @@ -123,7 +103,7 @@ So, the "special" fields are the `delta2url` function and the detected, either because the user followed a link, typed something in the location bar, or used the back or forward buttons. - Note that this function will *not* be called when your `delta2url` method + Note that this function will _not_ be called when your `delta2url` method initiates a `UrlChange` -- since in that case, the relevant change in the model has already occurred. @@ -131,67 +111,20 @@ So, the "special" fields are the `delta2url` function and the can respond to. Those messages will be fed into your app, to produce the changes to the model that the new URL implies. --} -type alias App model msg = - { delta2url : model -> model -> Maybe UrlChange - , location2messages : Location -> List msg - , init : ( model, Cmd msg ) - , update : msg -> model -> ( model, Cmd msg ) - , subscriptions : model -> Sub msg - , view : model -> Html msg - } - - -{-| The configuration needed to use this module to make a `Program flags`. - -The `init`, `update`, `subscriptions` and `view` fields have the same meaning -as they do in -[`Html.programWithFlags`](http://package.elm-lang.org/packages/elm-lang/html/2.0.0/Html#programWithFlags) --- that is, you should provide what you normally provide to that function. - -So, the special functions are `delta2url` and `location2messages`, -which are described above, under [`App`](#App). - --} -type alias AppWithFlags model msg flags = - { delta2url : model -> model -> Maybe UrlChange - , location2messages : Location -> List msg - , init : flags -> ( model, Cmd msg ) - , update : msg -> model -> ( model, Cmd msg ) - , subscriptions : model -> Sub msg - , view : model -> Html msg - } - + - `onExternalUrlRequest` is very similar to `Browser.application`'s `onUrlRequest`, + but since the preceding two functions handle everything involved with internal + `UrlRequest`s, this function only needs to handle the external case. As such, its + argument is a `String`, mirroring the `External String` variant of [`Browser.UrlRequest`](https://package.elm-lang.org/packages/elm/browser/latest/Browser#UrlRequest). -{-| This works around an issue in Elm 0.18 using `programWithFlags` when -you are actually intending to ignore the flags. It's a long story. -} -type alias AppCommon model msg = +type alias App model msg flags = { delta2url : model -> model -> Maybe UrlChange - , location2messages : Location -> List msg + , location2messages : Url -> List msg + , init : flags -> Key -> ( model, Cmd msg ) , update : msg -> model -> ( model, Cmd msg ) , subscriptions : model -> Sub msg - , view : model -> Html msg - } - - -app2Common : App model msg -> AppCommon model msg -app2Common app = - { delta2url = app.delta2url - , location2messages = app.location2messages - , update = app.update - , subscriptions = app.subscriptions - , view = app.view - } - - -appWithFlags2Common : AppWithFlags model msg flags -> AppCommon model msg -appWithFlags2Common app = - { delta2url = app.delta2url - , location2messages = app.location2messages - , update = app.update - , subscriptions = app.subscriptions - , view = app.view + , view : model -> Document msg + , onExternalUrlRequest : String -> msg } @@ -204,43 +137,46 @@ a new entry in the browser's history (`NewEntry`), or merely replacing the current URL (`ModifyEntry`). This is ultimately implemented via -[`Navigation.newUrl`](http://package.elm-lang.org/packages/elm-lang/navigation/1.0.0/Navigation#newUrl) or -[`Navigation.modifyUrl`](http://package.elm-lang.org/packages/elm-lang/navigation/1.0.0/Navigation#modifyUrl). +[`Browser.Navigation.pushUrl`](https://package.elm-lang.org/packages/elm/browser/latest/Browser-Navigation#pushUrl) or +[`Browser.Navigation.replaceUrl`](https://package.elm-lang.org/packages/elm/browser/latest/Browser-Navigation#replaceUrl). The reason we use this intermediate type is so that we can check whether the -provided string already corresponds to the current URL. In that case, we can +provided `UrlChange` already corresponds to the current URL. In that case, we can avoid creating a spurious duplicate entry in the browser's history. -The reason we take a `String` (rather than a more structured type) is that -there may be several ways you might want to build up the required URL. We -don't want to be prescriptive about that. However, the `String` you provide -must follow a couple of rules. - - - The `String` must already be uri-encoded. +The `path`, `query`, and `fragment` `String`s have exactly the same meaning as +their analogs in [`Url.Url`](https://package.elm-lang.org/packages/elm/url/latest/Url#Url). +In particular, these strings must already be uri-encoded. - - The `String` must either start with a '/', a `?' or a '#'. - - If it starts with a '/', it will be interpreted as a full path, including - optional query parameters and hash. +Important Note: the `path` must be absolute. If it is not, `RouteUrl` will prepend a `/` to make it absolute. This +is necessary in order to prevent `Url.toString` from converting `{host = "example.com", path = "relative/path"}` into +`example.comrelative/path`, which will in turn cause a runtime exception from `history.pushState()` because you're not +allowed to change the host name. If you need to make relative paths based on your app's initial path, you must store +the initial path in your model and concatenate it when creating your `UrlChange`s. - - If it starts with a '?', then we'll assume that you want the current - path to stay the same -- only the query parameters and hash will change. +Use the narrowest type you can that captures the change you want to make. For +instance, if the path and query parts of your URL should remain the same and only +the fragment should change, don't bother creating a `NewPath` that copies those parts. - - If it starts with a '#', then we'll assume that you want the current - path and query parameters (if any) to stay the same -- only the - hash will change. - -So, what you should *not* provide is the scheme, host, or authentication -method -- that is, no ". You should also not use relative -URLs. (Let me know if you'd like relative URLs -- we might be able to do -something sensible with them, but we don't yet in this version). - -One way to construct a `UrlChange` in a modular way is to use the -`RouteUrl.Builder` module. However, a variety of approaches are possible. +This type does not let you alter the scheme, host, or authentication +method -- that is, no ". You also cannot use relative +URLs; the `path` is always treated as absolute. (Let me know if you'd like relative +URLs -- we might be able to do something sensible with them, but we don't yet in this +version). -} -type alias UrlChange = - { entry : HistoryEntry - , url : String - } +type UrlChange + = NewPath + HistoryEntry + { path : String + , query : Maybe String + , fragment : Maybe String + } + | NewQuery + HistoryEntry + { query : String + , fragment : Maybe String + } + | NewFragment HistoryEntry String {-| Indicates whether to create a new entry in the browser's history, or merely @@ -257,17 +193,21 @@ type HistoryEntry {-| This is the router's part of the larger model. -`reportedUrl` is the last Url reported to us by the `Navigation` module. +`reportedUrl` is the last Url reported to us by the `Browser` module. `expectedUrlChanges` represents how many outstanding commands we've sent to change the URL. We increment it when we send a command, and -decrement it when we get one from `Navigation` (unless it's already zero, +decrement it when we get one from `Browser` (unless it's already zero, of course). +`key` is the `Browser.Navigation.Key` that's needed to invoke +`pushUrl` and `replaceUrl`. + -} type alias RouterModel = { reportedUrl : Url , expectedUrlChanges : Int + , key : Key } @@ -298,19 +238,24 @@ mapModel mapper (WrappedModel user router) = internally by RouteUrl, and others are passed on to the application. -} type WrappedMsg user - = RouterMsg Location + = RouterMsgOnUrlChange Url + | RouterMsgOnUrlRequestInternal Url | UserMsg user {-| Given the wrapped msg type that `RouteUrl` uses, either apply a function -that works on a `Location`, or apply a function that works on the msg type +that works on a `Url` (a request, in the first case; or a change, in the second case), +or apply a function that works on the msg type that your program uses. -} -unwrapMsg : (Location -> a) -> (user -> a) -> WrappedMsg user -> a -unwrapMsg handleLocation handleUserMsg wrapped = +unwrapMsg : (Url -> a) -> (Url -> a) -> (user -> a) -> WrappedMsg user -> a +unwrapMsg handleUrlRequestInternal handleUrlChange handleUserMsg wrapped = case wrapped of - RouterMsg location -> - handleLocation location + RouterMsgOnUrlRequestInternal url -> + handleUrlRequestInternal url + + RouterMsgOnUrlChange url -> + handleUrlChange url UserMsg msg -> handleUserMsg msg @@ -324,14 +269,15 @@ wrapUserMsg = UserMsg -{-| Given a location, make the kind of message that `RouteUrl` uses. +{-| Given a `Url`, make the kind of message that `RouteUrl` uses to when a request +is made to navigate to that Url (for example, when the user clicks on a link) I'm not sure you'll ever need this ... perhaps for testing? -} -wrapLocation : Location -> WrappedMsg user +wrapLocation : Url -> WrappedMsg user wrapLocation = - RouterMsg + RouterMsgOnUrlRequestInternal @@ -339,7 +285,7 @@ wrapLocation = {-| A type which represents the various inputs to -[`Navigation.program`](http://package.elm-lang.org/packages/elm-lang/navigation/2.0.0/Navigation#program). +[`Browser.application`](https://package.elm-lang.org/packages/elm/browser/latest/Browser#application). You can produce this via [`navigationApp`](#navigationApp). Then, you can supply this to [`runNavigationApp`](#runNavigationApp) in order to create a `Program`. @@ -349,77 +295,33 @@ However, `NavigationApp` could be useful if you want to do any further wrapping of its functions. -} -type alias NavigationApp model msg = - { locationToMessage : Location -> msg - , init : Location -> ( model, Cmd msg ) - , update : msg -> model -> ( model, Cmd msg ) - , view : model -> Html msg - , subscriptions : model -> Sub msg - } - - -{-| A type which represents the various inputs to -[`Navigation.programWithFlags`](http://package.elm-lang.org/packages/elm-lang/navigation/2.0.0/Navigation#programWithFlags). - -You can produce this via [`navigationAppWithFlags`](#navigationAppWithFlags). Then, you can supply -this to [`runNavigationAppWithFlags`](#runNavigationAppWithFlags) in order to create a `Program`. - -Normally you don't need this -- you can just use [`programWithFlags`](#programWithFlags). -However, `NavigationAppWithFlags` could be useful if you want to do any further wrapping -of its functions. - --} -type alias NavigationAppWithFlags model msg flags = - { locationToMessage : Location -> msg - , init : flags -> Location -> ( model, Cmd msg ) +type alias NavigationApp model msg flags = + { locationToMessage : Url -> msg + , init : flags -> Url -> Key -> ( model, Cmd msg ) , update : msg -> model -> ( model, Cmd msg ) - , view : model -> Html msg + , view : model -> Document msg , subscriptions : model -> Sub msg + , onUrlRequest : UrlRequest -> msg } {-| Given your configuration, this function does some wrapping and produces the functions which -[`Navigation.program`](http://package.elm-lang.org/packages/elm-lang/navigation/2.0.0/Navigation#program) +[`Browser.application`](https://package.elm-lang.org/packages/elm/browser/latest/Browser#application) requires. Normally, you don't need this -- you can just use [`program`](#program). -} -navigationApp : App model msg -> NavigationApp (WrappedModel model) (WrappedMsg msg) +navigationApp : App model msg flags -> NavigationApp (WrappedModel model) (WrappedMsg msg) flags navigationApp app = - let - common = - app2Common app - in - { locationToMessage = RouterMsg - , init = init app.init common - , update = update common - , view = view common - , subscriptions = subscriptions common - } - - -{-| Given your configuration, this function does some wrapping and produces -the functions which -[`Navigation.programWithFlags`](http://package.elm-lang.org/packages/elm-lang/navigation/2.0.0/Navigation#programWithFlags) -requires. - -Normally, you don't need this -- you can just use [`programWithFlags`](#programWithFlags). - --} -navigationAppWithFlags : AppWithFlags model msg flags -> NavigationAppWithFlags (WrappedModel model) (WrappedMsg msg) flags -navigationAppWithFlags app = - let - common = - appWithFlags2Common app - in - { locationToMessage = RouterMsg - , init = initWithFlags app.init common - , update = update common - , view = view common - , subscriptions = subscriptions common - } + { locationToMessage = RouterMsgOnUrlChange + , init = init app.init app + , update = update app + , view = view app + , subscriptions = subscriptions app + , onUrlRequest = onUrlRequest app + } {-| Turns the output from [`navigationApp`](#navigationApp) @@ -432,54 +334,36 @@ sake of composability -- that is, in case there is something further you want to do with the `NavigationApp` structure before turning it into a `Program`. -} -runNavigationApp : NavigationApp model msg -> Program Never model msg +runNavigationApp : NavigationApp model msg flags -> Program flags model msg runNavigationApp app = - Navigation.program app.locationToMessage - { init = app.init - , update = app.update - , view = app.view - , subscriptions = app.subscriptions - } - - -{-| Turns the output from [`navigationApp`](#navigationApp) -into a `Program` that you can assign to your `main` function. - -For convenience, you will usually want to just use [`program`](#program), -which goes directly from the required -configuration to a `Program`. You would only want `runNavigationApp` for the -sake of composability -- that is, in case there is something further you want -to do with the `NavigationApp` structure before turning it into a `Program`. - --} -runNavigationAppWithFlags : NavigationAppWithFlags model msg flags -> Program flags model msg -runNavigationAppWithFlags app = - Navigation.programWithFlags app.locationToMessage + Browser.application { init = app.init , update = app.update , view = app.view + , onUrlChange = app.locationToMessage + , onUrlRequest = app.onUrlRequest , subscriptions = app.subscriptions } {-| A convenient alias for the `Program` type that lets you specify your -type for the `model` and `msg` ... the alias takes care of the wrapping +type for the `flags`, `model` and `msg` ... the alias takes care of the wrapping that `RouteUrl` supplies. For instance, suppose your `main` function would normally be typed like this: - main : Program Never Model Msg + main : Program () Model Msg Now, once you use `RouteUrl.program` to set things up, `RouteUrl` wraps your model and msg types, so that the signature for your `main` function would now be: - main : Program Never (WrappedModel Model) (WrappedMsg Msg) + main : Program () (WrappedModel Model) (WrappedMsg Msg) But that's a little ugly. So, if you like, you can use the `RouteUrlProgram` alias like this: - main : RouteUrlProgram Never Model Msg + main : RouteUrlProgram () Model Msg It's exactly the same type, but looks a little nicer. @@ -491,145 +375,174 @@ type alias RouteUrlProgram flags model msg = {-| Turns your configuration into a `Program` that you can assign to your `main` function. -} -program : App model msg -> RouteUrlProgram Never model msg +program : App model msg flags -> RouteUrlProgram flags model msg program = runNavigationApp << navigationApp -{-| Turns your configuration into a `Program flags` that you can assign to your -`main` function. --} -programWithFlags : AppWithFlags model msg flags -> RouteUrlProgram flags model msg -programWithFlags = - runNavigationAppWithFlags << navigationAppWithFlags - - -- IMPLEMENTATION {-| Call the provided view function with the user's part of the model -} -view : AppCommon model msg -> WrappedModel model -> Html (WrappedMsg msg) +view : App model msg flags -> WrappedModel model -> Document (WrappedMsg msg) view app (WrappedModel model _) = + let + docMap fn doc = + { title = doc.title + , body = List.map (Html.map fn) doc.body + } + in app.view model - |> Html.map UserMsg + |> docMap UserMsg {-| Call the provided subscriptions function with the user's part of the model -} -subscriptions : AppCommon model msg -> WrappedModel model -> Sub (WrappedMsg msg) +subscriptions : App model msg flags -> WrappedModel model -> Sub (WrappedMsg msg) subscriptions app (WrappedModel model _) = app.subscriptions model |> Sub.map UserMsg -{-| Call the provided init function with the user's part of the model +{-| Handle the given `UrlRequest`: internal requests are routed through our `update` function, +while external requests are passed to the App's onExternalUrlRequest function and the resulting +message is wrapped in `UserMsg` -} -initWithFlags : (flags -> ( model, Cmd msg )) -> AppCommon model msg -> flags -> Location -> ( WrappedModel model, Cmd (WrappedMsg msg) ) -initWithFlags appInit app flags location = - let - ( userModel, command ) = - appInit flags - |> sequence app.update (app.location2messages location) +onUrlRequest : App model msg flags -> UrlRequest -> WrappedMsg msg +onUrlRequest app req = + case req of + Internal location -> + RouterMsgOnUrlRequestInternal location - routerModel = - { expectedUrlChanges = 0 - , reportedUrl = Erl.parse location.href - } - in - ( WrappedModel userModel routerModel - , Cmd.map UserMsg command - ) + External location -> + app.onExternalUrlRequest location |> UserMsg {-| Call the provided init function with the user's part of the model -} -init : ( model, Cmd msg ) -> AppCommon model msg -> Location -> ( WrappedModel model, Cmd (WrappedMsg msg) ) -init appInit app location = +init : (flags -> Key -> ( model, Cmd msg )) -> App model msg flags -> flags -> Url -> Key -> ( WrappedModel model, Cmd (WrappedMsg msg) ) +init appInit app flags location key = let ( userModel, command ) = - sequence app.update (app.location2messages location) appInit + appInit flags key + |> sequence app.update (app.location2messages location) routerModel = { expectedUrlChanges = 0 - , reportedUrl = Erl.parse location.href + , reportedUrl = location + , key = key } in - ( WrappedModel userModel routerModel - , Cmd.map UserMsg command - ) + ( WrappedModel userModel routerModel + , Cmd.map UserMsg command + ) -{-| Interprets the UrlChange as a Cmd +{-| Extract the `HistoryEntry` part of the given `UrlChange` -} -urlChange2Cmd : UrlChange -> Cmd msg -urlChange2Cmd change = - change.url - |> case change.entry of - NewEntry -> - Navigation.newUrl - - ModifyEntry -> - Navigation.modifyUrl +getHistoryEntry : UrlChange -> HistoryEntry +getHistoryEntry urlChange = + case urlChange of + NewPath historyEntry _ -> + historyEntry + NewQuery historyEntry _ -> + historyEntry -mapUrl : (String -> String) -> UrlChange -> UrlChange -mapUrl func c1 = - { c1 | url = func c1.url } + NewFragment historyEntry _ -> + historyEntry -{-| Whether one Url is equal to another, for our purposes (that is, just comparing -the things we care about). +{-| create a new `Url` that's the result of applying the given change to the given url -} -eqUrl : Url -> Url -> Bool -eqUrl u1 u2 = - -- The queries are `List (String, String)`, so `==` should be OK - (u1.path == u2.path) - && (u1.hasTrailingSlash == u2.hasTrailingSlash) - && (u1.hash == u2.hash) - && (u1.query == u2.query) +apply : Url -> UrlChange -> Url +apply url change = + case change of + NewPath _ c -> + let + {- If we don't force the path to be absolute, we risk causing an error like: + + Uncaught DOMException: Failed to execute 'pushState' on 'History': + A history state object with URL 'http://example.comrelative/path' + cannot be created in a document with origin 'http://example.com' + and URL 'http://example.com/original/application/path' + + The user likely intended to make the path be `/original/application/path/relative/path' + in the preceding example, but we can't know that for sure, and we've already advised + of this risk in the documentation for `UrlChange` + -} + absolutePath = + case String.startsWith "/" c.path of + True -> + c.path + + False -> + "/" ++ c.path + in + { url + | path = absolutePath + , query = c.query + , fragment = c.fragment + } + NewQuery _ c -> + { url + | query = Just c.query + , fragment = c.fragment + } + + NewFragment _ c -> + { url | fragment = Just c } -checkDistinctUrl : Url -> UrlChange -> Maybe UrlChange -checkDistinctUrl old new = - if eqUrl (Erl.parse new.url) old then - Nothing - else - Just new +{-| Interprets the UrlChange as a Cmd +-} +urlChange2Cmd : Key -> Url -> UrlChange -> Cmd msg +urlChange2Cmd key oldUrl change = + apply oldUrl change + |> toString + |> (case getHistoryEntry change of + NewEntry -> + pushUrl key -url2path : Url -> String -url2path url = - "/" - ++ (String.join "/" url.path) - ++ if url.hasTrailingSlash && not (List.isEmpty url.path) then - "/" - else - "" + ModifyEntry -> + replaceUrl key + ) -{-| Supplies the default path or query string, if needed +{-| If the given change actually chages the given url, return `Just` that change; +otherwise, return `Nothing` -} -normalizeUrl : Url -> UrlChange -> UrlChange -normalizeUrl old change = - mapUrl - (if startsWith "?" change.url then - \url -> url2path old ++ url - else if startsWith "#" change.url then - \url -> url2path old ++ Erl.queryToString old ++ url - else - \url -> url - ) - change +checkDistinctUrl : Url -> UrlChange -> Maybe UrlChange +checkDistinctUrl old new = + let + newUrl = + apply old new + in + case old == newUrl of + True -> + Nothing + + False -> + Just new {-| This is the normal `update` function we're providing to `Navigation`. -} -update : AppCommon model msg -> WrappedMsg msg -> WrappedModel model -> ( WrappedModel model, Cmd (WrappedMsg msg) ) +update : App model msg flags -> WrappedMsg msg -> WrappedModel model -> ( WrappedModel model, Cmd (WrappedMsg msg) ) update app msg (WrappedModel user router) = case msg of - RouterMsg location -> + RouterMsgOnUrlRequestInternal requestedUrl -> + -- note: we do *not* increment expectedUrlChanges here, because we are *not* doing + -- this url change in response to a change in the app's state, but rather this is + -- an href which came from "outside" (as discussed below) + ( WrappedModel user router + , pushUrl router.key <| Url.toString requestedUrl + ) + + RouterMsgOnUrlChange location -> let -- This is the same, no matter which path we follow below. Basically, -- we're keeping track of the last reported Url (i.e. what's in the location @@ -637,33 +550,36 @@ update app msg (WrappedModel user router) = -- ourselves). So, we remove the current href from the expectations. newRouterModel = { reportedUrl = - Erl.parse location.href + location , expectedUrlChanges = if router.expectedUrlChanges > 0 then router.expectedUrlChanges - 1 + else 0 + , key = router.key } in - if router.expectedUrlChanges > 0 then - -- This is a Url change which we were expecting, because we did - -- it in response to a change in the app's state. So, we don't - -- make any *further* change to the app's state here ... we - -- just record that we've seen the Url change we expected. - ( WrappedModel user newRouterModel - , Cmd.none - ) - else - -- This is an href which came from the outside ... i.e. clicking on a link, - -- typing in the location bar, following a bookmark. So, we need to update - -- the app's state to correspond to the new location. - let - ( newUserModel, commands ) = - sequence app.update (app.location2messages location) ( user, Cmd.none ) - in - ( WrappedModel newUserModel newRouterModel - , Cmd.map UserMsg commands - ) + if router.expectedUrlChanges > 0 then + -- This is a Url change which we were expecting, because we did + -- it in response to a change in the app's state. So, we don't + -- make any *further* change to the app's state here ... we + -- just record that we've seen the Url change we expected. + ( WrappedModel user newRouterModel + , Cmd.none + ) + + else + -- This is an href which came from the outside ... i.e. clicking on a link, + -- typing in the location bar, following a bookmark. So, we need to update + -- the app's state to correspond to the new location. + let + ( newUserModel, commands ) = + sequence app.update (app.location2messages location) ( user, Cmd.none ) + in + ( WrappedModel newUserModel newRouterModel + , Cmd.map UserMsg commands + ) UserMsg userMsg -> let @@ -673,19 +589,19 @@ update app msg (WrappedModel user router) = maybeUrlChange = app.delta2url user newUserModel - |> Maybe.map (normalizeUrl router.reportedUrl) |> Maybe.andThen (checkDistinctUrl router.reportedUrl) in - case maybeUrlChange of - Just urlChange -> - ( WrappedModel newUserModel <| - { reportedUrl = Erl.parse urlChange.url - , expectedUrlChanges = router.expectedUrlChanges + 1 - } - , Cmd.map UserMsg <| Cmd.batch [ urlChange2Cmd urlChange, userCommand ] - ) - - Nothing -> - ( WrappedModel newUserModel router - , Cmd.map UserMsg userCommand - ) + case maybeUrlChange of + Just urlChange -> + ( WrappedModel newUserModel <| + { reportedUrl = apply router.reportedUrl urlChange + , expectedUrlChanges = router.expectedUrlChanges + 1 + , key = router.key + } + , Cmd.map UserMsg <| Cmd.batch [ urlChange2Cmd router.key router.reportedUrl urlChange, userCommand ] + ) + + Nothing -> + ( WrappedModel newUserModel router + , Cmd.map UserMsg userCommand + ) diff --git a/src/RouteUrl/Builder.elm b/src/RouteUrl/Builder.elm deleted file mode 100644 index b36d74f..0000000 --- a/src/RouteUrl/Builder.elm +++ /dev/null @@ -1,436 +0,0 @@ -module RouteUrl.Builder - exposing - ( Builder - , builder - , entry - , newEntry - , modifyEntry - , path - , modifyPath - , prependToPath - , appendToPath - , replacePath - , query - , modifyQuery - , insertQuery - , addQuery - , removeQuery - , getQuery - , replaceQuery - , hash - , modifyHash - , replaceHash - , toUrlChange - , toHashChange - , fromUrl - , fromHash - ) - -{-| This module provides a type which you can use to help construct a -`UrlChange` or parse a `Location`. - -However, the `Builder` type is not really the focus of elm-route-url. - - - Ultimately, a `UrlChange` just requires a `String` -- you don't need to - use this module to construct one. - - - You also don't need to use this module to parse a `Location` -- there are a - fair number of relevant packages for that, including: - - [evancz/url-parser](http://package.elm-lang.org/packages/evancz/url-parser/latest) - - [Bogdanp/elm-combine](http://package.elm-lang.org/packages/Bogdanp/elm-combine/latest) - - [Bogdanp/elm-route](http://package.elm-lang.org/packages/Bogdanp/elm-route/latest) - - [etaque/elm-route-parser](http://package.elm-lang.org/packages/etaque/elm-route-parser/latest) - - [poyang/elm-router](http://package.elm-lang.org/packages/poying/elm-router/latest) - - [sporto/erl](http://package.elm-lang.org/packages/sporto/erl/latest) - - [sporto/hop](http://package.elm-lang.org/packages/sporto/hop/latest) - -So, this module is potentially useful, but there are quite a few other -options you may wish to investigate. - -Note that you should not uri-encode anything provided to this module. That -will be done for you. - - -# Initialization - -@docs Builder, builder - - -# Creating or modifying history entries - -@docs entry, newEntry, modifyEntry - - -# Manipulating the path - -@docs path, modifyPath, prependToPath, appendToPath, replacePath - - -# Manipulating the query - -@docs query, modifyQuery, insertQuery, addQuery, removeQuery, getQuery, replaceQuery - - -# Manipulating the hash - -@docs hash, modifyHash, replaceHash - - -# Conversion - -@docs toUrlChange, toHashChange, fromUrl, fromHash - --} - -import RouteUrl exposing (HistoryEntry(..), UrlChange) -import Dict exposing (Dict) -import Http exposing (encodeUri, decodeUri) -import Regex exposing (HowMany(..), replace, regex) -import String -import Erl - - --- THE TYPE - - -{-| An opaque type which helps to build up a URL for a `URLChange`, -or parse a `Location`. - -Start with [`builder`](#builder), and then use other functions to make changes. -Or, if you have a URL, start with [`fromUrl`](#fromUrl) or [`fromHash`](#fromHash). - --} -type Builder - = Builder - { entry : HistoryEntry - , path : List String - , query : List ( String, String ) - , hash : String - } - - -{-| Creates a default `Builder`. Start with this, then use other methods -to build up the URL. - - url : Builder - url = - builder - |> newEntry - |> appendToPath [ "home" ] - --} -builder : Builder -builder = - Builder - { entry = NewEntry - , path = [] - , query = [] - , hash = "" - } - - - --- ENTRY - - -{-| Indicates whether the `Builder` will make a new entry in the browser's -history, or merely modify the current entry. --} -entry : Builder -> HistoryEntry -entry (Builder builder) = - builder.entry - - -{-| Make a new entry in the browser's history. --} -newEntry : Builder -> Builder -newEntry (Builder builder) = - Builder { builder | entry = NewEntry } - - -{-| Modify the current entry in the browser's history. --} -modifyEntry : Builder -> Builder -modifyEntry (Builder builder) = - Builder { builder | entry = ModifyEntry } - - - --- PATH - - -{-| The segments of the path. The path is represented by a list of strings. -Ultimately, they will be uri-encoded for you, and joined with a "/". --} -path : Builder -> List String -path (Builder builder) = - builder.path - - -{-| Replace the path with the result of a function which acts on -the current path. --} -modifyPath : (List String -> List String) -> Builder -> Builder -modifyPath func (Builder builder) = - Builder { builder | path = func builder.path } - - -{-| Add the provided list to the beginning of the builder's path. --} -prependToPath : List String -> Builder -> Builder -prependToPath = - modifyPath << List.append - - -{-| Add the provided list to the end of the builder's path. --} -appendToPath : List String -> Builder -> Builder -appendToPath = - modifyPath << flip List.append - - -{-| Sets the path to the provided list. --} -replacePath : List String -> Builder -> Builder -replacePath list (Builder builder) = - Builder { builder | path = list } - - - --- QUERY - - -{-| The query portion of the URL. It is represented by a `List` of -key/value pairs. --} -query : Builder -> List ( String, String ) -query (Builder builder) = - builder.query - - -{-| Replace the query with the result of a function that acts on the current query. --} -modifyQuery : (List ( String, String ) -> List ( String, String )) -> Builder -> Builder -modifyQuery func (Builder builder) = - Builder { builder | query = func builder.query } - - -{-| Insert a key/value pair into the query. Replaces keys with the same name, -in case of collision. --} -insertQuery : String -> String -> Builder -> Builder -insertQuery newKey newValue = - modifyQuery - (\query -> - query - |> List.foldl - (\( oldKey, oldValue ) ( acc, replaced ) -> - if newKey == oldKey then - -- If it's the key we're replacing, then see if - -- we've already done it. - if replaced then - -- If so, we just drop the old one ... the new - -- one has already been inserted - ( acc, replaced ) - else - -- If not, we insert the new one instead of the - -- old one, and remember that we've done it. - ( ( newKey, newValue ) :: acc - , True - ) - else - -- If it's some other key, just pass it through - ( ( oldKey, oldValue ) :: acc - , replaced - ) - ) - ( [], False ) - |> \( reversedList, replaced ) -> - -- Since we did a `foldl`, and then a bunch of `::`, the list - -- was reversed. So, check whether we still need to add our - -- new key, and then un-reverse. (This helps us put the new - -- key at the end, if it didn't exist before). - if replaced then - List.reverse reversedList - else - List.reverse <| - ( newKey, newValue ) - :: reversedList - ) - - -{-| Add a key/value pair into the query. Does not replace a key with the same name ... -just adds another value. --} -addQuery : String -> String -> Builder -> Builder -addQuery key value = - modifyQuery (\query -> List.reverse (( key, value ) :: List.reverse query)) - - -{-| Remove a query key. --} -removeQuery : String -> Builder -> Builder -removeQuery key = - modifyQuery (List.filter (\( k, _ ) -> k /= key)) - - -{-| Get the values for a query key (can return multiple values if the key -is given more than once in the query). --} -getQuery : String -> Builder -> List String -getQuery key (Builder builder) = - builder.query - |> List.filterMap - (\( k, v ) -> - if k == key then - Just v - else - Nothing - ) - - -{-| Replace the whole query with a different list of key/value pairs. --} -replaceQuery : List ( String, String ) -> Builder -> Builder -replaceQuery query (Builder builder) = - Builder { builder | query = query } - - - --- HASH - - -{-| Gets the hash portion of the URL, without the "#". --} -hash : Builder -> String -hash (Builder builder) = - builder.hash - - -{-| Replace the hash with the result of a function applied to the current hash. --} -modifyHash : (String -> String) -> Builder -> Builder -modifyHash func (Builder builder) = - Builder { builder | hash = func builder.hash } - - -{-| Replace the hash with the provided value. Note that you should not include the "#". --} -replaceHash : String -> Builder -> Builder -replaceHash hash (Builder builder) = - Builder { builder | hash = hash } - - - --- CONVERSION - - -toChange : Bool -> Builder -> UrlChange -toChange stuffIntoHash (Builder builder) = - let - prefix = - if stuffIntoHash then - "#!/" - else - "/" - - queryPrefix = - if stuffIntoHash then - "^" - else - "?" - - joinedPath = - String.join "/" (List.map encodeUri builder.path) - - joinedQuery = - if List.isEmpty builder.query then - "" - else - queryPrefix ++ String.join "&" (List.map eachQuery builder.query) - - eachQuery ( key, value ) = - encodeUri key ++ "=" ++ encodeUri value - - hashPrefix = - if stuffIntoHash then - "$" - else - "#" - - formattedHash = - if builder.hash == "" then - "" - else - hashPrefix ++ encodeUri builder.hash - in - { entry = builder.entry - , url = prefix ++ joinedPath ++ joinedQuery ++ formattedHash - } - - -{-| Once you've built up your URL, use this to convert it to a `UrlChange` for use with -`RouteUrl`. --} -toUrlChange : Builder -> UrlChange -toUrlChange = - toChange False - - -{-| Like [`toUrlChange`](#toUrlChange), but puts everything into the hash, prepended by "#!". - -If your `Builder` has a hash component, we'll use '$' instead of '#' to -delimit the embedded hash. And, we will use '^' instead of '?' to begin -the query parameters. - --} -toHashChange : Builder -> UrlChange -toHashChange = - toChange True - - -{-| Constructs a `Builder` from a URL. --} -fromUrl : String -> Builder -fromUrl url = - let - erl = - Erl.parse url - in - Builder - { entry = NewEntry - , path = erl.path - , query = erl.query - - -- note that Erl.parse doesn't seem to decode the hash for you - , hash = Maybe.withDefault "" <| decodeUri erl.hash - } - - -{-| Constructs a `Builder` from the hash portion of a URL. - - - Assumes that the hash starts with "#!/". - - - Assumes that any embedded hash is delimited with a '$' instead of a '#'. - - - Assumes that any embedded query parameters being with a '^' instead of - a '?'. - --} -fromHash : String -> Builder -fromHash url = - let - unwrapped = - Erl.parse url - |> .hash - |> replace (AtMost 1) (regex "^!") (always "") - |> replace (AtMost 1) (regex "$") (always "#") - |> replace (AtMost 1) (regex "\\^") (always "?") - |> Erl.parse - in - Builder - { entry = NewEntry - , path = unwrapped.path - , query = unwrapped.query - , hash = unwrapped.hash - } diff --git a/tests/BuilderTest.elm b/tests/BuilderTest.elm deleted file mode 100644 index cbde255..0000000 --- a/tests/BuilderTest.elm +++ /dev/null @@ -1,179 +0,0 @@ -module BuilderTest exposing (..) - -import Expect exposing (Expectation) -import Fuzz exposing (Fuzzer, int, list, string) -import RouteUrl.Builder exposing (..) -import RouteUrl exposing (..) -import Test exposing (..) - - -fixture : Builder -fixture = - builder - |> replaceQuery - [ ( "a", "7" ) - , ( "b", "8" ) - , ( "c", "9" ) - , ( "b", "10" ) - , ( "e", "14" ) - ] - - -fuzzQuery : Fuzzer (List ( String, String )) -fuzzQuery = - Fuzz.list (Fuzz.tuple ( Fuzz.string, Fuzz.string )) - - -toUrlChangeTest : Test -toUrlChangeTest = - describe "toUrlChange" - [ test "preserves order" <| - \() -> - fixture - |> toUrlChange - |> Expect.equal - (UrlChange NewEntry "/?a=7&b=8&c=9&b=10&e=14") - , fuzz fuzzQuery "will round-trip" <| - \randomQuery -> - builder - |> replaceQuery randomQuery - |> toUrlChange - |> .url - |> fromUrl - |> query - |> Expect.equal randomQuery - ] - - -addQueryTest : Test -addQueryTest = - describe "addQuery" - [ test "adds new keys to the end" <| - \() -> - fixture - |> addQuery "z" "102" - |> query - |> Expect.equal - [ ( "a", "7" ) - , ( "b", "8" ) - , ( "c", "9" ) - , ( "b", "10" ) - , ( "e", "14" ) - , ( "z", "102" ) - ] - , test "adds existing keys to the end, and keeps old key" <| - \() -> - fixture - |> addQuery "a" "103" - |> query - |> Expect.equal - [ ( "a", "7" ) - , ( "b", "8" ) - , ( "c", "9" ) - , ( "b", "10" ) - , ( "e", "14" ) - , ( "a", "103" ) - ] - ] - - -removeQueryTest : Test -removeQueryTest = - describe "removeQuery" - [ test "removes one" <| - \() -> - fixture - |> removeQuery "a" - |> query - |> Expect.equal - [ ( "b", "8" ) - , ( "c", "9" ) - , ( "b", "10" ) - , ( "e", "14" ) - ] - , test "removes multiple" <| - \() -> - fixture - |> removeQuery "b" - |> query - |> Expect.equal - [ ( "a", "7" ) - , ( "c", "9" ) - , ( "e", "14" ) - ] - ] - - -getQueryTest : Test -getQueryTest = - describe "getQuery" - [ test "with one" <| - \() -> - fixture - |> getQuery "a" - |> Expect.equal [ "7" ] - , test "with two" <| - \() -> - fixture - |> getQuery "b" - |> Expect.equal [ "8", "10" ] - , test "with none" <| - \() -> - fixture - |> getQuery "notthere" - |> Expect.equal [] - ] - - -insertQueryTest : Test -insertQueryTest = - describe "insertQuery" - [ test "adds new keys to the end" <| - \() -> - fixture - |> insertQuery "z" "102" - |> query - |> Expect.equal - [ ( "a", "7" ) - , ( "b", "8" ) - , ( "c", "9" ) - , ( "b", "10" ) - , ( "e", "14" ) - , ( "z", "102" ) - ] - , test "modifies existing key where it was (first)" <| - \() -> - fixture - |> insertQuery "a" "103" - |> query - |> Expect.equal - [ ( "a", "103" ) - , ( "b", "8" ) - , ( "c", "9" ) - , ( "b", "10" ) - , ( "e", "14" ) - ] - , test "modifies existing key where it was (third)" <| - \() -> - fixture - |> insertQuery "c" "104" - |> query - |> Expect.equal - [ ( "a", "7" ) - , ( "b", "8" ) - , ( "c", "104" ) - , ( "b", "10" ) - , ( "e", "14" ) - ] - , test "replaces multiple key/values pairs at first position" <| - \() -> - fixture - |> insertQuery "b" "105" - |> query - |> Expect.equal - [ ( "a", "7" ) - , ( "b", "105" ) - , ( "c", "9" ) - , ( "e", "14" ) - ] - ] diff --git a/tests/elm-package.json b/tests/elm-package.json deleted file mode 100644 index ea182d6..0000000 --- a/tests/elm-package.json +++ /dev/null @@ -1,22 +0,0 @@ -{ - "version": "1.0.0", - "summary": "Test Suites", - "repository": "https://github.com/rgrempel/elm-route-url.git", - "license": "BSD3", - "source-directories": [ - "../src", - "." - ], - "exposed-modules": [], - "dependencies": { - "ccapndave/elm-update-extra": "2.3.1 <= v < 4.0.0", - "eeue56/elm-html-test": "5.1.1 <= v < 6.0.0", - "elm-community/elm-test": "4.0.0 <= v < 5.0.0", - "elm-lang/core": "5.0.0 <= v < 6.0.0", - "elm-lang/html": "2.0.0 <= v < 3.0.0", - "elm-lang/http": "1.0.0 <= v < 2.0.0", - "elm-lang/navigation": "2.0.0 <= v < 3.0.0", - "sporto/erl": "11.0.0 <= v < 14.0.0" - }, - "elm-version": "0.18.0 <= v < 0.19.0" -}