summaryrefslogtreecommitdiff
path: root/elm/Lib
diff options
context:
space:
mode:
Diffstat (limited to 'elm/Lib')
-rw-r--r--elm/Lib/Api.elm53
-rw-r--r--elm/Lib/Editsum.elm65
-rw-r--r--elm/Lib/Ffi.elm18
-rw-r--r--elm/Lib/Ffi.js9
-rw-r--r--elm/Lib/Html.elm74
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 ])
+ ) []