Put the current search in the URL

www/src/App.elm

@@ -3,6 +3,7 @@ module App exposing (main)
 import Browser
 import Browser.Dom
 import Browser.Events
+import Browser.Navigation
 import Dict
 import Element as E
 import Element.Background as Background
@@ -18,6 +19,8 @@ import Regex
 import Task
 import Url
 import Url.Builder
+import Url.Parser exposing ((</>), (<?>))
+import Url.Parser.Query
 
 
 type alias Window =
@@ -41,7 +44,8 @@ type alias Card =
 
 
 type alias Model =
-    { viewport : Window
+    { navigationKey : Browser.Navigation.Key
+    , viewport : Window
     , criteria : Criteria
     , cardPage : Maybe (ResultPage Card)
     }
@@ -130,12 +134,8 @@ expectPaginatedJson toMsg decoder =
                             Err (Http.BadBody (Json.Decode.errorToString err))
 
 
-search : Criteria -> Cmd Msg
-search criteria =
-    Http.get
-        { url =
-            Url.Builder.absolute
-                [ "search" ]
+searchQuery : Criteria -> List Url.Builder.QueryParameter
+searchQuery criteria =
     [ Url.Builder.string "q" criteria.query
     , Url.Builder.string "in_collection"
         (if criteria.ownedOnly then
@@ -144,8 +144,16 @@ search criteria =
          else
             ""
         )
-                , Url.Builder.int "limit" 18
     ]
+
+
+search : Criteria -> Cmd Msg
+search criteria =
+    Http.get
+        { url =
+            Url.Builder.absolute
+                [ "search" ]
+                (Url.Builder.int "limit" 18 :: searchQuery criteria)
         , expect = expectPaginatedJson FoundCards decodeCard
         }
 
@@ -167,13 +175,45 @@ decodeCard =
         |> JDP.required "rarity" Json.Decode.string
 
 
-init : Json.Decode.Value -> url -> key -> ( Model, Cmd Msg )
-init _ _ _ =
+parseUrl : Url.Parser.Parser (Criteria -> a) a
+parseUrl =
     let
-        criteria =
+        query =
+            Url.Parser.Query.string "q"
+                |> Url.Parser.Query.map (Maybe.withDefault "")
+
+        inCollection =
+            Url.Parser.Query.enum "in_collection"
+                (Dict.fromList
+                    [ ( "true", True )
+                    , ( "false", False )
+                    , ( "yes", True )
+                    , ( "no", False )
+                    ]
+                )
+                |> Url.Parser.Query.map (Maybe.withDefault True)
+    in
+    Url.Parser.top <?> Url.Parser.Query.map2 Criteria query inCollection
+
+
+criteriaFromUrl : Url.Url -> Criteria
+criteriaFromUrl url =
+    let
+        emptyCriteria =
             { query = "", ownedOnly = True }
     in
-    ( { viewport = { width = 1280, height = 720 }
+    Url.Parser.parse parseUrl url
+        |> Maybe.withDefault emptyCriteria
+
+
+init : Json.Decode.Value -> Url.Url -> Browser.Navigation.Key -> ( Model, Cmd Msg )
+init _ url key =
+    let
+        criteria =
+            criteriaFromUrl url
+    in
+    ( { navigationKey = key
+      , viewport = { width = 1280, height = 720 }
       , criteria = criteria
       , cardPage = Nothing
       }
@@ -191,14 +231,18 @@ init _ _ _ =
     )
 
 
-updateCriteria : CriteriaMsg -> Criteria -> Criteria
+updateCriteria : CriteriaMsg -> Criteria -> ( Criteria, Cmd Msg )
 updateCriteria msg model =
     case msg of
         UpdateName text ->
-            { model | query = text }
+            ( { model | query = text }, Cmd.none )
 
         UpdateOwnedOnly value ->
+            let
+                newCriteria =
                     { model | ownedOnly = value }
+            in
+            ( newCriteria, search newCriteria )
 
 
 updateCardPage cardpage newCards =
@@ -208,8 +252,12 @@ updateCardPage cardpage newCards =
 update : Msg -> Model -> ( Model, Cmd Msg )
 update msg model =
     case msg of
-        UrlChanged _ ->
-            ( model, Cmd.none )
+        UrlChanged url ->
+            let
+                criteria =
+                    criteriaFromUrl url
+            in
+            ( { model | criteria = criteria }, search criteria )
 
         LinkClicked _ ->
             ( model, Cmd.none )
@@ -218,12 +266,20 @@ update msg model =
             ( { model | viewport = viewport }, Cmd.none )
 
         UpdateCriteria criteriaMsg ->
-            ( { model | criteria = updateCriteria criteriaMsg model.criteria }
-            , Cmd.none
-            )
+            let
+                ( newCriteria, cmd ) =
+                    updateCriteria criteriaMsg model.criteria
+            in
+            ( { model | criteria = newCriteria }, cmd )
 
         Search ->
-            ( model, search model.criteria )
+            ( model
+            , Cmd.batch
+                [ search model.criteria
+                , Browser.Navigation.pushUrl model.navigationKey <|
+                    Url.Builder.relative [] (searchQuery model.criteria)
+                ]
+            )
 
         GetPage url ->
             ( model, loadPage url )