summaryrefslogtreecommitdiff
path: root/elm
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2020-02-21 08:30:46 +0100
committerYorhel <git@yorhel.nl>2020-03-16 12:45:42 +0100
commitbe6aa6cc7e8034cfc064acb22f44e66aa527e06f (patch)
treef5e27345a3bec3d4d516a7c986d34b23e37c2d28 /elm
parent8fe95ae3c2119e5a5219ad072d441bac406ea547 (diff)
imgflag: Initial schema + UI for image flagging
Lots of TODO's left to work on, but you have to start somewhere. I've bumped the Docker image version because this change requires TUWF commit 74aad378d49592df4359ea8a9f6f36d4a0013c04 (Elm decoder for structs with more than 8 fields)
Diffstat (limited to 'elm')
-rw-r--r--elm/ImageFlagging.elm192
-rw-r--r--elm/Lib/Api.elm1
2 files changed, 193 insertions, 0 deletions
diff --git a/elm/ImageFlagging.elm b/elm/ImageFlagging.elm
new file mode 100644
index 00000000..b45cbde9
--- /dev/null
+++ b/elm/ImageFlagging.elm
@@ -0,0 +1,192 @@
+module ImageFlagging exposing (main)
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Array
+import Dict
+import Browser
+import Task
+import Process
+import Json.Decode as JD
+import Lib.Html exposing (..)
+import Lib.Util exposing (..)
+import Lib.Api as Api
+import Lib.Ffi as Ffi
+import Gen.Api as GApi
+import Gen.Images as GI
+import Gen.ImageVote as GIV
+
+
+-- TODO: Keyboard shortcuts
+main : Program () Model Msg
+main = Browser.element
+ { init = \e -> (init e, Cmd.none)
+ , view = view
+ , update = update
+ , subscriptions = always Sub.none
+ }
+
+
+type alias Model =
+ { warn : Bool
+ , images : Array.Array GApi.ApiImageResult
+ , index : Int
+ , changes : Dict.Dict String GIV.SendVotes
+ , saved : Bool
+ , saveTimer : Bool
+ , loadState : Api.State
+ , saveState : Api.State
+ }
+
+init : () -> Model
+init _ =
+ { warn = True
+ , images = Array.empty
+ , index = 0
+ , changes = Dict.empty
+ , saved = False
+ , saveTimer = False
+ , saveState = Api.Normal
+ , loadState = Api.Normal
+ }
+
+
+type Msg
+ = SkipWarn
+ | Load GApi.Response
+ | Vote (Maybe Int) (Maybe Int) Bool
+ | Save
+ | Saved GApi.Response
+ | Prev
+ | Next
+
+
+isLast : Model -> Bool
+isLast model = Array.get model.index model.images |> Maybe.map (\i -> i.my_sexual == Nothing || i.my_violence == Nothing) |> Maybe.withDefault True
+
+
+-- TODO: preload next image
+update : Msg -> Model -> (Model, Cmd Msg)
+update msg model =
+ let -- Load more images if we're about to run out
+ load (m,c) =
+ if m.loadState /= Api.Loading && Array.length m.images - m.index <= 3
+ then ({ m | loadState = Api.Loading }, Cmd.batch [ c, GI.send {} Load ])
+ else (m,c)
+ -- Start a timer to save changes
+ save (m,c) =
+ if not m.saveTimer && not (Dict.isEmpty m.changes) && m.saveState /= Api.Loading
+ then ({ m | saveTimer = True }, Cmd.batch [ c, Task.perform (always Save) (Process.sleep 5000) ])
+ else (m,c)
+ in
+ case msg of
+ SkipWarn -> load ({ model | warn = False }, Cmd.none)
+
+ Load (GApi.ImageResult l) ->
+ let nm = { model | loadState = Api.Normal, images = Array.append model.images (Array.fromList l) }
+ nc = if nm.index < 200 then nm
+ else { nm | index = nm.index - 100, images = Array.slice 100 (Array.length nm.images) nm.images }
+ in (nc, Cmd.none)
+ Load e -> ({ model | loadState = Api.Error e }, Cmd.none)
+
+ Vote s v _ ->
+ case Array.get model.index model.images of
+ Nothing -> (model, Cmd.none)
+ Just i ->
+ let m = { model | saved = False, images = Array.set model.index { i | my_sexual = s, my_violence = v } model.images }
+ in case (s,v) of
+ -- Complete vote, mark it as a change and go to next image
+ (Just xs, Just xv) -> save <| load
+ ({ m | index = m.index + (if isLast model then 1 else 0)
+ , changes = Dict.insert i.id { id = i.id, sexual = xs, violence = xv } m.changes
+ }, Cmd.none)
+ -- Otherwise just save it internally
+ _ -> (m, Cmd.none)
+
+ Save -> ({ model | saveTimer = False, saveState = Api.Loading, changes = Dict.empty }, GIV.send { votes = Dict.values model.changes } Saved)
+ Saved r -> save ({ model | saved = True, saveState = if r == GApi.Success then Api.Normal else Api.Error r }, Cmd.none)
+
+ Prev -> ({ model | saved = False, index = model.index - (if model.index == 0 then 0 else 1) }, Cmd.none)
+ Next -> ({ model | saved = False, index = model.index + (if isLast model then 0 else 1) }, Cmd.none)
+
+
+view : Model -> Html Msg
+view model =
+ let
+ -- TODO: Dynamic box size depending on available space?
+ boxwidth = 800
+ boxheight = 600
+ px n = String.fromInt (floor n) ++ "px"
+ stat avg stddev =
+ case (avg, stddev) of
+ (Just a, Just s) -> Ffi.fmtFloat a 2 ++ " σ " ++ Ffi.fmtFloat s 2
+ _ -> "-"
+
+ imgView i =
+ let entry = i.entry_type ++ String.fromInt i.entry_id
+ in
+ [ div []
+ [ a [ href "#", onClickD Prev, classList [("invisible", model.index == 0)] ] [ text "««" ]
+ , span []
+ [ b [ class "grayedout" ] [ text (entry ++ ":") ]
+ , a [ href ("/" ++ entry) ] [ text i.entry_title ]
+ ]
+ , a [ href "#", onClickD Next, classList [("invisible", isLast model)] ] [ text "»»" ]
+ ]
+ , div [ style "width" (px boxwidth), style "height" (px boxheight) ] <|
+ -- Don't use an <img> here, changing the src= causes the old image to be displayed with the wrong dimensions while the new image is being loaded.
+ [ a [ href i.url, style "background-image" ("url("++i.url++")")
+ , style "background-size" (if i.width > boxwidth || i.height > boxheight then "contain" else "auto")
+ ] [ text "" ] ]
+ , div []
+ [ span [] <|
+ case model.saveState of
+ Api.Error e -> [ b [ class "standout" ] [ text <| "Save failed: " ++ Api.showResponse e ] ]
+ _ ->
+ [ span [ class "spinner", classList [("invisible", model.saveState == Api.Normal)] ] []
+ , b [ class "grayedout" ] [ text <|
+ if not (Dict.isEmpty model.changes)
+ then "Unsaved votes: " ++ String.fromInt (Dict.size model.changes)
+ else if model.saved then "Saved!" else "" ]
+ ]
+ , span []
+ [ text <| String.fromInt i.votecount ++ (if i.votecount == 1 then " vote" else " votes")
+ , b [ class "grayedout" ] [ text " / " ]
+ , text <| "sexual: " ++ stat i.sexual_avg i.sexual_stddev
+ , b [ class "grayedout" ] [ text " / " ]
+ , text <| "violence: " ++ stat i.violence_avg i.violence_stddev
+ , b [ class "grayedout" ] [ text " / " ]
+ , a [ href i.url ] [ text <| String.fromInt i.width ++ "x" ++ String.fromInt i.height ]
+ ]
+ ]
+ -- TODO: Mouse-over quick explanations
+ , ul [ class "imgvoteopt" ]
+ [ li [] [ span [] [ text "Sexual" ] ]
+ , li [ classList [("sel", i.my_sexual == Just 0)] ] [ label [] [ inputRadio "sexual" (i.my_sexual == Just 0) (Vote (Just 0) i.my_violence), text " Safe" ] ]
+ , li [ classList [("sel", i.my_sexual == Just 1)] ] [ label [] [ inputRadio "sexual" (i.my_sexual == Just 1) (Vote (Just 1) i.my_violence), text " Suggestive" ] ]
+ , li [ classList [("sel", i.my_sexual == Just 2)] ] [ label [] [ inputRadio "sexual" (i.my_sexual == Just 2) (Vote (Just 2) i.my_violence), text " Explicit" ] ]
+ , li [] [ span [] [ text "Violence" ] ]
+ , li [ classList [("sel", i.my_violence == Just 0)] ] [ label [] [ inputRadio "violence" (i.my_violence == Just 0) (Vote i.my_sexual (Just 0)), text " Tame" ] ]
+ , li [ classList [("sel", i.my_violence == Just 1)] ] [ label [] [ inputRadio "violence" (i.my_violence == Just 1) (Vote i.my_sexual (Just 1)), text " Violent" ] ]
+ , li [ classList [("sel", i.my_violence == Just 2)] ] [ label [] [ inputRadio "violence" (i.my_violence == Just 2) (Vote i.my_sexual (Just 2)), text " Brutal" ] ]
+ ]
+ -- TODO: list of users who voted on this image
+ ]
+
+ in div [ class "mainbox" ]
+ [ h1 [] [ text "Image flagging" ]
+ , div [ class "imageflag" ] <|
+ if model.warn
+ then [ ul []
+ [ li [] [ text "Make sure you are familiar with the ", a [ href "/d19" ] [ text "image flagging guidelines" ], text "." ]
+ , li [] [ b [ class "standout" ] [ text "WARNING: " ], text "Images shown may be highly offensive and/or depictions of explicit sexual acts." ]
+ ]
+ , inputButton "I understand, continue" SkipWarn []
+ ]
+ else case (Array.get model.index model.images, model.loadState) of
+ (Just i, _) -> imgView i
+ (_, Api.Loading) -> [ span [ class "spinner" ] [] ]
+ (_, Api.Error e) -> [ b [ class "standout" ] [ text <| Api.showResponse e ] ]
+ (_, Api.Normal) -> [ text "No more images to vote on!" ]
+ ]
diff --git a/elm/Lib/Api.elm b/elm/Lib/Api.elm
index d8cb1315..ee2df07f 100644
--- a/elm/Lib/Api.elm
+++ b/elm/Lib/Api.elm
@@ -47,6 +47,7 @@ showResponse res =
TagResult _ -> unexp
VNResult _ -> unexp
ProducerResult _ -> unexp
+ ImageResult _ -> unexp
expectResponse : (Response -> msg) -> Http.Expect msg