Split the collection page into its own module

This commit is contained in:
Correl Roush 2022-12-16 17:15:10 -05:00
parent 2e2f2be488
commit 1506960047
3 changed files with 908 additions and 695 deletions

View file

@ -21,244 +21,101 @@ import Maybe.Extra
import Paginated import Paginated
import Spinner import Spinner
import Task import Task
import UI
import Url import Url
import Url.Builder import Url.Builder
import Url.Parser exposing ((</>), (<?>)) import Url.Parser exposing ((</>), (<?>))
import Url.Parser.Query import Url.Parser.Query
type alias Dimensions =
{ width : Int
, height : Int
}
type alias Criteria =
{ query : String
, sortBy : String
, ownedOnly : Bool
}
type alias Model = type alias Model =
{ navigationKey : Browser.Navigation.Key { navigationKey : Browser.Navigation.Key
, viewport : Dimensions , url : Url.Url
, viewport : UI.Dimensions
, device : E.Device , device : E.Device
, spinner : Spinner.Model , route : Route
, criteria : Criteria , page : Page
, cardPage : CardPage
, activeCard : Maybe Card.Card
, collectionStatistics : Maybe Collection.Statistics
} }
type Msg type Msg
= UrlChanged Url.Url = UrlChanged Url.Url
| ViewportChanged Dimensions | ViewportChanged UI.Dimensions
| LinkClicked Browser.UrlRequest | LinkClicked Browser.UrlRequest
| CollectionMsg Collection.Msg
| SpinnerMsg Spinner.Msg | SpinnerMsg Spinner.Msg
| UpdateCriteria CriteriaMsg
| Search
| GetPage Url.Url
| GotStatistics (Result Http.Error Collection.Statistics)
| FoundCards (Result Http.Error (Paginated.Page Card.Card))
| ShowCardDetails Card.Card
| ClearCardDetails
type CriteriaMsg type Page
= UpdateName String = NotFound
| UpdateSortBy String | Collection Collection.Model
| UpdateOwnedOnly Bool | Decks
type CardPage type Route
= Ready (Paginated.Page Card.Card) = Home
| Loading (Paginated.Page Card.Card) | MyCollection
| Failed | MyDecks
toLoading : CardPage -> CardPage routeToUrl : Route -> String
toLoading cardPage = routeToUrl route =
case cardPage of case route of
Ready page -> Home ->
Loading page Url.Builder.absolute [] []
Loading page -> MyCollection ->
Loading page Url.Builder.absolute [ "collection" ] []
Failed -> MyDecks ->
Loading Paginated.empty Url.Builder.absolute [ "decks" ] []
manaSpinner : Spinner.Config
manaSpinner =
let
color index =
if index < 1.0 then
Color.red
else if index < 2.0 then
Color.green
else if index < 3.0 then
Color.purple
else if index < 4.0 then
Color.blue
else
Color.white
default =
Spinner.defaultConfig
in
{ default
| lines = 5.0
, length = 0.0
, width = 20
, color = color
}
searchQuery : Criteria -> List Url.Builder.QueryParameter
searchQuery criteria =
[ Url.Builder.string "q" criteria.query
, Url.Builder.string "sort_by" criteria.sortBy
, Url.Builder.string "in_collection"
(if criteria.ownedOnly then
"yes"
else
"no"
)
]
search : Criteria -> Cmd Msg
search criteria =
loadPage <|
Url.Builder.absolute
[ "api", "search" ]
(Url.Builder.int "limit" 18 :: searchQuery criteria)
loadPage : String -> Cmd Msg
loadPage url =
Http.get
{ url = url
, expect = Paginated.expectJson FoundCards Card.decode
}
getCollectionStatistics : Cmd Msg
getCollectionStatistics =
Http.get
{ url = Url.Builder.absolute [ "api", "collection" ] []
, expect = Http.expectJson GotStatistics Collection.decodeStatistics
}
parseUrl : Url.Parser.Parser (Criteria -> a) a
parseUrl =
let
query =
Url.Parser.Query.string "q"
|> Url.Parser.Query.map (Maybe.withDefault "")
sortBy =
Url.Parser.Query.enum "sort_by"
(Dict.fromList
[ ( "rarity", "rarity" )
, ( "price", "price" )
]
)
|> Url.Parser.Query.map (Maybe.withDefault "rarity")
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.map3 Criteria query sortBy inCollection
criteriaFromUrl : Url.Url -> Criteria
criteriaFromUrl url =
let
emptyCriteria =
{ query = "", sortBy = "price", ownedOnly = True }
in
Url.Parser.parse parseUrl url
|> Maybe.withDefault emptyCriteria
init : Json.Decode.Value -> Url.Url -> Browser.Navigation.Key -> ( Model, Cmd Msg ) init : Json.Decode.Value -> Url.Url -> Browser.Navigation.Key -> ( Model, Cmd Msg )
init _ url key = init _ url key =
let let
criteria =
criteriaFromUrl url
viewport = viewport =
{ width = 1280, height = 720 } { width = 1280, height = 720 }
device =
E.classifyDevice viewport
( pageModel, pageCmd ) =
Collection.init key url device
in in
( { navigationKey = key ( { navigationKey = key
, url = url
, viewport = viewport , viewport = viewport
, device = E.classifyDevice viewport , device = device
, spinner = Spinner.init , route = MyCollection
, criteria = criteria , page = Collection pageModel
, cardPage = Loading Paginated.empty
, activeCard = Nothing
, collectionStatistics = Nothing
} }
, Cmd.batch , Cmd.batch
[ search criteria [ UI.getViewport ViewportChanged
, getCollectionStatistics , Cmd.map CollectionMsg pageCmd
, Task.perform
(\x ->
ViewportChanged
{ width = floor x.viewport.width
, height = floor x.viewport.height
}
)
Browser.Dom.getViewport
] ]
) )
updateCriteria : CriteriaMsg -> Criteria -> Criteria updateWith : (pageModel -> Page) -> (pageMsg -> Msg) -> Model -> ( pageModel, Cmd pageMsg ) -> ( Model, Cmd Msg )
updateCriteria msg model = updateWith pageType pageMsg model ( subModel, subCmd ) =
case msg of ( { model | page = pageType subModel }, Cmd.map pageMsg subCmd )
UpdateName text ->
{ model | query = text }
UpdateSortBy column ->
{ model | sortBy = column }
UpdateOwnedOnly value ->
{ model | ownedOnly = value }
update : Msg -> Model -> ( Model, Cmd Msg ) update : Msg -> Model -> ( Model, Cmd Msg )
update msg model = update msg model =
case msg of case ( msg, model.page ) of
UrlChanged url -> ( UrlChanged url, Collection pageModel ) ->
let Collection.update (Collection.UrlChanged url) pageModel
criteria = |> updateWith Collection CollectionMsg model
Debug.log "criteria" <| criteriaFromUrl url
in
( { model | criteria = criteria }, search criteria )
LinkClicked _ -> ( UrlChanged url, _ ) ->
( model, Cmd.none ) ( model, Cmd.none )
ViewportChanged viewport -> ( LinkClicked _, _ ) ->
( model, Cmd.none )
( ViewportChanged viewport, _ ) ->
( { model ( { model
| viewport = viewport | viewport = viewport
, device = E.classifyDevice viewport , device = E.classifyDevice viewport
@ -266,496 +123,62 @@ update msg model =
, Cmd.none , Cmd.none
) )
SpinnerMsg msg_ -> ( SpinnerMsg spinnerMsg, Collection pageModel ) ->
( { model | spinner = Spinner.update msg_ model.spinner }, Cmd.none ) Collection.update (Collection.SpinnerMsg spinnerMsg) pageModel
|> updateWith Collection CollectionMsg model
UpdateCriteria msg_ -> ( CollectionMsg pageMsg, Collection pageModel ) ->
let Collection.update pageMsg pageModel
newCriteria = |> updateWith Collection CollectionMsg model
updateCriteria msg_ model.criteria
in
case msg_ of
UpdateName _ ->
( { model | criteria = newCriteria }
, Cmd.none
)
UpdateSortBy _ -> ( _, _ ) ->
update Search { model | criteria = newCriteria } ( model, Cmd.none )
UpdateOwnedOnly _ ->
update Search { model | criteria = newCriteria }
Search -> navBar : Model -> E.Element Msg
( { model navBar model =
| cardPage = toLoading model.cardPage let
, activeCard = Nothing navLink : Route -> String -> E.Element Msg
} navLink route text =
, Cmd.batch E.link
[ Browser.Navigation.pushUrl model.navigationKey <| [ E.pointer
Url.Builder.relative [] (searchQuery model.criteria) , E.padding 10
, Font.center
, Background.color UI.colors.primary
] ]
) { url = routeToUrl route, label = E.text text }
GetPage url ->
( { model | cardPage = toLoading model.cardPage }, loadPage (Url.toString url) )
GotStatistics (Ok statistics) ->
( { model | collectionStatistics = Just statistics }, Cmd.none )
GotStatistics (Err _) ->
( model, Cmd.none )
FoundCards (Ok cardPage) ->
( { model | cardPage = Ready cardPage }, Cmd.none )
FoundCards (Err _) ->
( model, Cmd.none )
ShowCardDetails card ->
( { model | activeCard = Just card }, Cmd.none )
ClearCardDetails ->
( { model | activeCard = Nothing }, Cmd.none )
colors =
let
blue =
E.rgb255 100 100 255
slate =
E.rgb255 150 150 200
lighterGrey =
E.rgb255 60 60 60
lightGrey =
E.rgb255 50 50 50
grey =
E.rgb255 40 40 40
darkGrey =
E.rgb255 30 30 30
darkerGrey =
E.rgb255 20 20 20
white =
E.rgb255 255 255 255
offwhite =
E.rgb255 200 200 200
mythic =
E.rgb255 205 55 0
rare =
E.rgb255 218 165 32
uncommon =
E.rgb255 112 128 144
common =
E.rgb255 47 79 79
in in
{ primary = blue E.row
, secondary = slate
, background = lightGrey
, navBar = darkerGrey
, sidebar = lighterGrey
, selected = darkGrey
, hover = grey
, title = white
, subtitle = offwhite
, text = offwhite
, mythic = mythic
, rare = rare
, uncommon = uncommon
, common = common
}
isMobile : E.Device -> Bool
isMobile device =
case device.orientation of
E.Landscape ->
False
E.Portrait ->
True
searchBar : Model -> E.Element Msg
searchBar model =
let
alignment =
if isMobile model.device then
E.column
else
E.row
in
alignment
[ E.padding 10 [ E.padding 10
, E.spacing 10 , E.spacing 10
, E.width E.fill , E.width E.fill
, Background.color colors.navBar , Background.color UI.colors.navBar
, Font.color UI.colors.text
] ]
[ E.row [ E.spacing 10, E.width E.fill ] [ E.el [ E.width <| E.fillPortion 1 ] <| E.text "Tutor"
[ Input.text , E.row [ E.width <| E.fillPortion 4 ]
[ onEnter Search [ navLink MyCollection "Collection"
, Background.color colors.background
, Font.color colors.text -- , navLink "" "Decks"
, E.width (E.fill |> E.minimum 150)
]
{ onChange = UpdateCriteria << UpdateName
, text = model.criteria.query
, placeholder = Nothing
, label = Input.labelHidden "Search Input"
}
, Input.button
[ Background.color colors.primary
, Font.color colors.text
, Border.rounded 10
, E.padding 10
]
{ onPress = Just Search
, label = E.text "Search"
}
]
, E.row [ E.spacing 10 ]
[ Input.radio [ E.padding 10 ]
{ onChange = UpdateCriteria << UpdateSortBy
, selected = Just model.criteria.sortBy
, label = Input.labelLeft [ Font.color colors.text ] (E.text "Sort by")
, options =
[ Input.option "price" <| E.el [ Font.color colors.text ] <| E.text "Price DESC"
, Input.option "rarity" <| E.el [ Font.color colors.text ] <| E.text "Rarity DESC"
]
}
] ]
] ]
viewCardBrowser : Model -> E.Element Msg
viewCardBrowser model =
let
viewCard : Dimensions -> Card.Card -> E.Element Msg
viewCard dimensions cardModel =
E.el
[ Border.rounded 10
, E.clip
, E.width <| E.px dimensions.width
, E.height <| E.px dimensions.height
]
<|
E.image
[ E.width <| E.px dimensions.width
, E.height <| E.px dimensions.height
, E.behindContent <|
E.html <|
Spinner.view manaSpinner model.spinner
]
{ src =
Url.Builder.crossOrigin "https://api.scryfall.com"
[ "cards", cardModel.scryfallId ]
[ Url.Builder.string "format" "image"
, Url.Builder.string "version" "border_crop"
]
, description = cardModel.name
}
badge color foil text =
E.el
[ Border.rounded 5
, Border.color color
, Border.width 1
, E.width <| E.px 60
, Font.family [ Font.typeface "sans" ]
, Font.size 10
, Font.color colors.title
]
<|
E.row [ E.height E.fill, E.width E.fill ]
[ E.el [ E.padding 2, E.width E.fill ] <| E.text text
, E.row [ E.padding 1, E.height E.fill, E.width E.fill, Background.color color ]
[ if foil then
E.el
[ E.width E.fill
, E.height E.fill
, Background.gradient
{ angle = 4.0
, steps =
[ E.rgb 148 0 211
, E.rgb 75 0 130
, E.rgb 0 0 255
, E.rgb 0 255 0
, E.rgb 255 255 0
, E.rgb 255 127 0
, E.rgb 255 0 0
]
}
]
E.none
else
E.none
]
]
setBadge : Card.Card -> E.Element Msg
setBadge card =
let
color =
case card.rarity of
"mythic" ->
colors.mythic
"rare" ->
colors.rare
"uncommon" ->
colors.uncommon
_ ->
colors.common
in
badge color card.foil card.setCode
priceBadge { currency, amount } =
E.el
[ Border.rounded 5
, Border.color colors.text
, E.width <| E.px 60
, E.padding 2
, Font.family [ Font.typeface "sans" ]
, Font.size 10
]
<|
E.row [ E.width E.fill ]
[ E.el [ E.width <| E.fillPortion 1 ] <| E.text <| String.toUpper currency
, E.el [ E.width <| E.fillPortion 2, Font.alignRight ] <| E.text amount
]
prices card =
Maybe.Extra.values
[ Maybe.map (\usd -> { currency = "usd", amount = usd }) <|
Maybe.Extra.or card.prices.usd card.prices.usd_foil
, Maybe.map (\eur -> { currency = "eur", amount = eur }) <|
Maybe.Extra.or card.prices.eur card.prices.eur_foil
, Maybe.map (\tix -> { currency = "tix", amount = tix }) card.prices.tix
]
cardDetails card =
E.column
[ E.spacing 20
, E.padding 10
]
<|
E.el [ E.centerX ]
(viewCard { width = 192, height = 272 } card)
:: (E.row [ E.spacing 5, E.centerX ] <| List.map priceBadge (prices card))
:: E.paragraph [ Font.heavy, Font.size 24, Font.center, Font.color colors.title ] [ E.text card.name ]
:: List.map (\text -> E.paragraph [ Font.size 16 ] [ E.text text ])
(String.lines card.oracleText)
cardRow : Maybe Card.Card -> Card.Card -> E.Element Msg
cardRow activeCard cardModel =
let
interactiveAttributes =
if activeCard == Just cardModel then
[ Background.color colors.selected ]
else
[ E.pointer
, E.mouseOver [ Background.color colors.hover ]
, Events.onClick <| ShowCardDetails cardModel
]
in
E.row
([ E.width E.fill
, E.spacing 10
, E.padding 3
]
++ interactiveAttributes
)
[ E.el [ E.width <| E.px 100 ] <|
E.image
[ E.height <| E.px 60
, E.centerX
]
{ src =
Url.Builder.crossOrigin "https://api.scryfall.com"
[ "cards", cardModel.scryfallId ]
[ Url.Builder.string "format" "image"
, Url.Builder.string "version" "art_crop"
]
, description = cardModel.name
}
, E.column [ E.centerY, E.height E.fill, E.width E.fill, E.clipX ]
[ E.el [ Font.color colors.title ] <| E.text cardModel.name
, E.el [ Font.size 16, Font.italic, Font.color colors.subtitle ] <| E.text cardModel.collection
]
, E.column [ E.alignRight, E.height E.fill ] <|
setBadge cardModel
:: List.map priceBadge (prices cardModel)
]
details =
if isMobile model.device then
case model.activeCard of
Just card ->
E.column
[ E.spacing 10
, E.padding 10
, E.height <| E.fillPortion 1
, E.width E.fill
, Background.color colors.sidebar
, E.scrollbarY
]
<|
E.paragraph [ Font.heavy, Font.size 24, Font.center ] [ E.text card.name ]
:: List.map (\text -> E.paragraph [ Font.size 16 ] [ E.text text ])
(String.lines card.oracleText)
Nothing ->
E.none
else
E.el
[ E.alignTop
, E.width <| E.fillPortion 1
, E.height E.fill
, Background.color colors.sidebar
]
(Maybe.map
cardDetails
model.activeCard
|> Maybe.withDefault
E.none
)
closedetails =
case model.activeCard of
Just _ ->
Input.button
[ E.height (E.px 30)
, E.width E.fill
, Background.color colors.secondary
, Border.rounded 5
, Font.color colors.text
, Font.center
]
{ label = E.text "Close", onPress = Just ClearCardDetails }
Nothing ->
E.none
navButton text maybeUrl =
case maybeUrl of
Just url ->
Input.button
[ E.height (E.px 30)
, E.width E.fill
, Background.color colors.primary
, Border.rounded 5
, Font.color colors.text
, Font.center
]
{ label = E.text text, onPress = Just (GetPage url) }
Nothing ->
E.el [ E.width E.fill ] E.none
cards cardPage =
let
attrs =
if isMobile model.device then
[ E.width E.fill
, E.height <| E.fillPortion 3
]
else
[ E.width <| E.fillPortion 2
, E.height E.fill
]
in
E.column attrs
[ E.row
[ E.spacing 5
, E.padding 5
, E.width E.fill
]
[ navButton "<-" cardPage.prev
, navButton "->" cardPage.next
]
, E.column
[ E.width E.fill
, E.height E.fill
, E.scrollbarY
]
<|
List.map (cardRow model.activeCard) cardPage.values
]
in
case model.cardPage of
Failed ->
E.none
Loading cardPage ->
E.el
[ E.height E.fill
, E.centerX
]
<|
E.html <|
Spinner.view manaSpinner model.spinner
Ready cardPage ->
if isMobile model.device then
E.column
[ E.width E.fill
, E.height E.fill
, Font.color colors.text
, E.scrollbarY
]
[ details, closedetails, cards cardPage ]
else
E.row
[ E.width E.fill
, E.height E.fill
, Font.color colors.text
, E.scrollbarY
]
[ details, cards cardPage ]
onEnter : msg -> E.Attribute msg
onEnter msg =
E.htmlAttribute
(Html.Events.on "keyup"
(Json.Decode.field "key" Json.Decode.string
|> Json.Decode.andThen
(\key ->
if key == "Enter" then
Json.Decode.succeed msg
else
Json.Decode.fail "Not the enter key"
)
)
)
view : Model -> Browser.Document Msg view : Model -> Browser.Document Msg
view model = view model =
let
viewPage page =
case page of
Collection pageModel ->
E.map CollectionMsg <| Collection.view pageModel
_ ->
E.none
in
{ title = "Tutor" { title = "Tutor"
, body = , body =
[ E.layout [ E.layout
[ Background.color colors.background [ Background.color UI.colors.background
, E.height E.fill , E.height E.fill
] ]
<| <|
@ -763,37 +186,28 @@ view model =
[ E.width E.fill [ E.width E.fill
, E.height E.fill , E.height E.fill
] ]
[ searchBar model [ viewPage model.page
, viewCardBrowser model
, E.el
[ E.height (E.px 50)
, E.width E.fill
, E.padding 10
, Font.color colors.text
, Background.color colors.navBar
, E.alignBottom
]
<|
case model.collectionStatistics of
Just statistics ->
E.el [ E.centerY, Font.size 16, Font.italic ] <|
E.text <|
String.concat
[ String.fromInt statistics.cards
, " cards in collection spanning "
, String.fromInt statistics.sets
, " sets (Estimated value: $"
, statistics.value
, ")"
]
Nothing ->
E.none
] ]
] ]
} }
subscriptions : Model -> Sub Msg
subscriptions model =
let
global =
[ Browser.Events.onResize
(\w h -> ViewportChanged { width = w, height = h })
]
in
case model.page of
Collection pageModel ->
Sub.batch (Sub.map CollectionMsg (Collection.subscriptions pageModel) :: global)
_ ->
Sub.batch global
main : Program Json.Decode.Value Model Msg main : Program Json.Decode.Value Model Msg
main = main =
Browser.application Browser.application
@ -802,11 +216,5 @@ main =
, onUrlRequest = LinkClicked , onUrlRequest = LinkClicked
, view = view , view = view
, update = update , update = update
, subscriptions = , subscriptions = subscriptions
\_ ->
Sub.batch
[ Browser.Events.onResize
(\w h -> ViewportChanged { width = w, height = h })
, Sub.map SpinnerMsg Spinner.subscription
]
} }

