summaryrefslogtreecommitdiff
path: root/elm
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2020-03-16 12:59:30 +0100
committerYorhel <git@yorhel.nl>2020-03-16 12:59:30 +0100
commit1060de04e9e54d7e40c5ad96c0012acc0e67dc5d (patch)
treefa2ad9438d0eea009f100569804d45f28582dbb0 /elm
parentea6d1b515165e352709a75e47c5879567ee48e22 (diff)
parentbe6aa6cc7e8034cfc064acb22f44e66aa527e06f (diff)
Merge branch 'imgflag'
While it's a bit early to put this feature online already, it is rather annoying to work on a different branch when if involves a somewhat large change in the database schema. It'll be much easier to continue development and testing on the master branch. Most of the changes that will follow won't affect the DB or the rest of the site much, so if this update succeeds I don't expect any trouble.
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