summaryrefslogtreecommitdiff
path: root/elm
diff options
context:
space:
mode:
Diffstat (limited to 'elm')
-rw-r--r--elm/0-compat.js31
-rw-r--r--elm/DocEdit.elm134
-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
-rw-r--r--elm/elm.json30
-rw-r--r--elm/global.js26
9 files changed, 440 insertions, 0 deletions
diff --git a/elm/0-compat.js b/elm/0-compat.js
new file mode 100644
index 00000000..02179ee3
--- /dev/null
+++ b/elm/0-compat.js
@@ -0,0 +1,31 @@
+/* classList.toggle() */
+(function() {
+ var historic = DOMTokenList.prototype.toggle;
+ DOMTokenList.prototype.toggle = function(token, force) {
+ if(arguments.length > 0 && this.contains(token) === force) {
+ return force;
+ }
+ return historic.call(this, token);
+ };
+})();
+
+
+/* Element.matches() and Element.closest() */
+if(!Element.prototype.matches)
+ Element.prototype.matches = Element.prototype.msMatchesSelector || Element.prototype.webkitMatchesSelector;
+if(!Element.prototype.closest)
+ Element.prototype.closest = function(s) {
+ var el = this;
+ if(!document.documentElement.contains(el)) return null;
+ do {
+ if(el.matches(s)) return el;
+ el = el.parentElement || el.parentNode;
+ } while(el !== null && el.nodeType === 1);
+ return null;
+ };
+
+
+/* NodeList.forEach */
+if(window.NodeList && !NodeList.prototype.forEach) {
+ NodeList.prototype.forEach = Array.prototype.forEach;
+}
diff --git a/elm/DocEdit.elm b/elm/DocEdit.elm
new file mode 100644
index 00000000..f7cbac61
--- /dev/null
+++ b/elm/DocEdit.elm
@@ -0,0 +1,134 @@
+module DocEdit exposing (main)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Browser
+import Browser.Navigation exposing (load)
+import Json.Encode as JE
+import Lib.Html exposing (..)
+import Lib.Api as Api
+import Lib.Ffi as Ffi
+import Gen.Api as GApi
+import Gen.DocEdit as GD
+
+--import Lib.Api as Api
+--import Lib.Ffi as Ffi
+
+import Lib.Editsum as Editsum
+
+main : Program GD.Recv Model Msg
+main = Browser.element
+ { init = \e -> (init e, Cmd.none)
+ , view = view
+ , update = update
+ , subscriptions = always Sub.none
+ }
+
+
+type alias Model =
+ { state : Api.State
+ , editsum : Editsum.Model
+ , title : String
+ , content : String
+ , id : Int
+ , preview : String
+ }
+
+
+init : GD.Recv -> Model
+init d =
+ { state = Api.Normal
+ , editsum = { authmod = True, editsum = d.editsum, locked = d.locked, hidden = d.hidden }
+ , title = d.title
+ , content = d.content
+ , id = d.id
+ , preview = ""
+ }
+
+
+encode : Model -> GD.Send
+encode model =
+ { editsum = model.editsum.editsum
+ , hidden = model.editsum.hidden
+ , locked = model.editsum.locked
+ , title = model.title
+ , content = model.content
+ }
+
+
+type Msg
+ = Editsum Editsum.Msg
+ | Submit
+ | Submitted GApi.Response
+ | Title String
+ | Content String
+ | Preview
+ | HandlePreview GApi.Response
+
+
+update : Msg -> Model -> (Model, Cmd Msg)
+update msg model =
+ case msg of
+ Editsum e -> ({ model | editsum = Editsum.update e model.editsum }, Cmd.none)
+ Title s -> ({ model | title = s }, Cmd.none)
+ Content s -> ({ model | content = s }, Cmd.none)
+
+ Submit ->
+ let
+ path = "/d" ++ String.fromInt model.id ++ "/edit"
+ body = GD.encode (encode model)
+ in ({ model | state = Api.Loading }, Api.post path body Submitted)
+
+ Submitted (GApi.Changed id rev) -> (model, load <| "/d" ++ String.fromInt id ++ "." ++ String.fromInt rev)
+ Submitted r -> ({ model | state = Api.Error r }, Cmd.none)
+
+ Preview ->
+ if model.preview /= "" then ( { model | preview = "" }, Cmd.none )
+ else
+ ( { model | state = Api.Loading, preview = "" }
+ , Api.post "/js/markdown.json" (JE.object [("content", JE.string model.content)]) HandlePreview
+ )
+
+ HandlePreview (GApi.Content s) -> ({ model | state = Api.Normal, preview = s }, Cmd.none)
+ HandlePreview r -> ({ model | state = Api.Error r }, Cmd.none)
+
+
+view : Model -> Html Msg
+view model =
+ Html.form [ onSubmit Submit ]
+ [ div [ class "mainbox" ]
+ [ h1 [] [ text <| "Edit d" ++ String.fromInt model.id ]
+ , table [ class "formtable" ]
+ [ tr [ class "newfield" ]
+ [ td [ class "label" ] [ label [ for "title" ] [ text "Title" ]]
+ , td [ class "field" ] [ inputText "title" model.title Title (style "width" "300px" :: GD.valTitle) ]
+ ]
+ , tr [ class "newfield" ]
+ [ td [ class "field", colspan 2 ]
+ [ br [] []
+ , text "Contents (HTML and MultiMarkdown supported, which is "
+ , a [ href "https://daringfireball.net/projects/markdown/basics", target "_blank" ] [ text "Markdown" ]
+ , text " with some "
+ , a [ href "http://fletcher.github.io/MultiMarkdown-5/syntax.html", target "_blank" ][ text "extensions" ]
+ , text ")."
+ , br [] []
+ , a [ href "#", style "float" "right", onClickN Preview ]
+ [ text <| if model.preview == "" then "Preview" else "Edit"
+ , if model.state == Api.Loading then div [ class "spinner" ] [] else text ""
+ ]
+ , br [] []
+ , if model.preview == ""
+ then inputTextArea "content" model.content Content ([rows 50, cols 90, style "width" "850px"] ++ GD.valContent)
+ else div [ class "docs preview", style "width" "850px", Ffi.innerHtml model.preview ] []
+ ]
+ ]
+ ]
+ ]
+ , div [ class "mainbox" ]
+ [ fieldset [ class "submit" ]
+ [ Html.map Editsum (Editsum.view model.editsum)
+ , submitButton "Submit" model.state True False
+ ]
+ ]
+ ]
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 ])
+ ) []
diff --git a/elm/elm.json b/elm/elm.json
new file mode 100644
index 00000000..51aca1a7
--- /dev/null
+++ b/elm/elm.json
@@ -0,0 +1,30 @@
+{
+ "type": "application",
+ "source-directories": [
+ "."
+ ],
+ "elm-version": "0.19.0",
+ "dependencies": {
+ "direct": {
+ "elm/browser": "1.0.1",
+ "elm/core": "1.0.2",
+ "elm/file": "1.0.1",
+ "elm/html": "1.0.0",
+ "elm/http": "2.0.0",
+ "elm/json": "1.1.2",
+ "elm/regex": "1.0.0",
+ "justinmimbs/date": "3.1.2"
+ },
+ "indirect": {
+ "elm/bytes": "1.0.3",
+ "elm/parser": "1.1.0",
+ "elm/time": "1.0.0",
+ "elm/url": "1.0.0",
+ "elm/virtual-dom": "1.0.2"
+ }
+ },
+ "test-dependencies": {
+ "direct": {},
+ "indirect": {}
+ }
+} \ No newline at end of file
diff --git a/elm/global.js b/elm/global.js
new file mode 100644
index 00000000..f1c5444a
--- /dev/null
+++ b/elm/global.js
@@ -0,0 +1,26 @@
+/* Add the X-CSRF-Token header to every POST request. Based on:
+ * https://stackoverflow.com/questions/24196140/adding-x-csrf-token-header-globally-to-all-instances-of-xmlhttprequest/24196317#24196317
+ */
+(function() {
+ var open = XMLHttpRequest.prototype.open,
+ token = document.querySelector('meta[name=csrf-token]').content;
+
+ XMLHttpRequest.prototype.open = function(method, url) {
+ var ret = open.apply(this, arguments);
+ this.dataUrl = url;
+ if(method.toLowerCase() == 'post' && /^\//.test(url))
+ this.setRequestHeader('X-CSRF-Token', token);
+ return ret;
+ };
+})();
+
+
+/* Find all divs with a data-elm-module and embed the given Elm module in the div */
+document.querySelectorAll('div[data-elm-module]').forEach(function(el) {
+ var mod = el.getAttribute('data-elm-module').split('.').reduce(function(p, c) { return p[c] }, window.Elm);
+ var flags = el.getAttribute('data-elm-flags');
+ if(flags)
+ mod.init({ node: el, flags: JSON.parse(flags)});
+ else
+ mod.init({ node: el });
+});
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-20 03:56:10 +0000