summaryrefslogtreecommitdiff
path: root/elm3/Lib
diff options
context:
space:
mode:
Diffstat (limited to 'elm3/Lib')
-rw-r--r--elm3/Lib/Api.elm265
-rw-r--r--elm3/Lib/Autocomplete.elm291
-rw-r--r--elm3/Lib/Editsum.elm59
-rw-r--r--elm3/Lib/Ffi.elm29
-rw-r--r--elm3/Lib/Html.elm182
-rw-r--r--elm3/Lib/RDate.elm84
-rw-r--r--elm3/Lib/Util.elm76
7 files changed, 986 insertions, 0 deletions
diff --git a/elm3/Lib/Api.elm b/elm3/Lib/Api.elm
new file mode 100644
index 00000000..512038e8
--- /dev/null
+++ b/elm3/Lib/Api.elm
@@ -0,0 +1,265 @@
+module Lib.Api exposing (..)
+
+import Json.Encode as JE
+import Json.Decode as JD
+import File exposing (File)
+import Http
+import Html exposing (Attribute)
+import Html.Events exposing (on)
+
+
+-- Handy state enum for forms
+type State
+ = Normal
+ | Loading
+ | Error Response
+
+
+type alias VN =
+ { id : Int
+ , title : String
+ , original : String
+ , hidden : Bool
+ }
+
+decodeVN : JD.Decoder VN
+decodeVN = JD.map4
+ (\a b c d -> { id = a, title = b, original = c, hidden = d})
+ (JD.field "id" JD.int)
+ (JD.field "title" JD.string)
+ (JD.field "original" JD.string)
+ (JD.field "hidden" JD.bool)
+
+
+type alias Staff =
+ { id : Int
+ , aid : Int
+ , name : String
+ , original : String
+ }
+
+decodeStaff : JD.Decoder Staff
+decodeStaff = JD.map4
+ (\a b c d -> { id = a, aid = b, name = c, original = d })
+ (JD.field "id" JD.int)
+ (JD.field "aid" JD.int)
+ (JD.field "name" JD.string)
+ (JD.field "original" JD.string)
+
+
+type alias Producer =
+ { id : Int
+ , name : String
+ , original : String
+ , hidden : Bool
+ }
+
+decodeProducer : JD.Decoder Producer
+decodeProducer = JD.map4
+ (\a b c d -> { id = a, name = b, original = c, hidden = d })
+ (JD.field "id" JD.int)
+ (JD.field "name" JD.string)
+ (JD.field "original" JD.string)
+ (JD.field "hidden" JD.bool)
+
+
+type alias Char =
+ { id : Int
+ , name : String
+ , original : String
+ , main : Maybe
+ { id : Int
+ , name : String
+ }
+ }
+
+decodeChar : JD.Decoder Char
+decodeChar = JD.map5
+ (\a b c d e ->
+ { id = a, name = b, original = c
+ , main = case (d, e) of
+ (Just id, Just name) -> Just { id = id, name = name }
+ _ -> Nothing
+ })
+ (JD.field "id" JD.int)
+ (JD.field "name" JD.string)
+ (JD.field "original" JD.string)
+ (JD.field "main" (JD.nullable JD.int ))
+ (JD.field "main_name" (JD.nullable JD.string))
+
+
+type alias Trait =
+ { id : Int
+ , name : String
+ , gid : Maybe Int
+ , group : Maybe String
+ }
+
+decodeTrait : JD.Decoder Trait
+decodeTrait = JD.map4
+ (\a b c d -> { id = a, name = b, gid = c, group = d })
+ (JD.field "id" JD.int)
+ (JD.field "name" JD.string)
+ (JD.field "gid" (JD.nullable JD.int))
+ (JD.field "group" (JD.nullable JD.string))
+
+
+-- Same as Lib.Gen.CharEditVnrelsReleases
+type alias Release =
+ { id : Int
+ , title : String
+ , lang : List String
+ }
+
+decodeRelease : JD.Decoder Release
+decodeRelease = JD.map3
+ (\a b c -> { id = a, title = b, lang = c })
+ (JD.field "id" JD.int)
+ (JD.field "title" JD.string)
+ (JD.field "lang" (JD.list JD.string))
+
+
+-- Possible server responses. This only includes "expected" responses. Much of
+-- the form validation is performed client side, so a constraint violation in
+-- the JSON structure or data fields is unexpected and is reported by the
+-- server as a 400 or 500 response.
+type Response
+ = HTTPError Http.Error
+ | Success
+ | CSRF
+ | Throttled
+ | Invalid JE.Value -- JSON structure constraint violation, contains TUWF::Validate error for low-level error reporting
+ | Unauth
+ | BadEmail
+ | BadLogin
+ | BadPass
+ | Bot
+ | Taken
+ | DoubleEmail
+ | DoubleIP
+ | Unchanged
+ | Changed Int Int -- DB entry updated, entry ID and revision number
+ | VNResult (List VN)
+ | StaffResult (List Staff)
+ | ProducerResult (List Producer)
+ | CharResult (List Char)
+ | TraitResult (List Trait)
+ | ReleaseResult (List Release)
+ | ImgFormat
+ | Image Int Int Int -- Uploaded image (id, width, height)
+ | Content String -- Text content
+
+
+decodeResponse : JD.Decoder Response
+decodeResponse = JD.oneOf
+ [ JD.field "Success" <| JD.succeed Success
+ , JD.field "Throttled" <| JD.succeed Throttled
+ , JD.field "CSRF" <| JD.succeed CSRF
+ , JD.field "Invalid" <| JD.map Invalid JD.value
+ , JD.field "Unauth" <| JD.succeed Unauth
+ , JD.field "BadEmail" <| JD.succeed BadEmail
+ , JD.field "BadLogin" <| JD.succeed BadLogin
+ , JD.field "BadPass" <| JD.succeed BadPass
+ , JD.field "Bot" <| JD.succeed Bot
+ , JD.field "Taken" <| JD.succeed Taken
+ , JD.field "DoubleEmail" <| JD.succeed DoubleEmail
+ , JD.field "DoubleIP" <| JD.succeed DoubleIP
+ , JD.field "Unchanged" <| JD.succeed Unchanged
+ , JD.field "Changed" <| JD.map2 Changed (JD.index 0 JD.int) (JD.index 1 JD.int)
+ , JD.field "VNResult" <| JD.map VNResult <| JD.list decodeVN
+ , JD.field "StaffResult" <| JD.map StaffResult <| JD.list decodeStaff
+ , JD.field "ProducerResult"<| JD.map ProducerResult <| JD.list decodeProducer
+ , JD.field "CharResult" <| JD.map CharResult <| JD.list decodeChar
+ , JD.field "TraitResult" <| JD.map TraitResult <| JD.list decodeTrait
+ , JD.field "ReleaseResult" <| JD.map ReleaseResult <| JD.list decodeRelease
+ , JD.field "ImgFormat" <| JD.succeed ImgFormat
+ , JD.field "Image" <| JD.map3 Image (JD.index 0 JD.int) (JD.index 1 JD.int) (JD.index 2 JD.int)
+ , JD.field "Content" <| JD.map Content JD.string
+ ]
+
+
+-- User-friendly error message if the response isn't what the code expected
+showResponse : Response -> String
+showResponse res =
+ let unexp = "Unexpected response, please report a bug."
+ in case res of
+ HTTPError (Http.Timeout) -> "Network timeout, please try again later."
+ HTTPError (Http.NetworkError) -> "Network error, please try again later."
+ HTTPError (Http.BadStatus r) -> "Server error " ++ String.fromInt r ++ ", please try again later, or report an issue if this persists."
+ HTTPError (Http.BadBody r) -> "Invalid response from the server, please report a bug (debug info: " ++ r ++")."
+ HTTPError (Http.BadUrl _) -> unexp
+ Success -> unexp
+ CSRF -> "Invalid CSRF token, please refresh the page and try again."
+ Throttled -> "Action throttled."
+ Invalid _ -> "Invalid form data, please report a bug." -- This error is already logged server-side, no debug info necessary
+ Unauth -> "You do not have the permission to perform this action."
+ BadEmail -> "Unknown email address."
+ BadLogin -> "Invalid username or password."
+ BadPass -> "Your chosen password is in a database of leaked passwords, please choose another one."
+ Bot -> "Invalid answer to the anti-bot question."
+ Taken -> "Username already taken, please choose a different name."
+ DoubleEmail -> "Email address already used for another account."
+ DoubleIP -> "You can only register one account from the same IP within 24 hours."
+ Unchanged -> "No changes"
+ Changed _ _ -> unexp
+ VNResult _ -> unexp
+ StaffResult _ -> unexp
+ ProducerResult _ -> unexp
+ CharResult _ -> unexp
+ TraitResult _ -> unexp
+ ReleaseResult _ -> unexp
+ ImgFormat -> "Unrecognized image format, please upload a JPG or PNG file."
+ Image _ _ _ -> unexp
+ Content _ -> unexp
+
+
+expectResponse : (Response -> msg) -> Http.Expect msg
+expectResponse msg =
+ let
+ res r = msg <| case r of
+ Err e -> HTTPError e
+ Ok v -> v
+ in Http.expectJson res decodeResponse
+
+
+-- Send a POST request with a JSON body to the VNDB API and get a Response back.
+post : String -> JE.Value -> (Response -> msg) -> Cmd msg
+post url body msg =
+ Http.post
+ { url = url
+ , body = Http.jsonBody body
+ , expect = expectResponse msg
+ }
+
+
+
+-- Simple image upload API
+
+type ImageType
+ = Cv
+ | Sf
+ | Ch
+
+
+onFileChange : (List File -> m) -> Attribute m
+onFileChange msg = on "change" <| JD.map msg <| JD.at ["target","files"] <| JD.list File.decoder
+
+
+-- Upload an image to /js/imageupload.json
+postImage : ImageType -> File -> (Response -> msg) -> Cmd msg
+postImage ty file msg =
+ let
+ tys = case ty of
+ Cv -> "cv"
+ Sf -> "sf"
+ Ch -> "ch"
+
+ body = Http.multipartBody
+ [ Http.stringPart "type" tys
+ , Http.filePart "img" file
+ ]
+ in Http.post
+ { url = "/js/imageupload.json"
+ , body = body
+ , expect = expectResponse msg
+ }
diff --git a/elm3/Lib/Autocomplete.elm b/elm3/Lib/Autocomplete.elm
new file mode 100644
index 00000000..a6935057
--- /dev/null
+++ b/elm3/Lib/Autocomplete.elm
@@ -0,0 +1,291 @@
+module Lib.Autocomplete exposing
+ ( Config
+ , SourceConfig
+ , Model
+ , Msg
+ , staffSource
+ , vnSource
+ , producerSource
+ , charSource
+ , traitSource
+ , init
+ , clear
+ , update
+ , view
+ )
+
+import Html exposing (..)
+import Html.Events exposing (..)
+import Html.Attributes exposing (..)
+import Html.Keyed as Keyed
+import Json.Encode as JE
+import Json.Decode as JD
+import Task
+import Process
+import Browser.Dom as Dom
+import Lib.Html exposing (..)
+import Lib.Api as Api
+
+
+type alias Config m a =
+ -- How to wrap a Msg from this model into a Msg of the using model
+ { wrap : Msg a -> m
+ -- A unique 'id' of the input box (necessary for the blur/focus events)
+ , id : String
+ -- The source defines where to get autocomplete results from and how to display them
+ , source : SourceConfig m a
+ }
+
+
+type alias SourceConfig m a =
+ -- API path to query for completion results.
+ -- (The API must accept POST requests with {"search":".."} as body)
+ { path : String
+ -- How to decode results from the API
+ , decode : Api.Response -> Maybe (List a)
+ -- How to display the decoded results
+ , view : a -> List (Html m)
+ -- Unique ID of an item (must not be an empty string).
+ -- This is used to remember selection across data refreshes and to optimize
+ -- HTML generation.
+ , key : a -> String
+ }
+
+
+
+staffSource : SourceConfig m Api.Staff
+staffSource =
+ { path = "/js/staff.json"
+ , decode = \x -> case x of
+ Api.StaffResult e -> Just e
+ _ -> Nothing
+ , view = (\i -> [ div [ class "row row-compact" ]
+ [ div [ class "col single-line muted" ] [ text <| "s" ++ String.fromInt i.id ]
+ , div [ class "col col--2 single-line semi-bold" ] [ text i.name ]
+ , div [ class "col col--2 single-line" ] [ text i.original ]
+ ] ] )
+ , key = .aid >> String.fromInt
+ }
+
+
+vnSource : SourceConfig m Api.VN
+vnSource =
+ { path = "/js/vn.json"
+ , decode = \x -> case x of
+ Api.VNResult e -> Just e
+ _ -> Nothing
+ , view = (\i -> [ div [ class "row row-compact" ]
+ [ div [ class "col single-line muted" ] [ text <| "v" ++ String.fromInt i.id ]
+ , div [ class "col col--4 single-line semi-bold" ] [ text i.title ]
+ ] ] )
+ , key = .id >> String.fromInt
+ }
+
+
+producerSource : SourceConfig m Api.Producer
+producerSource =
+ { path = "/js/producer.json"
+ , decode = \x -> case x of
+ Api.ProducerResult e -> Just e
+ _ -> Nothing
+ , view = (\i -> [ div [ class "row row-compact" ]
+ [ div [ class "col single-line muted" ] [ text <| "p" ++ String.fromInt i.id ]
+ , div [ class "col col--4 single-line semi-bold" ] [ text i.name ]
+ ] ] )
+ , key = .id >> String.fromInt
+ }
+
+
+charSource : SourceConfig m Api.Char
+charSource =
+ { path = "/js/char.json"
+ , decode = \x -> case x of
+ Api.CharResult e -> Just e
+ _ -> Nothing
+ , view = (\i -> [ div [ class "row row-compact" ]
+ [ div [ class "col single-line muted" ] [ text <| "c" ++ String.fromInt i.id ]
+ , div [ class "col col--2 single-line semi-bold" ] [ text i.name ]
+ , div [ class "col col--2 single-line" ] [ text i.original ]
+ ] ] )
+ , key = .id >> String.fromInt
+ }
+
+
+traitSource : SourceConfig m Api.Trait
+traitSource =
+ { path = "/js/trait.json"
+ , decode = \x -> case x of
+ Api.TraitResult e -> Just e
+ _ -> Nothing
+ , view = (\i -> [ div [ class "row row-compact" ]
+ [ div [ class "col single-line muted" ] [ text <| "i" ++ String.fromInt i.id ]
+ , div [ class "col col--4 single-line" ]
+ [ span [ class "muted" ] [ text <| (Maybe.withDefault "" i.group) ++ " / " ]
+ , span [ class "semi-bold" ] [ text i.name ]
+ ]
+ ] ] )
+ , key = .id >> String.fromInt
+ }
+
+
+
+type alias Model a =
+ { position : Maybe Dom.Element
+ , value : String
+ , results : List a
+ , sel : String
+ , loading : Bool
+ , wait : Int
+ }
+
+
+init : Model a
+init =
+ { position = Nothing
+ , value = ""
+ , results = []
+ , sel = ""
+ , loading = False
+ , wait = 0
+ }
+
+
+clear : Model a -> Model a
+clear m = { m
+ | value = ""
+ , results = []
+ , sel = ""
+ , loading = False
+ }
+
+
+type Msg a
+ = Noop
+ | Focus
+ | Blur
+ | Pos (Result Dom.Error Dom.Element)
+ | Input String
+ | Search Int
+ | Key String
+ | Sel String
+ | Enter a
+ | Results String Api.Response
+
+
+select : Config m a -> Int -> Model a -> Model a
+select cfg offset model =
+ let
+ get n = List.drop n model.results |> List.head
+ count = List.length model.results
+ find (n,i) = if cfg.source.key i == model.sel then Just n else Nothing
+ curidx = List.indexedMap (\a b -> (a,b)) model.results |> List.filterMap find |> List.head
+ nextidx = (Maybe.withDefault -1 curidx) + offset
+ nextsel = if nextidx < 0 then 0 else if nextidx >= count then count-1 else nextidx
+ in
+ { model | sel = Maybe.withDefault "" <| Maybe.map cfg.source.key <| get nextsel }
+
+
+update : Config m a -> Msg a -> Model a -> (Model a, Cmd m, Maybe a)
+update cfg msg model =
+ let
+ mod m = (m, Cmd.none, Nothing)
+ -- Ugly hack: blur and focus the input on enter. This does two things:
+ -- 1. If the user clicked on an entry (resulting in the 'Enter' message),
+ -- then this will cause the input to be focussed again. This is
+ -- convenient when adding multiple entries.
+ -- 2. If, as a result of the enter key ('Key Enter' message), the input box
+ -- position was moved (likely, because the input box is usually below
+ -- the data being added), then this blur + focus causes the 'Focus'
+ -- message to be triggered again, updating the position of the dropdown
+ -- div. Without this hack the div positioning will be incorrect.
+ -- (This hack does rely on the view being updated before these tasks
+ -- are executed - but the Dom package seems to guarantee this)
+ refocus = Dom.blur cfg.id
+ |> Task.andThen (always (Dom.focus cfg.id))
+ |> Task.attempt (always (cfg.wrap Noop))
+ in
+ case msg of
+ Noop -> mod model
+ Blur -> mod { model | position = Nothing }
+ Focus -> ({ model | loading = False }, Task.attempt (cfg.wrap << Pos) (Dom.getElement cfg.id), Nothing)
+ Pos (Ok p) -> mod { model | position = Just p }
+ Pos _ -> mod model
+ Sel s -> mod { model | sel = s }
+ Enter r -> (model, refocus, Just r)
+
+ Key "Enter" -> (model, refocus, List.filter (\i -> cfg.source.key i == model.sel) model.results |> List.head)
+ Key "ArrowUp" -> mod <| select cfg -1 model
+ Key "ArrowDown" -> mod <| select cfg 1 model
+ Key _ -> mod model
+
+ Input s ->
+ if s == ""
+ then mod { model | value = s, loading = False, results = [] }
+ else ( { model | value = s, loading = True, wait = model.wait + 1 }
+ , Task.perform (always <| cfg.wrap <| Search <| model.wait + 1) (Process.sleep 500)
+ , Nothing )
+
+ Search i ->
+ if model.value == "" || model.wait /= i
+ then mod model
+ else ( model
+ , Api.post cfg.source.path (JE.object [("search", JE.string model.value)]) (cfg.wrap << Results model.value)
+ , Nothing )
+
+ Results s r -> mod <|
+ if s == model.value
+ then { model | loading = False, results = cfg.source.decode r |> Maybe.withDefault [] }
+ else model -- Discard stale results
+
+
+view : Config m a -> Model a -> List (Attribute m) -> List (Html m)
+view cfg model attrs =
+ let
+ input =
+ inputText cfg.id model.value (cfg.wrap << Input)
+ [ onFocus <| cfg.wrap Focus
+ , onBlur <| cfg.wrap Blur
+ , custom "keydown" <| JD.map (\c ->
+ if c == "Enter" || c == "ArrowUp" || c == "ArrowDown"
+ then { preventDefault = True, stopPropagation = True, message = cfg.wrap (Key c) }
+ else { preventDefault = False, stopPropagation = False, message = cfg.wrap (Key c) }
+ ) <| JD.field "key" JD.string
+ ]
+
+ inputDiv = div
+ (classList [("form-control-wrap",True), ("form-control-wrap--loading",model.loading)] :: attrs)
+ [ input ]
+
+ msg = [("",
+ if List.isEmpty model.results
+ then b [] [text "No results"]
+ else text ""
+ )]
+
+ box p =
+ Keyed.node "div"
+ [ style "top" <| String.fromFloat (p.element.y + p.element.height) ++ "px"
+ , style "left" <| String.fromFloat p.element.x ++ "px"
+ , style "width" <| String.fromFloat p.element.width ++ "px"
+ , class "dropdown-menu dropdown-menu--open"
+ ] <| msg ++ List.map item model.results
+
+ item i =
+ ( cfg.source.key i
+ , a
+ [ href "#"
+ , classList [("dropdown-menu__item", True), ("dropdown-menu__item--active", cfg.source.key i == model.sel) ]
+ , onMouseOver <| cfg.wrap <| Sel <| cfg.source.key i
+ , onMouseDown <| cfg.wrap <| Enter i
+ ] <| cfg.source.view i
+ )
+
+ in
+ [ inputDiv
+ , case model.position of
+ Nothing -> text ""
+ Just p ->
+ if model.value == "" || (model.loading && List.isEmpty model.results)
+ then text ""
+ else box p
+ ]
diff --git a/elm3/Lib/Editsum.elm b/elm3/Lib/Editsum.elm
new file mode 100644
index 00000000..3ddc1506
--- /dev/null
+++ b/elm3/Lib/Editsum.elm
@@ -0,0 +1,59 @@
+-- This module provides an the 'Edit summary' box, including the 'hidden' and
+-- 'locked' moderation checkboxes.
+
+module Lib.Editsum exposing (Model, Msg, new, update, view)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Lib.Html exposing (..)
+
+
+type alias Model =
+ { authmod : Bool
+ , locked : Bool
+ , hidden : Bool
+ , editsum : String
+ }
+
+
+type Msg
+ = Locked Bool
+ | Hidden Bool
+ | Editsum String
+
+
+new : Model
+new =
+ { authmod = False
+ , locked = False
+ , hidden = False
+ , editsum = ""
+ }
+
+
+update : Msg -> Model -> Model
+update msg model =
+ case msg of
+ Locked b -> { model | locked = b }
+ Hidden b -> { model | hidden = b }
+ Editsum s -> { model | editsum = s }
+
+
+view : Model -> Html Msg
+view model =
+ let
+ lockhid = cardRow "Mod actions" Nothing <| formGroups
+ [ [ label [ class "checkbox" ]
+ [ inputCheck "" model.locked Locked
+ , text " Locked" ]
+ ]
+ , [ label [ class "checkbox" ]
+ [ inputCheck "" model.hidden Hidden
+ , text " Hidden" ]
+ ]
+ ]
+ in card_
+ [ lockhid
+ , cardRow "Edit summary" (Just "English please!")
+ <| formGroup [ inputTextArea "" model.editsum Editsum [rows 4, minlength 2, maxlength 5000, required True] ]
+ ]
diff --git a/elm3/Lib/Ffi.elm b/elm3/Lib/Ffi.elm
new file mode 100644
index 00000000..6c3cbf46
--- /dev/null
+++ b/elm3/Lib/Ffi.elm
@@ -0,0 +1,29 @@
+-- Elm 0.19: "We've removed all Native modules and plugged all XSS vectors,
+-- it's now impossible to talk with Javascript other than with ports!"
+-- Me: "Oh yeah? I'll just run sed over the generated Javascript!"
+
+-- This module is a hack to work around the lack of an FFI (Foreign Function
+-- Interface) in Elm. The functions in this module are stubs, their
+-- implementations are replaced by the Makefile with calls to
+-- window.elmFfi_<name> and the actual implementations are in static/v3/vndb.js.
+--
+-- Use sparingly, all of this will likely break in future Elm versions.
+module Lib.Ffi exposing (..)
+
+import Html exposing (Attribute)
+import Html.Attributes exposing (title)
+
+
+-- This is an "onclick = openLightbox(this)" attribute
+openLightbox : Attribute msg
+openLightbox = title ""
+
+
+-- Set the innerHTML attribute of a node
+innerHtml : String -> Attribute msg
+innerHtml = always (title "")
+
+
+-- The current year
+curYear : Int
+curYear = 2018
diff --git a/elm3/Lib/Html.elm b/elm3/Lib/Html.elm
new file mode 100644
index 00000000..b811f9fd
--- /dev/null
+++ b/elm3/Lib/Html.elm
@@ -0,0 +1,182 @@
+module Lib.Html exposing (..)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import List
+import Lib.Api as Api
+import Lib.Gen exposing (urlStatic)
+import Lib.Ffi as Ffi
+import Json.Encode as JE
+import String exposing (padLeft)
+
+-- Quick short-hand way of creating a form that can be disabled.
+-- Usage:
+-- form Submit_msg (state == Disabled) [contents]
+form_ : msg -> Bool -> List (Html msg) -> Html msg
+form_ sub dis cont = Html.form [ onSubmit sub ]
+ [ fieldset [disabled dis] cont ]
+
+
+-- Submit button with loading indicator and error message display
+-- TODO: This use of pull-right is ugly.
+submitButton : String -> Api.State -> Bool -> Bool -> Html m
+submitButton val state valid load = div []
+ [ input [ type_ "submit", class "btn pull-right", tabindex 10, value val, disabled (state == Api.Loading || not valid || load) ] []
+ , case state of
+ Api.Error r -> div [class "invalid-feedback pull-right" ] [ text <| Api.showResponse r ]
+ _ -> if valid
+ then text ""
+ else div [class "invalid-feedback pull-right" ] [ text "The form contains errors, please fix these before submitting. " ]
+ , if state == Api.Loading || load
+ then div [ class "spinner spinner--md pull-right" ] []
+ else text ""
+ ]
+
+
+inputSelect : List (Attribute m) -> String -> List (String, String) -> Html m
+inputSelect attrs sel lst =
+ let opt (id, name) = option [ value id, selected (id == sel) ] [ text name ]
+ in select ([class "form-control", tabindex 10] ++ attrs) <| List.map opt lst
+
+
+inputText : String -> String -> (String -> m) -> List (Attribute m) -> Html m
+inputText nam val onch attrs = input (
+ [ type_ "text"
+ , class "form-control"
+ , tabindex 10
+ , value val
+ , onInput onch
+ ]
+ ++ attrs
+ ++ (if nam == "" then [] else [ id nam, name nam ])
+ ) []
+
+inputTextArea : String -> String -> (String -> m) -> List (Attribute m) -> Html m
+inputTextArea nam val onch attrs = textarea (
+ [ class "form-control"
+ , tabindex 10
+ , onInput onch
+ ]
+ ++ attrs
+ ++ (if nam == "" then [] else [ id nam, name nam ])
+ ) [ text val ]
+
+inputCheck : String -> Bool -> (Bool -> m) -> Html m
+inputCheck nam val onch = input (
+ [ type_ "checkbox"
+ , tabindex 10
+ , onCheck onch
+ , checked val
+ ]
+ ++ (if nam == "" then [] else [ id nam, name nam ])
+ ) []
+
+inputRadio : String -> Bool -> (Bool -> m) -> Html m
+inputRadio nam val onch = input (
+ [ type_ "radio"
+ , tabindex 10
+ , onCheck onch
+ , checked val
+ ]
+ ++ (if nam == "" then [] else [ name nam ])
+ ) []
+
+-- Generate a card with: Id, Title, [Header stuff], [Sections]
+-- TODO: Also abstract "small-card"s (many of the User/ things) into this
+card : String -> String -> List (Html m) -> List (Html m) -> Html m
+card i t h sections = div
+ ([class "card"] ++ if i == "" then [] else [id i])
+ <|
+ [ div [class "card__header"] ([ div [class "card__title"] [text t] ] ++ h)
+ ] ++ List.map (\c -> div [class "card__section"] [c]) sections
+
+-- Card without header
+card_ : List (Html m) -> Html m
+card_ c = div [class "card"] [ div [class "card__body"] c ]
+
+-- Generate a 2-column row for use within a card section: Title, Subtitle, Content
+cardRow : String -> Maybe String -> List (Html m) -> Html m
+cardRow t s c = div [class "row"]
+ [ div [class "col-md col-md--1 card__form-section-left"]
+ [ div [class "card__form-section-title"] [text t]
+ , case s of
+ Just n -> div [class "card__form-section-subtitle"] [text n]
+ Nothing -> text ""
+ ]
+ , div [class "col-md col-md--2"] c
+ ]
+
+formGroup : List (Html m) -> List (Html m)
+formGroup c = [div [class "form-group"] c]
+
+formGroups : List (List (Html m)) -> List (Html m)
+formGroups groups = List.map (\c -> div [class "form-group"] c) groups
+
+
+removeButton : m -> Html m
+removeButton cmd = button [type_ "button", class "btn", tabindex 10, onClick cmd]
+ [ span [class "d-none d-sm-inline"] [text "x"]
+ , span [class "d-sm-none"] [text "Remove"]
+ ]
+
+
+
+editList : List (Html m) -> List (Html m)
+editList ct =
+ if List.isEmpty ct
+ then []
+ else [ div [class "editable-list editable-list--sm"] ct ]
+
+editListRow : String -> List (Html m) -> Html m
+editListRow cl ct = div [class ("editable-list__row row row--compact " ++ cl)] ct
+
+editListField : Int -> String -> List (Html m) -> Html m
+editListField sm cl ct = div
+ [ classList <|
+ [ ("editable-list__field", True)
+ , ("col-sm", True )
+ , ("col-sm--auto", sm == 0)
+ , ("col-sm--1", sm == 1)
+ , ("col-sm--2", sm == 2)
+ , ("col-sm--3", sm == 3)
+ , (cl, cl /= "")
+ ]
+ ] ct
+
+
+-- Special arguments,
+-- id == -1 -> spinner
+-- id == 0 -> camera-alt.svg
+dbImg : String -> Int -> List (Attribute m) -> Maybe { id: String, width: Int, height: Int } -> Html m
+dbImg dir id attrs full =
+ if id == 0 then
+ div (class "vn-image-placeholder img--rounded" :: attrs)
+ [ div [ class "vn-image-placeholder__icon" ]
+ [ img [ src (urlStatic ++ "/v3/camera-alt.svg"), class "svg-icon" ] [] ]
+ ]
+ else if id == -1 then
+ div (class "vn-image-placeholder img--rounded" :: attrs)
+ [ div [ class "vn-image-placeholder__icon" ]
+ [ div [ class "spinner spinner--md" ] [] ]
+ ]
+ else
+ let
+ url d = urlStatic ++ "/" ++ d ++ "/" ++ (padLeft 2 '0' (String.fromInt (modBy 100 id))) ++ "/" ++ (String.fromInt id) ++ ".jpg"
+ i = img [src (url dir), class "img--fit img--rounded" ] []
+ fdir = if dir == "st" then "sf" else dir
+ in case full of
+ Nothing -> i
+ Just f -> a
+ [ href (url fdir)
+ , Ffi.openLightbox
+ , attribute "data-lightbox-id" f.id
+ , attribute "data-lightbox-nfo" <| JE.encode 0 <| JE.object [("width", JE.int f.width), ("height", JE.int f.height)]
+ ] [ i ]
+
+
+iconLanguage : String -> Html msg
+iconLanguage lang = span [ class "lang-badge" ] [ text lang ]
+
+iconPlatform : String -> Html msg
+iconPlatform plat = img [ class "svg-icon", src (urlStatic ++ "/v3/windows.svg"), title "Windows" ] []
diff --git a/elm3/Lib/RDate.elm b/elm3/Lib/RDate.elm
new file mode 100644
index 00000000..397f7243
--- /dev/null
+++ b/elm3/Lib/RDate.elm
@@ -0,0 +1,84 @@
+-- Utility module and UI widget for handling release dates.
+--
+-- Release dates are integers with the following format: 0 or yyyymmdd
+-- Special values
+-- 0 -> unknown
+-- 99999999 -> TBA
+-- yyyy9999 -> year known, month & day unknown
+-- yyyymm99 -> year & month known, day unknown
+--
+-- I'm not a big fan of the UI widget. It's functional, but could be much more
+-- convenient and intuitive.
+module Lib.RDate exposing (..)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Date
+import Lib.Html exposing (..)
+import Lib.Ffi exposing (curYear)
+
+
+type alias RDate = Int
+
+type alias RDateComp =
+ { y : Int
+ , m : Int
+ , d : Int
+ }
+
+
+expand : RDate -> RDateComp
+expand r =
+ { y = r // 10000
+ , m = modBy 100 (r // 100)
+ , d = modBy 100 r
+ }
+
+
+compact : RDateComp -> RDate
+compact r = r.y * 10000 + r.m * 100 + r.d
+
+
+normalize : RDateComp -> RDateComp
+normalize r =
+ if r.y == 0 then { y = 0, m = 0, d = 0 }
+ else if r.y == 9999 then { y = 9999, m = 99, d = 99 }
+ else if r.m == 99 then { y = r.y, m = 99, d = 99 }
+ else r
+
+
+type Msg
+ = Year String
+ | Month String
+ | Day String
+
+
+update : Msg -> RDate -> RDate
+update msg ro =
+ let r = expand ro
+ in compact <| normalize <| case msg of
+ Year s -> { r | y = Maybe.withDefault r.y <| String.toInt s }
+ Month s -> { r | m = Maybe.withDefault r.m <| String.toInt s }
+ Day s -> { r | d = Maybe.withDefault r.d <| String.toInt s }
+
+
+view : RDate -> Bool -> Html Msg
+view ro permitUnknown =
+ let r = expand ro
+ range s = List.range s >> List.map (\n -> (String.fromInt n, String.fromInt n))
+ yl = (if permitUnknown then [("0", "Unknown")] else [])
+ ++ List.reverse (range 1980 (curYear + 5))
+ ++ [("9999", "TBA")]
+ ml = ("99", "- month -") :: (range 1 12)
+ maxDay = Date.fromCalendarDate r.y (Date.numberToMonth r.m) 1 |> Date.add Date.Months 1 |> Date.add Date.Days -1 |> Date.day
+ dl = ("99", "- day -") :: (range 1 maxDay)
+ in div []
+ [ inputSelect [class "form-control--inline", onInput Year] (String.fromInt r.y) yl
+ , if r.y == 0 || r.y == 9999
+ then text ""
+ else inputSelect [class "form-control--inline", onInput Month] (String.fromInt r.m) ml
+ , if r.m == 0 || r.m == 99
+ then text ""
+ else inputSelect [class "form-control--inline", onInput Day] (String.fromInt r.d) dl
+ ]
diff --git a/elm3/Lib/Util.elm b/elm3/Lib/Util.elm
new file mode 100644
index 00000000..f6b39188
--- /dev/null
+++ b/elm3/Lib/Util.elm
@@ -0,0 +1,76 @@
+module Lib.Util exposing (..)
+
+import Char
+import Dict
+
+-- Delete an element from a List
+delidx : Int -> List a -> List a
+delidx n l = List.take n l ++ List.drop (n+1) l
+
+
+-- Modify an element in a List
+modidx : Int -> (a -> a) -> List a -> List a
+modidx n f = List.indexedMap (\i e -> if i == n then f e else e)
+
+
+isJust : Maybe a -> Bool
+isJust m = case m of
+ Just _ -> True
+ _ -> False
+
+
+-- Split by newline, trim whitespace and remove empty lines
+splitLn : String -> List String
+splitLn = String.lines >> List.map String.trim >> List.filter ((/=)"")
+
+-- Returns true if the list contains duplicates
+hasDuplicates : List comparable -> Bool
+hasDuplicates l =
+ let
+ step e acc =
+ case acc of
+ Nothing -> Nothing
+ Just m -> if Dict.member e m then Nothing else Just (Dict.insert e True m)
+ in
+ case List.foldr step (Just Dict.empty) l of
+ Nothing -> True
+ Just _ -> False
+
+
+-- Similar to perl's ucfirst() (not terribly efficient)
+toUpperFirst : String -> String
+toUpperFirst s = String.toList s |> List.indexedMap (\i c -> if i == 0 then Char.toUpper c else c) |> String.fromList
+
+
+-- Haskell's 'lookup' - find an entry in an association list
+lookup : a -> List (a,b) -> Maybe b
+lookup n l = List.filter (\(a,_) -> a == n) l |> List.head |> Maybe.map Tuple.second
+
+
+formatGtin : Int -> String
+formatGtin n = if n == 0 then "" else String.fromInt n |> String.padLeft 12 '0'
+
+
+-- Based on VNDBUtil::gtintype()
+validateGtin : String -> Maybe Int
+validateGtin =
+ let check = String.fromInt
+ >> String.reverse
+ >> String.toList
+ >> List.indexedMap (\i c -> (Char.toCode c - Char.toCode '0') * if modBy 2 i == 0 then 1 else 3)
+ >> List.sum
+ inval n =
+ n < 1000000000
+ || (n >= 200000000000 && n < 600000000000)
+ || (n >= 2000000000000 && n < 3000000000000)
+ || n >= 9770000000000
+ || modBy 10 (check n) /= 0
+ in String.filter Char.isDigit >> String.toInt >> Maybe.andThen (\n -> if inval n then Nothing else Just n)
+
+
+spoilLevels : List (String, String)
+spoilLevels =
+ [ ("0", "No spoiler")
+ , ("1", "Minor spoiler")
+ , ("2", "Major spoiler")
+ ]