summaryrefslogtreecommitdiff
path: root/elm3/Lib/Html.elm
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2019-07-25 14:30:04 +0200
committerYorhel <git@yorhel.nl>2019-07-25 14:36:21 +0200
commitf296495a912ce759df11c43e78b4552788bdbff2 (patch)
tree0c10802de65fb7c8475722e12234bff5eb980628 /elm3/Lib/Html.elm
parent0f3cfeb85caec6424bcbea47142eefbf8011636b (diff)
Merge the v3 branch into separate namespace + fix Docker stuff (again)
I was getting tired of having to keep two branches up-to-date with the latest developments, so decided to throw v3 into the same branch - just different files (...which will get mostly rewritten again soon). The two versions aren't very different in terms of dependencies, build system and support code, so they can now properly share files. Added a section to the README to avoid confusion. This merge also makes it easier to quickly switch between the different versions, which is handy for development. It's even possible to run both at the same time, but my scripts use the same port so that needs a workaround. And it's amazing how often I break the Docker scripts.
Diffstat (limited to 'elm3/Lib/Html.elm')
-rw-r--r--elm3/Lib/Html.elm182
1 files changed, 182 insertions, 0 deletions
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" ] []