diff options
Diffstat (limited to 'elm/Lib')
-rw-r--r-- | elm/Lib/Api.elm | 53 | ||||
-rw-r--r-- | elm/Lib/Editsum.elm | 65 | ||||
-rw-r--r-- | elm/Lib/Ffi.elm | 18 | ||||
-rw-r--r-- | elm/Lib/Ffi.js | 9 | ||||
-rw-r--r-- | elm/Lib/Html.elm | 74 |
5 files changed, 219 insertions, 0 deletions
diff --git a/elm/Lib/Api.elm b/elm/Lib/Api.elm new file mode 100644 index 00000000..31bf3613 --- /dev/null +++ b/elm/Lib/Api.elm @@ -0,0 +1,53 @@ +module Lib.Api exposing (..) + +import Json.Encode as JE +import Http + +import Gen.Api exposing (..) + + +-- Handy state enum for forms +type State + = Normal + | Loading + | Error Response + + +-- User-friendly error message if the response isn't what the code expected. +-- (Technically a good chunk of this function could also be automatically +-- generated by Elm.pm, but that wouldn't really have all that much value). +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." + Invalid -> "Invalid form data, please report a bug." + Unauth -> "You do not have the permission to perform this action." + Unchanged -> "No changes" + Changed _ _ -> 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 decode + + +-- 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 + } diff --git a/elm/Lib/Editsum.elm b/elm/Lib/Editsum.elm new file mode 100644 index 00000000..7ab1f994 --- /dev/null +++ b/elm/Lib/Editsum.elm @@ -0,0 +1,65 @@ +-- 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 = + [ label [] + [ inputCheck "" model.hidden Hidden + , text " Deleted" ] + , label [] + [ inputCheck "" model.locked Locked + , text " Locked" ] + , br [] [] + , text "Note: edit summary of the last edit should indicate the reason for the deletion." + , br [] [] + ] + in fieldset [] <| + (if model.authmod then lockhid else []) + ++ + [ h2 [] + [ text "Edit summary" + , b [class "standout"] [text " (English please!)"] + ] + -- TODO: BBCode preview + , inputTextArea "editsum" model.editsum Editsum [rows 4, cols 50, minlength 2, maxlength 5000, required True] + ] diff --git a/elm/Lib/Ffi.elm b/elm/Lib/Ffi.elm new file mode 100644 index 00000000..6a2a5364 --- /dev/null +++ b/elm/Lib/Ffi.elm @@ -0,0 +1,18 @@ +-- 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 Ffi.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) + +-- Set the innerHTML attribute of a node +innerHtml : String -> Attribute msg +innerHtml = always (title "") diff --git a/elm/Lib/Ffi.js b/elm/Lib/Ffi.js new file mode 100644 index 00000000..86418d97 --- /dev/null +++ b/elm/Lib/Ffi.js @@ -0,0 +1,9 @@ +window.elmFfi_innerHtml = function(wrap) { // \s -> _VirtualDom_property('innerHTML', _Json_wrap(s)) + return function(s) { + return { + $: 'a2', + n: 'innerHTML', + o: wrap(s) + } + } +}; diff --git a/elm/Lib/Html.elm b/elm/Lib/Html.elm new file mode 100644 index 00000000..bbd2e1fb --- /dev/null +++ b/elm/Lib/Html.elm @@ -0,0 +1,74 @@ +module Lib.Html exposing (..) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import Json.Decode as JD +import List +import Lib.Api as Api + + +-- onClick with stopPropagation & preventDefault +onClickN : m -> Attribute m +onClickN action = custom "click" (JD.succeed { message = action, stopPropagation = True, preventDefault = True}) + + +-- Submit button with loading indicator and error message display +submitButton : String -> Api.State -> Bool -> Bool -> Html m +submitButton val state valid load = div [] + [ input [ type_ "submit", class "submit", tabindex 10, value val, disabled (state == Api.Loading || not valid || load) ] [] + , case state of + Api.Error r -> p [] [ b [class "standout" ] [ text <| Api.showResponse r ] ] + _ -> if valid + then text "" + else p [] [ b [class "standout" ] [ text "The form contains errors, please fix these before submitting. " ] ] + , if state == Api.Loading || load + then div [ class "spinner" ] [] + else text "" + ] + + +inputSelect : String -> String -> (String -> m) -> List (Attribute m) -> List (String, String) -> Html m +inputSelect nam sel onch attrs lst = + let opt (id, name) = option [ value id, selected (id == sel) ] [ text name ] + in select ( + [ tabindex 10 + , onInput onch + ] + ++ attrs + ++ (if nam == "" then [] else [ id nam, name nam ]) + ) <| List.map opt lst + + +inputText : String -> String -> (String -> m) -> List (Attribute m) -> Html m +inputText nam val onch attrs = input ( + [ type_ "text" + , class "text" + , 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 ( + [ 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 ]) + ) [] |