Put the current search in the URL

This commit is contained in:
Correl Roush 2021-07-15 22:41:09 -04:00
parent b9b5badec6
commit 863ab021a6

View file

@ -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,22 +134,26 @@ expectPaginatedJson toMsg decoder =
Err (Http.BadBody (Json.Decode.errorToString err))
searchQuery : Criteria -> List Url.Builder.QueryParameter
searchQuery criteria =
[ Url.Builder.string "q" criteria.query
, Url.Builder.string "in_collection"
(if criteria.ownedOnly then
"yes"
else
""
)
]
search : Criteria -> Cmd Msg
search criteria =
Http.get
{ url =
Url.Builder.absolute
[ "search" ]
[ Url.Builder.string "q" criteria.query
, Url.Builder.string "in_collection"
(if criteria.ownedOnly then
"yes"
else
""
)
, Url.Builder.int "limit" 18
]
(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 ->
{ model | ownedOnly = 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 )