View file

@ -1,7 +1,31 @@
module Collection exposing (..) module Collection exposing (..)
import Browser
import Browser.Dom
import Browser.Events
import Browser.Navigation
import Card
import Color
import Dict
import Element as E
import Element.Background as Background
import Element.Border as Border
import Element.Events as Events
import Element.Font as Font
import Element.Input as Input
import Html.Events
import Http
import Json.Decode import Json.Decode
import Json.Decode.Pipeline as JDP import Json.Decode.Pipeline as JDP
import Maybe.Extra
import Paginated
import Spinner
import Task
import UI
import Url
import Url.Builder
import Url.Parser exposing ((</>), (<?>))
import Url.Parser.Query
type alias Statistics = type alias Statistics =
@ -17,3 +41,655 @@ decodeStatistics =
|> JDP.required "cards" Json.Decode.int |> JDP.required "cards" Json.Decode.int
|> JDP.required "sets" Json.Decode.int |> JDP.required "sets" Json.Decode.int
|> JDP.required "value" Json.Decode.string |> JDP.required "value" Json.Decode.string
type alias Criteria =
{ query : String
, sortBy : String
, ownedOnly : Bool
}
type alias Model =
{ navigationKey : Browser.Navigation.Key
, url : Url.Url
, device : E.Device
, spinner : Spinner.Model
, criteria : Criteria
, cardPage : CardPage
, activeCard : Maybe Card.Card
, collectionStatistics : Maybe Statistics
}
type Msg
= UrlChanged Url.Url
| ViewportChanged UI.Dimensions
| LinkClicked Browser.UrlRequest
| SpinnerMsg Spinner.Msg
| UpdateCriteria CriteriaMsg
| Search
| GetPage Url.Url
| GotStatistics (Result Http.Error Statistics)
| FoundCards (Result Http.Error (Paginated.Page Card.Card))
| ShowCardDetails Card.Card
| ClearCardDetails
type CriteriaMsg
= UpdateName String
| UpdateSortBy String
| UpdateOwnedOnly Bool
type CardPage
= Ready (Paginated.Page Card.Card)
| Loading (Paginated.Page Card.Card)
| Failed
toLoading : CardPage -> CardPage
toLoading cardPage =
case cardPage of
Ready page ->
Loading page
Loading page ->
Loading page
Failed ->
Loading Paginated.empty
searchQuery : Criteria -> List Url.Builder.QueryParameter
searchQuery criteria =
[ Url.Builder.string "q" criteria.query
, Url.Builder.string "sort_by" criteria.sortBy
, Url.Builder.string "in_collection"
(if criteria.ownedOnly then
"yes"
else
"no"
)
]
search : Criteria -> Cmd Msg
search criteria =
loadPage <|
Url.Builder.absolute
[ "api", "search" ]
(Url.Builder.int "limit" 18 :: searchQuery criteria)
loadPage : String -> Cmd Msg
loadPage url =
Http.get
{ url = url
, expect = Paginated.expectJson FoundCards Card.decode
}
getCollectionStatistics : Cmd Msg
getCollectionStatistics =
Http.get
{ url = Url.Builder.absolute [ "api", "collection" ] []
, expect = Http.expectJson GotStatistics decodeStatistics
}
parseUrl : Url.Parser.Parser (Criteria -> a) a
parseUrl =
let
query =
Url.Parser.Query.string "q"
|> Url.Parser.Query.map (Maybe.withDefault "")
sortBy =
Url.Parser.Query.enum "sort_by"
(Dict.fromList
[ ( "rarity", "rarity" )
, ( "price", "price" )
]
)
|> Url.Parser.Query.map (Maybe.withDefault "rarity")
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.map3 Criteria query sortBy inCollection
criteriaFromUrl : Url.Url -> Criteria
criteriaFromUrl url =
let
emptyCriteria =
{ query = "", sortBy = "price", ownedOnly = True }
in
Url.Parser.parse parseUrl url
|> Maybe.withDefault emptyCriteria
init : Browser.Navigation.Key -> Url.Url -> E.Device -> ( Model, Cmd Msg )
init key url device =
let
criteria =
criteriaFromUrl url
in
( { navigationKey = key
, url = url
, device = device
, spinner = Spinner.init
, criteria = criteria
, cardPage = Loading Paginated.empty
, activeCard = Nothing
, collectionStatistics = Nothing
}
, Cmd.batch
[ UI.getViewport ViewportChanged
, search criteria
, getCollectionStatistics
]
)
updateCriteria : CriteriaMsg -> Criteria -> Criteria
updateCriteria msg model =
case msg of
UpdateName text ->
{ model | query = text }
UpdateSortBy column ->
{ model | sortBy = column }
UpdateOwnedOnly value ->
{ model | ownedOnly = value }
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
UrlChanged url ->
let
criteria =
Debug.log "criteria" <| criteriaFromUrl url
in
( { model | criteria = criteria }, search criteria )
LinkClicked _ ->
( model, Cmd.none )
ViewportChanged viewport ->
( { model
| device = E.classifyDevice viewport
}
, Cmd.none
)
SpinnerMsg msg_ ->
( { model | spinner = Spinner.update msg_ model.spinner }, Cmd.none )
UpdateCriteria msg_ ->
let
newCriteria =
updateCriteria msg_ model.criteria
in
case msg_ of
UpdateName _ ->
( { model | criteria = newCriteria }
, Cmd.none
)
UpdateSortBy _ ->
update Search { model | criteria = newCriteria }
UpdateOwnedOnly _ ->
update Search { model | criteria = newCriteria }
Search ->
( { model
| cardPage = toLoading model.cardPage
, activeCard = Nothing
}
, Cmd.batch
[ Browser.Navigation.pushUrl model.navigationKey <|
Url.Builder.relative [] (searchQuery model.criteria)
]
)
GetPage url ->
( { model | cardPage = toLoading model.cardPage }, loadPage (Url.toString url) )
GotStatistics (Ok statistics) ->
( { model | collectionStatistics = Just statistics }, Cmd.none )
GotStatistics (Err _) ->
( model, Cmd.none )
FoundCards (Ok cardPage) ->
( { model | cardPage = Ready cardPage }, Cmd.none )
FoundCards (Err _) ->
( model, Cmd.none )
ShowCardDetails card ->
( { model | activeCard = Just card }, Cmd.none )
ClearCardDetails ->
( { model | activeCard = Nothing }, Cmd.none )
searchBar : Model -> E.Element Msg
searchBar model =
let
alignment =
if UI.isMobile model.device then
E.column
else
E.row
in
alignment
[ E.padding 10
, E.spacing 10
, E.width E.fill
, Background.color UI.colors.navBar
]
[ E.row [ E.spacing 10, E.width E.fill ]
[ Input.text
[ onEnter Search
, Background.color UI.colors.background
, Font.color UI.colors.text
, E.width (E.fill |> E.minimum 150)
]
{ onChange = UpdateCriteria << UpdateName
, text = model.criteria.query
, placeholder = Nothing
, label = Input.labelHidden "Search Input"
}
, Input.button
[ Background.color UI.colors.primary
, Font.color UI.colors.text
, Border.rounded 10
, E.padding 10
]
{ onPress = Just Search
, label = E.text "Search"
}
]
, E.row [ E.spacing 10 ]
[ Input.radio [ E.padding 10 ]
{ onChange = UpdateCriteria << UpdateSortBy
, selected = Just model.criteria.sortBy
, label = Input.labelLeft [ Font.color UI.colors.text ] (E.text "Sort by")
, options =
[ Input.option "price" <| E.el [ Font.color UI.colors.text ] <| E.text "Price DESC"
, Input.option "rarity" <| E.el [ Font.color UI.colors.text ] <| E.text "Rarity DESC"
]
}
]
]
viewCardBrowser : Model -> E.Element Msg
viewCardBrowser model =
let
viewCard : UI.Dimensions -> Card.Card -> E.Element Msg
viewCard dimensions cardModel =
E.el
[ Border.rounded 10
, E.clip
, E.width <| E.px dimensions.width
, E.height <| E.px dimensions.height
]
<|
E.image
[ E.width <| E.px dimensions.width
, E.height <| E.px dimensions.height
, E.behindContent <|
E.html <|
Spinner.view UI.manaSpinner model.spinner
]
{ src =
Url.Builder.crossOrigin "https://api.scryfall.com"
[ "cards", cardModel.scryfallId ]
[ Url.Builder.string "format" "image"
, Url.Builder.string "version" "border_crop"
]
, description = cardModel.name
}
badge color foil text =
E.el
[ Border.rounded 5
, Border.color color
, Border.width 1
, E.width <| E.px 60
, Font.family [ Font.typeface "sans" ]
, Font.size 10
, Font.color UI.colors.title
]
<|
E.row [ E.height E.fill, E.width E.fill ]
[ E.el [ E.padding 2, E.width E.fill ] <| E.text text
, E.row [ E.padding 1, E.height E.fill, E.width E.fill, Background.color color ]
[ if foil then
E.el
[ E.width E.fill
, E.height E.fill
, Background.gradient
{ angle = 4.0
, steps =
[ E.rgb 148 0 211
, E.rgb 75 0 130
, E.rgb 0 0 255
, E.rgb 0 255 0
, E.rgb 255 255 0
, E.rgb 255 127 0
, E.rgb 255 0 0
]
}
]
E.none
else
E.none
]
]
setBadge : Card.Card -> E.Element Msg
setBadge card =
let
color =
case card.rarity of
"mythic" ->
UI.colors.mythic
"rare" ->
UI.colors.rare
"uncommon" ->
UI.colors.uncommon
_ ->
UI.colors.common
in
badge color card.foil card.setCode
priceBadge { currency, amount } =
E.el
[ Border.rounded 5
, Border.color UI.colors.text
, E.width <| E.px 60
, E.padding 2
, Font.family [ Font.typeface "sans" ]
, Font.size 10
]
<|
E.row [ E.width E.fill ]
[ E.el [ E.width <| E.fillPortion 1 ] <| E.text <| String.toUpper currency
, E.el [ E.width <| E.fillPortion 2, Font.alignRight ] <| E.text amount
]
prices card =
Maybe.Extra.values
[ Maybe.map (\usd -> { currency = "usd", amount = usd }) <|
Maybe.Extra.or card.prices.usd card.prices.usd_foil
, Maybe.map (\eur -> { currency = "eur", amount = eur }) <|
Maybe.Extra.or card.prices.eur card.prices.eur_foil
, Maybe.map (\tix -> { currency = "tix", amount = tix }) card.prices.tix
]
cardDetails card =
E.column
[ E.spacing 20
, E.padding 10
]
<|
E.el [ E.centerX ]
(viewCard { width = 192, height = 272 } card)
:: (E.row [ E.spacing 5, E.centerX ] <| List.map priceBadge (prices card))
:: E.paragraph [ Font.heavy, Font.size 24, Font.center, Font.color UI.colors.title ] [ E.text card.name ]
:: List.map (\text -> E.paragraph [ Font.size 16 ] [ E.text text ])
(String.lines card.oracleText)
cardRow : Maybe Card.Card -> Card.Card -> E.Element Msg
cardRow activeCard cardModel =
let
interactiveAttributes =
if activeCard == Just cardModel then
[ Background.color UI.colors.selected ]
else
[ E.pointer
, E.mouseOver [ Background.color UI.colors.hover ]
, Events.onClick <| ShowCardDetails cardModel
]
in
E.row
([ E.width E.fill
, E.spacing 10
, E.padding 3
]
++ interactiveAttributes
)
[ E.el [ E.width <| E.px 100 ] <|
E.image
[ E.height <| E.px 60
, E.centerX
]
{ src =
Url.Builder.crossOrigin "https://api.scryfall.com"
[ "cards", cardModel.scryfallId ]
[ Url.Builder.string "format" "image"
, Url.Builder.string "version" "art_crop"
]
, description = cardModel.name
}
, E.column [ E.centerY, E.height E.fill, E.width E.fill, E.clipX ]
[ E.el [ Font.color UI.colors.title ] <| E.text cardModel.name
, E.el [ Font.size 16, Font.italic, Font.color UI.colors.subtitle ] <| E.text cardModel.collection
]
, E.column [ E.alignRight, E.height E.fill ] <|
setBadge cardModel
:: List.map priceBadge (prices cardModel)
]
details =
if UI.isMobile model.device then
case model.activeCard of
Just card ->
E.column
[ E.spacing 10
, E.padding 10
, E.height <| E.fillPortion 1
, E.width E.fill
, Background.color UI.colors.sidebar
, E.scrollbarY
]
<|
E.paragraph [ Font.heavy, Font.size 24, Font.center ] [ E.text card.name ]
:: List.map (\text -> E.paragraph [ Font.size 16 ] [ E.text text ])
(String.lines card.oracleText)
Nothing ->
E.none
else
E.el
[ E.alignTop
, E.width <| E.fillPortion 1
, E.height E.fill
, Background.color UI.colors.sidebar
]
(Maybe.map
cardDetails
model.activeCard
|> Maybe.withDefault
E.none
)
closedetails =
case model.activeCard of
Just _ ->
Input.button
[ E.height (E.px 30)
, E.width E.fill
, Background.color UI.colors.secondary
, Border.rounded 5
, Font.color UI.colors.text
, Font.center
]
{ label = E.text "Close", onPress = Just ClearCardDetails }
Nothing ->
E.none
navButton text maybeUrl =
case maybeUrl of
Just url ->
Input.button
[ E.height (E.px 30)
, E.width E.fill
, Background.color UI.colors.primary
, Border.rounded 5
, Font.color UI.colors.text
, Font.center
]
{ label = E.text text, onPress = Just (GetPage url) }
Nothing ->
E.el [ E.width E.fill ] E.none
cards cardPage =
let
attrs =
if UI.isMobile model.device then
[ E.width E.fill
, E.height <| E.fillPortion 3
]
else
[ E.width <| E.fillPortion 2
, E.height E.fill
]
in
E.column attrs
[ E.row
[ E.spacing 5
, E.padding 5
, E.width E.fill
]
[ navButton "<-" cardPage.prev
, navButton "->" cardPage.next
]
, E.column
[ E.width E.fill
, E.height E.fill
, E.scrollbarY
]
<|
List.map (cardRow model.activeCard) cardPage.values
]
in
case model.cardPage of
Failed ->
E.none
Loading cardPage ->
E.el
[ E.height E.fill
, E.centerX
]
<|
E.html <|
Spinner.view UI.manaSpinner model.spinner
Ready cardPage ->
if UI.isMobile model.device then
E.column
[ E.width E.fill
, E.height E.fill
, Font.color UI.colors.text
, E.scrollbarY
]
[ details, closedetails, cards cardPage ]
else
E.row
[ E.width E.fill
, E.height E.fill
, Font.color UI.colors.text
, E.scrollbarY
]
[ details, cards cardPage ]
onEnter : msg -> E.Attribute msg
onEnter msg =
E.htmlAttribute
(Html.Events.on "keyup"
(Json.Decode.field "key" Json.Decode.string
|> Json.Decode.andThen
(\key ->
if key == "Enter" then
Json.Decode.succeed msg
else
Json.Decode.fail "Not the enter key"
)
)
)
view : Model -> E.Element Msg
view model =
E.column
[ E.width E.fill
, E.height E.fill
]
[ searchBar model
, viewCardBrowser model
, E.el
[ E.height (E.px 50)
, E.width E.fill
, E.padding 10
, Font.color UI.colors.text
, Background.color UI.colors.navBar
, E.alignBottom
]
<|
case model.collectionStatistics of
Just statistics ->
E.el [ E.centerY, Font.size 16, Font.italic ] <|
E.text <|
String.concat
[ String.fromInt statistics.cards
, " cards in collection spanning "
, String.fromInt statistics.sets
, " sets (Estimated value: $"
, statistics.value
, ")"
]
Nothing ->
E.none
]
subscriptions : Model -> Sub Msg
subscriptions model =
Sub.batch
[ Browser.Events.onResize
(\w h -> ViewportChanged { width = w, height = h })
, Sub.map SpinnerMsg Spinner.subscription
]

129
www/src/UI.elm Normal file
View file

@ -0,0 +1,129 @@
module UI exposing
( Dimensions
, colors
, getViewport
, isMobile
, manaSpinner
)
import Browser.Dom
import Color
import Element as E
import Spinner
import Task
type alias Dimensions =
{ width : Int
, height : Int
}
colors =
let
blue =
E.rgb255 100 100 255
slate =
E.rgb255 150 150 200
lighterGrey =
E.rgb255 60 60 60
lightGrey =
E.rgb255 50 50 50
grey =
E.rgb255 40 40 40
darkGrey =
E.rgb255 30 30 30
darkerGrey =
E.rgb255 20 20 20
white =
E.rgb255 255 255 255
offwhite =
E.rgb255 200 200 200
mythic =
E.rgb255 205 55 0
rare =
E.rgb255 218 165 32
uncommon =
E.rgb255 112 128 144
common =
E.rgb255 47 79 79
in
{ primary = blue
, secondary = slate
, background = lightGrey
, navBar = darkerGrey
, sidebar = lighterGrey
, selected = darkGrey
, hover = grey
, title = white
, subtitle = offwhite
, text = offwhite
, mythic = mythic
, rare = rare
, uncommon = uncommon
, common = common
}
getViewport : (Dimensions -> msg) -> Cmd msg
getViewport msg =
Task.perform
(\x ->
msg
{ width = floor x.viewport.width
, height = floor x.viewport.height
}
)
Browser.Dom.getViewport
isMobile : E.Device -> Bool
isMobile device =
case device.orientation of
E.Landscape ->
False
E.Portrait ->
True
manaSpinner : Spinner.Config
manaSpinner =
let
color index =
if index < 1.0 then
Color.red
else if index < 2.0 then
Color.green
else if index < 3.0 then
Color.purple
else if index < 4.0 then
Color.blue
else
Color.white
default =
Spinner.defaultConfig
in
{ default
| lines = 5.0
, length = 0.0
, width = 20
, color = color
}