diff options
Diffstat (limited to 'elm')
70 files changed, 5540 insertions, 2892 deletions
diff --git a/elm/AdvSearch/Anime.elm b/elm/AdvSearch/Anime.elm new file mode 100644 index 00000000..8d0882dc --- /dev/null +++ b/elm/AdvSearch/Anime.elm @@ -0,0 +1,93 @@ +module AdvSearch.Anime exposing (..) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Set +import Dict +import Lib.Autocomplete as A +import Lib.Html exposing (..) +import Lib.Util exposing (..) +import Gen.Api as GApi +import AdvSearch.Lib exposing (..) +import AdvSearch.Set as S + + + +type alias Model = + { sel : S.Model Int + , conf : A.Config Msg GApi.ApiAnimeResult + , search : A.Model GApi.ApiAnimeResult + } + +type Msg + = Sel (S.Msg Int) + | Search (A.Msg GApi.ApiAnimeResult) + + +init : Data -> (Data, Model) +init dat = + let (ndat, sel) = S.init dat + in ( { ndat | objid = ndat.objid + 1 } + , { sel = { sel | single = False } + , conf = { wrap = Search, id = "xsearch_anime" ++ String.fromInt ndat.objid, source = A.animeSource True } + , search = A.init "" + } + ) + + +update : Data -> Msg -> Model -> (Data, Model, Cmd Msg) +update dat msg model = + case msg of + Sel m -> (dat, { model | sel = S.update m model.sel }, Cmd.none) + Search m -> + let (nm, c, res) = A.update model.conf m model.search + in case res of + Nothing -> (dat, { model | search = nm }, c) + Just s -> + if Set.member s.id model.sel.sel then (dat, { model | search = nm }, c) + else ( { dat | anime = Dict.insert s.id s dat.anime } + , { model | search = A.clear nm "", sel = S.update (S.Sel s.id True) model.sel } + , c ) + + +toQuery m = S.toQuery (QInt 13) m.sel + +fromQuery dat qf = S.fromQuery (\q -> + case q of + QInt 13 op v -> Just (op, v) + _ -> Nothing) dat qf + |> Maybe.map (\(ndat,sel) -> + ( { ndat | objid = ndat.objid+1 } + , { sel = { sel | single = False } + , conf = { wrap = Search, id = "xsearch_anime" ++ String.fromInt ndat.objid, source = A.animeSource True } + , search = A.init "" + } + )) + + + +view : Data -> Model -> (Html Msg, () -> List (Html Msg)) +view dat model = + ( case Set.toList model.sel.sel of + [] -> small [] [ text "Anime" ] + [s] -> span [ class "nowrap" ] + [ S.lblPrefix model.sel + , small [] [ text <| "a" ++ String.fromInt s ++ ":" ] + , Dict.get s dat.anime |> Maybe.map (\e -> e.title) |> Maybe.withDefault "" |> text + ] + l -> span [] [ S.lblPrefix model.sel, text <| "Anime (" ++ String.fromInt (List.length l) ++ ")" ] + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text "Anime" ] + , Html.map Sel (S.opts model.sel True True) + ] + , ul [] <| List.map (\s -> + li [ style "overflow" "hidden", style "text-overflow" "ellipsis" ] + [ inputButton "X" (Sel (S.Sel s False)) [] + , small [] [ text <| " a" ++ String.fromInt s ++ ": " ] + , Dict.get s dat.anime |> Maybe.map (\e -> e.title) |> Maybe.withDefault "" |> text + ] + ) (Set.toList model.sel.sel) + , A.view model.conf model.search [ placeholder "Search..." ] + ] + ) diff --git a/elm/AdvSearch/Birthday.elm b/elm/AdvSearch/Birthday.elm new file mode 100644 index 00000000..a03b124f --- /dev/null +++ b/elm/AdvSearch/Birthday.elm @@ -0,0 +1,67 @@ +module AdvSearch.Birthday exposing (..) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Lib.Html exposing (..) +import Lib.RDate as RDate +import AdvSearch.Lib exposing (..) + + +type alias Model = + { op : Op + , month : Int + , day : Int + } + + +type Msg + = MOp Op + | Month Int + | Day Int + + +update : Msg -> Model -> Model +update msg model = + case msg of + MOp o -> { model | op = o } + Month m -> { model | month = m, day = if m == 0 then 0 else model.day } + Day d -> { model | day = d } + + +init : Data -> (Data, Model) +init dat = (dat, + { op = Eq + , month = 0 + , day = 0 + }) + + + +toQuery : Model -> Maybe Query +toQuery model = Just <| QTuple 14 model.op model.month model.day + + +fromQuery : Data -> Query -> Maybe (Data, Model) +fromQuery dat q = + case q of + QTuple 14 o m d -> Just (dat, { op = o, month = m, day = d }) + _ -> Nothing + + +view : Model -> (Html Msg, () -> List (Html Msg)) +view model = + ( text <| showOp model.op ++ " " + ++ (if model.month == 0 then "Unknown" + else List.drop (model.month-1) RDate.monthList |> List.head |> Maybe.withDefault "") + ++ (if model.day == 0 then "" else " " ++ String.fromInt model.day) + , \() -> + [ div [ class "advheader", style "width" "290px" ] + [ h3 [] [ text "Birthday" ] + , div [ class "opts" ] [ inputOp True model.op MOp ] + ] + , inputSelect "" model.month Month [style "width" "128px"] <| (0, "Unknown") :: RDate.monthSelect + , if model.month == 0 then text "" + else inputSelect "" model.day Day [style "width" "70px"] + <| (0, "- day -") :: List.map (\i -> (i, String.fromInt i)) (List.range 1 31) + ] + ) diff --git a/elm/AdvSearch/DRM.elm b/elm/AdvSearch/DRM.elm new file mode 100644 index 00000000..ccf64328 --- /dev/null +++ b/elm/AdvSearch/DRM.elm @@ -0,0 +1,78 @@ +module AdvSearch.DRM exposing (..) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Set +import Lib.Autocomplete as A +import Lib.Html exposing (..) +import Lib.Util exposing (..) +import Gen.Api as GApi +import AdvSearch.Lib exposing (..) +import AdvSearch.Set as S + + + +type alias Model = + { sel : S.Model String + , conf : A.Config Msg GApi.ApiDRM + , search : A.Model GApi.ApiDRM + } + +type Msg + = Sel (S.Msg String) + | Search (A.Msg GApi.ApiDRM) + + +init : Data -> (Data, Model) +init dat = + let (ndat, sel) = S.init dat + in ( { ndat | objid = ndat.objid + 1 } + , { sel = { sel | single = False } + , conf = { wrap = Search, id = "xsearch_drm" ++ String.fromInt ndat.objid, source = A.drmSource } + , search = A.init "" + } + ) + + +update : Data -> Msg -> Model -> (Data, Model, Cmd Msg) +update dat msg model = + case msg of + Sel m -> (dat, { model | sel = S.update m model.sel }, Cmd.none) + Search m -> + let (nm, c, res) = A.update model.conf m model.search + in case res of + Nothing -> (dat, { model | search = nm }, c) + Just e -> (dat, { model | search = A.clear nm "", sel = S.update (S.Sel e.name True) model.sel }, c) + + +toQuery m = S.toQuery (QStr 20) m.sel + +fromQuery dat q = + let f q2 = case q2 of + QStr 20 op v -> Just (op, v) + _ -> Nothing + in S.fromQuery f dat q |> Maybe.map (\(ndat,sel) -> + ( { ndat | objid = ndat.objid+1 } + , { sel = { sel | single = False } + , conf = { wrap = Search, id = "xsearch_drm" ++ String.fromInt ndat.objid, source = A.drmSource } + , search = A.init "" + } + )) + +view : Model -> (Html Msg, () -> List (Html Msg)) +view model = + ( case Set.toList model.sel.sel of + [] -> small [] [ text "DRM implementation" ] + [s] -> span [ class "nowrap" ] [ S.lblPrefix model.sel, text s ] + l -> span [] [ S.lblPrefix model.sel, text <| "DRM (" ++ String.fromInt (List.length l) ++ ")" ] + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text "DRM implementation" ] + , Html.map Sel (S.opts model.sel False False) + ] + , ul [] <| List.map (\s -> + li [] [ inputButton "X" (Sel (S.Sel s False)) [], text " ", text s ] + ) <| List.filter (\x -> x /= "") <| Set.toList model.sel.sel + , A.view model.conf model.search [ placeholder "Search..." ] + ] + ) diff --git a/elm/AdvSearch/Engine.elm b/elm/AdvSearch/Engine.elm new file mode 100644 index 00000000..8214cae2 --- /dev/null +++ b/elm/AdvSearch/Engine.elm @@ -0,0 +1,79 @@ +module AdvSearch.Engine exposing (..) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Set +import Lib.Autocomplete as A +import Lib.Html exposing (..) +import Lib.Util exposing (..) +import Gen.Api as GApi +import AdvSearch.Lib exposing (..) +import AdvSearch.Set as S + + + +type alias Model = + { sel : S.Model String + , conf : A.Config Msg GApi.ApiEngines + , search : A.Model GApi.ApiEngines + } + +type Msg + = Sel (S.Msg String) + | Search (A.Msg GApi.ApiEngines) + + +init : Data -> (Data, Model) +init dat = + let (ndat, sel) = S.init dat + in ( { ndat | objid = ndat.objid + 1 } + , { sel = { sel | single = False } + , conf = { wrap = Search, id = "xsearch_eng" ++ String.fromInt ndat.objid, source = A.engineSource } + , search = A.init "" + } + ) + + +update : Data -> Msg -> Model -> (Data, Model, Cmd Msg) +update dat msg model = + case msg of + Sel m -> (dat, { model | sel = S.update m model.sel }, Cmd.none) + Search m -> + let (nm, c, res) = A.update model.conf m model.search + in case res of + Nothing -> (dat, { model | search = nm }, c) + Just e -> (dat, { model | search = A.clear nm "", sel = S.update (S.Sel e.engine True) model.sel }, c) + + +toQuery m = S.toQuery (QStr 15) m.sel + +fromQuery dat q = + let f q2 = case q2 of + QStr 15 op v -> Just (op, v) + _ -> Nothing + in S.fromQuery f dat q |> Maybe.map (\(ndat,sel) -> + ( { ndat | objid = ndat.objid+1 } + , { sel = { sel | single = False } + , conf = { wrap = Search, id = "xsearch_eng" ++ String.fromInt ndat.objid, source = A.engineSource } + , search = A.init "" + } + )) + +view : Model -> (Html Msg, () -> List (Html Msg)) +view model = + ( case Set.toList model.sel.sel of + [] -> small [] [ text "Engine" ] + [s] -> span [ class "nowrap" ] [ S.lblPrefix model.sel, text (if s == "" then "Unknown engine" else s) ] + l -> span [] [ S.lblPrefix model.sel, text <| "Engines (" ++ String.fromInt (List.length l) ++ ")" ] + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text "Engine" ] + , Html.map Sel (S.opts model.sel False False) + ] + , ul [] <| List.map (\s -> + li [] [ inputButton "X" (Sel (S.Sel s False)) [], text " ", text s ] + ) <| List.filter (\x -> x /= "") <| Set.toList model.sel.sel + , A.view model.conf model.search [ placeholder "Search..." ] + , label [] [ inputCheck "" (Set.member "" model.sel.sel) (Sel << S.Sel ""), text " Unknown" ] + ] + ) diff --git a/elm/AdvSearch/Fields.elm b/elm/AdvSearch/Fields.elm new file mode 100644 index 00000000..2ec6e205 --- /dev/null +++ b/elm/AdvSearch/Fields.elm @@ -0,0 +1,784 @@ +module AdvSearch.Fields exposing (..) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Array +import Set +import Lib.Util exposing (..) +import Lib.Html exposing (..) +import Lib.DropDown as DD +import Lib.Api as Api +import Lib.Autocomplete as A +import AdvSearch.Anime as AA +import AdvSearch.Set as AS +import AdvSearch.Producers as AP +import AdvSearch.Staff as AT +import AdvSearch.Tags as AG +import AdvSearch.Traits as AI +import AdvSearch.RDate as AD +import AdvSearch.Range as AR +import AdvSearch.Resolution as AE +import AdvSearch.Engine as AEng +import AdvSearch.DRM as ADRM +import AdvSearch.Birthday as AB +import AdvSearch.Lib exposing (..) +import Gen.ExtLinks as GEL + + +-- "Nested" fields are a container for other fields. +-- The code for nested fields is tightly coupled with the generic 'Field' abstraction below. + +type alias NestModel = + { ptype : QType -- type of the parent field + , qtype : QType -- type of the child fields + , fields : List Field + , and : Bool + , andDd : DD.Config FieldMsg + , addDd : DD.Config FieldMsg + , addtype : List QType + , neg : Bool -- only if ptype /= qtype + } + + +type NestMsg + = NAndToggle Bool + | NAnd Bool Bool + | NAddToggle Bool + | NAdd Int + | NAddType (List QType) + | NField Int FieldMsg + | NNeg Bool Bool + + +nestInit : Bool -> QType -> QType -> List Field -> Data -> (Data, NestModel) +nestInit and ptype qtype list dat = + ( { dat | objid = dat.objid+2 } + , { ptype = ptype + , qtype = qtype + , fields = list + , and = and + , andDd = DD.init ("xsearch_field"++String.fromInt (dat.objid+0)) (FSNest << NAndToggle) + , addDd = DD.init ("xsearch_field"++String.fromInt (dat.objid+1)) (FSNest << NAddToggle) + , addtype = [qtype] + , neg = False + } + ) + + +nestUpdate : Data -> NestMsg -> NestModel -> (Data, NestModel, Cmd NestMsg) +nestUpdate dat msg model = + case msg of + NAndToggle b -> (dat, { model | andDd = DD.toggle model.andDd b, addtype = [model.qtype] }, Cmd.none) + NAnd b _ -> (dat, { model | and = b, andDd = DD.toggle model.andDd False }, Cmd.none) + NAddToggle b -> (dat, { model | addDd = DD.toggle model.addDd b, addtype = [model.qtype] }, Cmd.none) + NAdd n -> + let addPar lst (ndat,f) = + case lst of + (a::b::xs) -> + -- Don't add the child field if it's an And/Or, the parent field covers that already. + let nf = case f of + (_,_,FMNest m) -> if m.ptype == m.qtype then [] else [f] + _ -> [f] + in addPar (b::xs) (nestInit True b a nf ndat |> Tuple.mapSecond FMNest |> fieldCreate -1) + _ -> (ndat,f) + (ndat2,f2) = addPar model.addtype (fieldInit n dat) + nestMsg lst i = + case lst of + (a::xs) -> NField i (FSNest (nestMsg xs 0)) + _ -> NField i (FToggle True) + in (ndat2, { model | addDd = DD.toggle model.addDd False, addtype = [model.qtype], fields = model.fields ++ [f2] } + , selfCmd (nestMsg (List.drop 1 model.addtype) (List.length model.fields))) + NAddType t -> (dat, { model | addtype = t }, Cmd.none) + NField n FDel -> (dat, { model | fields = delidx n model.fields }, Cmd.none) + NField n FMoveSub -> + let subfields = List.drop n model.fields |> List.take 1 |> List.map (\(fid,fdd,fm) -> (fid, DD.toggle fdd False, fm)) + (ndat,subm) = nestInit (not model.and) model.qtype model.qtype subfields dat + (ndat2,subf) = fieldCreate -1 (ndat, FMNest subm) + in (ndat2, { model | fields = modidx n (always subf) model.fields }, Cmd.none) + NField n m -> + case List.head (List.drop n model.fields) of + Nothing -> (dat, model, Cmd.none) + Just f -> + let (ndat, nf, nc) = fieldUpdate dat m f + in (ndat, { model | fields = modidx n (always nf) model.fields }, Cmd.map (NField n) nc) + NNeg b _ -> (dat, { model | neg = b }, Cmd.none) + + +nestToQuery : Data -> NestModel -> Maybe Query +nestToQuery dat model = + let op = if model.neg then Ne else Eq + com = if model.and then QAnd else QOr + wrap f = + case List.filterMap (fieldToQuery dat) model.fields of + [] -> Nothing + [x] -> Just (f x) + xs -> Just (f (com xs)) + in case (model.ptype, model.qtype) of + (V, R) -> wrap (QQuery 50 op) + (V, C) -> wrap (QQuery 51 op) + (V, S) -> wrap (QQuery 52 op) + (V, P) -> wrap (QQuery 55 op) + (C, S) -> wrap (QQuery 52 op) + (C, V) -> wrap (QQuery 53 op) + (R, V) -> wrap (QQuery 53 op) + (R, P) -> wrap (QQuery 55 op) + _ -> wrap identity + + +nestFromQuery : QType -> QType -> Data -> Query -> Maybe (Data, NestModel) +nestFromQuery ptype qtype dat q = + let init and l = + let (ndat,fl) = List.foldr (\f (d,a) -> let (nd,fm) = fieldFromQuery qtype d f in (nd,(fm::a))) (dat,[]) l + in nestInit and ptype qtype fl ndat + + initSub op val = if op /= Eq && op /= Ne then Nothing else Just <| + let (ndat,f) = fieldFromQuery qtype dat val + (ndat2,m) = nestInit True ptype qtype [f] ndat + -- If there is only a single nested query and it's an and/or nest, merge it into this node. + m2 = case m.fields of + [(_,_,FMNest cm)] -> if cm.ptype == cm.qtype then { m | fields = cm.fields, and = cm.and } else m + _ -> m + in (ndat2, { m2 | neg = op == Ne }) + + in case (ptype, qtype, q) of + (V, R, QQuery 50 op r) -> initSub op r + (V, C, QQuery 51 op r) -> initSub op r + (V, S, QQuery 52 op r) -> initSub op r + (V, P, QQuery 55 op r) -> initSub op r + (C, S, QQuery 52 op r) -> initSub op r + (C, V, QQuery 53 op r) -> initSub op r + (R, V, QQuery 53 op r) -> initSub op r + (R, P, QQuery 55 op r) -> initSub op r + (_, _, QAnd l) -> if ptype == qtype then Just (init True l) else Nothing + (_, _, QOr l) -> if ptype == qtype then Just (init False l) else Nothing + _ -> Nothing + + +nestView : Data -> DD.Config FieldMsg -> NestModel -> Html FieldMsg +nestView dat dd model = + let + isNest (_,_,f) = + case f of + FMNest _ -> True + _ -> False + hasNest = List.any isNest model.fields + filterDat = + { dat + | level = if model.ptype /= model.qtype then 1 else dat.level+1 + , parentTypes = if model.ptype /= model.qtype then Set.insert (showQType model.ptype) dat.parentTypes else dat.parentTypes + } + filters = List.indexedMap (\i f -> + Html.map (FSNest << NField i) <| fieldView filterDat f + ) model.fields + + add = + let parents = Set.union filterDat.parentTypes <| Set.fromList <| List.map showQType <| List.drop 1 model.addtype + lst = Array.toIndexedList fields |> List.filter (\(_,f) -> + Just f.ptype == List.head model.addtype + && f.title /= "" + && (dat.uid /= Nothing || f.title /= "My Labels") + && (dat.uid /= Nothing || f.title /= "My List") + && (f.title /= "Name" || not (Set.isEmpty parents)) + && not (f.title == "Role" && (List.head (List.drop 1 model.addtype)) == Just C) -- No "role" filter for character seiyuu (the seiyuu role is implied, after all) + && not (Set.member (showQType f.qtype) parents)) + showT par t = + case (par,t) of + (_,V) -> "VN" + (_,R) -> "Release" + (_,C) -> "Character" + (C,S) -> "VA" + (_,S) -> "Staff" + (V,P) -> "Developer" + (_,P) -> "Producer" + breads pre par l = + case l of + [] -> [] + [x] -> [ strong [] [ text (showT par x) ] ] + (x::xs) -> a [ href "#", onClickD (FSNest (NAddType (x::pre))) ] [ text (showT par x) ] :: text " » " :: breads (x::pre) x xs + in + div [ class "elm_dd_input elm_dd_noarrow short" ] + [ DD.view model.addDd Api.Normal (text "+") <| \() -> + [ div [ class "advheader", style "min-width" "200px" ] + [ h3 [] [ text "Add filter" ] + , if List.length model.addtype <= 1 then text "" else + div [] <| breads [] model.qtype (List.reverse model.addtype) + ] + , ul (if List.length lst > 6 then [ style "columns" "2" ] else []) <| + List.map (\(n,f) -> + li [] [ a [ href "#", onClickD (FSNest <| if f.qtype /= f.ptype then NAddType (f.qtype :: model.addtype) else NAdd n)] [ text f.title ] ] + ) lst + ] + ] + + andcont () = [ ul [] + [ li [] [ linkRadio ( model.and) (FSNest << NAnd True ) [ text "And: All filters must match" ] ] + , li [] [ linkRadio (not model.and) (FSNest << NAnd False) [ text "Or: At least one filter must match" ] ] + ] ] + + andlbl = text <| if model.and then "And" else "Or" + + and = div [ class "elm_dd_input short" ] [ DD.view model.andDd Api.Normal andlbl andcont ] + + negcont () = + let (a,b) = + case (model.ptype, model.qtype) of + (_, C) -> ("Has a character that matches these filters", "Does not have a character that matches these filters") + (_, R) -> ("Has a release that matches these filters", "Does not have a release that matches these filters") + (_, V) -> ("Linked to a visual novel that matches these filters", "Not linked to a visual novel that matches these filters") + (V, S) -> ("Has staff that matches these filters", "Does not have staff that matches these filters") + (V, P) -> ("Has a developer that matches these filters", "Does not have a developer that matches these filters") + (C, S) -> ("Has a voice actor that matches these filters", "Does not have a voice actor that matches these filters") + (R, P) -> ("Has a producer that matches these filters", "Does not have a producer that matches these filters") + _ -> ("","") + in [ ul [] + [ li [] [ linkRadio (not model.neg) (FSNest << NNeg False) [ text a ] ] + , li [] [ linkRadio ( model.neg) (FSNest << NNeg True ) [ text b ] ] + ] ] + + neglbl = text <| (if model.neg then "¬" else "") ++ + case (model.ptype, model.qtype) of + (_, C) -> "Char" + (_, R) -> "Rel" + (_, V) -> "VN" + (V, S) -> "Staff" + (V, P) -> "Developer" + (R, P) -> "Producer" + (C, S) -> "VA" + _ -> "" + + ourdd = + if model.qtype == model.ptype + then fieldViewDd dat dd andlbl andcont + else fieldViewDd dat dd neglbl negcont + + initialdd = if model.ptype == model.qtype || List.length model.fields == 1 then [ ourdd ] else [ ourdd, and ] + + in + if hasNest + then table [ class "advnest" ] <| List.indexedMap (\i f -> tr [] + [ td [] <| if i == 0 then initialdd else [] + , td [ class (if i == 0 then "start" else "mid") ] [ div [] [], span [] [] ] + , td [] [ f ] + ]) filters + ++ [ tr [] + [ td [] [] + , td [ class "end" ] [ div [] [], span [] [] ] + , td [] [ add ] + ] + ] + else table [ class "advrow" ] [ tr [] + [ td [] (initialdd ++ [small [] [ text " → " ]]) + , td [] (filters ++ [add]) ] ] + + + + + +-- Generic field abstraction. +-- (this is where typeclasses would have been *awesome*) +-- +-- The following functions and definitions are only intended to provide field +-- listings and function dispatchers, if the implementation of anything in here +-- is longer than a single line, it should get its own definition near where +-- the rest of that field is defined. + +type alias Field = (Int, DD.Config FieldMsg, FieldModel) -- The Int is the index into 'fields' + +type alias ListModel = + { val : Int + , lst : List (Query, String) + } + +type FieldModel + = FMCustom Query -- A read-only placeholder for Query values that failed to parse into a Field + | FMNest NestModel + | FMList ListModel + | FMLang AS.LangModel + | FMRPlatform (AS.Model String) + | FMVPlatform (AS.Model String) + | FMLength (AS.Model Int) + | FMDevStatus (AS.Model Int) + | FMRole (AS.Model String) + | FMBlood (AS.Model String) + | FMSex (AS.SexModel) + | FMGender (AS.Model String) + | FMMedium (AS.Model String) + | FMVoiced (AS.Model Int) + | FMAniEro (AS.Model Int) + | FMAniStory (AS.Model Int) + | FMRType (AS.Model String) + | FMLabel (AS.Model Int) + | FMRList (AS.Model Int) + | FMSRole (AS.Model String) + | FMPType (AS.Model String) + | FMRExtLinks (AS.Model String) + | FMSExtLinks (AS.Model String) + | FMHeight (AR.Model Int) + | FMWeight (AR.Model Int) + | FMBust (AR.Model Int) + | FMWaist (AR.Model Int) + | FMHips (AR.Model Int) + | FMCup (AR.Model String) + | FMAge (AR.Model Int) + | FMPopularity (AR.Model Int) + | FMRating (AR.Model Int) + | FMVotecount (AR.Model Int) + | FMMinAge (AR.Model Int) + | FMProdId AP.Model + | FMProducer AP.Model + | FMDeveloper AP.Model + | FMStaff AT.Model + | FMAnime AA.Model + | FMRDate AD.Model + | FMResolution AE.Model + | FMEngine AEng.Model + | FMDRMType ADRM.Model + | FMTag AG.Model + | FMTrait AI.Model + | FMBirthday AB.Model + +type FieldMsg + = FSCustom () -- Not actually used at the moment + | FSNest NestMsg + | FSList Int + | FSLang (AS.Msg String) + | FSRPlatform (AS.Msg String) + | FSVPlatform (AS.Msg String) + | FSLength (AS.Msg Int) + | FSDevStatus (AS.Msg Int) + | FSRole (AS.Msg String) + | FSBlood (AS.Msg String) + | FSSex AS.SexMsg + | FSGender (AS.Msg String) + | FSMedium (AS.Msg String) + | FSVoiced (AS.Msg Int) + | FSAniEro (AS.Msg Int) + | FSAniStory (AS.Msg Int) + | FSRType (AS.Msg String) + | FSLabel (AS.Msg Int) + | FSRList (AS.Msg Int) + | FSSRole (AS.Msg String) + | FSPType (AS.Msg String) + | FSRExtLinks (AS.Msg String) + | FSSExtLinks (AS.Msg String) + | FSHeight AR.Msg + | FSWeight AR.Msg + | FSBust AR.Msg + | FSWaist AR.Msg + | FSHips AR.Msg + | FSCup AR.Msg + | FSAge AR.Msg + | FSPopularity AR.Msg + | FSRating AR.Msg + | FSVotecount AR.Msg + | FSMinAge AR.Msg + | FSProdId AP.Msg + | FSProducer AP.Msg + | FSDeveloper AP.Msg + | FSStaff AT.Msg + | FSAnime AA.Msg + | FSRDate AD.Msg + | FSResolution AE.Msg + | FSEngine AEng.Msg + | FSDRMType ADRM.Msg + | FSTag AG.Msg + | FSTrait AI.Msg + | FSBirthday AB.Msg + | FToggle Bool + | FDel -- intercepted in nestUpdate + | FMoveSub -- intercepted in nestUpdate + | FMovePar + +type alias FieldDesc = + { qtype : QType + , ptype : QType + , title : String -- How it's listed in the field selection menu. + , quick : Int -- Whether it should be included in the default set of fields (>0) ("quick mode") and in which order. + , init : Data -> (Data, FieldModel) -- How to initialize an empty field + , fromQuery : Data -> Query -> Maybe (Data, FieldModel) -- How to initialize the field from a query + } + + +-- XXX: Should this be lazily initialized instead? May impact JS load time like this. +fields : Array.Array FieldDesc +fields = + let f qtype title quick wrap init fromq = + { qtype = qtype + , ptype = qtype + , title = title + , quick = quick + , init = \d -> (Tuple.mapSecond wrap (init d)) + , fromQuery = \d q -> Maybe.map (Tuple.mapSecond wrap) (fromq d q) + } + -- List type queries are fully defined here for convenience + l qtype title quick lst = + f qtype title quick FMList (\d -> (d, { val = 0, lst = lst })) + (\d q -> List.indexedMap (\i (k,v) -> (i,k,v)) lst |> List.filter (\(i,k,_) -> k == q) |> List.head |> Maybe.map (\(i,_,_) -> (d, { val = i, lst = lst }))) + -- Nested queries + n ptype qtype title = + { qtype = qtype + , ptype = ptype + , title = title + , quick = 0 + , init = nestInit True ptype qtype [] >> Tuple.mapSecond FMNest + , fromQuery = \d -> nestFromQuery ptype qtype d >> Maybe.map (Tuple.mapSecond FMNest) + } + in Array.fromList + -- IMPORTANT: This list is processed in reverse order when reading a Query + -- into Fields, so "catch all" fields must be listed first. In particular, + -- FMNest with qtype == ptype go before everything else. + + -- T TITLE QUICK WRAP INIT FROM_QUERY + [ n V V "And/Or" + , n V R "Release »" + , n V S "Staff »" + , n V C "Character »" + , n V P "Developer »" + , f V "Language" 1 FMLang (AS.langInit AS.LangVN) (AS.langFromQuery AS.LangVN) + , f V "Original language" 2 FMLang (AS.langInit AS.LangVNO) (AS.langFromQuery AS.LangVNO) + , f V "Platform" 3 FMVPlatform AS.init AS.platformFromQuery + , f V "Tags" 4 FMTag AG.init (AG.fromQuery -1 True False) + , f V "" -4 FMTag AG.init (AG.fromQuery 0 True False) + , f V "" -4 FMTag AG.init (AG.fromQuery 1 True False) + , f V "" -4 FMTag AG.init (AG.fromQuery 2 True False) + , f V "" -4 FMTag AG.init (AG.fromQuery 2 True True ) + , f V "" -4 FMTag AG.init (AG.fromQuery 0 False False) + , f V "" -4 FMTag AG.init (AG.fromQuery 1 False False) + , f V "" -4 FMTag AG.init (AG.fromQuery 2 False False) + , f V "" -4 FMTag AG.init (AG.fromQuery 2 False True ) + , f V "My Labels" 0 FMLabel AS.init AS.labelFromQuery + , l V "My List" 0 [(QInt 65 Eq 1, "On my list"), (QInt 65 Ne 1, "Not on my list")] + , f V "Length" 0 FMLength AS.init AS.lengthFromQuery + , f V "Development status" 0 FMDevStatus AS.init AS.devStatusFromQuery + , f V "Release date" 0 FMRDate AD.init AD.fromQuery + , f V "" -1 FMPopularity AR.popularityInit AR.popularityFromQuery + , f V "Rating" 0 FMRating AR.ratingInit AR.ratingFromQuery + , f V "Number of votes" 0 FMVotecount AR.votecountInit AR.votecountFromQuery + , f V "Anime" 0 FMAnime AA.init AA.fromQuery + , l V "Has description" 0 [(QInt 61 Eq 1, "Has description"), (QInt 61 Ne 1, "No description")] + , l V "Has anime" 0 [(QInt 62 Eq 1, "Has anime relation"), (QInt 62 Ne 1, "No anime relation")] + , l V "Has screenshot" 0 [(QInt 63 Eq 1, "Has screenshot(s)"), (QInt 63 Ne 1, "No screenshot(s)")] + , l V "Has review" 0 [(QInt 64 Eq 1, "Has review(s)"), (QInt 64 Ne 1, "No review(s)")] + -- Deprecated + , f V "" 0 FMDeveloper AP.init (AP.fromQuery 6) + + , n R R "And/Or" + , n R V "Visual Novel »" + , n R P "Producer »" + , f R "Language" 1 FMLang (AS.langInit AS.LangRel) (AS.langFromQuery AS.LangRel) + , f R "Platform" 2 FMRPlatform AS.init AS.platformFromQuery + , f R "Type" 3 FMRType AS.init AS.rtypeFromQuery + , l R "Patch" 0 [(QInt 61 Eq 1, "Patch to another release"),(QInt 61 Ne 1, "Standalone release")] + , l R "Freeware" 0 [(QInt 62 Eq 1, "Freeware"), (QInt 62 Ne 1, "Non-free")] + , l R "Erotic scenes" 0 [(QInt 66 Eq 1, "Has erotic scenes"), (QInt 66 Ne 1, "No erotic scenes")] + , l R "Uncensored" 0 [(QInt 64 Eq 1, "Uncensored (no mosaic)"), (QInt 64 Ne 1, "Censored (or no erotic content to censor)")] + , l R "Official" 0 [(QInt 65 Eq 1, "Official"), (QInt 65 Ne 1, "Unofficial")] + , f R "Release date" 0 FMRDate AD.init AD.fromQuery + , f R "Resolution" 0 FMResolution AE.init AE.fromQuery + , f R "Age rating" 0 FMMinAge AR.minageInit AR.minageFromQuery + , f R "Medium" 0 FMMedium AS.init AS.mediumFromQuery + , f R "Voiced" 0 FMVoiced AS.init AS.voicedFromQuery + , f R "Ero animation" 0 FMAniEro AS.init (AS.animatedFromQuery False) + , f R "Story animation" 0 FMAniStory AS.init (AS.animatedFromQuery True) + , f R "Engine" 0 FMEngine AEng.init AEng.fromQuery + , f R "DRM implementation" 0 FMDRMType ADRM.init ADRM.fromQuery + , f R "External links" 0 FMRExtLinks AS.init (AS.extlinkFromQuery 19) + , f R "My List" 0 FMRList AS.init AS.rlistFromQuery + -- Deprecated + , f R "" 0 FMDeveloper AP.init (AP.fromQuery 6) + , f R "" 0 FMProducer AP.init (AP.fromQuery 17) + + + , n C C "And/Or" + , n C S "Voice Actor »" + , n C V "Visual Novel »" + , f C "Role" 1 FMRole AS.init AS.roleFromQuery + , f C "Age" 0 FMAge AR.ageInit AR.ageFromQuery + , f C "Birthday" 0 FMBirthday AB.init AB.fromQuery + , f C "Sex" 2 FMSex (AS.sexInit False) (AS.sexFromQuery False) + , f C "" 0 FMSex (AS.sexInit True) (AS.sexFromQuery True) + , f C "Traits" 3 FMTrait AI.init (AI.fromQuery -1 True False) + , f C "" 0 FMTrait AI.init (AI.fromQuery 0 True False) + , f C "" 0 FMTrait AI.init (AI.fromQuery 1 True False) + , f C "" 0 FMTrait AI.init (AI.fromQuery 2 True False) + , f C "" 0 FMTrait AI.init (AI.fromQuery 2 True True) + , f C "" 0 FMTrait AI.init (AI.fromQuery 0 False False) + , f C "" 0 FMTrait AI.init (AI.fromQuery 1 False False) + , f C "" 0 FMTrait AI.init (AI.fromQuery 2 False False) + , f C "" 0 FMTrait AI.init (AI.fromQuery 2 False True) + , f C "Blood type" 0 FMBlood AS.init AS.bloodFromQuery + , f C "Height" 0 FMHeight AR.heightInit AR.heightFromQuery + , f C "Weight" 0 FMWeight AR.weightInit AR.weightFromQuery + , f C "Bust" 0 FMBust AR.bustInit AR.bustFromQuery + , f C "Waist" 0 FMWaist AR.waistInit AR.waistFromQuery + , f C "Hips" 0 FMHips AR.hipsInit AR.hipsFromQuery + , f C "Cup size" 0 FMCup AR.cupInit AR.cupFromQuery + + , n S S "And/Or" + , f S "Name" 0 FMStaff AT.init AT.fromQuery + , f S "Language" 1 FMLang (AS.langInit AS.LangStaff) (AS.langFromQuery AS.LangStaff) + , f S "Gender" 2 FMGender AS.init AS.genderFromQuery + , f S "Role" 3 FMSRole AS.init AS.sroleFromQuery + , f S "External links" 0 FMSExtLinks AS.init (AS.extlinkFromQuery 6) + + , n P P "And/Or" + , f P "Name" 0 FMProdId AP.init (AP.fromQuery 3) + , f P "Language" 1 FMLang (AS.langInit AS.LangProd) (AS.langFromQuery AS.LangProd) + , f P "Type" 2 FMPType AS.init AS.ptypeFromQuery + ] + + +fieldUpdate : Data -> FieldMsg -> Field -> (Data, Field, Cmd FieldMsg) +fieldUpdate dat msg_ (num, dd, model) = + let maps f m = (dat, (num, dd, f m), Cmd.none) -- Simple version: update function returns a Model + mapf fm fc (d,m,c) = (d, (num, dd, fm m), Cmd.map fc c) -- Full version: update function returns (Data, Model, Cmd) + mapc fm fc (d,m,c) = (d, (num, DD.toggle dd False, fm m), Cmd.map fc c) -- Full version that also closes the DD (Ugly hack...) + noop = (dat, (num, dd, model), Cmd.none) + + -- Called when opening a dropdown, can be used to focus an input element + focus = + case model of + FMTag m -> Cmd.map FSTag (A.refocus m.conf) + FMTrait m -> Cmd.map FSTrait (A.refocus m.conf) + FMProdId m -> Cmd.map FSProdId (A.refocus m.conf) + FMProducer m -> Cmd.map FSProducer (A.refocus m.conf) + FMDeveloper m -> Cmd.map FSDeveloper (A.refocus m.conf) + FMStaff m -> Cmd.map FSStaff (A.refocus m.conf) + FMAnime m -> Cmd.map FSAnime (A.refocus m.conf) + FMResolution m -> Cmd.map FSResolution (A.refocus m.conf) + FMEngine m -> Cmd.map FSEngine (A.refocus m.conf) + FMDRMType m -> Cmd.map FSDRMType (A.refocus m.conf) + _ -> Cmd.none + in case (msg_, model) of + -- Move to parent node is tricky, needs to be intercepted at this point so that we can access the parent NestModel. + (FSNest (NField parentNum (FSNest (NField fieldNum FMovePar))), FMNest grandModel) -> + case List.head <| List.drop parentNum grandModel.fields of + Just (_,_,FMNest parentModel) -> + let fieldField = List.drop fieldNum parentModel.fields |> List.take 1 + newFields = List.map (\(fid,fdd,fm) -> (fid, DD.toggle fdd False, fm)) fieldField + newParentModel = { parentModel | fields = delidx fieldNum parentModel.fields } + addGrandFields = List.take parentNum grandModel.fields ++ newFields ++ List.drop parentNum grandModel.fields + newGrandFields = + if List.isEmpty newParentModel.fields + then delidx (parentNum+1) addGrandFields + else modidx (parentNum+1) (\(pid,pdd,_) -> (pid,pdd,FMNest newParentModel)) addGrandFields + newGrandModel = { grandModel | fields = newGrandFields } + in (dat, (num,dd,FMNest newGrandModel), Cmd.none) + _ -> noop + + -- Move root node to sub; for child nodes this is handled in nestUpdate, but the root node must be handled separately + (FMoveSub, FMNest m) -> + let subfields = [(num,DD.toggle dd False,model)] + (ndat,subm) = nestInit True m.qtype m.qtype subfields dat + (ndat2,subf) = fieldCreate -1 (ndat, FMNest subm) + in (ndat2, subf, Cmd.none) + + (FSNest (NAnd a b), FMNest m) -> mapc FMNest FSNest (nestUpdate dat (NAnd a b) m) + (FSNest (NNeg a b), FMNest m) -> mapc FMNest FSNest (nestUpdate dat (NNeg a b) m) + (FSNest msg, FMNest m) -> mapf FMNest FSNest (nestUpdate dat msg m) + (FSList msg, FMList m) -> (dat, (num,DD.toggle dd False,FMList { m | val = msg }), Cmd.none) + (FSLang msg, FMLang m) -> maps FMLang (AS.langUpdate msg m) + (FSRPlatform msg,FMRPlatform m)-> maps FMRPlatform(AS.update msg m) + (FSVPlatform msg,FMVPlatform m)-> maps FMVPlatform(AS.update msg m) + (FSLength msg, FMLength m) -> maps FMLength (AS.update msg m) + (FSDevStatus msg,FMDevStatus m)-> maps FMDevStatus(AS.update msg m) + (FSRole msg, FMRole m) -> maps FMRole (AS.update msg m) + (FSBlood msg, FMBlood m) -> maps FMBlood (AS.update msg m) + (FSSex msg, FMSex m) -> maps FMSex (AS.sexUpdate msg m) + (FSGender msg, FMGender m) -> maps FMGender (AS.update msg m) + (FSMedium msg, FMMedium m) -> maps FMMedium (AS.update msg m) + (FSVoiced msg, FMVoiced m) -> maps FMVoiced (AS.update msg m) + (FSAniEro msg, FMAniEro m) -> maps FMAniEro (AS.update msg m) + (FSAniStory msg, FMAniStory m) -> maps FMAniStory (AS.update msg m) + (FSRType msg, FMRType m) -> maps FMRType (AS.update msg m) + (FSLabel msg, FMLabel m) -> maps FMLabel (AS.update msg m) + (FSRList msg, FMRList m) -> maps FMRList (AS.update msg m) + (FSSRole msg, FMSRole m) -> maps FMSRole (AS.update msg m) + (FSPType msg, FMPType m) -> maps FMPType (AS.update msg m) + (FSRExtLinks msg,FMRExtLinks m)-> maps FMRExtLinks (AS.update msg m) + (FSSExtLinks msg,FMSExtLinks m)-> maps FMSExtLinks (AS.update msg m) + (FSHeight msg, FMHeight m) -> maps FMHeight (AR.update msg m) + (FSWeight msg, FMWeight m) -> maps FMWeight (AR.update msg m) + (FSBust msg, FMBust m) -> maps FMBust (AR.update msg m) + (FSWaist msg, FMWaist m) -> maps FMWaist (AR.update msg m) + (FSHips msg, FMHips m) -> maps FMHips (AR.update msg m) + (FSCup msg, FMCup m) -> maps FMCup (AR.update msg m) + (FSAge msg, FMAge m) -> maps FMAge (AR.update msg m) + (FSPopularity msg,FMPopularity m)->maps FMPopularity (AR.update msg m) + (FSRating msg, FMRating m) -> maps FMRating (AR.update msg m) + (FSVotecount msg,FMVotecount m)-> maps FMVotecount (AR.update msg m) + (FSMinAge msg ,FMMinAge m) -> maps FMMinAge (AR.update msg m) + (FSProdId msg, FMProdId m) -> mapf FMProdId FSProdId (AP.update dat msg m) + (FSProducer msg, FMProducer m) -> mapf FMProducer FSProducer (AP.update dat msg m) + (FSDeveloper msg,FMDeveloper m)-> mapf FMDeveloper FSDeveloper (AP.update dat msg m) + (FSStaff msg, FMStaff m) -> mapf FMStaff FSStaff (AT.update dat msg m) + (FSAnime msg, FMAnime m) -> mapf FMAnime FSAnime (AA.update dat msg m) + (FSRDate msg, FMRDate m) -> maps FMRDate (AD.update msg m) + (FSResolution msg,FMResolution m)->mapf FMResolution FSResolution (AE.update dat msg m) + (FSEngine msg, FMEngine m) -> mapf FMEngine FSEngine (AEng.update dat msg m) + (FSDRMType msg, FMDRMType m) -> mapf FMDRMType FSDRMType (ADRM.update dat msg m) + (FSTag msg, FMTag m) -> mapf FMTag FSTag (AG.update dat msg m) + (FSTrait msg, FMTrait m) -> mapf FMTrait FSTrait (AI.update dat msg m) + (FSBirthday msg, FMBirthday m) -> maps FMBirthday (AB.update msg m) + (FToggle b, _) -> (dat, (num, DD.toggle dd b, model), if b then focus else Cmd.none) + _ -> noop + + +fieldViewDd : Data -> DD.Config FieldMsg -> Html FieldMsg -> (() -> List (Html FieldMsg)) -> Html FieldMsg +fieldViewDd dat dd lbl cont = + div [ class "elm_dd_input" ] + [ DD.view dd Api.Normal lbl <| \() -> + div [ class "advbut" ] + [ if dat.level == 0 + then small [ title "Can't delete the top-level filter" ] [ text "⊗" ] + else a [ href "#", onClickD FDel, title "Delete this filter" ] [ text "⊗" ] + , if dat.level <= 1 + then small [ title "Can't move this filter to parent branch" ] [ text "↰" ] + else a [ href "#", onClickD FMovePar, title "Move this filter to parent branch" ] [ text "↰" ] + , a [ href "#", onClickD FMoveSub, title "Create new branch for this filter" ] [ text "↳" ] + ] :: cont () + ] + +fieldView : Data -> Field -> Html FieldMsg +fieldView dat (_, dd, model) = + let f wrap (lbl,cont) = fieldViewDd dat dd (Html.map wrap lbl) <| \() -> List.map (Html.map wrap) (cont ()) + l m = ( span [ class "nowrap" ] [ text <| Maybe.withDefault "" <| Maybe.map Tuple.second <| List.head <| List.drop m.val m.lst ] + , \() -> [ ul [] <| List.indexedMap (\n (_,v) -> li [] [ linkRadio (n == m.val) (\_ -> n) [ text v ] ]) m.lst ] + ) + in case model of + FMCustom m -> f FSCustom (text "Unrecognized query", \() -> [text ""]) -- TODO: Display the Query + FMList m -> f FSList (l m) + FMLang m -> f FSLang (AS.langView m) + FMVPlatform m -> f FSVPlatform (AS.platformView False m) + FMRPlatform m -> f FSRPlatform (AS.platformView True m) + FMLength m -> f FSLength (AS.lengthView m) + FMDevStatus m -> f FSDevStatus (AS.devStatusView m) + FMRole m -> f FSRole (AS.roleView m) + FMBlood m -> f FSBlood (AS.bloodView m) + FMSex m -> f FSSex (AS.sexView m) + FMGender m -> f FSGender (AS.genderView m) + FMMedium m -> f FSMedium (AS.mediumView m) + FMVoiced m -> f FSVoiced (AS.voicedView m) + FMAniEro m -> f FSAniEro (AS.animatedView False m) + FMAniStory m -> f FSAniStory (AS.animatedView True m) + FMRType m -> f FSRType (AS.rtypeView m) + FMLabel m -> f FSLabel (AS.labelView dat m) + FMRList m -> f FSRList (AS.rlistView m) + FMSRole m -> f FSSRole (AS.sroleView m) + FMPType m -> f FSPType (AS.ptypeView m) + FMRExtLinks m -> f FSRExtLinks (AS.extlinkView GEL.releaseSites m) + FMSExtLinks m -> f FSSExtLinks (AS.extlinkView GEL.staffSites m) + FMHeight m -> f FSHeight (AR.heightView m) + FMWeight m -> f FSWeight (AR.weightView m) + FMBust m -> f FSBust (AR.bustView m) + FMWaist m -> f FSWaist (AR.waistView m) + FMHips m -> f FSHips (AR.hipsView m) + FMCup m -> f FSCup (AR.cupView m) + FMAge m -> f FSAge (AR.ageView m) + FMPopularity m -> f FSPopularity (AR.popularityView m) + FMRating m -> f FSRating (AR.ratingView m) + FMVotecount m -> f FSVotecount (AR.votecountView m) + FMMinAge m -> f FSMinAge (AR.minageView m) + FMProdId m -> f FSProdId (AP.view "Name" dat m) + FMProducer m -> f FSProducer (AP.view "Producer" dat m) + FMDeveloper m -> f FSDeveloper (AP.view "Developer" dat m) + FMStaff m -> f FSStaff (AT.view dat m) + FMAnime m -> f FSAnime (AA.view dat m) + FMRDate m -> f FSRDate (AD.view m) + FMResolution m -> f FSResolution (AE.view m) + FMEngine m -> f FSEngine (AEng.view m) + FMDRMType m -> f FSDRMType (ADRM.view m) + FMTag m -> f FSTag (AG.view dat m) + FMTrait m -> f FSTrait (AI.view dat m) + FMBirthday m -> f FSBirthday (AB.view m) + FMNest m -> nestView dat dd m + + +fieldToQuery : Data -> Field -> Maybe Query +fieldToQuery dat (_, _, model) = + case model of + FMCustom m -> Just m + FMList m -> List.drop m.val m.lst |> List.head |> Maybe.map Tuple.first + FMNest m -> nestToQuery dat m + FMLang m -> AS.langToQuery m + FMRPlatform m-> AS.toQuery (QStr 4) m + FMVPlatform m-> AS.toQuery (QStr 4) m + FMLength m -> AS.toQuery (QInt 5) m + FMDevStatus m-> AS.toQuery (QInt 66) m + FMRole m -> AS.toQuery (QStr 2) m + FMBlood m -> AS.toQuery (QStr 3) m + FMSex (s,m) -> AS.toQuery (QStr (if s then 5 else 4)) m + FMGender m -> AS.toQuery (QStr 4) m + FMMedium m -> AS.toQuery (QStr 11) m + FMVoiced m -> AS.toQuery (QInt 12) m + FMAniEro m -> AS.toQuery (QInt 13) m + FMAniStory m -> AS.toQuery (QInt 14) m + FMRType m -> AS.toQuery (QStr 16) m + FMLabel m -> AS.toQuery (\op v -> QTuple 12 op (Maybe.withDefault 0 (Maybe.map vndbidNum dat.uid)) v) m + FMRList m -> AS.toQuery (QInt 18) m + FMSRole m -> AS.toQuery (QStr 5) m + FMPType m -> AS.toQuery (QStr 4) m + FMRExtLinks m-> AS.toQuery (QStr 19) m + FMSExtLinks m-> AS.toQuery (QStr 6) m + FMHeight m -> AR.toQuery (QInt 6) (QStr 6) m + FMWeight m -> AR.toQuery (QInt 7) (QStr 7) m + FMBust m -> AR.toQuery (QInt 8) (QStr 8) m + FMWaist m -> AR.toQuery (QInt 9) (QStr 9) m + FMHips m -> AR.toQuery (QInt 10) (QStr 10) m + FMCup m -> AR.toQuery (QStr 11) (QStr 11) m + FMAge m -> AR.toQuery (QInt 12) (QStr 12) m + FMPopularity m->AR.toQuery (QInt 9) (QStr 9) m + FMRating m -> AR.toQuery (QInt 10) (QStr 10) m + FMVotecount m-> AR.toQuery (QInt 11) (QStr 11) m + FMMinAge m -> AR.toQuery (QInt 10) (QStr 10) m + FMProdId m -> AP.toQuery 3 m + FMProducer m -> AP.toQuery 17 m + FMDeveloper m-> AP.toQuery 6 m + FMStaff m -> AT.toQuery m + FMAnime m -> AA.toQuery m + FMRDate m -> AD.toQuery m + FMResolution m-> AE.toQuery m + FMEngine m -> AEng.toQuery m + FMDRMType m -> ADRM.toQuery m + FMTag m -> AG.toQuery m + FMTrait m -> AI.toQuery m + FMBirthday m -> AB.toQuery m + + +fieldCreate : Int -> (Data,FieldModel) -> (Data,Field) +fieldCreate fid (dat,fm) = + ( {dat | objid = dat.objid + 1} + , (fid, DD.init ("xsearch_field" ++ String.fromInt dat.objid) FToggle, fm) + ) + + +fieldInit : Int -> Data -> (Data,Field) +fieldInit n dat = + case Array.get n fields of + Just f -> fieldCreate n (f.init dat) + Nothing -> fieldCreate -1 (dat, FMCustom (QAnd [])) -- Shouldn't happen. + + +fieldFromQuery : QType -> Data -> Query -> (Data,Field) +fieldFromQuery qtype dat q = + let (field, _) = + Array.foldr (\f (af,n) -> + case (if af /= Nothing || f.ptype /= qtype then Nothing else f.fromQuery dat q) of + Nothing -> (af,n-1) + Just ret -> (Just (fieldCreate n ret), 0) + ) (Nothing,Array.length fields-1) fields + in case field of + Just ret -> ret + Nothing -> fieldCreate -1 (dat, FMCustom q) + + +fieldSub : Field -> Sub FieldMsg +fieldSub (_,dd,fm) = + case fm of + FMNest m -> + Sub.batch + <| DD.sub dd + :: DD.sub m.addDd + :: DD.sub m.andDd + :: List.indexedMap (\i -> Sub.map (FSNest << NField i) << fieldSub) m.fields + _ -> DD.sub dd diff --git a/elm/AdvSearch/Lib.elm b/elm/AdvSearch/Lib.elm new file mode 100644 index 00000000..2841acce --- /dev/null +++ b/elm/AdvSearch/Lib.elm @@ -0,0 +1,185 @@ +module AdvSearch.Lib exposing (..) + +import Json.Encode as JE +import Json.Decode as JD +import Html +import Html.Attributes +import Lib.Html +import Dict +import Set +import Gen.Api as GApi + +-- Generic dynamically typed representation of a query. +-- Used only as an intermediate format to help with encoding/decoding. +-- Corresponds to the compact JSON form. +type QType = V | R | C | S | P +type Op = Eq | Ne | Ge | Gt | Le | Lt +type Query + = QAnd (List Query) + | QOr (List Query) + | QInt Int Op Int + | QStr Int Op String + | QQuery Int Op Query + | QTuple Int Op Int Int + + +encodeOp : Op -> JE.Value +encodeOp o = JE.string <| + case o of + Eq -> "=" + Ne -> "!=" + Ge -> ">=" + Gt -> ">" + Le -> "<=" + Lt -> "<" + +encodeQuery : Query -> JE.Value +encodeQuery q = + case q of + QAnd l -> JE.list identity (JE.int 0 :: List.map encodeQuery l) + QOr l -> JE.list identity (JE.int 1 :: List.map encodeQuery l) + QInt s o a -> JE.list identity [JE.int s, encodeOp o, JE.int a] + QStr s o a -> JE.list identity [JE.int s, encodeOp o, JE.string a] + QQuery s o a -> JE.list identity [JE.int s, encodeOp o, encodeQuery a] + QTuple s o a b -> JE.list identity [JE.int s, encodeOp o, JE.int a, JE.int b] + + + +-- Drops the first item in the list, decodes the rest +decodeQList : JD.Decoder (List Query) +decodeQList = + let dec l = List.map (JD.decodeValue decodeQuery) (List.drop 1 l) -- [Result Query] + f v r = Result.andThen (\a -> Result.map (\e -> (e::a)) v) r -- Result Query -> Result [Query] -> Result [Query] + res l = case List.foldr f (Ok []) (dec l) of -- Decoder [Query] + Err e -> JD.fail (JD.errorToString e) + Ok v -> JD.succeed v + in JD.list JD.value |> JD.andThen res -- [Value] + +decodeOp : JD.Decoder Op +decodeOp = JD.string |> JD.andThen (\s -> + case s of + "=" -> JD.succeed Eq + "!=" -> JD.succeed Ne + ">=" -> JD.succeed Ge + ">" -> JD.succeed Gt + "<=" -> JD.succeed Le + "<" -> JD.succeed Lt + _ -> JD.fail "Invalid operator") + +decodeQuery : JD.Decoder Query +decodeQuery = JD.index 0 JD.int |> JD.andThen (\s -> + case s of + 0 -> JD.map QAnd decodeQList + 1 -> JD.map QOr decodeQList + _ -> JD.oneOf + [ JD.map2 (QInt s ) (JD.index 1 decodeOp) (JD.index 2 JD.int) + , JD.map2 (QStr s ) (JD.index 1 decodeOp) (JD.index 2 JD.string) + , JD.map2 (QQuery s) (JD.index 1 decodeOp) (JD.index 2 decodeQuery) + , JD.map2 (\o (a,b) -> QTuple s o a b) (JD.index 1 decodeOp) <| JD.index 2 <| JD.map2 (\a b -> (a,b)) (JD.index 0 JD.int) (JD.index 1 JD.int) + ] + ) + + + + +-- Encode a Query to the compact query format. See lib/VNWeb/AdvSearch.pm for details. + +encIntAlpha : Int -> String +encIntAlpha n = String.slice n (n+1) "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_-" + +encIntRaw : Int -> Int -> String +encIntRaw len n = (if len > 1 then encIntRaw (len-1) (n//64) else "") ++ encIntAlpha (modBy 64 n) + +encInt : Int -> Maybe String +encInt n = if n < 0 then Nothing + else if n < 49 then Just <| encIntAlpha n + else if n < 689 then Just <| encIntAlpha (49 + (n-49)//64) ++ encIntAlpha (modBy 64 (n-49)) + else if n < 4785 then Just <| "X" ++ encIntRaw 2 (n-689) + else if n < 266929 then Just <| "Y" ++ encIntRaw 3 (n-4785) + else if n < 17044145 then Just <| "Z" ++ encIntRaw 4 (n-266929) + else if n < 1090785969 then Just <| "_" ++ encIntRaw 5 (n-17044145) + else if n < 69810262705 then Just <| "-" ++ encIntRaw 6 (n-1090785969) + else Nothing + + +encStrMap : Dict.Dict Char String +encStrMap = Dict.fromList <| List.indexedMap (\n c -> (c,"_"++Maybe.withDefault "" (encInt n))) <| String.toList " !\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~" + +encStr : String -> String +encStr = String.foldl (\c s -> s ++ Maybe.withDefault (String.fromChar c) (Dict.get c encStrMap)) "" + + +encQuery : Query -> String +encQuery query = + let fint n = Maybe.withDefault "" (encInt n) + lst n l = let nl = List.map encQuery l in fint n ++ fint (List.length nl) ++ String.concat nl + encOp o = + case o of + Eq -> 0 + Ne -> 1 + Ge -> 2 + Gt -> 3 + Le -> 4 + Lt -> 5 + encTypeOp o t = fint (encOp o + 8*t) + encStrField n o v = + let s = encStr v + f l = fint n ++ encTypeOp o l ++ s + in case String.length s of + 2 -> f 2 + 3 -> f 3 + l -> f 4 ++ "-" + in case query of + QAnd l -> lst 0 l + QOr l -> lst 1 l + QInt n o v -> + case encInt v of -- Integers that can't be represented in encoded form will be encoded as strings + Just s -> fint n ++ encTypeOp o 0 ++ s + Nothing -> encStrField n o (String.fromInt v) + QStr n o v -> encStrField n o v + QQuery n o q -> fint n ++ encTypeOp o 1 ++ encQuery q + QTuple n o a b -> fint n ++ encTypeOp o 5 ++ fint a ++ fint b + + +showQType : QType -> String +showQType q = + case q of + V -> "v" + R -> "r" + C -> "c" + S -> "s" + P -> "p" + +showOp : Op -> String +showOp op = + case op of + Eq -> "=" + Ne -> "≠" + Le -> "≤" + Lt -> "<" + Ge -> "≥" + Gt -> ">" + + +inputOp : Bool -> Op -> (Op -> a) -> Html.Html a +inputOp onlyEq val msg = + Html.div [ Html.Attributes.class "opselect" ] <| + List.map (\op -> + if val == op then Html.strong [] [ Html.text (showOp op) ] else Html.a [ Html.Attributes.href "#", Lib.Html.onClickD (msg op) ] [ Html.text (showOp op) ] + ) <| if onlyEq then [Eq, Ne] else [Eq, Ne, Ge, Gt, Le, Lt] + + +-- Global data that's passed around for Fields +type alias Data = + { objid : Int -- Incremental integer for global identifiers + , level : Int -- Nesting level of the field being processed + , parentTypes : Set.Set String -- Only used for 'view' functions: query types that the current field is a subquery of + , uid : Maybe String + , labels : List (Int, String) + , defaultSpoil : Int + , producers : Dict.Dict String GApi.ApiProducerResult + , staff : Dict.Dict String GApi.ApiStaffResult + , tags : Dict.Dict String GApi.ApiTagResult + , traits : Dict.Dict String GApi.ApiTraitResult + , anime : Dict.Dict Int GApi.ApiAnimeResult + } diff --git a/elm/AdvSearch/Main.elm b/elm/AdvSearch/Main.elm new file mode 100644 index 00000000..31331692 --- /dev/null +++ b/elm/AdvSearch/Main.elm @@ -0,0 +1,267 @@ +module AdvSearch.Main exposing (main) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import Browser +import Set +import Dict +import Task +import Browser.Dom as Dom +import Array as Array +import Json.Encode as JE +import Json.Decode as JD +import Gen.Api as GApi +import Gen.AdvSearchSave as GASS +import Gen.AdvSearchDel as GASD +import Lib.Html exposing (..) +import Lib.Api as Api +import Lib.Ffi as Ffi +import Lib.DropDown as DD +import Lib.Autocomplete as A +import AdvSearch.Lib exposing (..) +import AdvSearch.Fields exposing (..) + + +main : Program Recv Model Msg +main = Browser.element + { init = \e -> (init e, Cmd.none) + , view = view + , update = update + , subscriptions = \m -> Sub.batch [ DD.sub m.saveDd, Sub.map Field (fieldSub m.query) ] + } + +type alias SQuery = { name: String, query: String } +type alias Recv = + { uid : Maybe String + , labels : List { id: Int, label: String } + , defaultSpoil : Int + , saved : List SQuery + , error : Bool + , query : GApi.ApiAdvSearchQuery + } + +type SaveAct = Save | Load | Delete | Default + +type alias Model = + { query : Field + , qtype : QType + , data : Data + , error : Bool + , saved : List SQuery + , saveState : Api.State + , saveDd : DD.Config Msg + , saveAct : SaveAct + , saveName : String + , saveDel : Set.Set String + , loadQuery : Maybe String + } + +type Msg + = Noop + | Field FieldMsg + | SaveToggle Bool + | SaveAct SaveAct + | SaveName String + | SaveSave String + | SaveSaved SQuery GApi.Response + | SaveLoad String + | SaveDelSel String + | SaveDel (Set.Set String) + | SaveDeleted (Set.Set String) GApi.Response + + +-- If the query only contains "quick" selection fields, add the remaining quick fields and sort them. +normalize : QType -> Field -> Data -> (Field, Data) +normalize qtype query odat = + let quickFromId (n,_,_) = Array.get n fields |> Maybe.map (\f -> abs f.quick) |> Maybe.withDefault 0 + present = List.foldl (\f a -> Set.insert (quickFromId f) a) Set.empty + defaults pres = Array.foldl (\f (al,dat,an) -> + if f.qtype == qtype && f.quick > 0 && not (Set.member (abs f.quick) pres) + then let (ndat, nf) = fieldInit an dat + in (nf::al, ndat, an+1) + else (al,dat,an+1) + ) ([],odat,0) fields + cmp a b = compare (quickFromId a) (quickFromId b) + in case query of + (qid, qdd, FMNest qm) -> + let pres = present qm.fields + (nl, ndat, _) = defaults pres + nqm = { qm | fields = List.sortWith cmp (nl++qm.fields) } + in if Set.member 0 pres || List.length nqm.fields > 4 then (query, odat) else ((qid, qdd, FMNest nqm), ndat) + _ -> (query, odat) + + +loadQuery : Data -> GApi.ApiAdvSearchQuery -> (QType, Field, Data) +loadQuery odat arg = + let dat = { objid = 0 + , level = 0 + , parentTypes = Set.empty + , uid = odat.uid + , labels = odat.labels + , defaultSpoil = odat.defaultSpoil + , producers = Dict.union (Dict.fromList <| List.map (\p -> (p.id,p)) <| arg.producers) odat.producers + , staff = Dict.union (Dict.fromList <| List.map (\s -> (s.id,s)) <| arg.staff ) odat.staff + , tags = Dict.union (Dict.fromList <| List.map (\t -> (t.id,t)) <| arg.tags ) odat.tags + , traits = Dict.union (Dict.fromList <| List.map (\t -> (t.id,t)) <| arg.traits ) odat.traits + , anime = Dict.union (Dict.fromList <| List.map (\a -> (a.id,a)) <| arg.anime ) odat.anime + } + qtype = + case arg.qtype of + "v" -> V + "c" -> C + "s" -> S + "p" -> P + _ -> R + + (dat2, query) = JD.decodeValue decodeQuery arg.query |> Result.toMaybe |> Maybe.withDefault (QAnd []) |> fieldFromQuery qtype dat + + -- We always want the top-level query to be a Nest type. + addtoplvl = let (_,m) = fieldCreate -1 (Tuple.mapSecond FMNest (nestInit True qtype qtype [query] dat2)) in m + query2 = case query of + (_,_,FMNest m) -> if m.qtype == qtype then query else addtoplvl + _ -> addtoplvl + dat3 = { dat2 | objid = dat2.objid + 5 } -- +5 for the creation of query2 + + (query3, dat4) = normalize qtype query2 dat3 + in (qtype, query3, dat4) + + +init : Recv -> Model +init arg = + let dat = { objid = 0 + , level = 0 + , parentTypes = Set.empty + , uid = arg.uid + , labels = (0, "Unlabeled") :: List.map (\e -> (e.id, e.label)) arg.labels + , defaultSpoil = arg.defaultSpoil + , producers = Dict.empty + , staff = Dict.empty + , tags = Dict.empty + , traits = Dict.empty + , anime = Dict.empty + } + (qtype, query, ndat) = loadQuery dat arg.query + in { query = query + , qtype = qtype + , data = ndat + , error = arg.error + , saved = arg.saved + , saveState = Api.Normal + , saveDd = DD.init "xsearch_save" SaveToggle + , saveAct = Save + , saveName = "" + , saveDel = Set.empty + , loadQuery = Nothing + } + + +update : Msg -> Model -> (Model, Cmd Msg) +update msg model = + case msg of + Noop -> (model, Cmd.none) + Field m -> + let (ndat, nm, nc) = fieldUpdate model.data m model.query + in ({ model | data = ndat, query = nm, error = False }, Cmd.map Field nc) + SaveToggle b -> + let act = if model.saveAct == Save && not (List.isEmpty model.saved) && fieldToQuery model.data model.query == Nothing then Load else model.saveAct + in ( { model | saveDd = DD.toggle model.saveDd b, saveAct = act, saveDel = Set.empty } + , if b && act == Save then Task.attempt (always Noop) (Dom.focus "xsearch_saveinput") else Cmd.none) + SaveAct n -> ({ model | saveAct = n, saveDel = Set.empty }, Cmd.none) + SaveName n -> ({ model | saveName = n }, Cmd.none) + SaveSave s -> + case Maybe.map encQuery (fieldToQuery model.data model.query) of + Just q -> ({ model | saveState = Api.Loading }, GASS.send { name = s, qtype = showQType model.qtype, query = q } (SaveSaved { name = s, query = q }) ) + Nothing -> (model, Cmd.none) + SaveSaved q GApi.Success -> + let f rep lst = case lst of + (x::xs) -> + if x.name == q.name then q :: f True xs + else if not rep && x.name > q.name then q :: x :: f True xs + else x :: f rep xs + [] -> if rep then [] else [q] + in ({ model | saveState = Api.Normal, saveDd = DD.toggle model.saveDd False, saved = f False model.saved }, Cmd.none) + SaveSaved _ e -> ({ model | saveState = Api.Error e }, Cmd.none) + SaveLoad q -> ({ model | saveState = Api.Loading, saveDd = DD.toggle model.saveDd False, loadQuery = Just q }, Task.attempt (always Noop) (Ffi.elemCall "click" "advsubmit")) + SaveDelSel s -> ({ model | saveDel = (if Set.member s model.saveDel then Set.remove else Set.insert) s model.saveDel }, Cmd.none) + SaveDel d -> ({ model | saveState = Api.Loading }, GASD.send { qtype = showQType model.qtype, name = Set.toList d } (SaveDeleted d)) + SaveDeleted d GApi.Success -> ({ model | saveState = Api.Normal, saveDel = Set.empty, saved = List.filter (\e -> not (Set.member e.name d)) model.saved }, Cmd.none) + SaveDeleted _ e -> ({ model | saveState = Api.Error e }, Cmd.none) + + +saveIcon = "<svg xmlns=\"http://www.w3.org/2000/svg\" viewBox=\"0 0 24 24\"><g fill=\"none\" stroke=\"currentColor\" stroke-width=\"2\" stroke-linecap=\"round\" stroke-linejoin=\"round\"><path d=\"M19 21H5a2 2 0 0 1-2-2V5a2 2 0 0 1 2-2h11l5 5v11a2 2 0 0 1-2 2z\"></path><polyline points=\"17 21 17 13 7 13 7 21\"></polyline><polyline points=\"7 3 7 8 15 8\"></polyline></g></svg>" + +view : Model -> Html Msg +view model = div [ class "xsearch" ] <| + let encQ = Maybe.withDefault "" <| Maybe.map encQuery (fieldToQuery model.data model.query) + in + [ input [ type_ "hidden", id "f", name "f", value (Maybe.withDefault encQ model.loadQuery) ] [] + , input [ type_ "submit", id "advsubmit", class "hidden" ] [] + , if model.data.uid == Nothing then text "" else div [ class "elm_dd_input elm_dd_noarrow elm_dd_rightish short" ] + [ DD.view model.saveDd model.saveState (span [ Ffi.innerHtml saveIcon ] []) <| \() -> + [ div [ class "advheader", style "min-width" "300px" ] + [ div [ class "opts", style "margin-bottom" "5px" ] + [ if model.saveAct == Save then strong [] [ text "Save" ] else a [ href "#", onClickD (SaveAct Save ) ] [ text "Save" ] + , if model.saveAct == Load then strong [] [ text "Load" ] else a [ href "#", onClickD (SaveAct Load ) ] [ text "Load" ] + , if model.saveAct == Delete then strong [] [ text "Delete" ] else a [ href "#", onClickD (SaveAct Delete ) ] [ text "Delete" ] + , if model.saveAct == Default then strong [] [ text "Default"] else a [ href "#", onClickD (SaveAct Default) ] [ text "Default" ] + ] + , h3 [] [ text <| case model.saveAct of + Save -> "Save current filter" + Load -> "Load filter" + Delete -> "Delete saved filter" + Default -> "Default filter" ] + ] + , case (List.filter (\e -> e.name /= "") model.saved, model.saveAct) of + (_, Save) -> + if encQ == "" then text "Nothing to save." else + form_ "" (SaveSave model.saveName) False + [ inputText "xsearch_saveinput" model.saveName SaveName [ required True, maxlength 50, placeholder "Name...", style "width" "290px" ] + , if model.saveName /= "" && List.any (\e -> e.name == model.saveName) model.saved + then text "You already have a filter by that name, click save to overwrite it." + else text "" + , submitButton "Save" model.saveState True + ] + (_, Default) -> + div [] + [ p [ class "center", style "padding" "0px 5px" ] <| + case model.qtype of + V -> [ text "You can set a default filter that will be applied automatically to most listings on the site," + , text " this includes the \"Random visual novel\" button, lists on the homepage, tag pages, etc." + , text " This feature is mainly useful to filter out tags, languages or platforms that you are not interested in seeing." + ] + R -> [ text "You can set a default filter that will be applied automatically to this release browser and the listings on the homepage." + , text " This feature is mainly useful to filter out tags, languages or platforms that you are not interested in seeing." + ] + _ -> [ text "You can set a default filter that will be applied automatically when you open this listing." ] + , br [] [] + , case List.filter (\e -> e.name == "") model.saved of + [d] -> span [] + [ inputButton "Load my default filters" (SaveLoad d.query) [style "width" "100%"] + , br [] [] + , br [] [] + , inputButton "Delete my default filters" (SaveDel (Set.fromList [""])) [style "width" "100%"] + ] + _ -> text "You don't have a default filter set." + , if encQ /= "" then inputButton "Save current filters as default" (SaveSave "") [ style "width" "100%" ] else text "" + ] + ([], _) -> text "You don't have any saved queries." + (l, Load) -> + div [] + [ if encQ == "" || List.any (\e -> encQ == e.query) l + then text "" else text "Unsaved changes will be lost when loading a saved filter." + , ul [] <| List.map (\e -> li [ style "overflow" "hidden", style "text-overflow" "ellipsis" ] [ a [ href "#", onClickD (SaveLoad e.query) ] [ text e.name ] ]) l + ] + (l, Delete) -> + div [] + [ ul [] <| List.map (\e -> li [ style "overflow" "hidden", style "text-overflow" "ellipsis" ] [ linkRadio (Set.member e.name model.saveDel) (always (SaveDelSel e.name)) [ text e.name ] ]) l + , inputButton "Delete selected" (SaveDel model.saveDel) [ disabled (Set.isEmpty model.saveDel) ] + ] + ] + ] + , Html.map Field (fieldView model.data model.query) + , if model.error + then b [] [ text "Error parsing search query. The URL was probably corrupted in some way. " + , text "Please report a bug if you opened this page from VNDB (as opposed to getting here from an external site)." ] + else text "" + ] diff --git a/elm/AdvSearch/Producers.elm b/elm/AdvSearch/Producers.elm new file mode 100644 index 00000000..5d34aeb0 --- /dev/null +++ b/elm/AdvSearch/Producers.elm @@ -0,0 +1,93 @@ +module AdvSearch.Producers exposing (..) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Set +import Dict +import Lib.Autocomplete as A +import Lib.Html exposing (..) +import Lib.Util exposing (..) +import Gen.Api as GApi +import AdvSearch.Lib exposing (..) +import AdvSearch.Set as S + + + +type alias Model = + { sel : S.Model Int + , conf : A.Config Msg GApi.ApiProducerResult + , search : A.Model GApi.ApiProducerResult + } + +type Msg + = Sel (S.Msg Int) + | Search (A.Msg GApi.ApiProducerResult) + + +init : Data -> (Data, Model) +init dat = + let (ndat, sel) = S.init dat + in ( { ndat | objid = ndat.objid + 1 } + , { sel = { sel | single = False } + , conf = { wrap = Search, id = "xsearch_prod" ++ String.fromInt ndat.objid, source = A.producerSource } + , search = A.init "" + } + ) + + +update : Data -> Msg -> Model -> (Data, Model, Cmd Msg) +update dat msg model = + case msg of + Sel m -> (dat, { model | sel = S.update m model.sel }, Cmd.none) + Search m -> + let (nm, c, res) = A.update model.conf m model.search + in case res of + Nothing -> (dat, { model | search = nm }, c) + Just p -> + if Set.member (vndbidNum p.id) model.sel.sel then (dat, { model | search = nm }, c) + else ( { dat | producers = Dict.insert p.id p dat.producers } + , { model | search = A.clear nm "", sel = S.update (S.Sel (vndbidNum p.id) True) model.sel } + , c ) + + +toQuery n m = S.toQuery (QInt n) m.sel + +fromQuery n dat qf = S.fromQuery (\q -> + case q of + QInt id op v -> if id == n then Just (op, v) else Nothing + _ -> Nothing) dat qf + |> Maybe.map (\(ndat,sel) -> + ( { ndat | objid = ndat.objid+1 } + , { sel = { sel | single = False } + , conf = { wrap = Search, id = "xsearch_prod" ++ String.fromInt ndat.objid, source = A.producerSource } + , search = A.init "" + } + )) + + + +view : String -> Data -> Model -> (Html Msg, () -> List (Html Msg)) +view lbl dat model = + ( case Set.toList model.sel.sel of + [] -> small [] [ text lbl ] + [s] -> span [ class "nowrap" ] + [ S.lblPrefix model.sel + , small [] [ text <| "p" ++ String.fromInt s ++ ":" ] + , Dict.get (vndbid 'p' s) dat.producers |> Maybe.map (\p -> p.name) |> Maybe.withDefault "" |> text + ] + l -> span [] [ S.lblPrefix model.sel, text <| lbl ++ "s (" ++ String.fromInt (List.length l) ++ ")" ] + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text "Producer identifier" ] + , Html.map Sel (S.opts model.sel False True) + ] + , ul [] <| List.map (\s -> + li [ style "overflow" "hidden", style "text-overflow" "ellipsis" ] + [ inputButton "X" (Sel (S.Sel s False)) [] + , small [] [ text <| " p" ++ String.fromInt s ++ ": " ] + , Dict.get (vndbid 'p' s) dat.producers |> Maybe.map (\p -> a [ href ("/" ++ p.id), target "_blank", style "display" "inline" ] [ text p.name ]) |> Maybe.withDefault (text "") + ] + ) (Set.toList model.sel.sel) + , A.view model.conf model.search [ placeholder "Search..." ] + ] + ) diff --git a/elm/AdvSearch/RDate.elm b/elm/AdvSearch/RDate.elm new file mode 100644 index 00000000..7dc6f88b --- /dev/null +++ b/elm/AdvSearch/RDate.elm @@ -0,0 +1,99 @@ +module AdvSearch.RDate exposing (..) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Lib.Html exposing (..) +import Lib.RDate as R +import AdvSearch.Lib exposing (..) + + +type alias Model = + { op : Op + , fuzzy : Bool + , date : R.RDate + } + + +type Msg + = MOp Op + | Fuzzy Bool + | Date R.RDate + + +onlyEq : Int -> Bool +onlyEq d = d == 99999999 || d == 0 + + +update : Msg -> Model -> Model +update msg model = + case msg of + MOp o -> { model | op = o } + Fuzzy f -> { model | fuzzy = f } + Date d -> { model | op = if onlyEq d && model.op /= Eq && model.op /= Ne then Eq else model.op, date = d } + + +init : Data -> (Data, Model) +init dat = (dat, + { op = Le + , fuzzy = True + , date = 1 + }) + + +toQuery : Model -> Maybe Query +toQuery model = Just <| + let f o date = QInt 7 o date + e = R.expand model.date + ystart = R.compact { y=e.y, m= 1, d= 1 } + mstart = R.compact { y=e.y, m=e.m, d= 1 } + in + if not model.fuzzy || e.y == 0 || e.y == 9999 then f model.op model.date else + case (model.op, e.m, e.d) of + -- Fuzzy (in)equality turns into a date range + (Eq, 99, 99) -> QAnd [ f Ge ystart, f Le model.date ] + (Eq, _, 99) -> QAnd [ f Ge mstart, f Le model.date ] + (Ne, 99, 99) -> QOr [ f Lt ystart, f Gt model.date ] + (Ne, _, 99) -> QOr [ f Lt mstart, f Gt model.date ] + -- Fuzzy Ge and Lt just need the date adjusted to the correct boundary + (Ge, 99, 99) -> f Ge ystart + (Ge, _, 99) -> f Ge mstart + (Lt, 99, 99) -> f Lt ystart + (Lt, _, 99) -> f Lt mstart + _ -> f model.op model.date + + +fromQuery : Data -> Query -> Maybe (Data, Model) +fromQuery dat q = + let m op fuzzy date = Just (dat, { op = op, fuzzy = fuzzy, date = date }) + fuzzyNeq op start end = + let se = R.expand start + ee = R.expand end + in if se.y == ee.y && (ee.m < 99 || se.m == 1) && se.d == 1 && ee.d == 99 then m op True end else Nothing + canFuzzy o e = e.y == 0 || e.y == 9999 || e.d /= 99 || o == Gt || o == Le + in + case q of + QAnd [QInt 7 Ge start, QInt 7 Le end] -> fuzzyNeq Eq start end + QOr [QInt 7 Lt start, QInt 7 Gt end] -> fuzzyNeq Ne start end + QInt 7 o v -> m o (canFuzzy o (R.expand v)) v + _ -> Nothing + + +view : Model -> (Html Msg, () -> List (Html Msg)) +view model = + ( text <| showOp model.op ++ " " ++ R.format (R.expand model.date) + , \() -> + [ div [ class "advheader", style "width" "290px" ] + [ h3 [] [ text "Release date" ] + , div [ class "opts" ] + [ inputOp (onlyEq model.date) model.op MOp + , if (R.expand model.date).d /= 99 || model.date == 99999999 then text "" else + linkRadio model.fuzzy Fuzzy [ span [ title + <| "Without fuzzy matching, partial dates will always match after the last date of the chosen time period, " + ++ "e.g. \"< 2010-10\" would also match anything released in 2010-10 and \"= 2010-10\" would only match releases for which we don't know the exact date." + ++ "\n\nFuzzy match will adjust the query to do what you mean." + ] [ text "fuzzy" ] ] + ] + ] + , R.view model.date True True Date + ] + ) diff --git a/elm/AdvSearch/Range.elm b/elm/AdvSearch/Range.elm new file mode 100644 index 00000000..89ab3a16 --- /dev/null +++ b/elm/AdvSearch/Range.elm @@ -0,0 +1,215 @@ +module AdvSearch.Range exposing (..) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import Lib.Html exposing (..) +import Lib.Util exposing (..) +import Array +import Lib.Ffi as Ffi +import Gen.Types as GT +import AdvSearch.Lib exposing (..) + + +type alias Model a = + { op : Op + , val : Int + , unk : Bool + , lst : Array.Array a + } + + +type Msg + = MOp Op + | Val String + | Unknown Bool + + +update : Msg -> Model a -> Model a +update msg model = + case msg of + MOp o -> { model | op = o } + Val n -> { model | val = Maybe.withDefault 0 (String.toInt n) } + Unknown b -> { model | unk = b, op = if b && model.op /= Ne && model.op /= Eq then Eq else model.op } + +fromQuery : (Data, Model comparable) -> Op -> comparable -> Maybe (Data, Model comparable) +fromQuery (dat,m) op v = Array.foldl (\v2 (i,r) -> (i+1, if v2 == v then Just i else r)) (0,Nothing) m.lst |> Tuple.second |> Maybe.map (\i -> (dat,{ m | val = i, op = op, unk = False })) + +fromQueryUnk : (Data, Model comparable) -> Op -> Maybe (Data, Model comparable) +fromQueryUnk (dat,m) op = Just (dat, { m | unk = True, op = if op == Eq then Eq else Ne }) + +toQuery : (Op -> a -> Query) -> (Op -> String -> Query) -> Model a -> Maybe Query +toQuery k u m = if m.unk then Just (u m.op "") else Array.get m.val m.lst |> Maybe.map (\v -> k m.op v) + +view : Bool -> String -> (a -> String) -> Model a -> (Html Msg, () -> List (Html Msg)) +view canUnk lbl fmt model = + let val n = Array.get n model.lst |> Maybe.map fmt |> Maybe.withDefault "" + in + ( span [ class "nowrap" ] [ text <| lbl ++ " " ++ showOp model.op ++ " " ++ if model.unk then "Unknown" else val model.val ] + , \() -> + [ div [ class "advheader", style "width" "290px" ] + [ h3 [] [ text lbl ] + , div [ class "opts" ] + [ inputOp model.unk model.op MOp + , if canUnk then linkRadio model.unk Unknown [text "Unknown"] else text "" + ] + ] + , if model.unk + then p [ class "center" ] [ text <| lbl ++ " is " ++ (if model.op /= Eq then "known/set." else "unknown/unset.") ] + else + div [ style "display" "flex", style "justify-content" "space-between", style "margin-top" "5px" ] + [ small [] [ text (val 0) ] + , strong [] [ text (val model.val) ] + , small [] [ text (val (Array.length model.lst - 1)) ] + ] + , if model.unk then text "" else + input + [ type_ "range" + , Html.Attributes.min "0" + , Html.Attributes.max (String.fromInt (Array.length model.lst - 1)) + , value (String.fromInt model.val) + , onInput Val + , style "width" "290px" + ] [] + ] + ) + + + + +heightInit dat = (dat, { op = Ge, val = 150, unk = False, lst = Array.initialize 300 (\n -> n+1) }) + +heightFromQuery d q = + case q of + QInt 6 op v -> fromQuery (heightInit d) op v + QStr 6 op "" -> fromQueryUnk (heightInit d) op + _ -> Nothing + +heightView = view True "Height" (\v -> String.fromInt v ++ "cm") + + + + +weightInit dat = (dat, { op= Ge, val = 60, unk = False, lst = Array.initialize 401 identity }) + +weightFromQuery d q = + case q of + QInt 7 op v -> fromQuery (weightInit d) op v + QStr 7 op "" -> fromQueryUnk (weightInit d) op + _ -> Nothing + +weightView = view True "Weight" (\v -> String.fromInt v ++ "kg") + + + + +bustInit dat = (dat, { op = Ge, val = 40, unk = False, lst = Array.initialize 101 (\n -> n+20) }) + +bustFromQuery d q = + case q of + QInt 8 op v -> fromQuery (bustInit d) op v + QStr 8 op "" -> fromQueryUnk (bustInit d) op + _ -> Nothing + +bustView = view True "Bust" (\v -> String.fromInt v ++ "cm") + + + + +waistInit dat = (dat, { op = Ge, val = 40, unk = False, lst = Array.initialize 101 (\n -> n+20) }) + +waistFromQuery d q = + case q of + QInt 9 op v -> fromQuery (waistInit d) op v + QStr 9 op "" -> fromQueryUnk (waistInit d) op + _ -> Nothing + +waistView = view True "Waist" (\v -> String.fromInt v ++ "cm") + + + + +hipsInit dat = (dat, { op = Ge, val = 40, unk = False, lst = Array.initialize 101 (\n -> n+20) }) + +hipsFromQuery d q = + case q of + QInt 10 op v -> fromQuery (hipsInit d) op v + QStr 10 op "" -> fromQueryUnk (hipsInit d) op + _ -> Nothing + +hipsView = view True "Hips" (\v -> String.fromInt v ++ "cm") + + + + +cupInit dat = (dat, { op = Ge, val = 3, unk = False, lst = Array.fromList (List.map Tuple.first (List.drop 1 GT.cupSizes)) }) + +cupFromQuery d q = + case q of + QStr 11 op "" -> fromQueryUnk (cupInit d) op + QStr 11 op v -> fromQuery (cupInit d) op v + _ -> Nothing + +cupView = view True "Cup size" identity + + + + +ageInit dat = (dat, { op = Ge, val = 17, unk = False, lst = Array.initialize 121 identity }) + +ageFromQuery d q = + case q of + QInt 12 op v -> fromQuery (ageInit d) op v + QStr 12 op "" -> fromQueryUnk (ageInit d) op + _ -> Nothing + +ageView = view True "Age" (\v -> if v == 1 then "1 year" else String.fromInt v ++ " years") + + + + +popularityInit dat = (dat, { op = Ge, val = 10, unk = False, lst = Array.initialize 101 identity }) + +popularityFromQuery d q = + case q of + QInt 9 op v -> fromQuery (popularityInit d) op v + _ -> Nothing + +popularityView = view False "Popularity" String.fromInt + + + + +ratingInit dat = (dat, { op = Ge, val = 40, unk = False, lst = Array.initialize 91 (\v -> v+10) }) + +ratingFromQuery d q = + case q of + QInt 10 op v -> fromQuery (ratingInit d) op v + _ -> Nothing + +ratingView = view False "Rating" (\v -> Ffi.fmtFloat (toFloat v / 10) 1) + + + + +votecountInit dat = (dat, { op = Ge, val = 10, unk = False, lst = Array.fromList [ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 20, 30, 40, 50, 60, 70, 80, 90, 100, 200, 300, 400, 500, 600, 700, 800, 900, 1000, 2000, 3000, 4000, 5000 ] }) + +votecountFromQuery d q = + case q of + QInt 11 op v -> fromQuery (votecountInit d) op v + _ -> Nothing + +votecountView = view False "# Votes" String.fromInt + + + + +minageInit dat = (dat, { op = Lt, val = 13, unk = False, lst = Array.fromList <| List.map Tuple.first GT.ageRatings }) + +minageFromQuery d q = + case q of + QInt 10 op v -> fromQuery (minageInit d) op v + QStr 10 op "" -> fromQueryUnk (minageInit d) op + _ -> Nothing + +minageView = view True "Age rating" <| \v -> Maybe.withDefault "" <| List.head <| String.split " (" <| Maybe.withDefault "" <| lookup v GT.ageRatings diff --git a/elm/AdvSearch/Resolution.elm b/elm/AdvSearch/Resolution.elm new file mode 100644 index 00000000..7617d02c --- /dev/null +++ b/elm/AdvSearch/Resolution.elm @@ -0,0 +1,85 @@ +module AdvSearch.Resolution exposing (..) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Lib.Autocomplete as A +import Lib.Html exposing (..) +import Lib.Util exposing (..) +import Gen.Api as GApi +import AdvSearch.Lib exposing (..) + + +type alias Model = + { op : Op + , reso : Maybe (Int,Int) + , conf : A.Config Msg GApi.ApiResolutions + , search : A.Model GApi.ApiResolutions + , aspect : Bool + } + + +type Msg + = MOp Op + | Search (A.Msg GApi.ApiResolutions) + | Aspect Bool + + +onlyEq : Maybe (Int,Int) -> Bool +onlyEq reso = reso == Just (0,0) || reso == Just (0,1) + + +update : Data -> Msg -> Model -> (Data, Model, Cmd Msg) +update dat msg model = + case msg of + MOp o -> (dat, { model | op = o, aspect = o /= Eq && o /= Ne && model.aspect }, Cmd.none) + Aspect b -> (dat, { model | aspect = b }, Cmd.none) + Search m -> + let (nm, c, en) = A.update model.conf m model.search + search = Maybe.withDefault nm <| Maybe.map (\e -> A.clear nm e.resolution) en + reso = resoParse True search.value + op = if onlyEq reso && model.op /= Eq && model.op /= Ne then Eq else model.op + in (dat, { model | search = search, reso = reso, op = op, aspect = op /= Eq && op /= Ne && model.aspect }, c) + + +init : Data -> (Data, Model) +init dat = + ( { dat | objid = dat.objid+1 } + , { op = Ge + , reso = Nothing + , conf = { wrap = Search, id = "xsearch_reso" ++ String.fromInt dat.objid, source = A.resolutionSource } + , search = A.init "" + , aspect = False + } + ) + + +toQuery : Model -> Maybe Query +toQuery model = Maybe.map (\(x,y) -> QTuple (if model.aspect then 9 else 8) model.op x y) model.reso + +fromQuery : Data -> Query -> Maybe (Data, Model) +fromQuery dat q = + let m op x y aspect = Just <| Tuple.mapSecond (\mod -> { mod | op = op, reso = Just (x,y), search = A.init (resoFmt False x y), aspect = aspect }) <| init dat + in + case q of + QTuple 8 op x y -> m op x y False + QTuple 9 op x y -> m op x y True + _ -> Nothing + + +view : Model -> (Html Msg, () -> List (Html Msg)) +view model = + ( case model.reso of + Nothing -> small [] [ text "Resolution" ] + Just (x,y) -> span [ class "nowrap" ] [ text <| (if x > 0 && model.aspect then "A " else "R ") ++ showOp model.op ++ " " ++ resoFmt False x y ] + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text "Resolution" ] + , div [ class "opts" ] + [ div [ class "opselect" ] [ inputOp (onlyEq model.reso) model.op MOp ] + , if model.op == Eq || model.op == Ne then text "" else + linkRadio model.aspect Aspect [ span [ title "Aspect ratio must be the same" ] [ text "aspect" ] ] + ] + ] + , A.view model.conf model.search [ placeholder "width x height" ] + ] + ) diff --git a/elm/AdvSearch/Set.elm b/elm/AdvSearch/Set.elm new file mode 100644 index 00000000..f5f2897c --- /dev/null +++ b/elm/AdvSearch/Set.elm @@ -0,0 +1,565 @@ +module AdvSearch.Set exposing (..) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Set +import Lib.Html exposing (..) +import Lib.Util exposing (..) +import Gen.Types as GT +import Gen.ExtLinks as GEL +import AdvSearch.Lib exposing (..) + + +type alias Model a = + { sel : Set.Set a + , single : Bool + , and : Bool + , neg : Bool + , last : Set.Set a -- Last selection before switching to single mode, if there were multiple items selected + } + +type Msg a + = Sel a Bool + | Neg Bool + | And Bool + | Single Bool + | Mode -- Toggle between single / multi (or) / multi (and) + + +init : Data -> (Data, Model a) +init dat = (dat, { sel = Set.empty, single = True, and = False, neg = False, last = Set.empty }) + + +update : Msg comparable -> Model comparable -> Model comparable +update msg model = + let singleMode m = + { m | sel = if m.single then Set.fromList <| List.take 1 <| Set.toList m.sel + else if model.single && not m.single && not (Set.isEmpty model.last) then m.last + else m.sel + , last = if m.single && not model.single && Set.size m.sel > 1 then m.sel else Set.empty } + in + case msg of + Sel v b -> { model | last = Set.empty, sel = if not b then Set.remove v model.sel else if model.single then Set.fromList [v] else Set.insert v model.sel } + Neg b -> { model | neg = b } + And b -> { model | and = b } + Single b -> singleMode { model | single = b } + Mode -> singleMode { model | single = not model.single && model.and, and = not model.single && not model.and } + + +toQuery : (Op -> a -> Query) -> Model a -> Maybe Query +toQuery f m = + case (m.neg, m.and, Set.toList m.sel) of + (_,_,[]) -> Nothing + (n,_,[v]) -> Just (f (if n then Ne else Eq) v) + (False, False, l) -> Just <| QOr <| List.map (\v -> f Eq v) l + (True , False, l) -> Just <| QAnd <| List.map (\v -> f Ne v) l + (False, True , l) -> Just <| QAnd <| List.map (\v -> f Eq v) l + (True , True , l) -> Just <| QOr <| List.map (\v -> f Ne v) l + + +-- Only recognizes queries generated by setToQuery, doesn't handle alternative query structures. +-- Usage: +-- setFromQuery (\q -> case q of +-- QStr 2 op v -> Just (op, v) +-- _ -> Nothing) model +fromQuery : (Query -> Maybe (Op,comparable)) -> Data -> Query -> Maybe (Data, Model comparable) +fromQuery f dat q = + let single qs = f qs |> Maybe.andThen (\(op,v) -> + if op /= Ne && op /= Eq + then Nothing + else Just (dat, { sel = Set.fromList [v], and = False, neg = (op == Ne), single = True, last = Set.empty })) + lst and mm xqs = + case (mm, xqs) of + (Nothing, _) -> Nothing + (_, []) -> mm + (Just (_,m), x :: xs) -> f x |> Maybe.andThen (\(op,v) -> + if (op /= Ne && op /= Eq) || (op == Ne) /= m.neg + then Nothing + else lst and (Just (dat, {m | and = xor and (op == Ne), single = False, sel = Set.insert v m.sel})) xs) + in case q of + QAnd (x::xs) -> lst True (single x) xs + QOr (x::xs) -> lst False (single x) xs + _ -> single q + + +lblPrefix m = text <| (if m.neg then "¬" else "") ++ (if m.single || Set.size m.sel == 1 then "" else if m.and then "∀ " else "∃ ") + + +optsMode m canAnd canSingle = + if not canAnd && not canSingle then span [] [] else + a [ href "#" + , onClickD (if canAnd && canSingle then Mode else if canSingle then Single (not m.single) else And (not m.and)) + , title <| if m.single then "Single-selection mode" else if m.and then "Entry must match all selected items" else "Entry must match at least one item" + ] [ text <| "Mode:" ++ if m.single then "single" else if m.and then "all" else "any" ] + +opts m canAnd canSingle = div [ class "opts" ] + [ optsMode m canAnd canSingle + , linkRadio m.neg Neg [ text "invert" ] + ] + + + + +-- Language + +type LangField + = LangVN + | LangVNO + | LangRel + | LangProd + | LangStaff + +type alias LangModel = (LangField, Model String) + +langInit field dat = init dat |> Tuple.mapSecond (\m -> (field,m)) + +langUpdate msg (field, model) = (field, update msg model) + +langView (field, model) = + let tprefix = if field == LangVNO then "O " else "L " + label = if field == LangVNO then "Orig language" else "Language" + msg = case field of + LangVN -> "Language(s) in which the visual novel is available." + LangVNO -> "Language the visual novel has been originally written in." + LangRel -> "Language(s) in which the release is available." + LangProd -> "Primary language of the producer." + LangStaff -> "Primary language of the staff." + canAnd = case field of + LangVN -> True + LangVNO -> False + LangRel -> True + LangProd -> False + LangStaff -> False + lst = case field of + LangVN -> scriptLangs + LangVNO -> scriptLangs + LangRel -> scriptLangs + LangProd -> locLangs + LangStaff -> locLangs + in + ( case Set.toList model.sel of + [] -> small [] [ text label ] + [v] -> span [ class "nowrap" ] [ text tprefix, lblPrefix model, langIcon v, text <| Maybe.withDefault "" (lookup v GT.languages) ] + l -> span [ class "nowrap" ] <| text tprefix :: lblPrefix model :: List.intersperse (text "") (List.map langIcon l) + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text msg ] + , opts model canAnd True + ] + , ul [ style "columns" "2"] <| List.map (\(l,t) -> li [] [ linkRadio (Set.member l model.sel) (Sel l) [ langIcon l, text t ] ]) lst + ] + ) + +langFromQuery field dat qs = Maybe.map (\(d,m) -> (d,(field,m))) <| fromQuery (\q -> + case (field, q) of + (LangVNO, QStr 3 op v) -> Just (op, v) + (LangVNO, _) -> Nothing + (_, QStr 2 op v) -> Just (op, v) + _ -> Nothing) dat qs + +langToQuery (field, model) = toQuery (QStr (if field == LangVNO then 3 else 2)) model + + + +-- Platform + +platformView unk model = + let lst = if unk then ("", "Unknown") :: GT.platforms else GT.platforms + fmt p t = [ if p == "" then text "" else platformIcon p, text t ] + in + ( case Set.toList model.sel of + [] -> small [] [ text "Platform" ] + [v] -> span [ class "nowrap" ] <| lblPrefix model :: fmt v (Maybe.withDefault "" (lookup v lst)) + l -> span [ class "nowrap" ] <| lblPrefix model :: List.intersperse (text "") (List.map platformIcon l) + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text "Platforms for which the visual novel is available." ] + , opts model True True + ] + , ul [ style "columns" "2"] <| List.map (\(p,t) -> + li [classList [("separator", p == "web")]] [ linkRadio (Set.member p model.sel) (Sel p) (fmt p t) ] + ) lst + ] + ) + +platformFromQuery = fromQuery (\q -> + case q of + QStr 4 op v -> Just (op, v) + _ -> Nothing) + + + + +-- Length + +lengthView model = + ( case Set.toList model.sel of + [] -> small [] [ text "Length" ] + [v] -> span [ class "nowrap" ] [ lblPrefix model, text <| Maybe.withDefault "" (lookup v GT.vnLengths) ] + l -> span [] [ lblPrefix model, text <| "Length (" ++ String.fromInt (List.length l) ++ ")" ] + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text "Length (estimated play time)" ] + , opts model False True ] + , ul [] <| List.map (\(l,t) -> li [] [ linkRadio (Set.member l model.sel) (Sel l) [ text t ] ]) GT.vnLengths + ] + ) + +lengthFromQuery = fromQuery (\q -> + case q of + QInt 5 op v -> Just (op, v) + _ -> Nothing) + + + + +-- Development status + +devStatusView model = + ( case Set.toList model.sel of + [] -> small [] [ text "Status" ] + [v] -> span [ class "nowrap" ] [ lblPrefix model, text <| Maybe.withDefault "" (lookup v GT.devStatus) ] + l -> span [] [ lblPrefix model, text <| "Dev Status (" ++ String.fromInt (List.length l) ++ ")" ] + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text "Development status" ] + , opts model False True ] + , ul [] <| List.map (\(l,t) -> li [] [ linkRadio (Set.member l model.sel) (Sel l) [ text t ] ]) GT.devStatus + ] + ) + +devStatusFromQuery = fromQuery (\q -> + case q of + QInt 66 op v -> Just (op, v) + _ -> Nothing) + + + + +-- Character role + +roleView model = + ( case Set.toList model.sel of + [] -> small [] [ text "Role" ] + [v] -> span [ class "nowrap" ] [ lblPrefix model, text <| Maybe.withDefault "" (lookup v GT.charRoles) ] + l -> span [] [ lblPrefix model, text <| "Role (" ++ String.fromInt (List.length l) ++ ")" ] + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text "Role" ] + , opts model True True ] + , ul [] <| List.map (\(l,t) -> li [] [ linkRadio (Set.member l model.sel) (Sel l) [ text t ] ]) GT.charRoles + ] + ) + +roleFromQuery = fromQuery (\q -> + case q of + QStr 2 op v -> Just (op, v) + _ -> Nothing) + + + + +-- Blood type + +bloodView model = + ( case Set.toList model.sel of + [] -> small [] [ text "Blood type" ] + [v] -> span [ class "nowrap" ] [ lblPrefix model, text <| "Blood type " ++ Maybe.withDefault "" (lookup v GT.bloodTypes) ] + l -> span [] [ lblPrefix model, text <| "Blood type (" ++ String.fromInt (List.length l) ++ ")" ] + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text "Blood type" ] + , opts model False True ] + , ul [] <| List.map (\(l,t) -> li [] [ linkRadio (Set.member l model.sel) (Sel l) [ text t ] ]) GT.bloodTypes + ] + ) + +bloodFromQuery = fromQuery (\q -> + case q of + QStr 3 op v -> Just (op, v) + _ -> Nothing) + + + + +-- Character sex + +type alias SexModel = (Bool, Model String) + +type SexMsg = SexSpoil | SexSel (Msg String) + +sexInit spoil dat = init dat |> Tuple.mapSecond (\m -> (spoil,m)) + +sexFromQuery spoil dat qf = Maybe.map (Tuple.mapSecond (\m -> (spoil,m))) <| fromQuery (\q -> + case (spoil, q) of + (False, QStr 4 op v) -> Just (op, v) + (True, QStr 5 op v) -> Just (op, v) + _ -> Nothing) dat qf + +sexUpdate msg (spoil,model) = + case msg of + SexSpoil -> (not spoil, model) + SexSel m -> (spoil, update m model) + +sexView (spoil,model) = + ( case Set.toList model.sel of + [] -> small [] [ text "Sex" ] + [v] -> span [ class "nowrap" ] [ lblPrefix model, text <| "Sex: " ++ Maybe.withDefault "" (lookup v GT.genders) ] + l -> span [] [ lblPrefix model, text <| "Sex (" ++ String.fromInt (List.length l) ++ ")" ] + , \() -> + [ div [ class "advheader", style "width" "280px" ] + [ h3 [] [ text "Sex" ] + , div [ class "opts" ] + [ Html.map SexSel (optsMode model False True) + , a [ href "#", onClickD SexSpoil ] [ text <| if spoil then "spoilers" else "no spoilers" ] + , linkRadio model.neg (SexSel << Neg) [ text "invert" ] + ] + ] + , ul [] <| List.map (\(l,t) -> li [] [ linkRadio (Set.member l model.sel) (SexSel << Sel l) [ text t ] ]) GT.genders + ] + ) + + + + +-- Staff gender + +genderView model = + ( case Set.toList model.sel of + [] -> small [] [ text "Gender" ] + [v] -> span [ class "nowrap" ] [ lblPrefix model, text <| Maybe.withDefault "" (lookup v GT.genders) ] + l -> span [] [ lblPrefix model, text <| "Gender (" ++ String.fromInt (List.length l) ++ ")" ] + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text "Gender" ] + , opts model False True ] + , ul [] <| List.map (\(k,l) -> li [] [ if k == "b" then text "" else linkRadio (Set.member k model.sel) (Sel k) [ text l ] ]) GT.genders + ] + ) + +genderFromQuery = fromQuery (\q -> + case q of + QStr 4 op v -> Just (op, v) + _ -> Nothing) + + + + +-- Release medium + +mediumView model = + ( case Set.toList model.sel of + [] -> small [] [ text "Medium" ] + [v] -> span [ class "nowrap" ] + [ lblPrefix model + , text <| if v == "" then "Medium: Unknown" else + Maybe.withDefault "" <| List.head <| List.filterMap (\(k,l,_) -> if v == k then Just l else Nothing) GT.media + ] + l -> span [] [ lblPrefix model, text <| "Media (" ++ String.fromInt (List.length l) ++ ")" ] + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text "Medium" ] + , opts model True True ] + , ul [] <| List.map + (\(k,l,_) -> li [] [ linkRadio (Set.member k model.sel) (Sel k) [ text l ] ]) + (("", "Unknown", True) :: GT.media) + ] + ) + +mediumFromQuery = fromQuery (\q -> + case q of + QStr 11 op v -> Just (op, v) + _ -> Nothing) + + + + +-- Release voiced + +voicedView model = + ( case Set.toList model.sel of + [] -> small [] [ text "Voiced" ] + [v] -> span [ class "nowrap" ] [ lblPrefix model, text <| Maybe.withDefault "" (lookup v GT.voiced) ] + l -> span [] [ lblPrefix model, text <| "Voiced (" ++ String.fromInt (List.length l) ++ ")" ] + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text "Voiced" ] + , opts model False True ] + , ul [] <| List.map (\(k,l) -> li [] [ linkRadio (Set.member k model.sel) (Sel k) [ text l ] ]) GT.voiced + ] + ) + +voicedFromQuery = fromQuery (\q -> + case q of + QInt 12 op v -> Just (op, v) + _ -> Nothing) + + + + +-- Release animation + +animatedView story model = + let lbl = (if story then "Story" else "Ero") ++ " animation" + in + ( case Set.toList model.sel of + [] -> small [] [ text lbl ] + [v] -> span [ class "nowrap" ] [ lblPrefix model, text <| (if story then "S " else "E ") ++ Maybe.withDefault "" (lookup v GT.animated) ] + l -> span [ class "nowrap" ] [ lblPrefix model, text <| lbl ++ " (" ++ String.fromInt (List.length l) ++ ")" ] + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text lbl ] + , opts model False True ] + , ul [] <| List.map (\(k,l) -> li [] [ linkRadio (Set.member k model.sel) (Sel k) [ text l ] ]) GT.animated + ] + ) + +animatedFromQuery story = fromQuery (\q -> + case q of + QInt 13 op v -> if not story then Just (op, v) else Nothing + QInt 14 op v -> if story then Just (op, v) else Nothing + _ -> Nothing) + + + + +-- Release type + +rtypeView model = + ( case Set.toList model.sel of + [] -> small [] [ text "Type" ] + [v] -> span [ class "nowrap" ] [ lblPrefix model, text <| Maybe.withDefault "" (lookup v GT.releaseTypes) ] + l -> span [ class "nowrap" ] [ lblPrefix model, text <| "Types (" ++ String.fromInt (List.length l) ++ ")" ] + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text "Release type" ] + , opts model False True ] + , ul [] <| List.map (\(k,l) -> li [] [ linkRadio (Set.member k model.sel) (Sel k) [ text l ] ]) GT.releaseTypes + ] + ) + +rtypeFromQuery = fromQuery (\q -> + case q of + QStr 16 op v -> Just (op, v) + _ -> Nothing) + + + + +-- Labels +-- TODO: Do something with labels from other users - if only to display them correctly. + +labelView dat model = + ( case Set.toList model.sel of + [] -> small [] [ text "Labels" ] + [v] -> span [ class "nowrap" ] [ lblPrefix model, text <| Maybe.withDefault "" (lookup v dat.labels) ] + l -> span [ class "nowrap" ] [ lblPrefix model, text <| "Labels (" ++ String.fromInt (List.length l) ++ ")" ] + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text "VN labels" ] + , opts model True True ] + , ul [] <| List.map (\(k,l) -> li [] [ linkRadio (Set.member k model.sel) (Sel k) [ text l ] ]) dat.labels + ] + ) + +labelFromQuery dat q = + fromQuery (\qs -> + case qs of + QTuple 12 op uid l -> if Just (vndbid 'u' uid) == dat.uid then Just (op, l) else Nothing + _ -> Nothing) dat q + + + + +-- Staff role + +sroleView model = + let lst = ("seiyuu","Voice actor") :: GT.creditTypes + in + ( case Set.toList model.sel of + [] -> small [] [ text "Role" ] + [v] -> span [ class "nowrap" ] [ lblPrefix model, text <| Maybe.withDefault "" <| lookup v lst ] + l -> span [ class "nowrap" ] [ lblPrefix model, text <| "Roles (" ++ String.fromInt (List.length l) ++ ")" ] + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text "Role" ] + , opts model True True ] + , ul [] <| List.map (\(k,l) -> li [] [ linkRadio (Set.member k model.sel) (Sel k) [ text l ] ]) lst + ] + ) + +sroleFromQuery = fromQuery (\q -> + case q of + QStr 5 op v -> Just (op, v) + _ -> Nothing) + + + + +-- Release list status + +rlistView model = + ( case Set.toList model.sel of + [] -> small [] [ text "List status" ] + [v] -> span [ class "nowrap" ] [ lblPrefix model, text <| Maybe.withDefault "" <| lookup v GT.rlistStatus ] + l -> span [ class "nowrap" ] [ lblPrefix model, text <| "List (" ++ String.fromInt (List.length l) ++ ")" ] + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text "List status" ] + , opts model False True ] + , ul [] <| List.map (\(k,l) -> li [] [ linkRadio (Set.member k model.sel) (Sel k) [ text l ] ]) GT.rlistStatus + ] + ) + +rlistFromQuery = fromQuery (\q -> + case q of + QInt 18 op v -> Just (op, v) + _ -> Nothing) + + + + +-- Producer type + +ptypeView model = + ( case Set.toList model.sel of + [] -> small [] [ text "Type" ] + [v] -> span [ class "nowrap" ] [ lblPrefix model, text <| Maybe.withDefault "" (lookup v GT.producerTypes) ] + l -> span [ class "nowrap" ] [ lblPrefix model, text <| "Types (" ++ String.fromInt (List.length l) ++ ")" ] + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text "Producer type" ] + , opts model False True ] + , ul [] <| List.map (\(k,l) -> li [] [ linkRadio (Set.member k model.sel) (Sel k) [ text l ] ]) GT.producerTypes + ] + ) + +ptypeFromQuery = fromQuery (\q -> + case q of + QStr 4 op v -> Just (op, v) + _ -> Nothing) + + + + +-- Extlinks (releases only, for now) + +extlinkView links model = + let lst = List.map (\l -> (l.advid, l.name)) links + in + ( case Set.toList model.sel of + [] -> small [] [ text "External links" ] + [v] -> span [ class "nowrap" ] [ lblPrefix model, text <| Maybe.withDefault "" (lookup v lst) ] + l -> span [ class "nowrap" ] [ lblPrefix model, text <| "Links (" ++ String.fromInt (List.length l) ++ ")" ] + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text "External links" ] + , opts model True True ] + , ul [ style "columns" "2" ] <| List.map (\(k,l) -> li [] [ linkRadio (Set.member k model.sel) (Sel k) [ text l ] ]) lst + ] + ) + +extlinkFromQuery num = fromQuery (\q -> + case q of + QStr n op v -> if n == num then Just (op, v) else Nothing + _ -> Nothing) diff --git a/elm/AdvSearch/Staff.elm b/elm/AdvSearch/Staff.elm new file mode 100644 index 00000000..7365419e --- /dev/null +++ b/elm/AdvSearch/Staff.elm @@ -0,0 +1,94 @@ +module AdvSearch.Staff exposing (..) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Set +import Dict +import Lib.Autocomplete as A +import Lib.Html exposing (..) +import Lib.Util exposing (..) +import Gen.Api as GApi +import AdvSearch.Lib exposing (..) +import AdvSearch.Set as S + + + +type alias Model = + { sel : S.Model Int + , conf : A.Config Msg GApi.ApiStaffResult + , search : A.Model GApi.ApiStaffResult + } + +type Msg + = Sel (S.Msg Int) + | Search (A.Msg GApi.ApiStaffResult) + + +init : Data -> (Data, Model) +init dat = + let (ndat, sel) = S.init dat + in ( { ndat | objid = ndat.objid + 1 } + , { sel = { sel | single = False } + , conf = { wrap = Search, id = "xsearch_staff" ++ String.fromInt ndat.objid, source = A.staffSource } + , search = A.init "" + } + ) + + +update : Data -> Msg -> Model -> (Data, Model, Cmd Msg) +update dat msg model = + case msg of + Sel m -> (dat, { model | sel = S.update m model.sel }, Cmd.none) + Search m -> + let (nm, c, res) = A.update model.conf m model.search + in case res of + Nothing -> (dat, { model | search = nm }, c) + Just s -> + if Set.member (vndbidNum s.id) model.sel.sel then (dat, { model | search = nm }, c) + else ( { dat | staff = Dict.insert s.id s dat.staff } + , { model | search = A.clear nm "", sel = S.update (S.Sel (vndbidNum s.id) True) model.sel } + , c ) + + +toQuery m = S.toQuery (QInt 3) m.sel + +fromQuery dat qf = S.fromQuery (\q -> + case q of + QInt 3 op v -> Just (op, v) + _ -> Nothing) dat qf + |> Maybe.map (\(ndat,sel) -> + ( { ndat | objid = ndat.objid+1 } + , { sel = { sel | single = False } + , conf = { wrap = Search, id = "xsearch_staff" ++ String.fromInt ndat.objid, source = A.staffSource } + , search = A.init "" + } + )) + + + +view : Data -> Model -> (Html Msg, () -> List (Html Msg)) +view dat model = + ( case Set.toList model.sel.sel of + [] -> small [] [ text "Name" ] + [s] -> span [ class "nowrap" ] + [ S.lblPrefix model.sel + , small [] [ text <| "s" ++ String.fromInt s ++ ":" ] + , Dict.get (vndbid 's' s) dat.staff |> Maybe.map (\e -> e.title) |> Maybe.withDefault "" |> text + ] + l -> span [] [ S.lblPrefix model.sel, text <| "Names (" ++ String.fromInt (List.length l) ++ ")" ] + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text "Staff identifier" ] + , Html.map Sel (S.opts model.sel False True) + ] + , ul [] <| List.map (\s -> + li [ style "overflow" "hidden", style "text-overflow" "ellipsis" ] + [ inputButton "X" (Sel (S.Sel s False)) [] + , small [] [ text <| " s" ++ String.fromInt s ++ ": " ] + , Dict.get (vndbid 's' s) dat.staff |> Maybe.map (\e -> a [ href ("/" ++ e.id), target "_blank", style "display" "inline" ] [ text e.title ]) |> Maybe.withDefault (text "") + ] + ) (Set.toList model.sel.sel) + , A.view model.conf model.search [ placeholder "Search..." ] + , small [] [ text "All aliases of the selected staff entries are searched, not just the names you specified." ] + ] + ) diff --git a/elm/AdvSearch/Tags.elm b/elm/AdvSearch/Tags.elm new file mode 100644 index 00000000..001890ee --- /dev/null +++ b/elm/AdvSearch/Tags.elm @@ -0,0 +1,127 @@ +module AdvSearch.Tags exposing (..) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Set +import Dict +import Lib.Autocomplete as A +import Lib.Html exposing (..) +import Lib.Util exposing (..) +import Gen.Api as GApi +import AdvSearch.Lib exposing (..) +import AdvSearch.Set as S + + + +type alias Model = + { sel : S.Model (Int,Int) -- Tag, Level + , conf : A.Config Msg GApi.ApiTagResult + , search : A.Model GApi.ApiTagResult + , spoiler : Int + , inherit : Bool + , exclie : Bool + } + +type Msg + = Sel (S.Msg (Int,Int)) + | Level (Int,Int) Int + | Spoiler + | Inherit Bool + | ExcLie Bool + | Search (A.Msg GApi.ApiTagResult) + + +init : Data -> (Data, Model) +init dat = + let (ndat, sel) = S.init dat + in ( { ndat | objid = ndat.objid + 1 } + , { sel = { sel | single = False, and = True } + , conf = { wrap = Search, id = "xsearch_tag" ++ String.fromInt ndat.objid, source = A.tagSource } + , search = A.init "" + , spoiler = dat.defaultSpoil + , inherit = True + , exclie = False + } + ) + + +update : Data -> Msg -> Model -> (Data, Model, Cmd Msg) +update dat msg model = + case msg of + Sel m -> (dat, { model | sel = S.update m model.sel }, Cmd.none) + Level (t,ol) nl -> (dat, { model | sel = S.update (S.Sel (t,ol) False) model.sel |> S.update (S.Sel (t,nl) True) }, Cmd.none) + Spoiler -> (dat, { model | spoiler = if model.spoiler < 2 then model.spoiler + 1 else 0, exclie = False }, Cmd.none) + Inherit b -> (dat, { model | inherit = b }, Cmd.none) + ExcLie b -> (dat, { model | exclie = b }, Cmd.none) + Search m -> + let (nm, c, res) = A.update model.conf m model.search + in case res of + Nothing -> (dat, { model | search = nm }, c) + Just t -> + ( { dat | tags = Dict.insert t.id t dat.tags } + , { model | search = A.clear nm "", sel = S.update (S.Sel (vndbidNum t.id,0) True) model.sel } + , c ) + + +toQuery m = S.toQuery (\o (t,l) -> + let id = if m.inherit then 8 else 14 + in if m.spoiler == 0 && not m.exclie && l == 0 then QInt id o t else QTuple id o t ((if m.exclie then 16*3 else 0) + l*3 + m.spoiler)) m.sel + +fromQuery spoil inherit exclie dat q = + let id = if inherit then 8 else 14 + f qr = case qr of + QInt x op t -> if id == x && spoil == 0 && not exclie then Just (op, (t,0)) else Nothing + QTuple x op t v -> if id == x && modBy 3 v == spoil && exclie == ((v // (16*3)) == 1) then Just (op, (t, modBy 16 (v//3))) else Nothing + _ -> Nothing + in + S.fromQuery f dat q |> Maybe.map (\(ndat,sel) -> + ( { ndat | objid = ndat.objid+1 } + , { sel = { sel | single = False, and = sel.and || Set.size sel.sel == 1 } + , conf = { wrap = Search, id = "xsearch_tag" ++ String.fromInt ndat.objid, source = A.tagSource } + , search = A.init "" + , spoiler = spoil + , inherit = inherit + , exclie = exclie + } + )) + + +view : Data -> Model -> (Html Msg, () -> List (Html Msg)) +view dat model = + ( case Set.toList model.sel.sel of + [] -> small [] [ text "Tags" ] + [(s,_)] -> span [ class "nowrap" ] + [ S.lblPrefix model.sel + , small [] [ text <| "g" ++ String.fromInt s ++ ":" ] + , Dict.get (vndbid 'g' s) dat.tags |> Maybe.map (\t -> t.name) |> Maybe.withDefault "" |> text + ] + l -> span [] [ S.lblPrefix model.sel, text <| "Tags (" ++ String.fromInt (List.length l) ++ ")" ] + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text "Tags" ] + , div [ class "opts" ] + [ Html.map Sel (S.optsMode model.sel True False) + , a [ href "#", onClickD Spoiler ] + [ text <| if model.spoiler == 0 then "no spoilers" else if model.spoiler == 1 then "minor spoilers" else "major spoilers" ] + , linkRadio model.sel.neg (Sel << S.Neg) [ text "invert" ] + ] + , div [ class "opts" ] + [ if model.spoiler < 2 then span [] [] else + linkRadio model.exclie ExcLie [ text "exclude lies" ] + , linkRadio model.inherit Inherit [ text "child tags" ] + ] + ] + , ul [] <| List.map (\(t,l) -> + li [ style "overflow" "hidden", style "text-overflow" "ellipsis" ] + [ inputButton "X" (Sel (S.Sel (t,l) False)) [] + , inputSelect "" l (Level (t,l)) [style "width" "60px"] <| + (0, "any") + :: List.map (\i -> (i, String.fromInt (i//5) ++ "." ++ String.fromInt (2*(modBy 5 i)) ++ "+")) (List.range 1 14) + ++ [(15, "3.0")] + , small [] [ text <| " g" ++ String.fromInt t ++ ": " ] + , Dict.get (vndbid 'g' t) dat.tags |> Maybe.map (\e -> a [ href ("/" ++ e.id), target "_blank", style "display" "inline" ] [ text e.name ]) |> Maybe.withDefault (text "") + ] + ) (Set.toList model.sel.sel) + , A.view model.conf model.search [ placeholder "Search..." ] + ] + ) diff --git a/elm/AdvSearch/Traits.elm b/elm/AdvSearch/Traits.elm new file mode 100644 index 00000000..db9b5f84 --- /dev/null +++ b/elm/AdvSearch/Traits.elm @@ -0,0 +1,123 @@ +module AdvSearch.Traits exposing (..) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Set +import Dict +import Lib.Autocomplete as A +import Lib.Html exposing (..) +import Lib.Util exposing (..) +import Gen.Api as GApi +import AdvSearch.Lib exposing (..) +import AdvSearch.Set as S + + + +type alias Model = + { sel : S.Model Int + , conf : A.Config Msg GApi.ApiTraitResult + , search : A.Model GApi.ApiTraitResult + , spoiler : Int + , inherit : Bool + , exclie : Bool + } + +type Msg + = Sel (S.Msg Int) + | Spoiler + | Inherit Bool + | ExcLie Bool + | Search (A.Msg GApi.ApiTraitResult) + + +init : Data -> (Data, Model) +init dat = + let (ndat, sel) = S.init dat + in ( { ndat | objid = ndat.objid + 1 } + , { sel = { sel | single = False, and = True } + , conf = { wrap = Search, id = "xsearch_trait" ++ String.fromInt ndat.objid, source = A.traitSource } + , search = A.init "" + , spoiler = dat.defaultSpoil + , inherit = True + , exclie = False + } + ) + + +update : Data -> Msg -> Model -> (Data, Model, Cmd Msg) +update dat msg model = + case msg of + Sel m -> (dat, { model | sel = S.update m model.sel }, Cmd.none) + Spoiler -> (dat, { model | spoiler = if model.spoiler < 2 then model.spoiler + 1 else 0, exclie = False }, Cmd.none) + Inherit b -> (dat, { model | inherit = b }, Cmd.none) + ExcLie b -> (dat, { model | exclie = b }, Cmd.none) + Search m -> + let (nm, c, res) = A.update model.conf m model.search + in case res of + Nothing -> (dat, { model | search = nm }, c) + Just t -> + ( { dat | traits = Dict.insert t.id t dat.traits } + , { model | search = A.clear nm "", sel = S.update (S.Sel (vndbidNum t.id) True) model.sel } + , c ) + + +toQuery m = S.toQuery (\o t -> + let id = if m.inherit then 13 else 15 + in if m.spoiler == 0 && not m.exclie then QInt id o t else QTuple id o t ((if m.exclie then 3 else 0) + m.spoiler)) m.sel + +fromQuery spoil inherit exclie dat q = + let id = if inherit then 13 else 15 + f qr = case qr of + QInt x op t -> if id == x && spoil == 0 then Just (op, t) else Nothing + QTuple x op t v -> if id == x && modBy 3 v == spoil && exclie == ((v // 3) == 1) then Just (op, t) else Nothing + _ -> Nothing + in + S.fromQuery f dat q |> Maybe.map (\(ndat,sel) -> + ( { ndat | objid = ndat.objid+1 } + , { sel = { sel | single = False, and = sel.and || Set.size sel.sel == 1 } + , conf = { wrap = Search, id = "xsearch_trait" ++ String.fromInt ndat.objid, source = A.traitSource } + , search = A.init "" + , spoiler = spoil + , inherit = inherit + , exclie = exclie + } + )) + + +view : Data -> Model -> (Html Msg, () -> List (Html Msg)) +view dat model = + ( case Set.toList model.sel.sel of + [] -> small [] [ text "Traits" ] + [s] -> span [ class "nowrap" ] + [ S.lblPrefix model.sel + , small [] [ text <| "i" ++ String.fromInt s ++ ":" ] + , Dict.get (vndbid 'i' s) dat.traits |> Maybe.map (\t -> t.name) |> Maybe.withDefault "" |> text + ] + l -> span [] [ S.lblPrefix model.sel, text <| "Traits (" ++ String.fromInt (List.length l) ++ ")" ] + , \() -> + [ div [ class "advheader" ] + [ h3 [] [ text "Traits" ] + , div [ class "opts" ] + [ Html.map Sel (S.optsMode model.sel True False) + , a [ href "#", onClickD Spoiler ] + [ text <| if model.spoiler == 0 then "no spoilers" else if model.spoiler == 1 then "minor spoilers" else "major spoilers" ] + , linkRadio model.sel.neg (Sel << S.Neg) [ text "invert" ] + ] + , div [ class "opts" ] + [ if model.spoiler < 2 then span [] [] else + linkRadio model.exclie ExcLie [ text "exclude lies" ] + , linkRadio model.inherit Inherit [ text "child traits" ] + ] + ] + , ul [] <| List.map (\t -> + li [ style "overflow" "hidden", style "text-overflow" "ellipsis" ] + [ inputButton "X" (Sel (S.Sel t False)) [] + , small [] [ text <| " i" ++ String.fromInt t ++ ": " ] + , Dict.get (vndbid 'i' t) dat.traits |> Maybe.map (\e -> span [] + [ Maybe.withDefault (text "") <| Maybe.map (\g -> small [] [ text (g ++ " / ") ]) e.group_name + , a [ href ("/" ++ e.id), target "_blank", style "display" "inline" ] [ text e.name ] ]) |> Maybe.withDefault (text "") + ] + ) (Set.toList model.sel.sel) + , A.view model.conf model.search [ placeholder "Search..." ] + ] + ) diff --git a/elm/CharEdit.elm b/elm/CharEdit.elm index 0f75a357..e8b8d420 100644 --- a/elm/CharEdit.elm +++ b/elm/CharEdit.elm @@ -8,8 +8,11 @@ import Browser import Browser.Navigation exposing (load) import Dict import Set +import Task +import Process import File exposing (File) import File.Select as FSel +import Lib.Ffi as Ffi import Lib.Util exposing (..) import Lib.Html exposing (..) import Lib.TextPreview as TP @@ -17,6 +20,7 @@ import Lib.Autocomplete as A import Lib.Api as Api import Lib.Editsum as Editsum import Lib.RDate as RDate +import Lib.Image as Img import Gen.Release as GR import Gen.CharEdit as GCE import Gen.Types as GT @@ -39,14 +43,17 @@ type Tab | VNs | All +type SelOpt = Spoil Int | Lie + type alias Model = { state : Api.State , tab : Tab + , invalidDis : Bool , editsum : Editsum.Model , name : String - , original : String + , latin : Maybe String , alias : String - , desc : TP.Model + , description : TP.Model , gender : String , spoilGender : Maybe String , bMonth : Int @@ -59,25 +66,20 @@ type alias Model = , weight : Maybe Int , bloodt : String , cupSize : String - , main : Maybe Int + , main : Maybe String , mainRef : Bool , mainHas : Bool , mainName : String , mainSearch : A.Model GApi.ApiCharResult , mainSpoil : Int - , image : Maybe String - , imageState : Api.State - , imageNew : Set.Set String - , imageSex : Maybe Int - , imageVio : Maybe Int + , image : Img.Image , traits : List GCE.RecvTraits , traitSearch : A.Model GApi.ApiTraitResult - , traitSelId : Int - , traitSelSpl : Int + , traitSel : (String, SelOpt) , vns : List GCE.RecvVns , vnSearch : A.Model GApi.ApiVNResult - , releases : Dict.Dict Int (List GCE.RecvReleasesRels) -- vid -> list of releases - , id : Maybe Int + , releases : Dict.Dict String (List GCE.RecvReleasesRels) -- vid -> list of releases + , id : Maybe String } @@ -85,11 +87,12 @@ init : GCE.Recv -> Model init d = { state = Api.Normal , tab = General - , editsum = { authmod = d.authmod, editsum = TP.bbcode d.editsum, locked = d.locked, hidden = d.hidden } + , invalidDis = False + , editsum = { authmod = d.authmod, editsum = TP.bbcode d.editsum, locked = d.locked, hidden = d.hidden, hasawait = False } , name = d.name - , original = d.original + , latin = d.latin , alias = d.alias - , desc = TP.bbcode d.desc + , description = TP.bbcode d.description , gender = d.gender , spoilGender = d.spoil_gender , bMonth = d.b_month @@ -108,15 +111,10 @@ init d = , mainName = d.main_name , mainSearch = A.init "" , mainSpoil = d.main_spoil - , image = d.image - , imageState = Api.Normal - , imageNew = Set.empty - , imageSex = d.image_sex - , imageVio = d.image_vio + , image = Img.info d.image_info , traits = d.traits , traitSearch = A.init "" - , traitSelId = 0 - , traitSelSpl = 0 + , traitSel = ("", Spoil 0) , vns = d.vns , vnSearch = A.init "" , releases = Dict.fromList <| List.map (\v -> (v.id, v.rels)) d.releases @@ -131,9 +129,9 @@ encode model = , hidden = model.editsum.hidden , locked = model.editsum.locked , name = model.name - , original = model.original + , latin = model.latin , alias = model.alias - , desc = model.desc.data + , description = model.description.data , gender = model.gender , spoil_gender= model.spoilGender , b_month = model.bMonth @@ -148,10 +146,8 @@ encode model = , cup_size = model.cupSize , main = if model.mainHas then model.main else Nothing , main_spoil = model.mainSpoil - , image = model.image - , image_sex = model.imageSex - , image_vio = model.imageVio - , traits = List.map (\t -> { tid = t.tid, spoil = t.spoil }) model.traits + , image = model.image.id + , traits = List.map (\t -> { tid = t.tid, spoil = t.spoil, lie = t.lie }) model.traits , vns = List.map (\v -> { vid = v.vid, rid = v.rid, spoil = v.spoil, role = v.role }) model.vns } @@ -167,10 +163,12 @@ vnConfig = { wrap = VnSearch, id = "vnadd", source = A.vnSource } type Msg = Editsum Editsum.Msg | Tab Tab + | Invalid Tab + | InvalidEnable | Submit | Submitted GApi.Response | Name String - | Original String + | Latin String | Alias String | Desc TP.Msg | Gender String @@ -188,23 +186,22 @@ type Msg | MainHas Bool | MainSearch (A.Msg GApi.ApiCharResult) | MainSpoil Int - | ImageSet String + | ImageSet String Bool | ImageSelect | ImageSelected File - | ImageLoaded GApi.Response - | ImageSex Int Bool - | ImageVio Int Bool + | ImageMsg Img.Msg | TraitDel Int - | TraitSel Int Int + | TraitSel String SelOpt | TraitSpoil Int Int + | TraitLie Int Bool | TraitSearch (A.Msg GApi.ApiTraitResult) - | VnRel Int (Maybe Int) + | VnRel Int (Maybe String) | VnRole Int String | VnSpoil Int Int | VnDel Int - | VnRelAdd Int String + | VnRelAdd String String | VnSearch (A.Msg GApi.ApiVNResult) - | VnRelGet Int GApi.Response + | VnRelGet String GApi.Response update : Msg -> Model -> (Model, Cmd Msg) @@ -212,10 +209,13 @@ update msg model = case msg of Editsum m -> let (nm,nc) = Editsum.update m model.editsum in ({ model | editsum = nm }, Cmd.map Editsum nc) Tab t -> ({ model | tab = t }, Cmd.none) + Invalid t -> if model.invalidDis || model.tab == All || model.tab == t then (model, Cmd.none) else + ({ model | tab = t, invalidDis = True }, Task.attempt (always InvalidEnable) (Ffi.elemCall "reportValidity" "mainform" |> Task.andThen (\_ -> Process.sleep 100))) + InvalidEnable -> ({ model | invalidDis = False }, Cmd.none) Name s -> ({ model | name = s }, Cmd.none) - Original s -> ({ model | original = s }, Cmd.none) + Latin s -> ({ model | latin = if s == "" then Nothing else Just s }, Cmd.none) Alias s -> ({ model | alias = s }, Cmd.none) - Desc m -> let (nm,nc) = TP.update m model.desc in ({ model | desc = nm }, Cmd.map Desc nc) + Desc m -> let (nm,nc) = TP.update m model.description in ({ model | description = nm }, Cmd.map Desc nc) Gender s -> ({ model | gender = s }, Cmd.none) SpoilGender s->({model | spoilGender = s }, Cmd.none) BMonth n -> ({ model | bMonth = n }, Cmd.none) @@ -236,29 +236,31 @@ update msg model = Nothing -> ({ model | mainSearch = nm }, c) Just m1 -> case m1.main of - Just m2 -> ({ model | mainSearch = A.clear nm "", main = Just m2.id, mainName = m2.name }, c) - Nothing -> ({ model | mainSearch = A.clear nm "", main = Just m1.id, mainName = m1.name }, c) + Just m2 -> ({ model | mainSearch = A.clear nm "", main = Just m2.id, mainName = m2.title }, c) + Nothing -> ({ model | mainSearch = A.clear nm "", main = Just m1.id, mainName = m1.title }, c) MainSpoil n -> ({ model | mainSpoil = n }, Cmd.none) - ImageSet s -> ({ model | image = if s == "" then Nothing else Just s}, Cmd.none) - ImageSelect -> (model, FSel.file ["image/png", "image/jpg"] ImageSelected) - ImageSelected f -> ({ model | imageState = Api.Loading }, Api.postImage Api.Ch f ImageLoaded) - ImageLoaded (GApi.Image i _ _) -> ({ model | image = Just i, imageNew = Set.insert i model.imageNew, imageState = Api.Normal }, Cmd.none) - ImageLoaded e -> ({ model | imageState = Api.Error e }, Cmd.none) - ImageSex i _ -> ({ model | imageSex = Just i }, Cmd.none) - ImageVio i _ -> ({ model | imageVio = Just i }, Cmd.none) + ImageSet s b -> let (nm, nc) = Img.new b s in ({ model | image = nm }, Cmd.map ImageMsg nc) + ImageSelect -> (model, FSel.file ["image/png", "image/jpeg", "image/webp", "image/avif", "image/jxl"] ImageSelected) + ImageSelected f -> let (nm, nc) = Img.upload Api.Ch f in ({ model | image = nm }, Cmd.map ImageMsg nc) + ImageMsg m -> let (nm, nc) = Img.update m model.image in ({ model | image = nm }, Cmd.map ImageMsg nc) TraitDel idx -> ({ model | traits = delidx idx model.traits }, Cmd.none) - TraitSel id spl -> ({ model | traitSelId = id, traitSelSpl = spl }, Cmd.none) + TraitSel id opt -> ({ model | traitSel = (id, opt) }, Cmd.none) TraitSpoil idx spl -> ({ model | traits = modidx idx (\t -> { t | spoil = spl }) model.traits }, Cmd.none) + TraitLie idx v -> ({ model | traits = modidx idx (\t -> { t | lie = v }) model.traits }, Cmd.none) TraitSearch m -> let (nm, c, res) = A.update traitConfig m model.traitSearch in case res of Nothing -> ({ model | traitSearch = nm }, c) Just t -> - if not t.applicable || t.state /= 2 || List.any (\l -> l.tid == t.id) model.traits - then ({ model | traitSearch = A.clear nm "" }, c) - else ({ model | traitSearch = A.clear nm "", traits = model.traits ++ [{ tid = t.id, spoil = t.defaultspoil, name = t.name, group = t.group_name, applicable = t.applicable, new = True }] }, Cmd.none) + let n = { tid = t.id, spoil = t.defaultspoil, lie = False, new = True + , name = t.name, group = t.group_name + , hidden = t.hidden, locked = t.locked, applicable = t.applicable } + in + if not t.applicable || t.hidden || List.any (\l -> l.tid == t.id) model.traits + then ({ model | traitSearch = A.clear nm "" }, c) + else ({ model | traitSearch = A.clear nm "", traits = model.traits ++ [n] }, c) VnRel idx r -> ({ model | vns = modidx idx (\v -> { v | rid = r }) model.vns }, Cmd.none) VnRole idx s -> ({ model | vns = modidx idx (\v -> { v | role = s }) model.vns }, Cmd.none) @@ -275,7 +277,7 @@ update msg model = if List.any (\v -> v.vid == vn.id) model.vns then ({ model | vnSearch = A.clear nm "" }, c) else ({ model | vnSearch = A.clear nm "", vns = model.vns ++ [{ vid = vn.id, title = vn.title, rid = Nothing, spoil = 0, role = "primary" }] } - , if Dict.member vn.id model.releases then Cmd.none else GR.send { vid = vn.id } (VnRelGet vn.id)) + , Cmd.batch [c, if Dict.member vn.id model.releases then Cmd.none else GR.send { vid = vn.id } (VnRelGet vn.id)]) VnRelGet vid (GApi.Releases r) -> ({ model | releases = Dict.insert vid r model.releases }, Cmd.none) VnRelGet _ r -> ({ model | state = Api.Error r }, Cmd.none) -- XXX @@ -286,8 +288,10 @@ update msg model = isValid : Model -> Bool isValid model = not - ( (model.name /= "" && model.name == model.original) - || hasDuplicates (List.map (\v -> (v.vid, Maybe.withDefault 0 v.rid)) model.vns) + ( (model.name /= "" && Just model.name == model.latin) + || hasDuplicates (List.map (\v -> (v.vid, Maybe.withDefault "" v.rid)) model.vns) + || not (Img.isValid model.image) + || (model.mainHas && model.main /= Nothing && model.main == model.id) ) @@ -302,39 +306,28 @@ view : Model -> Html Msg view model = let geninfo = - [ formField "name::Name (romaji)" [ inputText "name" model.name Name GCE.valName ] - , formField "original::Original name" - [ inputText "original" model.original Original GCE.valOriginal - , if model.name /= "" && model.name == model.original - then b [ class "standout" ] [ br [] [], text "Should not be the same as the Name (romaji). Leave blank is the original name is already in the latin alphabet" ] - else text "" + [ formField "name::Name (original)" [ inputText "name" model.name Name (onInvalid (Invalid General) :: GCE.valName) ] + , if not (model.latin /= Nothing || containsNonLatin model.name) then text "" else + formField "latin::Name (latin)" + [ inputText "latin" (Maybe.withDefault "" model.latin) Latin (onInvalid (Invalid General) :: required True :: placeholder "Romanization" :: GCE.valLatin) + , case model.latin of + Just s -> if containsNonLatin s + then b [] [ br [] [], text "Romanization should only consist of characters in the latin alphabet." ] else text "" + Nothing -> text "" ] , formField "alias::Aliases" - [ inputTextArea "alias" model.alias Alias (rows 3 :: GCE.valAlias) + [ inputTextArea "alias" model.alias Alias (rows 3 :: onInvalid (Invalid General) :: GCE.valAlias) , br [] [] , text "(Un)official aliases, separated by a newline. Must not include spoilers!" ] - , formField "desc::Description" [ TP.view "desc" model.desc Desc 600 (style "height" "150px" :: GCE.valDesc) [ b [ class "standout" ] [ text "English please!" ] ] ] + , formField "desc::Description" [ TP.view "desc" model.description Desc 600 (style "height" "150px" :: onInvalid (Invalid General) :: GCE.valDescription) + [ b [] [ text "English please!" ] ] ] , formField "bmonth::Birthday" - [ inputSelect "bmonth" model.bMonth BMonth [style "width" "128px"] - [ ( 0, "Unknown") - , ( 1, "January") - , ( 2, "February") - , ( 3, "March") - , ( 4, "April") - , ( 5, "May") - , ( 6, "June") - , ( 7, "July") - , ( 8, "August") - , ( 9, "September") - , (10, "October") - , (11, "November") - , (12, "December") - ] + [ inputSelect "bmonth" model.bMonth BMonth [style "width" "128px"] <| (0, "Unknown") :: RDate.monthSelect , if model.bMonth == 0 then text "" else inputSelect "" model.bDay BDay [style "width" "70px"] <| List.map (\i -> (i, String.fromInt i)) <| List.range 1 31 ] - , formField "age::Age" [ inputNumber "age" model.age Age GCE.valAge, text " years" ] + , formField "age::Age" [ inputNumber "age" model.age Age (onInvalid (Invalid General) :: GCE.valAge), text " years" ] , tr [ class "newpart" ] [ td [ colspan 2 ] [ text "Body" ] ] , formField "gender::Sex" @@ -351,13 +344,13 @@ view model = , inputSelect "" gen (\s -> SpoilGender (Just s)) [] GT.genders ] ] - , formField "sbust::Bust" [ inputNumber "sbust" (if model.sBust == 0 then Nothing else Just model.sBust ) SBust GCE.valS_Bust, text " cm" ] - , formField "swaist::Waist" [ inputNumber "swiast" (if model.sWaist == 0 then Nothing else Just model.sWaist) SWaist GCE.valS_Waist,text " cm" ] - , formField "ship::Hips" [ inputNumber "ship" (if model.sHip == 0 then Nothing else Just model.sHip ) SHip GCE.valS_Hip, text " cm" ] - , formField "height::Height" [ inputNumber "height" (if model.height == 0 then Nothing else Just model.height) Height GCE.valHeight, text " cm" ] - , formField "weight::Weight" [ inputNumber "weight" model.weight Weight GCE.valWeight, text " kg" ] - , formField "bloodt::Blood type" [ inputSelect "bloodt" model.bloodt BloodT [] GT.bloodTypes ] - , formField "cupsize::Cup size" [ inputSelect "cupsize" model.cupSize CupSize [] GT.cupSizes ] + , formField "sbust::Bust" [ inputNumber "sbust" (if model.sBust == 0 then Nothing else Just model.sBust ) SBust (onInvalid (Invalid General) :: GCE.valS_Bust), text " cm" ] + , formField "swaist::Waist" [ inputNumber "swiast" (if model.sWaist == 0 then Nothing else Just model.sWaist) SWaist (onInvalid (Invalid General) :: GCE.valS_Waist),text " cm" ] + , formField "ship::Hips" [ inputNumber "ship" (if model.sHip == 0 then Nothing else Just model.sHip ) SHip (onInvalid (Invalid General) :: GCE.valS_Hip), text " cm" ] + , formField "height::Height" [ inputNumber "height" (if model.height == 0 then Nothing else Just model.height) Height (onInvalid (Invalid General) :: GCE.valHeight), text " cm" ] + , formField "weight::Weight" [ inputNumber "weight" model.weight Weight (onInvalid (Invalid General) :: GCE.valWeight), text " kg" ] + , formField "bloodt::Blood type" [ inputSelect "bloodt" model.bloodt BloodT [onInvalid (Invalid General)] GT.bloodTypes ] + , formField "cupsize::Cup size" [ inputSelect "cupsize" model.cupSize CupSize [onInvalid (Invalid General)] GT.cupSizes ] , tr [ class "newpart" ] [ td [ colspan 2 ] [ text "Instance" ] ] ] ++ if model.mainRef @@ -370,8 +363,9 @@ view model = , br_ 2 , Maybe.withDefault (text "No character selected") <| Maybe.map (\m -> span [] [ text "Selected character: " - , b [ class "grayedout" ] [ text <| "c" ++ String.fromInt m ++ ": " ] - , a [ href <| "/c" ++ String.fromInt m ] [ text model.mainName ] + , small [] [ text <| m ++ ": " ] + , a [ href <| "/" ++ m ] [ text model.mainName ] + , if Just m == model.id then b [] [ br [] [], text "A character can't be an instance of itself. Please select another character or disable the above checkbox to remove the instance." ] else text "" ]) model.main , br [] [] , A.view mainConfig model.mainSearch [placeholder "Set character..."] @@ -379,69 +373,63 @@ view model = ] image = - div [ class "formimage" ] - [ div [] [ - case model.image of - Nothing -> text "No image." - Just id -> img [ src (imageUrl id) ] [] - ] - , div [] + table [ class "formimage" ] [ tr [] + [ td [] [ Img.viewImg model.image ] + , td [] [ h2 [] [ text "Image ID" ] - , inputText "" (Maybe.withDefault "" model.image) ImageSet GCE.valImage - , Maybe.withDefault (text "") <| Maybe.map (\i -> a [ href <| "/img/"++i ] [ text " (flagging)" ]) model.image + , input ([ type_ "text", class "text", tabindex 10, value (Maybe.withDefault "" model.image.id), onInvalid (Invalid Image), onInputValidation ImageSet ] ++ GCE.valImage) [] , br [] [] , text "Use an image that already exists on the server or empty to remove the current image." , br_ 2 , h2 [] [ text "Upload new image" ] , inputButton "Browse image" ImageSelect [] - , case model.imageState of - Api.Normal -> text "" - Api.Loading -> span [ class "spinner" ] [] - Api.Error e -> b [ class "standout" ] [ text <| Api.showResponse e ] , br [] [] - , text "Image must be in JPEG or PNG format and at most 10 MiB. Images larger than 256x300 will automatically be resized." - , if not (Set.member (Maybe.withDefault "" model.image) model.imageNew) then text "" else div [] - [ br [] [] - , text "Please flag this image: (see the ", a [ href "/d19" ] [ text "image flagging guidelines" ], text " for guidance)" - , table [] - [ thead [] [ tr [] [ td [] [ text "Sexual" ], td [] [ text "Violence" ] ] ] - , tr [] - [ td [] - [ label [] [ inputRadio "" (model.imageSex == Just 0) (ImageSex 0), text " Safe" ], br [] [] - , label [] [ inputRadio "" (model.imageSex == Just 1) (ImageSex 1), text " Suggestive" ], br [] [] - , label [] [ inputRadio "" (model.imageSex == Just 2) (ImageSex 2), text " Explicit" ] - ] - , td [] - [ label [] [ inputRadio "" (model.imageVio == Just 0) (ImageVio 0), text " Tame" ], br [] [] - , label [] [ inputRadio "" (model.imageVio == Just 1) (ImageVio 1), text " Violent" ], br [] [] - , label [] [ inputRadio "" (model.imageVio == Just 2) (ImageVio 2), text " Brutal" ] - ] + , text "Supported file types: JPEG, PNG, WebP, AVIF or JXL, at most 10 MiB." + , br [] [] + , text "Images larger than 256x300 are automatically resized." + , case Img.viewVote model.image ImageMsg (Invalid Image) of + Nothing -> text "" + Just v -> + div [] + [ br [] [] + , text "Please flag this image: (see the ", a [ href "/d19" ] [ text "image flagging guidelines" ], text " for guidance)" + , v ] - ] - ] ] - ] + ] ] traits = let old = List.filter (\(_,t) -> not t.new) <| List.indexedMap (\i t -> (i,t)) model.traits new = List.filter (\(_,t) -> t.new) <| List.indexedMap (\i t -> (i,t)) model.traits - spoil t = if t.tid == model.traitSelId then model.traitSelSpl else t.spoil - trait (i,t) = (String.fromInt t.tid, + spoil t = case model.traitSel of + (x,Spoil s) -> if t.tid == x then s else t.spoil + _ -> t.spoil + lie t = case model.traitSel of + (x,Lie) -> if t.tid == x then True else t.lie + _ -> t.lie + trait (i,t) = (t.tid, tr [] - [ td [ style "padding" "0 0 0 10px", style "text-decoration" (if t.applicable then "none" else "line-through") ] - [ Maybe.withDefault (text "") <| Maybe.map (\g -> b [ class "grayedout" ] [ text <| g ++ " / " ]) t.group - , a [ href <| "/i" ++ String.fromInt t.tid ] [ text t.name ] - , if t.applicable then text "" else b [ class "standout" ] [ text " (not applicable)" ] + [ td [ style "padding" "0 0 0 10px", style "text-decoration" (if t.applicable && not t.hidden then "none" else "line-through") ] + [ Maybe.withDefault (text "") <| Maybe.map (\g -> small [] [ text <| g ++ " / " ]) t.group + , a [ href <| "/" ++ t.tid ] [ text t.name ] + , if t.hidden && not t.locked then b [] [ text " (awaiting moderation)" ] + else if t.hidden then b [] [ text " (deleted)" ] + else if not t.applicable then b [] [ text " (not applicable)" ] + else text "" ] , td [ class "buts" ] - [ a [ href "#", onMouseOver (TraitSel t.tid 0), onMouseOut (TraitSel 0 0), onClickD (TraitSpoil i 0), classList [("s0", spoil t == 0 )], title "Not a spoiler" ] [] - , a [ href "#", onMouseOver (TraitSel t.tid 1), onMouseOut (TraitSel 0 0), onClickD (TraitSpoil i 1), classList [("s1", spoil t == 1 )], title "Minor spoiler" ] [] - , a [ href "#", onMouseOver (TraitSel t.tid 2), onMouseOut (TraitSel 0 0), onClickD (TraitSpoil i 2), classList [("s2", spoil t == 2 )], title "Major spoiler" ] [] + [ a [ href "#", onMouseOver (TraitSel t.tid (Spoil 0)), onMouseOut (TraitSel "" (Spoil 0)), onClickD (TraitSpoil i 0), classList [("s0", spoil t == 0 )], title "Not a spoiler" ] [] + , a [ href "#", onMouseOver (TraitSel t.tid (Spoil 1)), onMouseOut (TraitSel "" (Spoil 0)), onClickD (TraitSpoil i 1), classList [("s1", spoil t == 1 )], title "Minor spoiler" ] [] + , a [ href "#", onMouseOver (TraitSel t.tid (Spoil 2)), onMouseOut (TraitSel "" (Spoil 0)), onClickD (TraitSpoil i 2), classList [("s2", spoil t == 2 )], title "Major spoiler" ] [] + , a [ href "#", onMouseOver (TraitSel t.tid Lie), onMouseOut (TraitSel "" (Spoil 0)), onClickD (TraitLie i (not t.lie)), classList [("sl", lie t)], title "Lie" ] [] ] - , td [] - [ case (t.tid == model.traitSelId, lookup model.traitSelSpl spoilOpts) of - (True, Just s) -> text s + , td [ style "width" "150px", style "white-space" "nowrap" ] + [ case (t.tid == Tuple.first model.traitSel, Tuple.second model.traitSel) of + (True, Spoil 0) -> text "Not a spoiler" + (True, Spoil 1) -> text "Minor spoiler" + (True, Spoil 2) -> text "Major spoiler" + (True, Lie) -> text "This turns out to be false" _ -> a [ href "#", onClickD (TraitDel i)] [ text "remove" ] ] ]) @@ -463,24 +451,23 @@ view model = case lst of (x::xs) -> if Set.member x set then uniq xs set else x :: uniq xs (Set.insert x set) [] -> [] - showrel r = "[" ++ (RDate.format (RDate.expand r.released)) ++ " " ++ (String.join "," r.lang) ++ "] " ++ r.title ++ " (r" ++ String.fromInt r.id ++ ")" vn vid lst rels = let title = Maybe.withDefault "<unknown>" <| Maybe.map (\(_,v) -> v.title) <| List.head lst in - [ ( String.fromInt vid + [ ( vid , tr [ class "newpart" ] [ td [ colspan 4, style "padding-bottom" "5px" ] - [ b [ class "grayedout" ] [ text <| "v" ++ String.fromInt vid ++ ":" ] - , a [ href <| "/v" ++ String.fromInt vid ] [ text title ] + [ small [] [ text <| vid ++ ":" ] + , a [ href <| "/" ++ vid ] [ text title ] ]] ) ] ++ List.map (\(idx,item) -> - ( String.fromInt vid ++ "i" ++ String.fromInt (Maybe.withDefault 0 item.rid) + ( vid ++ "i" ++ Maybe.withDefault "r0" item.rid , tr [] [ td [] [ inputSelect "" item.rid (VnRel idx) [ style "width" "400px", style "margin" "0 15px" ] <| (Nothing, if List.length lst == 1 then "All (full) releases" else "Other releases") - :: List.map (\r -> (Just r.id, showrel r)) rels + :: List.map (\r -> (Just r.id, RDate.showrel r)) rels ++ if isJust item.rid && List.isEmpty (List.filter (\r -> Just r.id == item.rid) rels) - then [(item.rid, "Deleted release: r" ++ String.fromInt (Maybe.withDefault 0 item.rid))] else [] + then [(item.rid, "Deleted release: " ++ Maybe.withDefault "" item.rid)] else [] ] , td [] [ inputSelect "" item.role (VnRole idx) [] GT.charRoles ] , td [] [ inputSelect "" item.spoil (VnSpoil idx) [ style "width" "130px", style "margin" "0 5px" ] spoilOpts ] @@ -488,22 +475,22 @@ view model = ] ) ) lst - ++ (if List.map (\(_,r) -> Maybe.withDefault 0 r.rid) lst |> hasDuplicates |> not then [] else [ - ( String.fromInt vid ++ "dup" - , td [] [ td [ colspan 4, style "padding" "0 15px" ] [ b [ class "standout" ] [ text "List contains duplicate releases." ] ] ] + ++ (if List.map (\(_,r) -> Maybe.withDefault "" r.rid) lst |> hasDuplicates |> not then [] else [ + ( vid ++ "dup" + , td [] [ td [ colspan 4, style "padding" "0 15px" ] [ b [] [ text "List contains duplicate releases." ] ] ] ) ]) ++ (if 1 /= List.length (List.filter (\(_,r) -> isJust r.rid) lst) then [] else [ - ( String.fromInt vid ++ "warn" + ( vid ++ "warn" , tr [] [ td [ colspan 4, style "padding" "0 15px" ] - [ b [ class "standout" ] [ text "Note: " ] + [ b [] [ text "Note: " ] , text "Only select specific releases if the character has a significantly different role in those releases. " , br [] [] , text "If the character's role is mostly the same in all releases (ignoring trials), then just select \"All (full) releases\"." ] ]) ]) ++ (if List.length lst > List.length rels then [] else [ - ( String.fromInt vid ++ "add" + ( vid ++ "add" , tr [] [ td [ colspan 4 ] [ inputButton "add release" (VnRelAdd vid title) [style "margin" "0 15px"] ] ] ) ]) @@ -516,9 +503,9 @@ view model = [ ("add", tr [] [ td [ colspan 4 ] [ br_ 1, A.view vnConfig model.vnSearch [placeholder "Add visual novel..."] ] ]) ] in - form_ Submit (model.state == Api.Loading) - [ div [ class "maintabs left" ] - [ ul [] + form_ "mainform" Submit (model.state == Api.Loading) + [ nav [] + [ menu [] [ li [ classList [("tabselected", model.tab == General)] ] [ a [ href "#", onClickD (Tab General) ] [ text "General info" ] ] , li [ classList [("tabselected", model.tab == Image )] ] [ a [ href "#", onClickD (Tab Image ) ] [ text "Image" ] ] , li [ classList [("tabselected", model.tab == Traits )] ] [ a [ href "#", onClickD (Tab Traits ) ] [ text "Traits" ] ] @@ -526,13 +513,12 @@ view model = , li [ classList [("tabselected", model.tab == All )] ] [ a [ href "#", onClickD (Tab All ) ] [ text "All items" ] ] ] ] - , div [ class "mainbox", classList [("hidden", model.tab /= General && model.tab /= All)] ] [ h1 [] [ text "General info" ], table [ class "formtable" ] geninfo ] - , div [ class "mainbox", classList [("hidden", model.tab /= Image && model.tab /= All)] ] [ h1 [] [ text "Image" ], image ] - , div [ class "mainbox", classList [("hidden", model.tab /= Traits && model.tab /= All)] ] [ h1 [] [ text "Traits" ], traits ] - , div [ class "mainbox", classList [("hidden", model.tab /= VNs && model.tab /= All)] ] [ h1 [] [ text "Visual Novels" ], vns ] - , div [ class "mainbox" ] [ fieldset [ class "submit" ] - [ Html.map Editsum (Editsum.view model.editsum) - , submitButton "Submit" model.state (isValid model) - ] + , article [ classList [("hidden", model.tab /= General && model.tab /= All)] ] [ h1 [] [ text "General info" ], table [ class "formtable" ] geninfo ] + , article [ classList [("hidden", model.tab /= Image && model.tab /= All)] ] [ h1 [] [ text "Image" ], image ] + , article [ classList [("hidden", model.tab /= Traits && model.tab /= All)] ] [ h1 [] [ text "Traits" ], traits ] + , article [ classList [("hidden", model.tab /= VNs && model.tab /= All)] ] [ h1 [] [ text "Visual Novels" ], vns ] + , article [ class "submit" ] + [ Html.map Editsum (Editsum.view model.editsum) + , submitButton "Submit" model.state (isValid model) ] ] diff --git a/elm/ColSelect.elm b/elm/ColSelect.elm deleted file mode 100644 index 93c9a093..00000000 --- a/elm/ColSelect.elm +++ /dev/null @@ -1,78 +0,0 @@ --- Column selection dropdown for tables. Assumes that the currently selected --- columns are in the query string as the 'c' parameter, e.g.: --- --- ?c=column_id&c=modified&... --- --- Accepts a [ $current_url, [ list of columns ] ] from Perl, e.g.: --- --- [ '?c=column_id', [ --- [ 'column_id', 'Column Label' ], --- [ 'modified', 'Date modified' ], --- ... --- ] ] -module ColSelect exposing (main) - -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) -import Browser -import Browser.Navigation exposing (load) -import Set -import Erl -- elm/url can't extract a full list of query parameters and hence can't be used to modify a parameter without removing all others. -import Lib.DropDown as DD -import Lib.Api as Api -import Lib.Html exposing (..) - - -main : Program (String, Columns) Model Msg -main = Browser.element - { init = \e -> (init e, Cmd.none) - , view = view - , update = update - , subscriptions = \model -> DD.sub model.dd - } - - -type alias Columns = List (String, String) - -type alias Model = - { cols : Columns - , url : Erl.Url -- Without the "c" parameter - , sel : Set.Set String - , dd : DD.Config Msg - } - - -init : (String, Columns) -> Model -init (u, c) = - { cols = c - , url = Erl.removeQuery "c" <| Erl.parse u - , sel = Set.fromList <| Erl.getQueryValuesForKey "c" <| Erl.parse u - , dd = DD.init "colselect" Open - } - - -type Msg - = Open Bool - | Toggle String Bool - | Update - - -update : Msg -> Model -> (Model, Cmd Msg) -update msg model = - case msg of - Open b -> ({ model | dd = DD.toggle model.dd b }, Cmd.none) - Toggle s b -> ({ model | sel = if b then Set.insert s model.sel else Set.remove s model.sel }, Cmd.none) - Update -> (model, load <| Erl.toString <| List.foldl (\s u -> Erl.addQuery "c" s u) model.url <| Set.toList model.sel) - - -view : Model -> Html Msg -view model = - let item (cid, cname) = li [ ] [ linkRadio (Set.member cid model.sel) (Toggle cid) [ text cname ] ] - in - DD.view model.dd Api.Normal - (text "Select columns") - (\_ -> [ ul [] - <| List.map item model.cols - ++ [ li [ ] [ input [ type_ "button", class "submit", value "update", onClick Update ] [] ] ] - ]) diff --git a/elm/Discussions/Edit.elm b/elm/Discussions/Edit.elm index f8873fa7..f4899e95 100644 --- a/elm/Discussions/Edit.elm +++ b/elm/Discussions/Edit.elm @@ -24,45 +24,45 @@ main = Browser.element type alias Model = - { state : Api.State - , tid : Maybe Int - , num : Maybe Int - , can_mod : Bool - , can_private : Bool - , locked : Bool - , hidden : Bool - , private : Bool - , nolastmod : Bool - , delete : Bool - , title : Maybe String - , boards : Maybe (List GDE.SendBoards) - , boardAdd : A.Model GApi.ApiBoardResult - , msg : TP.Model - , poll : Maybe GDE.SendPoll - , pollEnabled : Bool - , pollEdit : Bool + { state : Api.State + , tid : Maybe String + , can_mod : Bool + , can_private : Bool + , locked : Bool + , hidden : Bool + , private : Bool + , nolastmod : Bool + , delete : Bool + , title : Maybe String + , boards : Maybe (List GDE.SendBoards) + , boardAdd : A.Model GApi.ApiBoardResult + , boardsLocked : Bool + , msg : TP.Model + , poll : Maybe GDE.SendPoll + , pollEnabled : Bool + , pollEdit : Bool } init : GDE.Recv -> Model init d = - { state = Api.Normal - , can_mod = d.can_mod - , can_private = d.can_private - , tid = d.tid - , num = d.num - , locked = d.locked - , hidden = d.hidden - , private = d.private - , nolastmod = False - , delete = False - , title = d.title - , boards = d.boards - , boardAdd = A.init "" - , msg = TP.bbcode d.msg - , poll = d.poll - , pollEnabled = isJust d.poll - , pollEdit = isJust d.poll + { state = Api.Normal + , can_mod = d.can_mod + , can_private = d.can_private + , tid = d.tid + , locked = d.locked + , hidden = d.hidden + , private = d.private + , nolastmod = False + , delete = False + , title = d.title + , boards = d.boards + , boardAdd = A.init "" + , boardsLocked = d.boards_locked + , msg = TP.bbcode d.msg + , poll = d.poll + , pollEnabled = isJust d.poll + , pollEdit = isJust d.poll } @@ -72,17 +72,17 @@ searchConfig = { wrap = BoardSearch, id = "boardadd", source = A.boardSource } encode : Model -> GDE.Send encode m = - { tid = m.tid - , num = m.num - , locked = m.locked - , hidden = m.hidden - , private = m.private - , nolastmod = m.nolastmod - , delete = m.delete - , boards = m.boards - , poll = if m.pollEnabled then m.poll else Nothing - , title = m.title - , msg = m.msg.data + { tid = m.tid + , locked = m.locked + , hidden = m.hidden + , private = m.private + , nolastmod = m.nolastmod + , delete = m.delete + , boards = m.boards + , boards_locked = m.boardsLocked + , poll = if m.pollEnabled then m.poll else Nothing + , title = m.title + , msg = m.msg.data } @@ -90,7 +90,7 @@ numPollOptions : Model -> Int numPollOptions model = Maybe.withDefault 0 (Maybe.map (\o -> List.length o.options) model.poll) dupBoards : Model -> Bool -dupBoards model = hasDuplicates (List.map (\b -> (b.btype, b.iid)) (Maybe.withDefault [] model.boards)) +dupBoards model = hasDuplicates (List.map (\b -> (b.btype, Maybe.withDefault "" b.iid)) (Maybe.withDefault [] model.boards)) isValid : Model -> Bool isValid model = not (model.boards == Just [] || dupBoards model || Maybe.map (\p -> p.max_options < 1 || p.max_options > numPollOptions model) model.poll == Just True) @@ -104,6 +104,7 @@ type Msg | Delete Bool | Content TP.Msg | Title String + | BoardsLocked Bool | BoardDel Int | BoardSearch (A.Msg GApi.ApiBoardResult) | PollEnabled Bool @@ -133,6 +134,7 @@ update msg model = PollRem n -> ({ model | poll = Maybe.map (\p -> { p | options = delidx n p.options }) model.poll }, Cmd.none) PollAdd -> ({ model | poll = Maybe.map (\p -> { p | options = p.options ++ [""] }) model.poll }, Cmd.none) + BoardsLocked b-> ({ model | boardsLocked = b }, Cmd.none) BoardDel i -> ({ model | boards = Maybe.map (\b -> delidx i b) model.boards }, Cmd.none) BoardSearch m -> let (nm, c, res) = A.update searchConfig m model.boardAdd @@ -148,32 +150,36 @@ update msg model = view : Model -> Html Msg view model = let - thread = model.tid == Nothing || model.num == Just 1 - board n bd = li [] <| - [ text "[" - , a [ href "#", onClickD (BoardDel n), tabindex 10 ] [ text "remove" ] - , text "] " + [ if model.boardsLocked then text "" else span [] + [ text "[" + , a [ href "#", onClickD (BoardDel n), tabindex 10 ] [ text "remove" ] + , text "] " + ] , text (Maybe.withDefault "" (lookup bd.btype boardTypes)) - ] ++ case (bd.btype, bd.title) of - (_, Just title) -> - [ b [ class "grayedout" ] [ text " > " ] - , a [ href <| "/" ++ bd.btype ++ String.fromInt bd.iid ] [ text title ] + ] ++ case (bd.btype, bd.iid, bd.title) of + (_, Just iid, Just title) -> + [ small [] [ text " > " ] + , a [ href <| "/" ++ iid ] [ text title ] ] - ("u", _) -> [ b [ class "grayedout" ] [ text " > " ], text <| bd.btype ++ String.fromInt bd.iid ++ " (deleted)" ] - (_, _) -> [] + ("u", Just iid, _) -> [ small [] [ text " > " ], text <| iid ++ " (deleted)" ] + _ -> [] boards () = - [ text "You can link this thread to multiple boards. Every visual novel, producer and user in the database has its own board," + [ if not model.can_mod then text "" + else label [] [ inputCheck "" model.boardsLocked BoardsLocked, text " Lock boards.", br [] [] ] + , text "You can link this thread to multiple boards. Every visual novel, producer and user in the database has its own board," , text " but you can also use the \"General Discussions\" and \"VNDB Discussions\" boards for threads that do not fit at a particular database entry." , ul [ style "list-style-type" "none", style "margin" "10px" ] <| List.indexedMap board (Maybe.withDefault [] model.boards) - , A.view searchConfig model.boardAdd [placeholder "Add boards..."] + , if model.boardsLocked + then text "Boards are locked, only a moderator can move this thread." + else A.view searchConfig model.boardAdd [placeholder "Add boards..."] ] ++ if model.boards == Just [] - then [ b [ class "standout" ] [ text "Please add at least one board." ] ] + then [ b [] [ text "Please add at least one board." ] ] else if dupBoards model - then [ b [ class "standout" ] [ text "List contains duplicates." ] ] + then [ b [] [ text "List contains duplicates." ] ] else [] pollOpt n p = @@ -184,14 +190,14 @@ view model = else text "" ] - poll () = + poll = [ tr [ class "newpart" ] [ td [ colspan 2 ] [ text "" ] ] , formField "" [ label [] [ inputCheck "" model.pollEnabled PollEnabled, text " Add poll" ] ] ] ++ case (model.pollEnabled, model.poll) of (True, Just p) -> [ if model.pollEdit - then formField "" [ b [ class "standout" ] [ text "Votes will be reset if any changes are made to these options!" ] ] + then formField "" [ b [] [ text "Votes will be reset if any changes are made to these options!" ] ] else text "" , formField "pollq::Poll question" [ inputText "pollq" p.question PollQ (style "width" "400px" :: GDE.valPollQuestion) ] , formField "Options" @@ -209,47 +215,37 @@ view model = in - form_ Submit (model.state == Api.Loading) - [ div [ class "mainbox" ] - [ h1 [] [ text <| if model.tid == Nothing then "Create new thread" else "Edit post" ] + form_ "" Submit (model.state == Api.Loading) + [ article [] + [ h1 [] [ text <| if model.tid == Nothing then "Create new thread" else "Edit thread" ] , table [ class "formtable" ] <| - [ if thread - then formField "title::Thread title" [ inputText "title" (Maybe.withDefault "" model.title) Title (style "width" "400px" :: required True :: GDE.valTitle) ] - else formField "Topic" [ a [ href <| "/t" ++ String.fromInt (Maybe.withDefault 0 model.tid) ] [ text (Maybe.withDefault "" model.title) ] ] - , if thread && model.can_mod + [ formField "title::Thread title" [ inputText "title" (Maybe.withDefault "" model.title) Title (style "width" "400px" :: required True :: GDE.valTitle) ] + , if model.can_mod then formField "" [ label [] [ inputCheck "" model.locked Locked, text " Locked" ] ] else text "" , if model.can_mod then formField "" [ label [] [ inputCheck "" model.hidden Hidden, text " Hidden" ] ] else text "" - , if thread && model.can_private + , if model.can_private then formField "" [ label [] [ inputCheck "" model.private Private, text " Private" ] ] else text "" , if model.tid /= Nothing && model.can_mod then formField "" [ label [] [ inputCheck "" model.nolastmod Nolastmod, text " Don't update last modification timestamp" ] ] else text "" - , if thread - then formField "boardadd::Boards" (boards ()) - else text "" + , formField "boardadd::Boards" (boards ()) , tr [ class "newpart" ] [ td [ colspan 2 ] [ text "" ] ] , formField "msg::Message" [ TP.view "msg" model.msg Content 700 ([rows 12, cols 50] ++ GDE.valMsg) - [ b [ class "standout" ] [ text " (English please!) " ] - , a [ href "/d9#3" ] [ text "Formatting" ] + [ b [] [ text " (English please!) " ] + , a [ href "/d9#4" ] [ text "Formatting" ] ] ] ] - ++ (if thread then poll () else []) - ++ (if not model.can_mod then [] else + ++ poll + ++ (if not model.can_mod || model.tid == Nothing then [] else [ tr [ class "newpart" ] [ td [ colspan 2 ] [ text "DANGER ZONE" ] ] - , formField "" - [ inputCheck "" model.delete Delete - , text <| " Permanently delete this " ++ if thread then "thread and all replies." else "post." - , text <| if thread then "" else " This causes all replies after this one to be renumbered." - , text <| " This action can not be reverted, only do this with obvious spam!" - ] + , formField "" [ inputCheck "" model.delete Delete, text " Permanently delete this thread and all replies. This action can not be reverted, only do this with obvious spam!" ] ]) ] - , div [ class "mainbox" ] - [ fieldset [ class "submit" ] [ submitButton "Submit" model.state (isValid model) ] ] + , article [ class "submit" ] [ submitButton "Submit" model.state (isValid model) ] ] diff --git a/elm/Discussions/Poll.elm b/elm/Discussions/Poll.elm index 04761530..6764bfbd 100644 --- a/elm/Discussions/Poll.elm +++ b/elm/Discussions/Poll.elm @@ -109,8 +109,8 @@ view model = else text "" ] in - form_ Submit (model.state == Api.Loading) - [ div [ class "mainbox" ] + form_ "" Submit (model.state == Api.Loading) + [ article [] [ h1 [] [ text model.data.question ] , table [ class "votebooth" ] [ if model.data.can_vote && model.data.max_options > 1 @@ -120,9 +120,9 @@ view model = [ td [ class "tc1" ] [ if model.data.can_vote then submitButton "Vote" model.state True - else b [ class "standout" ] [ text "You must be logged in to be able to vote." ] + else b [] [ text "You must be logged in to be able to vote." ] , if toomany model - then b [ class "standout" ] [ text "Too many options selected." ] + then b [] [ text "Too many options selected." ] else text "" ] , td [ class "tc2" ] diff --git a/elm/Discussions/PostEdit.elm b/elm/Discussions/PostEdit.elm new file mode 100644 index 00000000..00b833ba --- /dev/null +++ b/elm/Discussions/PostEdit.elm @@ -0,0 +1,112 @@ +module Discussions.PostEdit exposing (main) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Browser +import Browser.Navigation exposing (load) +import Lib.Html exposing (..) +import Lib.TextPreview as TP +import Lib.Api as Api +import Gen.Api as GApi +import Gen.DiscussionsPostEdit as GPE + + +main : Program GPE.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 + , id : String + , num : Int + , can_mod : Bool + , hidden : Maybe String + , nolastmod : Bool + , delete : Bool + , msg : TP.Model + } + + +init : GPE.Recv -> Model +init d = + { state = Api.Normal + , id = d.id + , num = d.num + , can_mod = d.can_mod + , hidden = d.hidden + , nolastmod = False + , delete = False + , msg = TP.bbcode d.msg + } + +encode : Model -> GPE.Send +encode m = + { id = m.id + , num = m.num + , hidden = m.hidden + , nolastmod = m.nolastmod + , delete = m.delete + , msg = m.msg.data + } + + +type Msg + = Hidden (Maybe String) + | Nolastmod Bool + | Delete Bool + | Content TP.Msg + | Submit + | Submitted GApi.Response + + +update : Msg -> Model -> (Model, Cmd Msg) +update msg model = + case msg of + Hidden s -> ({ model | hidden = s }, Cmd.none) + Nolastmod b -> ({ model | nolastmod = b }, Cmd.none) + Delete b -> ({ model | delete = b }, Cmd.none) + Content m -> let (nm,nc) = TP.update m model.msg in ({ model | msg = nm }, Cmd.map Content nc) + + Submit -> ({ model | state = Api.Loading }, GPE.send (encode model) Submitted) + Submitted (GApi.Redirect s) -> (model, load s) + Submitted r -> ({ model | state = Api.Error r }, Cmd.none) + + +view : Model -> Html Msg +view model = + form_ "" Submit (model.state == Api.Loading) + [ article [] + [ h1 [] [ text "Edit post" ] + , table [ class "formtable" ] <| + [ formField "Post" [ a [ href <| "/" ++ model.id ++ "." ++ String.fromInt model.num ] [ text <| "#" ++ String.fromInt model.num ++ " on " ++ model.id ] ] + , if model.can_mod + then formField "" + [ label [] [ inputCheck "" (model.hidden /= Nothing) (\b -> Hidden (if b then Just "" else Nothing)), text " Hidden" ] + , Maybe.withDefault (text "") <| Maybe.map (\msg -> + span [] [ br [] [], inputText "" msg (Just >> Hidden) [placeholder "(Optional) reason for deletion", style "width" "500px"] ] + ) model.hidden + ] + else text "" + , if model.can_mod + then formField "" [ label [] [ inputCheck "" model.nolastmod Nolastmod, text " Don't update last modification timestamp" ] ] + else text "" + , tr [ class "newpart" ] [ td [ colspan 2 ] [ text "" ] ] + , formField "msg::Message" + [ TP.view "msg" model.msg Content 700 ([rows 12, cols 50] ++ GPE.valMsg) + [ b [] [ text " (English please!) " ] + , a [ href "/d9#4" ] [ text "Formatting" ] + ] + ] + ] + ++ (if not model.can_mod then [] else + [ tr [ class "newpart" ] [ td [ colspan 2 ] [ text "DANGER ZONE" ] ] + , formField "" [ inputCheck "" model.delete Delete, text " Permanently delete this post. This action can not be reverted, only do this with obvious spam!" ] + ]) + ] + , article [ class "submit" ] [ submitButton "Submit" model.state True ] + ] diff --git a/elm/Discussions/Reply.elm b/elm/Discussions/Reply.elm deleted file mode 100644 index a8d25434..00000000 --- a/elm/Discussions/Reply.elm +++ /dev/null @@ -1,82 +0,0 @@ -module Discussions.Reply exposing (main) - -import Html exposing (..) -import Html.Attributes exposing (..) -import Browser -import Browser.Navigation exposing (load,reload) -import Lib.Html exposing (..) -import Lib.TextPreview as TP -import Lib.Api as Api -import Gen.Api as GApi -import Gen.DiscussionsReply as GDR - - -main : Program GDR.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 - , tid : Int - , old : Bool - , msg : TP.Model - } - - -init : GDR.Recv -> Model -init e = - { state = Api.Normal - , tid = e.tid - , old = e.old - , msg = TP.bbcode "" - } - - -type Msg - = NotOldAnymore - | Content TP.Msg - | Submit - | Submitted GApi.Response - - -update : Msg -> Model -> (Model, Cmd Msg) -update msg model = - case msg of - NotOldAnymore -> ({ model | old = False }, Cmd.none) - Content m -> let (nm,nc) = TP.update m model.msg in ({ model | msg = nm }, Cmd.map Content nc) - - Submit -> ({ model | state = Api.Loading }, GDR.send { msg = model.msg.data, tid = model.tid } Submitted) - -- Reload is necessary because s may be the same as the current URL (with a location.hash) - Submitted (GApi.Redirect s) -> (model, Cmd.batch [ load s, reload ]) - Submitted r -> ({ model | state = Api.Error r }, Cmd.none) - - -view : Model -> Html Msg -view model = - form_ Submit (model.state == Api.Loading) - [ div [ class "mainbox" ] <| [ - if model.old - then - p [ class "center" ] - [ text "This thread has not seen any activity for more than 6 months, but you may still " - , a [ href "#", onClickD NotOldAnymore ] [ text "reply" ] - , text " if you have something relevant to add." - , text " If your message is not directly relevant to this thread, perhaps it's better to " - , a [ href "/t/ge/new" ] [ text "create a new thread" ] - , text " instead." - ] - else - fieldset [ class "submit" ] - [ TP.view "msg" model.msg Content 600 ([rows 4, cols 50] ++ GDR.valMsg) - [ b [] [ text "Quick reply" ] - , b [ class "standout" ] [ text " (English please!) " ] - , a [ href "/d9#3" ] [ text "Formatting" ] - ] - , submitButton "Submit" model.state True - ] - ] ] diff --git a/elm/DocEdit.elm b/elm/DocEdit.elm deleted file mode 100644 index 9fbea631..00000000 --- a/elm/DocEdit.elm +++ /dev/null @@ -1,102 +0,0 @@ -module DocEdit exposing (main) - -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) -import Browser -import Browser.Navigation exposing (load) -import Lib.Html exposing (..) -import Lib.TextPreview as TP -import Lib.Api as Api -import Lib.Ffi as Ffi -import Lib.Editsum as Editsum -import Gen.Api as GApi -import Gen.DocEdit as GD - - -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 : TP.Model - , id : Int - } - - -init : GD.Recv -> Model -init d = - { state = Api.Normal - , editsum = { authmod = True, editsum = TP.bbcode d.editsum, locked = d.locked, hidden = d.hidden } - , title = d.title - , content = TP.markdown d.content - , id = d.id - } - - -encode : Model -> GD.Send -encode model = - { id = model.id - , editsum = model.editsum.editsum.data - , hidden = model.editsum.hidden - , locked = model.editsum.locked - , title = model.title - , content = model.content.data - } - - -type Msg - = Editsum Editsum.Msg - | Submit - | Submitted GApi.Response - | Title String - | Content TP.Msg - - -update : Msg -> Model -> (Model, Cmd Msg) -update msg model = - case msg of - Editsum m -> let (nm,nc) = Editsum.update m model.editsum in ({ model | editsum = nm }, Cmd.map Editsum nc) - Title s -> ({ model | title = s }, Cmd.none) - Content m -> let (nm,nc) = TP.update m model.content in ({ model | content = nm }, Cmd.map Content nc) - - Submit -> ({ model | state = Api.Loading }, GD.send (encode model) Submitted) - Submitted (GApi.Redirect s) -> (model, load s) - Submitted r -> ({ model | state = Api.Error r }, Cmd.none) - - -view : Model -> Html Msg -view model = - form_ Submit (model.state == Api.Loading) - [ div [ class "mainbox" ] - [ h1 [] [ text <| "Edit d" ++ String.fromInt model.id ] - , table [ class "formtable" ] - [ formField "title::Title" [ inputText "title" model.title Title (style "width" "300px" :: GD.valTitle) ] - , formField "none" - [ br_ 1 - , b [] [ text "Contents" ] - , TP.view "content" model.content Content 850 ([rows 50, cols 90] ++ GD.valContent) - [ text "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 "." - ] - ] - ] - ] - , div [ class "mainbox" ] - [ fieldset [ class "submit" ] - [ Html.map Editsum (Editsum.view model.editsum) - , submitButton "Submit" model.state True - ] - ] - ] diff --git a/elm/ImageFlagging.elm b/elm/ImageFlagging.elm index 0e99f1b5..a53cf248 100644 --- a/elm/ImageFlagging.elm +++ b/elm/ImageFlagging.elm @@ -47,8 +47,9 @@ type alias Model = , changes : Dict.Dict String GIV.SendVotes , saved : Bool , saveTimer : Bool - , loadState : Api.State , saveState : Api.State + , loadState : Api.State + , loadDone : Bool -- If we have received the last batch of images , pWidth : Int , pHeight : Int } @@ -71,6 +72,7 @@ init d = , saveTimer = False , saveState = Api.Normal , loadState = Api.Normal + , loadDone = False , pWidth = d.pWidth , pHeight = d.pHeight } @@ -132,7 +134,7 @@ update : Msg -> Model -> (Model, Cmd Msg) update msg model = let -- Load more images if we're about to run out load (m,c) = - if not m.single && m.loadState /= Api.Loading && Array.length m.images - m.index <= 3 + if not m.loadDone && not m.single && m.loadState /= Api.Loading && Array.length m.images - m.index <= 3 then ({ m | loadState = Api.Loading }, Cmd.batch [ c, GI.send { excl_voted = m.exclVoted } Load ]) else (m,c) -- Start a timer to save changes @@ -147,7 +149,7 @@ update msg model = -- Preload next image pre (m, c) = case Array.get (m.index+1) m.images of - Just i -> (m, Cmd.batch [ c, preload (imageUrl i.id) ]) + Just i -> (m, Cmd.batch [ c, preload (imageUrl "" i.id) ]) Nothing -> (m, c) in case msg of @@ -158,7 +160,7 @@ update msg model = Desc s v -> ({ model | desc = (s,v) }, Cmd.none) Load (GApi.ImageResult l) -> - let nm = { model | loadState = Api.Normal, images = Array.append model.images (Array.fromList l) } + let nm = { model | loadState = Api.Normal, loadDone = List.length l < 30, images = Array.append model.images (Array.fromList l) } nc = if nm.index < 1000 then nm else { nm | index = nm.index - 100, images = Array.slice 100 (Array.length nm.images) nm.images } in pre (nc, Cmd.none) @@ -221,8 +223,8 @@ view model = else [ p [ class "center" ] [ text num - , 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 + , small [] [ text " / " ], text <| "sexual: " ++ stat i.sexual_avg i.sexual_stddev + , small [] [ text " / " ], text <| "violence: " ++ stat i.violence_avg i.violence_stddev ] , table [] <| List.map (\v -> @@ -230,7 +232,7 @@ view model = [ td [ Ffi.innerHtml v.user ] [] , td [] [ text <| if v.sexual == 0 then "Safe" else if v.sexual == 1 then "Suggestive" else "Explicit" ] , td [] [ text <| if v.violence == 0 then "Tame" else if v.violence == 1 then "Violent" else "Brutal" ] - , td [] <| Maybe.withDefault [] <| Maybe.map (\u -> [ a [ href <| "/img/list?view=" ++ model.nsfwToken ++ "&u=" ++ String.fromInt u ] [ text "votes" ] ]) v.uid + , td [] <| Maybe.withDefault [] <| Maybe.map (\u -> [ a [ href <| "/img/list?view=" ++ model.nsfwToken ++ "&u=" ++ u ] [ text "votes" ] ]) v.uid ] ) i.votes ] @@ -239,79 +241,79 @@ view model = [ div [] [ inputButton "««" Prev [ classList [("invisible", model.index == 0)] ] , span [] <| - case i.entry of + case List.head i.entries of Nothing -> [] Just e -> - [ b [ class "grayedout" ] [ text (e.id ++ ":") ] + [ small [] [ text (e.id ++ ":") ] , a [ href ("/" ++ e.id) ] [ text e.title ] ] , inputButton "»»" Next [ classList [("invisible", model.single)] ] ] - , div [ style "width" (px boxwidth), style "height" (px boxheight) ] <| + , div [ style "width" (px (boxwidth + 10)), 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 (imageUrl i.id), style "background-image" ("url("++imageUrl i.id++")") + [ a [ href (imageUrl "" i.id), style "background-image" ("url("++imageUrl "" i.id++")") , 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 ] ] + Api.Error e -> [ b [] [ text <| "Save failed: " ++ Api.showResponse e ] ] _ -> [ span [ class "spinner", classList [("invisible", model.saveState == Api.Normal)] ] [] - , b [ class "grayedout" ] [ text <| + , small [] [ text <| if not (Dict.isEmpty model.changes) then "Unsaved votes: " ++ String.fromInt (Dict.size model.changes) else if model.saved then "Saved!" else "" ] ] , span [] [ a [ href <| "/img/" ++ i.id ] [ text i.id ] - , b [ class "grayedout" ] [ text " / " ] - , a [ href (imageUrl i.id) ] [ text <| String.fromInt i.width ++ "x" ++ String.fromInt i.height ] + , small [] [ text " / " ] + , a [ href (imageUrl "" i.id) ] [ text <| String.fromInt i.width ++ "x" ++ String.fromInt i.height ] ] ] , div [] <| if i.token == Nothing then [] else [ p [] <| case Tuple.first model.desc of - Just 0 -> [ b [] [ text "Safe" ], br [] [] + Just 0 -> [ strong [] [ text "Safe" ], br [] [] , text "- No nudity", br [] [] , text "- No (implied) sexual actions", br [] [] , text "- No suggestive clothing or visible underwear", br [] [] , text "- No sex toys" ] - Just 1 -> [ b [] [ text "Suggestive" ], br [] [] + Just 1 -> [ strong [] [ text "Suggestive" ], br [] [] , text "- Visible underwear or skimpy clothing", br [] [] , text "- Erotic posing", br [] [] , text "- Sex toys (but not visibly being used)", br [] [] , text "- No visible genitals or female nipples" ] - Just 2 -> [ b [] [ text "Explicit" ], br [] [] + Just 2 -> [ strong [] [ text "Explicit" ], br [] [] , text "- Visible genitals or female nipples", br [] [] , text "- Penetrative sex (regardless of clothing)", br [] [] , text "- Visible use of sex toys" ] _ -> [] , ul [] - [ li [] [ b [] [ text "Sexual" ] ] + [ li [] [ strong [] [ text "Sexual" ] ] , but i (Just 0) i.my_violence "vio0" " Safe" , but i (Just 1) i.my_violence "vio1" " Suggestive" , but i (Just 2) i.my_violence "vio2" " Explicit" , if model.mod then li [ class "overrule" ] [ label [ title "Overrule" ] [ inputCheck "" i.my_overrule (\b -> Vote i.my_sexual i.my_violence b True), text " Overrule" ] ] else text "" ] , ul [] - [ li [] [ b [] [ text "Violence" ] ] + [ li [] [ strong [] [ text "Violence" ] ] , but i i.my_sexual (Just 0) "sex0" " Tame" , but i i.my_sexual (Just 1) "sex1" " Violent" , but i i.my_sexual (Just 2) "sex2" " Brutal" ] , p [] <| case Tuple.second model.desc of - Just 0 -> [ b [] [ text "Tame" ], br [] [] + Just 0 -> [ strong [] [ text "Tame" ], br [] [] , text "- No visible violence", br [] [] , text "- Tame slapstick comedy", br [] [] , text "- Weapons, but not used to harm anyone", br [] [] , text "- Only very minor visible blood or bruises", br [] [] ] - Just 1 -> [ b [] [ text "Violent" ], br [] [] + Just 1 -> [ strong [] [ text "Violent" ], br [] [] , text "- Visible blood", br [] [] , text "- Non-comedic fight scenes", br [] [] , text "- Physically harmful activities" ] - Just 2 -> [ b [] [ text "Brutal" ], br [] [] + Just 2 -> [ strong [] [ text "Brutal" ], br [] [] , text "- Excessive amounts of blood", br [] [] , text "- Cut off limbs", br [] [] , text "- Sliced-open bodies", br [] [] @@ -325,17 +327,17 @@ view model = ] , votestats i , if model.fullscreen -- really lazy fullscreen mode - then div [ class "fullscreen", style "background-image" ("url("++imageUrl i.id++")"), onClick (Fullscreen False) ] [ text "" ] + then div [ class "fullscreen", style "background-image" ("url("++imageUrl "" i.id++")"), onClick (Fullscreen False) ] [ text "" ] else text "" ] - in div [ class "mainbox" ] + in article [] [ h1 [] [ text "Image flagging" ] , div [ class "imageflag", style "width" (px (boxwidth + 10)) ] <| 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 include spoilers, be highly offensive and/or contain very explicit depictions of sexual acts." ] + , li [] [ b [] [ text "WARNING: " ], text "Images shown may include spoilers, be highly offensive and/or contain very explicit depictions of sexual acts." ] ] , br [] [] , if model.single @@ -346,6 +348,6 @@ view model = 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.Error e) -> [ b [] [ text <| Api.showResponse e ] ] (_, Api.Normal) -> [ text "No more images to vote on!" ] ] diff --git a/elm/ImageFlagging.js b/elm/ImageFlagging.js deleted file mode 100644 index d460bd10..00000000 --- a/elm/ImageFlagging.js +++ /dev/null @@ -1,16 +0,0 @@ -wrap_elm_init('ImageFlagging', function(init, opt) { - opt.flags.pWidth = window.innerWidth || document.documentElement.clientWidth || document.body.clientWidth; - opt.flags.pHeight = window.innerHeight || document.documentElement.clientHeight || document.body.clientHeight; - var app = init(opt); - var preload = {}; - var curid = ''; - - app.ports.preload.subscribe(function(url) { - if(Object.keys(preload).length > 100) - preload = {}; - if(!preload[url]) { - preload[url] = new Image(); - preload[url].src = url; - } - }); -}); diff --git a/elm/Lib/Api.elm b/elm/Lib/Api.elm index 4af28ea6..5b1bf583 100644 --- a/elm/Lib/Api.elm +++ b/elm/Lib/Api.elm @@ -23,37 +23,37 @@ showResponse res = 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 403) -> "Permission denied. Your session may have expired, try reloading the page." + HTTPError (Http.BadStatus 413) -> "File upload too large." + HTTPError (Http.BadStatus 429) -> "Action throttled, 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 Redirect _ -> unexp - CSRF -> "Invalid CSRF token, please refresh the page and try again." Invalid -> "Invalid form data, please report a bug." Editsum -> "Invalid edit summary." Unauth -> "You do not have the permission to perform this action." Unchanged -> "No changes" Content _ -> unexp - BadLogin -> "Invalid username or password." - LoginThrottle -> "Action throttled, too many failed login attempts." - InsecurePass -> "Your chosen password is in a database of leaked passwords, please choose another one." - BadEmail -> "Unknown email address." - Bot -> "Invalid answer to the anti-bot question." - Taken -> "Username already taken, please choose a different name." - DoubleEmail -> "Email address already used for another account." - DoubleIP -> "You can only register one account from the same IP within 24 hours." - BadCurPass -> "Current password is invalid." - MailChange -> unexp - ImgFormat -> "Unrecognized image format, only JPEG and PNG are accepted." - Image _ _ _ -> unexp + ImgFormat -> "Unrecognized image format, only JPEG, PNG and WebP are accepted." + LabelId _ -> unexp + DupNames _ -> "Name or alias already in the database." Releases _ -> unexp + Resolutions _ -> unexp + Engines _ -> unexp + DRM _ -> unexp BoardResult _ -> unexp TagResult _ -> unexp TraitResult _ -> unexp VNResult _ -> unexp ProducerResult _ -> unexp + StaffResult _ -> unexp CharResult _ -> unexp + AnimeResult _ -> unexp ImageResult _ -> unexp + UListWidget _ -> unexp + AdvSearchQuery _ -> unexp expectResponse : (Response -> msg) -> Http.Expect msg diff --git a/elm/Lib/Autocomplete.elm b/elm/Lib/Autocomplete.elm index 738f6008..4c465d7c 100644 --- a/elm/Lib/Autocomplete.elm +++ b/elm/Lib/Autocomplete.elm @@ -9,9 +9,15 @@ module Lib.Autocomplete exposing , traitSource , vnSource , producerSource + , staffSource , charSource + , animeSource + , resolutionSource + , engineSource + , drmSource , init , clear + , refocus , update , view ) @@ -35,7 +41,12 @@ import Gen.Tags as GT import Gen.Traits as GTR import Gen.VN as GV import Gen.Producers as GP +import Gen.Staff as GS import Gen.Chars as GC +import Gen.Anime as GA +import Gen.Resolutions as GR +import Gen.Engines as GE +import Gen.DRM as GDRM type alias Config m a = @@ -51,6 +62,8 @@ type alias Config m a = type SearchSource m a -- API endpoint to query for completion results + Function to decode results from the API = Endpoint (String -> (GApi.Response -> m) -> Cmd m) (GApi.Response -> Maybe (List a)) + -- API endpoint that returns the full list of possible results + Function to decode results from the API + Function to match results against a query + | LazyList ((GApi.Response -> m) -> Cmd m) (GApi.Response -> Maybe (List a)) (String -> List a -> List a) -- Pure function for instant completion results | Func (String -> List a) @@ -76,20 +89,20 @@ boardSource = , view = (\i -> [ text <| Maybe.withDefault "" (lookup i.btype boardTypes) ] ++ case i.title of - Just title -> [ b [ class "grayedout" ] [ text " > " ], text title ] + Just title -> [ small [] [ text " > " ], text title ] _ -> [] ) - , key = \i -> i.btype ++ String.fromInt i.iid + , key = \i -> Maybe.withDefault i.btype i.iid } -tagtraitStatus i = - case (i.searchable, i.applicable, i.state) of - (_, _, 0) -> b [ class "grayedout" ] [ text " (awaiting approval)" ] - (_, _, 1) -> b [ class "grayedout" ] [ text " (deleted)" ] -- (not returned by the API for now) - (False, False, _) -> b [ class "grayedout" ] [ text " (meta)" ] - (True, False, _) -> b [ class "grayedout" ] [ text " (not applicable)" ] - (False, True, _) -> b [ class "grayedout" ] [ text " (not searchable)" ] +ttStatus i = + case ((i.hidden, i.locked), i.searchable, i.applicable) of + ((True, False), _, _ ) -> small [] [ text " (awaiting approval)" ] + ((True, True ), _, _ ) -> small [] [ text " (deleted)" ] -- (not returned by the API for now) + (_, False, False) -> small [] [ text " (meta)" ] + (_, True, False) -> small [] [ text " (not applicable)" ] + (_, False, True ) -> small [] [ text " (not searchable)" ] _ -> text "" @@ -99,8 +112,8 @@ tagSource = <| \x -> case x of GApi.TagResult e -> Just e _ -> Nothing - , view = \i -> [ text i.name, tagtraitStatus i ] - , key = \i -> String.fromInt i.id + , view = \i -> [ text i.name, ttStatus i ] + , key = \i -> i.id } @@ -113,37 +126,53 @@ traitSource = , view = \i -> [ case i.group_name of Nothing -> text "" - Just g -> b [ class "grayedout" ] [ text <| g ++ " / " ] + Just g -> small [] [ text <| g ++ " / " ] , text i.name - , tagtraitStatus i + , ttStatus i ] - , key = \i -> String.fromInt i.id + , key = \i -> i.id } vnSource : SourceConfig m GApi.ApiVNResult vnSource = - { source = Endpoint (\s -> GV.send { search = s }) + { source = Endpoint (\s -> GV.send { search = [s], hidden = False }) <| \x -> case x of GApi.VNResult e -> Just e _ -> Nothing , view = \i -> - [ b [ class "grayedout" ] [ text <| "v" ++ String.fromInt i.id ++ ": " ] + [ small [] [ text <| i.id ++ ": " ] , text i.title ] - , key = \i -> String.fromInt i.id + , key = \i -> i.id } producerSource : SourceConfig m GApi.ApiProducerResult producerSource = - { source = Endpoint (\s -> GP.send { search = s }) + { source = Endpoint (\s -> GP.send { search = [s] }) <| \x -> case x of GApi.ProducerResult e -> Just e _ -> Nothing , view = \i -> - [ b [ class "grayedout" ] [ text <| "p" ++ String.fromInt i.id ++ ": " ] + [ small [] [ text <| i.id ++ ": " ] , text i.name ] - , key = \i -> String.fromInt i.id + , key = \i -> i.id + } + + +staffSource : SourceConfig m GApi.ApiStaffResult +staffSource = + { source = Endpoint (\s -> GS.send { search = [s] }) + <| \x -> case x of + GApi.StaffResult e -> Just e + _ -> Nothing + , view = \i -> + [ langIcon i.lang + , small [] [ text <| i.id ++ ": " ] + , text i.title + , if i.alttitle == i.title then text "" else small [] [ text " ", text i.alttitle ] + ] + , key = \i -> String.fromInt i.aid } @@ -154,20 +183,73 @@ charSource = GApi.CharResult e -> Just e _ -> Nothing , view = \i -> - [ b [ class "grayedout" ] [ text <| "c" ++ String.fromInt i.id ++ ": " ] - , text i.name + [ small [] [ text <| i.id ++ ": " ] + , text i.title , Maybe.withDefault (text "") <| Maybe.map (\m -> - b [ class "grayedout" ] [ text <| " (instance of c" ++ String.fromInt m.id ++ ": " ++ m.name ] + small [] [ text <| " (instance of " ++ m.id ++ ": " ++ m.title ] ) i.main ] + , key = \i -> i.id + } + + +animeSource : Bool -> SourceConfig m GApi.ApiAnimeResult +animeSource ref = + { source = Endpoint (\s -> GA.send { search = s, ref = ref }) + <| \x -> case x of + GApi.AnimeResult e -> Just e + _ -> Nothing + , view = \i -> + [ small [] [ text <| "a" ++ String.fromInt i.id ++ ": " ] + , text i.title ] , key = \i -> String.fromInt i.id } +resolutionSource : SourceConfig m GApi.ApiResolutions +resolutionSource = + { source = LazyList + (GR.send {}) + (\x -> case x of + GApi.Resolutions e -> Just e + _ -> Nothing) + (\s l -> List.filter (\v -> String.contains (String.toLower s) (String.toLower v.resolution)) l |> List.take 10) + , view = \i -> [ text i.resolution, small [] [ text <| " (" ++ String.fromInt i.count ++ ")" ] ] + , key = \i -> i.resolution + } + + +engineSource : SourceConfig m GApi.ApiEngines +engineSource = + { source = LazyList + (GE.send {}) + (\x -> case x of + GApi.Engines e -> Just e + _ -> Nothing) + (\s l -> List.filter (\v -> String.contains (String.toLower s) (String.toLower v.engine)) l |> List.take 10) + , view = \i -> [ text i.engine, small [] [ text <| " (" ++ String.fromInt i.count ++ ")" ] ] + , key = \i -> i.engine + } + + +drmSource : SourceConfig m GApi.ApiDRM +drmSource = + { source = LazyList + (GDRM.send {}) + (\x -> case x of + GApi.DRM e -> Just e + _ -> Nothing) + (\s l -> List.filter (\v -> String.contains (String.toLower s) (String.toLower v.name)) l |> List.take 10) + , view = \i -> [ text i.name, small [] [ text <| " (" ++ String.fromInt i.count ++ ")" ] ] + , key = \i -> i.name + } + + type alias Model a = { visible : Bool , value : String , results : List a + , all : Maybe (List a) -- Used by LazyList , sel : String , default : String , loading : Bool @@ -180,6 +262,7 @@ init s = { visible = False , value = s , results = [] + , all = Nothing , sel = "" , default = s , loading = False @@ -222,26 +305,26 @@ select cfg offset model = { model | sel = Maybe.withDefault "" <| Maybe.map cfg.source.key <| get nextsel } +-- Blur and focus the input on enter. +refocus : Config m a -> Cmd m +refocus cfg = Dom.blur cfg.id + |> Task.andThen (always (Dom.focus cfg.id)) + |> Task.attempt (always (cfg.wrap Noop)) + + update : Config m a -> Msg a -> Model a -> (Model a, Cmd m, Maybe a) update cfg msg model = let mod m = (m, Cmd.none, Nothing) - -- Ugly hack: blur and focus the input on enter. This does two things: - -- 1. If the user clicked on an entry (resulting in the 'Enter' message), - -- then this will cause the input to be focussed again. This is - -- convenient when adding multiple entries. - refocus = Dom.blur cfg.id - |> Task.andThen (always (Dom.focus cfg.id)) - |> Task.attempt (always (cfg.wrap Noop)) in case msg of Noop -> mod model Blur -> mod { model | visible = False } Focus -> mod { model | loading = False, visible = True } Sel s -> mod { model | sel = s } - Enter r -> (model, refocus, Just r) + Enter r -> (model, refocus cfg, Just r) - Key "Enter" -> (model, refocus, + Key "Enter" -> (model, refocus cfg, case List.filter (\i -> cfg.source.key i == model.sel) model.results |> List.head of Just x -> Just x Nothing -> List.head model.results) @@ -250,26 +333,34 @@ update cfg msg model = Key _ -> mod model Input s -> + let m = { model | value = s, default = "" } + in if String.trim s == "" - then mod { model | value = s, default = "", loading = False, results = [] } - else case cfg.source.source of + then mod { m | loading = False, results = [] } + else case (cfg.source.source) of Endpoint _ _ -> - ( { model | value = s, default = "", loading = True, wait = model.wait + 1 } + ( { m | loading = True, wait = model.wait + 1 } , Task.perform (always <| cfg.wrap <| Search <| model.wait + 1) (Process.sleep 500) , Nothing ) - Func f -> mod { model | value = s, default = "", results = f s } + LazyList e _ f -> + case (model.loading, model.all) of + (_, Just l) -> mod { m | results = f s l } + (True, _) -> mod m + (False, _) -> ({ m | loading = True }, e (cfg.wrap << Results ""), Nothing) + Func f -> mod { m | results = f s } Search i -> if model.value == "" || model.wait /= i then mod model else case cfg.source.source of Endpoint e _ -> (model, e model.value (cfg.wrap << Results model.value), Nothing) + LazyList _ _ _ -> mod model Func _ -> mod model Results s r -> mod <| - if s /= model.value then model -- Discard stale results - else case cfg.source.source of - Endpoint _ d -> { model | loading = False, results = d r |> Maybe.withDefault [] } + case cfg.source.source of + Endpoint _ d -> if s /= model.value then model else { model | loading = False, results = d r |> Maybe.withDefault [] } + LazyList _ d f -> let all = d r in { model | loading = False, all = all, results = Maybe.map (\l -> f model.value l) all |> Maybe.withDefault [] } Func _ -> model @@ -310,7 +401,7 @@ view cfg model attrs = ) in div [ class "elm_dd", class "search", style "width" "300px" ] - [ div [ classList [("hidden", not visible)] ] [ Keyed.node "ul" [] <| msg ++ List.map item model.results ] - , input + [ div [ classList [("hidden", not visible)] ] [ div [] [ Keyed.node "ul" [] <| msg ++ List.map item model.results ] ] + , Html.form [] [ input ] , span [ class "spinner", classList [("hidden", not model.loading)] ] [] ] diff --git a/elm/Lib/DropDown.elm b/elm/Lib/DropDown.elm index 286a61cb..050dcfac 100644 --- a/elm/Lib/DropDown.elm +++ b/elm/Lib/DropDown.elm @@ -1,4 +1,4 @@ -module Lib.DropDown exposing (Config, init, sub, toggle, view) +module Lib.DropDown exposing (Config, init, sub, toggle, view, onClickOutside) import Browser.Events as E import Json.Decode as JD @@ -60,9 +60,9 @@ view conf status lbl cont = ] ++ if conf.hover then [ onMouseEnter (conf.toggle True) ] else [] ) <| case status of - Api.Normal -> [ lbl, span [] [ i [] [ text "▾" ] ] ] + Api.Normal -> [ lbl, span [] [ span [ class "arrow" ] [ text "▾" ] ] ] Api.Loading -> [ lbl, span [] [ span [ class "spinner" ] [] ] ] - Api.Error e -> [ b [ class "standout" ] [ text "error" ], span [] [ i [] [ text "▾" ] ] ] + Api.Error e -> [ b [] [ text "error" ], span [] [ span [ class "arrow" ] [ text "▾" ] ] ] , div [ classList [("hidden", not conf.opened)] ] - <| if conf.opened then cont () else [ text "" ] + [ if conf.opened then div [] (cont ()) else text "" ] ] diff --git a/elm/Lib/Editsum.elm b/elm/Lib/Editsum.elm index 656441e8..7320d66a 100644 --- a/elm/Lib/Editsum.elm +++ b/elm/Lib/Editsum.elm @@ -1,5 +1,5 @@ --- This module provides an the 'Edit summary' box, including the 'hidden' and --- 'locked' moderation checkboxes. +-- This module provides an the 'Edit summary' box, including the entry state +-- option for moderators. module Lib.Editsum exposing (Model, Msg, new, update, view) @@ -11,6 +11,7 @@ import Lib.TextPreview as TP type alias Model = { authmod : Bool + , hasawait : Bool , locked : Bool , hidden : Bool , editsum : TP.Model @@ -18,25 +19,24 @@ type alias Model = type Msg - = Locked Bool - | Hidden Bool + = State Bool Bool Bool | Editsum TP.Msg new : Model new = - { authmod = False - , locked = False - , hidden = False - , editsum = TP.bbcode "" + { authmod = False + , hasawait = False + , locked = False + , hidden = False + , editsum = TP.bbcode "" } update : Msg -> Model -> (Model, Cmd Msg) update msg model = case msg of - Locked b -> ({ model | locked = b }, Cmd.none) - Hidden b -> ({ model | hidden = b }, Cmd.none) + State hid lock _ -> ({ model | hidden = hid, locked = lock }, Cmd.none) Editsum m -> let (nm,nc) = TP.update m model.editsum in ({ model | editsum = nm }, Cmd.map Editsum nc) @@ -44,14 +44,13 @@ view : Model -> Html Msg view model = let lockhid = - [ label [] - [ inputCheck "" model.hidden Hidden - , text " Deleted" ] - , label [] - [ inputCheck "" model.locked Locked - , text " Locked" ] + [ label [] [ inputRadio "entry_state" (not model.hidden && not model.locked) (State False False), text " Normal " ] + , label [] [ inputRadio "entry_state" (not model.hidden && model.locked) (State False True ), text " Locked " ] + , label [] [ inputRadio "entry_state" ( model.hidden && model.locked) (State True True ), text " Deleted " ] + , if not model.hasawait then text "" else + label [] [ inputRadio "entry_state" ( model.hidden && not model.locked) (State True False), text " Awaiting approval" ] , br [] [] - , if model.hidden + , if model.hidden && model.locked then span [] [ text "Note: edit summary of the last edit should indicate the reason for the deletion.", br [] [] ] else text "" ] @@ -59,5 +58,8 @@ view model = (if model.authmod then lockhid else []) ++ [ TP.view "" model.editsum Editsum 600 [rows 4, cols 50, minlength 2, maxlength 5000, required True] - [ b [class "title"] [ text "Edit summary", b [class "standout"] [text " (English please!)"] ] ] + [ strong [] [ text "Edit summary", b [] [ text " (English please!)" ] ] + , br [] [] + , text "Summarize the changes you have made, including links to source(s)." + ] ] diff --git a/elm/Lib/ExtLinks.elm b/elm/Lib/ExtLinks.elm deleted file mode 100644 index b37dbb6e..00000000 --- a/elm/Lib/ExtLinks.elm +++ /dev/null @@ -1,130 +0,0 @@ -module Lib.ExtLinks exposing (..) - -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) -import Regex -import Lib.Html exposing (..) -import Gen.ReleaseEdit as GRE -import Gen.ExtLinks as GEL - - --- Takes a printf-style string with a single %s or %d formatting code and a parameter to format. --- Supports 0-padding with '%0<num>d' formatting codes, where <num> <= 99. --- Returns (prefix, formatted_param, suffix) --- (This is super ugly and probably better written with elm/parser, but it gets the job done) -splitPrintf : String -> String -> (String, String, String) -splitPrintf s p = - case String.split "%" s of - [ pre, suf ] -> - case String.uncons suf of - Just ('s', suf1) -> (pre, p, suf1) - Just ('d', suf1) -> (pre, p, suf1) - Just ('0', suf1) -> - case String.uncons suf1 of - Just (c2, suf2) -> - case String.uncons suf2 of - Just ('d', suf3) -> (pre, String.padLeft (Char.toCode c2 - 48) '0' p, suf3) - Just (c3, suf3) -> - case String.uncons suf3 of - Just ('d', suf4) -> (pre, String.padLeft (10*(Char.toCode c2 - 48) + Char.toCode c3 - 48) '0' p, suf4) - _ -> (pre, "%", suf) - _ -> (pre, "%", suf) - _ -> (pre, "%", suf) - _ -> (pre, "%", suf) - _ -> (s, "", "") - - -type Rec a - = Unrecognized - | Duplicate - | Add (GEL.Site a, String) -- Site, value - - -type alias Model a = - { links : a - , sites : List (GEL.Site a) - , input : String - , rec : Rec a - , lst : Bool - } - - -type Msg a - = Del (Int -> a -> a) Int - | Input String - | Enter - | Expand - - -new : a -> List (GEL.Site a) -> Model a -new l s = - { links = l - , sites = s - , input = "" - , rec = Unrecognized - , lst = False - } - - -update : Msg a -> Model a -> Model a -update msg model = - let - match s m = (s, List.map (Maybe.withDefault "") m.submatches |> List.filter (\a -> a /= "") |> List.head |> Maybe.withDefault "") - fmtval s v = let (_, val, _) = splitPrintf s.fmt v in val - dup s val = List.filter (\l -> fmtval s l == fmtval s val) (s.links model.links) |> List.isEmpty |> not - find i = - case List.concatMap (\s -> List.map (match s) (Regex.find s.regex i)) model.sites |> List.head of - Nothing -> Unrecognized - Just (s, val) -> if dup s val then Duplicate else Add (s, val) - add s val = { model | input = "", rec = Unrecognized, links = s.add val model.links } - - in case msg of - Del f i -> { model | links = f i model.links } - Input i -> - case find (String.trim i) of - Add (s, val) -> - if s.multi || List.isEmpty (s.links model.links) - then add s val - else { model | input = i, rec = Add (s, val) } - x -> { model | input = i, rec = x } - Enter -> - case model.rec of - Add (s, val) -> add s val - _ -> model - Expand -> { model | lst = not model.lst } - - -view : Model a -> Html (Msg a) -view model = - let msg st s = span [] [ br [] [], b [ class "grayedout" ] [ text ">>> " ], if st then b [ class "standout" ] [ text s ] else text s ] - in - Html.form [ onSubmit Enter ] - [ table [] <| List.concatMap (\s -> - List.indexedMap (\i l -> - let (pre, val, suf) = splitPrintf s.fmt l - in tr [] - [ td [] [ a [ href <| pre ++ val ++ suf, target "_blank" ] [ text s.name ] ] - , td [] [ b [ class "grayedout" ] [ text pre ], text val, b [ class "grayedout" ] [ text suf ] ] - , td [] [ inputButton "remove" (Del s.del i) [] ] - ] - ) (s.links model.links) - ) model.sites - , inputText "" model.input Input [style "width" "500px", placeholder "Add URL..."] - , case (model.input, model.rec) of - ("", _) -> text "" - (_, Unrecognized) -> msg True "Invalid or unrecognized URL." - (_, Duplicate) -> msg True "URL is already listed." - (_, Add (s, _)) -> span [] [ inputButton "Edit" Enter [], msg False <| "URL recognized as: " ++ s.name ] - , div [ style "margin-top" "5px" ] - [ span [ onClickD Expand, style "cursor" "pointer" ] [ text <| if model.lst then "▾ " else "▸ ", text "Recognized sites: " ] - , if model.lst - then table [] <| List.map (\s -> - tr [] - [ td [] [ text s.name ] - , td [] <| List.indexedMap (\i l -> if modBy 2 i == 0 then b [ class "grayedout" ] [ text l ] else text l) s.patt - ] - ) model.sites - else text <| String.join ", " (List.map (\s -> s.name) model.sites) ++ "." - ] - ] diff --git a/elm/Lib/Ffi.elm b/elm/Lib/Ffi.elm index b5601a9b..af8c963a 100644 --- a/elm/Lib/Ffi.elm +++ b/elm/Lib/Ffi.elm @@ -5,7 +5,7 @@ -- 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. +-- window.elmFfi_<name> and the actual implementations are in elm-support.js. -- -- Use sparingly, all of this will likely break in future Elm versions. module Lib.Ffi exposing (..) diff --git a/elm/Lib/Ffi.js b/elm/Lib/Ffi.js deleted file mode 100644 index 78d6083a..00000000 --- a/elm/Lib/Ffi.js +++ /dev/null @@ -1,26 +0,0 @@ -window.elmFfi_innerHtml = function(wrap,call) { // \s -> _VirtualDom_property('innerHTML', _Json_wrap(s)) - return function(s) { - return { - $: 'a2', - n: 'innerHTML', - o: wrap(s) - } - } -}; - -window.elmFfi_elemCall = function(wrap,call) { // _Browser_call - return call -}; - -window.elmFfi_fmtFloat = function(wrap,call) { - return function(val) { - return function(prec) { - return val.toLocaleString('en-US', { minimumFractionDigits: prec, maximumFractionDigits: prec }); - } - } -}; - -var urlStatic = document.querySelector('link[rel=stylesheet]').href.replace(/^(https?:\/\/[^/]+)\/.*$/, '$1'); -window.elmFfi_urlStatic = function(wrap,call) { - return urlStatic -}; diff --git a/elm/Lib/Html.elm b/elm/Lib/Html.elm index 2d7d516c..7ec8dacc 100644 --- a/elm/Lib/Html.elm +++ b/elm/Lib/Html.elm @@ -7,6 +7,7 @@ import Json.Decode as JD import List import Lib.Api as Api import Lib.Util exposing (..) +import Lib.Ffi as Ffi import Gen.Types as T @@ -25,6 +26,8 @@ onInputValidation msg = custom "input" <| targetValue (JD.at ["target", "validity", "valid"] JD.bool) +onInvalid : msg -> Attribute msg +onInvalid msg = on "invalid" (JD.succeed msg) -- Multi-<br> (ugly but oh, so, convenient) br_ : Int -> Html m @@ -33,9 +36,9 @@ br_ n = if n == 1 then br [] [] else span [] <| List.repeat n <| br [] [] -- 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 ] +-- form_ id Submit_msg (state == Disabled) [contents] +form_ : String -> msg -> Bool -> List (Html msg) -> Html msg +form_ s sub dis cont = Html.form [ id s, onSubmit sub ] [ fieldset [disabled dis] cont ] @@ -46,13 +49,13 @@ inputButton val onch attrs = -- Submit button with loading indicator and error message display submitButton : String -> Api.State -> Bool -> Html m -submitButton val state valid = div [] +submitButton val state valid = span [] [ input [ type_ "submit", class "submit", tabindex 10, value val, disabled (state == Api.Loading || not valid) ] [] , case state of - Api.Error r -> p [] [ b [class "standout" ] [ text <| Api.showResponse r ] ] + Api.Error r -> p [] [ b [] [ text <| Api.showResponse r ] ] _ -> if valid then text "" - else p [] [ b [class "standout" ] [ text "The form contains errors, please fix these before submitting. " ] ] + else p [] [ b [] [ text "The form contains errors, please fix these before submitting. " ] ] , if state == Api.Loading then div [ class "spinner" ] [] else text "" @@ -125,10 +128,11 @@ inputTextArea nam val onch attrs = textarea ( , onInput onch , rows 4 , cols 50 + , value val ] ++ attrs ++ (if nam == "" then [] else [ id nam, name nam ]) - ) [ text val ] + ) [] inputCheck : String -> Bool -> (Bool -> m) -> Html m @@ -154,14 +158,14 @@ inputRadio nam val onch = input ( -- Same as an inputText, but formats/parses an integer as Q### -inputWikidata : String -> Maybe Int -> (Maybe Int -> m) -> Html m -inputWikidata nam val onch = +inputWikidata : String -> Maybe Int -> (Maybe Int -> m) -> List (Attribute m) -> Html m +inputWikidata nam val onch attr = inputText nam (case val of Nothing -> "" Just v -> "Q" ++ String.fromInt v) (\v -> onch <| if v == "" then Nothing else String.toInt <| if String.startsWith "Q" v then String.dropLeft 1 v else v) - [ pattern "^Q?[1-9][0-9]{0,8}$" ] + (pattern "^Q?[1-9][0-9]{0,8}$" :: attr) -- Similar to inputCheck and inputRadio with a label, except this is just a link. @@ -187,7 +191,7 @@ formField lbl cont = else let (nlbl, eng) = if String.endsWith "#eng" lbl then (String.dropRight 4 lbl, True) else (lbl, False) - genlbl str = text str :: if eng then [ br [] [], b [ class "standout" ] [ text "English please!" ] ] else [] + genlbl str = text str :: if eng then [ br [] [], b [] [ text "English please!" ] ] else [] in td [ class "label" ] <| case String.split "::" nlbl of @@ -199,10 +203,19 @@ formField lbl cont = langIcon : String -> Html m -langIcon l = abbr [ class "icons lang", class l, title (Maybe.withDefault "" <| lookup l T.languages) ] [ text " " ] +langIcon l = abbr [ class ("icon-lang-"++l), title (Maybe.withDefault "" <| lookup l T.languages) ] [ text " " ] platformIcon : String -> Html m -platformIcon l = abbr [ class "icons", class l, title (Maybe.withDefault "" <| lookup l T.platforms) ] [ text " " ] +platformIcon l = abbr [ class ("icon-plat-"++l), title (Maybe.withDefault "" <| lookup l T.platforms) ] [ text " " ] releaseTypeIcon : String -> Html m -releaseTypeIcon t = abbr [ class ("icons rt"++t), title (Maybe.withDefault "" <| lookup t T.releaseTypes) ] [ text " " ] +releaseTypeIcon t = abbr [ class ("icon-rt"++t), title (Maybe.withDefault "" <| lookup t T.releaseTypes) ] [ text " " ] + +-- Special values: -1 = "add to list", not 1-6 = unknown +-- (Because why use the type system to encode special values?) +ulistIcon : Int -> String -> Html m +ulistIcon n lbl = + let fn = if n == -1 then "add" + else if n >= 1 && n <= 6 then "l" ++ String.fromInt n + else "unknown" + in abbr [ class ("icon-list-"++fn), title lbl ] [] diff --git a/elm/Lib/Image.elm b/elm/Lib/Image.elm new file mode 100644 index 00000000..14eca441 --- /dev/null +++ b/elm/Lib/Image.elm @@ -0,0 +1,184 @@ +module Lib.Image exposing (..) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import Process +import Task +import File exposing (File) +import Lib.Html exposing (..) +import Lib.Api as Api +import Lib.Util exposing (imageUrl) +import Gen.Api as GApi +import Gen.Image as GI +import Gen.ImageVote as GIV + + +type State + = Normal + | Invalid + | NotFound + | Loading + | Error GApi.Response + +type alias Image = + { id : Maybe String + , img : Maybe GApi.ApiImageResult + , imgState : State + , saveState : Api.State + , saveTimer : Bool + } + + +info : Maybe GApi.ApiImageResult -> Image +info img = + { id = Maybe.map (\i -> i.id) img + , img = img + , imgState = Normal + , saveState = Api.Normal + , saveTimer = False + } + + +-- Fetch image info from the ID +new : Bool -> String -> (Image, Cmd Msg) +new valid id = + ( { id = if id == "" then Nothing else Just id + , img = Nothing + , imgState = if id == "" then Normal else if valid then Loading else Invalid + , saveState = Api.Normal + , saveTimer = False + } + , if valid && id /= "" then GI.send { id = id } Loaded else Cmd.none + ) + + +-- Upload a new image from a form +upload : Api.ImageType -> File -> (Image, Cmd Msg) +upload t f = + ( { id = Nothing + , img = Nothing + , imgState = Loading + , saveState = Api.Normal + , saveTimer = False + } + , Api.postImage t f Loaded) + + +type Msg + = Loaded GApi.Response + | MySex Int Bool + | MyVio Int Bool + | Save + | Saved GApi.Response + + +update : Msg -> Image -> (Image, Cmd Msg) +update msg model = + let + save m = + if m.saveTimer || Maybe.withDefault True (Maybe.map (\i -> i.token == Nothing || i.my_sexual == Nothing || i.my_violence == Nothing) m.img) + then (m, Cmd.none) + else ({ m | saveTimer = True }, Task.perform (always Save) (Process.sleep 1000)) + in + case msg of + Loaded (GApi.ImageResult [i]) -> ({ model | id = Just i.id, img = Just i, imgState = Normal}, Cmd.none) + Loaded (GApi.ImageResult []) -> ({ model | imgState = NotFound}, Cmd.none) + Loaded e -> ({ model | imgState = Error e }, Cmd.none) + + MySex v _ -> save { model | img = Maybe.map (\i -> { i | my_sexual = Just v }) model.img } + MyVio v _ -> save { model | img = Maybe.map (\i -> { i | my_violence = Just v }) model.img } + + Save -> + case Maybe.map (\i -> (i.token, i.my_sexual, i.my_violence)) model.img of + Just (Just token, Just sex, Just vio) -> + ( { model | saveTimer = False, saveState = Api.Loading } + , GIV.send { votes = [{ id = Maybe.withDefault "" model.id, token = token, sexual = sex, violence = vio, overrule = False }] } Saved) + _ -> (model, Cmd.none) + Saved (GApi.Success) -> ({ model | saveState = Api.Normal}, Cmd.none) + Saved e -> ({ model | saveState = Api.Error e }, Cmd.none) + + + +isValid : Image -> Bool +isValid img = img.imgState == Normal + + +viewImg : Image -> Html m +viewImg image = + case (image.imgState, image.img) of + (Loading, _) -> div [ class "spinner" ] [] + (NotFound, _) ->b [] [ text "Image not found." ] + (Invalid, _) -> b [] [ text "Invalid image ID." ] + (Error e, _) -> b [] [ text <| Api.showResponse e ] + (_, Nothing) -> text "No image." + (_, Just i) -> + let + maxWidth = toFloat <| if String.startsWith "sf" i.id then 136 else 10000 + maxHeight = toFloat <| if String.startsWith "sf" i.id then 102 else 10000 + sWidth = maxWidth / toFloat i.width + sHeight = maxHeight / toFloat i.height + scale = Basics.min 1 <| if sWidth < sHeight then sWidth else sHeight + imgWidth = round <| scale * toFloat i.width + imgHeight = round <| scale * toFloat i.height + in + -- TODO: Onclick iv.js support for screenshot thumbnails + label [ class "imghover", style "width" (String.fromInt imgWidth++"px"), style "height" (String.fromInt imgHeight++"px") ] + [ div [ class "imghover--visible" ] + [ if String.startsWith "sf" i.id + then a [ href (imageUrl "" i.id), attribute "data-iv" <| String.fromInt i.width ++ "x" ++ String.fromInt i.height ++ ":scr" ] + [ img [ src <| imageUrl ".t" i.id ] [] ] + else img [ src <| imageUrl "" i.id ] [] + , a [ class "imghover--overlay", href <| "/img/"++i.id ] <| + case (i.sexual_avg, i.violence_avg) of + (Just sex, Just vio) -> + -- XXX: These thresholds are subject to change, maybe just show the numbers here? + [ text <| if sex > 1.3 then "Explicit" else if sex > 0.4 then "Suggestive" else "Safe" + , text " / " + , text <| if vio > 1.3 then "Brutal" else if vio > 0.4 then "Violent" else "Tame" + , text <| " (" ++ String.fromInt i.votecount ++ ")" + ] + _ -> [ text "Not flagged" ] + ] + ] + + +viewVote : Image -> (Msg -> a) -> a -> Maybe (Html a) +viewVote model wrap msg = + let + rad i sex val = input + [ type_ "radio" + , tabindex 10 + , required True + , onInvalid msg + , onCheck <| \b -> wrap <| (if sex then MySex else MyVio) val b + , checked <| (if sex then i.my_sexual else i.my_violence) == Just val + , name <| "imgvote-" ++ (if sex then "sex" else "vio") ++ "-" ++ Maybe.withDefault "" model.id + ] [] + vote i = table [] + [ thead [] [ tr [] + [ td [] [ text "Sexual ", if model.saveState == Api.Loading then span [ class "spinner" ] [] else text "" ] + , td [] [ text "Violence" ] + ] ] + , tfoot [] <| + case model.saveState of + Api.Error e -> [ tr [] [ td [ colspan 2 ] [ b [] [ text (Api.showResponse e) ] ] ] ] + _ -> [] + , tr [] + [ td [ style "white-space" "nowrap" ] + [ label [] [ rad i True 0, text " Safe" ], br [] [] + , label [] [ rad i True 1, text " Suggestive" ], br [] [] + , label [] [ rad i True 2, text " Explicit" ] + ] + , td [ style "white-space" "nowrap" ] + [ label [] [ rad i False 0, text " Tame" ], br [] [] + , label [] [ rad i False 1, text " Violent" ], br [] [] + , label [] [ rad i False 2, text " Brutal" ] + ] + ] + ] + in case model.img of + Nothing -> Nothing + Just i -> + if i.token == Nothing then Nothing + else Just (vote i) diff --git a/elm/Lib/RDate.elm b/elm/Lib/RDate.elm index 67888114..3eca4cfa 100644 --- a/elm/Lib/RDate.elm +++ b/elm/Lib/RDate.elm @@ -1,8 +1,9 @@ -- Utility module and UI widget for handling release dates. -- --- Release dates are integers with the following format: 0 or yyyymmdd +-- Release dates are integers with the following format: 0, 1 or yyyymmdd -- Special values --- 0 -> unknown +-- 0 -> unknown +-- 1 -> "today" (only used as filter) -- 99999999 -> TBA -- yyyy9999 -> year known, month & day unknown -- yyyymm99 -> year & month known, day unknown @@ -14,6 +15,7 @@ import Html.Events exposing (..) import Date import Lib.Html exposing (..) import Gen.Types as GT +import Gen.Api as GApi type alias RDate = Int @@ -44,18 +46,23 @@ fromDate d = , d = Date.day d } +maxDayInMonth : Int -> Int -> Int +maxDayInMonth y m = Date.fromCalendarDate y (Date.numberToMonth m) 1 |> Date.add Date.Months 1 |> Date.add Date.Days -1 |> Date.day normalize : RDateComp -> RDateComp normalize r = - if r.y == 0 then { y = 0, m = 0, d = 0 } + if r.y == 0 then { y = 0, m = 0, d = clamp 0 1 r.d } else if r.y == 9999 then { y = 9999, m = 99, d = 99 } - else if r.m == 99 then { y = r.y, m = 99, d = 99 } + else if r.m == 0 || r.m == 99 then { y = r.y, m = 99, d = 99 } + else if r.d == 0 then { r | d = 99 } + else if r.d /= 99 && r.d > 28 then { r | d = Basics.min r.d (maxDayInMonth r.y r.m) } -- Make sure the day field is in range else r format : RDateComp -> String format date = case (date.y, date.m, date.d) of + ( 0, 0, 1) -> "today" ( 0, _, _) -> "unknown" (9999, _, _) -> "TBA" ( y, 99, 99) -> String.fromInt y @@ -70,24 +77,45 @@ display today d = in if future then b [ class "future" ] [ text fmt ] else text fmt +monthList : List String +monthList = + [ "Jan" + , "Feb" + , "Mar" + , "Apr" + , "May" + , "Jun" + , "Jul" + , "Aug" + , "Sep" + , "Oct" + , "Nov" + , "Dec" + ] + +monthSelect : List (Int, String) +monthSelect = List.indexedMap (\m s -> (m+1, String.fromInt (m+1) ++ " (" ++ s ++ ")")) monthList + -- Input widget. --- --- BUG: Changing the month or year fields when day 30-31 is selected but no --- longer valid results in an invalid RDate. It also causes the "-day-" option --- to be selected (which is good), so I don't expect that many people will try --- to submit the form without changing it. -view : RDate -> Bool -> (RDate -> msg) -> Html msg -view ro permitUnknown msg = +view : RDate -> Bool -> Bool -> (RDate -> msg) -> Html msg +view ro permitUnknown permitToday msg = let r = expand ro range from to f = List.range from to |> List.map (\n -> (f n |> normalize |> compact, String.fromInt n)) - yl = (if permitUnknown then [(0, "Unknown")] else []) - ++ [(99999999, "TBA")] - ++ List.reverse (range 1980 (GT.curYear + 5) (\n -> {r|y=n})) - ml = ({r|m=99} |> normalize |> compact, "- month -") :: range 1 12 (\n -> {r|m=n}) - maxDay = Date.fromCalendarDate r.y (Date.numberToMonth r.m) 1 |> Date.add Date.Months 1 |> Date.add Date.Days -1 |> Date.day - dl = ({r|d=99} |> normalize |> compact, "- day -") :: range 1 maxDay (\n -> {r|d=n}) + yl = (if permitToday then [(1, "Today" )] else []) + ++ (if permitUnknown then [(0, "Unknown")] else []) + ++ [(99999999, "TBA")] + ++ List.reverse (range 1980 (GT.curYear + 5) (\n -> {r|y=n})) + ml = ({r|m=99} |> normalize |> compact, "- month -") :: List.map (\(m,s) -> (compact (normalize {r|m=m}), s)) monthSelect + dl = ({r|d=99} |> normalize |> compact, "- day -") :: range 1 (maxDayInMonth r.y r.m) (\n -> {r|d=n}) in div [] [ inputSelect "" ro msg [ style "width" "100px" ] yl , if r.y == 0 || r.y == 9999 then text "" else inputSelect "" ro msg [ style "width" "90px" ] ml , if r.m == 0 || r.m == 99 then text "" else inputSelect "" ro msg [ style "width" "90px" ] dl ] + + +-- Handy function for formatting release info as a string +-- (Typically used in selection boxes) +-- (Why is that in this module, you ask? Well, where else do I put it?) +showrel : GApi.ApiReleases -> String +showrel r = "[" ++ (format (expand r.released)) ++ " " ++ (String.join "," r.lang) ++ "] " ++ r.title ++ " (" ++ r.id ++ ")" diff --git a/elm/Lib/TextPreview.elm b/elm/Lib/TextPreview.elm index 9431848a..dc876048 100644 --- a/elm/Lib/TextPreview.elm +++ b/elm/Lib/TextPreview.elm @@ -7,7 +7,6 @@ import Lib.Html exposing (..) import Lib.Ffi as Ffi import Lib.Api as Api import Gen.Api as GApi -import Gen.Markdown as GM import Gen.BBCode as GB @@ -32,16 +31,6 @@ bbcode data = } -markdown : String -> Model -markdown data = - { state = Api.Normal - , data = data - , preview = "" - , display = False - , endpoint = GM.send - , class = "preview docs" - } - type Msg = Edit String @@ -73,18 +62,18 @@ view name model cmdmap width attr header = display = model.display && model.preview /= "" in div [ class "textpreview", style "width" (String.fromInt width ++ "px") ] - [ span [] - [ p [] header - , p [ class "right", classList [("invisible", model.data == "")] ] + [ div [] + [ div [] header + , div [ classList [("invisible", model.data == "")] ] [ case model.state of Api.Loading -> span [ class "spinner" ] [] - Api.Error _ -> b [ class "grayedout" ] [ text "Error loading preview. " ] + Api.Error _ -> small [] [ text "Error loading preview. " ] Api.Normal -> text "" , if display then a [ onClickN (cmdmap TextArea) ] [ text "Edit" ] - else i [] [text "Edit"] + else span [] [text "Edit"] , if display - then i [] [text "Preview"] + then span [] [text "Preview"] else a [ onClickN (cmdmap Preview) ] [ text "Preview" ] ] ] diff --git a/elm/Lib/Util.elm b/elm/Lib/Util.elm index f5954772..edde2e37 100644 --- a/elm/Lib/Util.elm +++ b/elm/Lib/Util.elm @@ -1,9 +1,12 @@ module Lib.Util exposing (..) -import Dict +import Set import Task +import Process import Regex import Lib.Ffi as Ffi +import Gen.Api as GApi +import Gen.Types as GT -- Delete an element from a List delidx : Int -> List a -> List a @@ -28,45 +31,44 @@ hasDuplicates l = step e acc = case acc of Nothing -> Nothing - Just m -> if Dict.member e m then Nothing else Just (Dict.insert e True m) + Just m -> if Set.member e m then Nothing else Just (Set.insert e m) in - case List.foldr step (Just Dict.empty) l of + case List.foldr step (Just Set.empty) l of Nothing -> True Just _ -> False +-- Returns true if list a contains elements also in list b +contains : List comparable -> List comparable -> Bool +contains a b = + let d = Set.fromList b + in List.any (\e -> Set.member e d) a + + -- Haskell's 'lookup' - find an entry in an association list lookup : a -> List (a,b) -> Maybe b lookup n l = List.filter (\(a,_) -> a == n) l |> List.head |> Maybe.map Tuple.second +-- Have to use Process.sleep instead of Task.succeed here, otherwise any +-- subscriptions are not updated. selfCmd : msg -> Cmd msg -selfCmd m = Task.perform (always m) (Task.succeed True) - - --- Based on VNDBUtil::gtintype() -validateGtin : String -> Bool -validateGtin = - let check = String.fromInt - >> String.reverse - >> String.toList - >> List.indexedMap (\i c -> (Char.toCode c - Char.toCode '0') * if modBy 2 i == 0 then 1 else 3) - >> List.sum - inval n = - n < 1000000000 - || (n >= 200000000000 && n < 600000000000) - || (n >= 2000000000000 && n < 3000000000000) - || n >= 9770000000000 - || modBy 10 (check n) /= 0 - in String.filter Char.isDigit >> String.toInt >> Maybe.map (not << inval) >> Maybe.withDefault False - - --- Convert an image ID (e.g. "sf500") into a URL. -imageUrl : String -> String -imageUrl id = +selfCmd m = Task.perform (always m) (Process.sleep 1.0) + + +-- Convert a dir suffix ("" or ".t") and an image ID (e.g. "sf500") into a URL. +imageUrl : String -> String -> String +imageUrl suff id = let num = String.dropLeft 2 id |> String.toInt |> Maybe.withDefault 0 - in Ffi.urlStatic ++ "/" ++ String.left 2 id ++ "/" ++ String.fromInt (modBy 10 (num // 10)) ++ String.fromInt (modBy 10 num) ++ "/" ++ String.fromInt num ++ ".jpg" + in Ffi.urlStatic ++ "/" ++ String.left 2 id ++ suff ++ "/" ++ String.fromInt (modBy 10 (num // 10)) ++ String.fromInt (modBy 10 num) ++ "/" ++ String.fromInt num ++ ".jpg" + +vndbidNum : String -> Int +vndbidNum = String.dropLeft 1 >> String.toInt >> Maybe.withDefault 0 + + +vndbid : Char -> Int -> String +vndbid c n = String.fromChar c ++ String.fromInt n jap_ : Regex.Regex @@ -74,10 +76,54 @@ jap_ = Maybe.withDefault Regex.never (Regex.fromString "[\\u3000-\\u9fff\\uff00- -- Not even close to comprehensive, just excludes a few scripts commonly found on VNDB. nonlatin_ : Regex.Regex -nonlatin_ = Maybe.withDefault Regex.never (Regex.fromString "[\\u3000-\\u9fff\\uff00-\\uff9f\\u0400-\\u04ff\\u1100-\\u11ff\\uac00-\\ud7af]") +nonlatin_ = Maybe.withDefault Regex.never (Regex.fromString "[\\u0400-\\u04ff\\u0600-\\u06ff\\u0e00-\\u0e7f\\u1100-\\u11ff\\u1400-\\u167f\\u3040-\\u3099\\u30a1-\\u30fa\\u3100-\\u9fff\\uac00-\\ud7af\\uff66-\\uffdc\\u{20000}-\\u{323af}]") +-- This regex can't differentiate between Japanese and Chinese, so has a good chance of returning true for Chinese as well. containsJapanese : String -> Bool containsJapanese = Regex.contains jap_ containsNonLatin : String -> Bool containsNonLatin = Regex.contains nonlatin_ + + +-- List of script-languages (i.e. not the generic "Chinese" option), with JA and EN ordered first. +scriptLangs : List (String, String) +scriptLangs = + (List.filter (\(l,_) -> l == "ja") GT.languages) + ++ (List.filter (\(l,_) -> l == "en") GT.languages) + ++ (List.filter (\(l,_) -> l /= "zh" && l /= "en" && l /= "ja") GT.languages) + +-- "Location languages", i.e. generic language without script indicator, again with JA and EN ordered first. +locLangs : List (String, String) +locLangs = + (List.filter (\(l,_) -> l == "ja") GT.languages) + ++ (List.filter (\(l,_) -> l == "en") GT.languages) + ++ (List.filter (\(l,_) -> l /= "zh-Hans" && l /= "zh-Hant" && l /= "en" && l /= "ja") GT.languages) + + +-- Format a release resolution, first argument indicates whether empty string is to be used for "unknown" +resoFmt : Bool -> Int -> Int -> String +resoFmt empty x y = + case (x,y) of + (0,0) -> if empty then "" else "Unknown" + (0,1) -> "Non-standard" + _ -> String.fromInt x ++ "x" ++ String.fromInt y + +-- Inverse of resoFmt +resoParse : Bool -> String -> Maybe (Int, Int) +resoParse empty s = + let t = String.replace "*" "x" s + |> String.replace "×" "x" + |> String.replace " " "" + |> String.replace "\t" "" + |> String.toLower |> String.trim + in + case (t, String.split "x" t) of + ("", _) -> if empty then Just (0,0) else Nothing + ("unknown", _) -> Just (0,0) + ("non-standard", _) -> Just (0,1) + (_, [sx,sy]) -> + case (String.toInt sx, String.toInt sy) of + (Just ix, Just iy) -> if ix < 1 || ix > 32767 || iy < 1 || iy > 32767 then Nothing else Just (ix,iy) + _ -> Nothing + _ -> Nothing diff --git a/elm/ReleaseEdit.elm b/elm/ReleaseEdit.elm deleted file mode 100644 index 1bcf91c5..00000000 --- a/elm/ReleaseEdit.elm +++ /dev/null @@ -1,450 +0,0 @@ -module ReleaseEdit exposing (main) - -import Html exposing (..) -import Html.Events exposing (..) -import Html.Attributes exposing (..) -import Browser -import Browser.Navigation exposing (load) -import Set -import Lib.Util exposing (..) -import Lib.Html exposing (..) -import Lib.TextPreview as TP -import Lib.Api as Api -import Lib.DropDown as DD -import Lib.Editsum as Editsum -import Lib.RDate as D -import Lib.Autocomplete as A -import Lib.ExtLinks as EL -import Gen.ReleaseEdit as GRE -import Gen.Types as GT -import Gen.Api as GApi -import Gen.ExtLinks as GEL - - -main : Program GRE.Recv Model Msg -main = Browser.element - { init = \e -> (init e, Cmd.none) - , view = view - , update = update - , subscriptions = sub - } - - -type alias Model = - { state : Api.State - , title : String - , original : String - , rtype : String - , patch : Bool - , freeware : Bool - , doujin : Bool - , lang : Set.Set String - , langDd : DD.Config Msg - , plat : Set.Set String - , platDd : DD.Config Msg - , media : List GRE.RecvMedia - , gtin : String - , gtinValid : Bool - , catalog : String - , released : D.RDate - , minage : Int - , uncensored : Bool - , resoX : Int - , resoY : Int - , resoConf : A.Config Msg GRE.RecvResolutions - , reso : A.Model GRE.RecvResolutions - , voiced : Int - , ani_story : Int - , ani_ero : Int - , website : String - , engineConf : A.Config Msg GRE.RecvEngines - , engine : A.Model GRE.RecvEngines - , extlinks : EL.Model GRE.RecvExtlinks - , vn : List GRE.RecvVn - , vnAdd : A.Model GApi.ApiVNResult - , prod : List GRE.RecvProducers - , prodAdd : A.Model GApi.ApiProducerResult - , notes : TP.Model - , editsum : Editsum.Model - , id : Maybe Int - } - - -engineConf : List GRE.RecvEngines -> A.Config Msg GRE.RecvEngines -engineConf lst = - { wrap = Engine - , id = "engine" - , source = - { source = A.Func (\s -> List.filter (\e -> String.contains (String.toLower s) (String.toLower e.engine)) lst |> List.take 10) - , view = \i -> [ text i.engine, b [ class "grayedout" ] [ text <| " (" ++ String.fromInt i.count ++ ")" ] ] - , key = \i -> i.engine - } - } - - -resoConf : List GRE.RecvResolutions -> A.Config Msg GRE.RecvResolutions -resoConf lst = - { wrap = Resolution - , id = "resolution" - , source = - { source = A.Func (\s -> List.filter (\e -> String.contains (String.toLower s) (String.toLower e.resolution)) lst |> List.take 10) - , view = \i -> [ text i.resolution, b [ class "grayedout" ] [ text <| " (" ++ String.fromInt i.count ++ ")" ] ] - , key = \i -> i.resolution - } - } - -resoFmt : Int -> Int -> String -resoFmt x y = - case (x,y) of - (0,0) -> "" - (0,1) -> "Non-standard" - _ -> String.fromInt x ++ "x" ++ String.fromInt y - -resoParse : String -> Maybe (Int, Int) -resoParse s = - let t = String.replace "*" "x" s - |> String.replace "×" "x" - |> String.replace " " "" - |> String.replace "\t" "" - |> String.toLower |> String.trim - in - case (t, String.split "x" t) of - ("", _) -> Just (0,0) - ("non-standard", _) -> Just (0,1) - (_, [sx,sy]) -> - case (String.toInt sx, String.toInt sy) of - (Just ix, Just iy) -> if ix < 1 || ix > 32767 || iy < 1 || iy > 32767 then Nothing else Just (ix,iy) - _ -> Nothing - _ -> Nothing - - -init : GRE.Recv -> Model -init d = - { state = Api.Normal - , title = d.title - , original = d.original - , rtype = d.rtype - , patch = d.patch - , freeware = d.freeware - , doujin = d.doujin - , lang = Set.fromList <| List.map (\e -> e.lang) d.lang - , langDd = DD.init "lang" LangOpen - , plat = Set.fromList <| List.map (\e -> e.platform) d.platforms - , platDd = DD.init "platforms" PlatOpen - , media = List.map (\m -> { m | qty = if m.qty == 0 then 1 else m.qty }) d.media - , gtin = if d.gtin == "0" then "" else String.padLeft 12 '0' d.gtin - , gtinValid = True - , catalog = d.catalog - , released = d.released - , minage = d.minage - , uncensored = d.uncensored - , resoX = d.reso_x - , resoY = d.reso_y - , resoConf = resoConf d.resolutions - , reso = A.init (resoFmt d.reso_x d.reso_y) - , voiced = d.voiced - , ani_story = d.ani_story - , ani_ero = d.ani_ero - , website = d.website - , engineConf = engineConf d.engines - , engine = A.init d.engine - , extlinks = EL.new d.extlinks GEL.releaseSites - , vn = d.vn - , vnAdd = A.init "" - , prod = d.producers - , prodAdd = A.init "" - , notes = TP.bbcode d.notes - , editsum = { authmod = d.authmod, editsum = TP.bbcode d.editsum, locked = d.locked, hidden = d.hidden } - , id = d.id - } - - -encode : Model -> GRE.Send -encode model = - { id = model.id - , editsum = model.editsum.editsum.data - , hidden = model.editsum.hidden - , locked = model.editsum.locked - , title = model.title - , original = model.original - , rtype = model.rtype - , patch = model.patch - , freeware = model.freeware - , doujin = model.doujin - , lang = List.map (\l -> {lang=l }) <| Set.toList model.lang - , platforms = List.map (\l -> {platform=l}) <| Set.toList model.plat - , media = model.media - , gtin = model.gtin - , catalog = model.catalog - , released = model.released - , minage = model.minage - , uncensored = model.uncensored - , reso_x = model.resoX - , reso_y = model.resoY - , voiced = model.voiced - , ani_story = model.ani_story - , ani_ero = model.ani_ero - , website = model.website - , engine = model.engine.value - , extlinks = model.extlinks.links - , vn = List.map (\l -> {vid=l.vid}) model.vn - , producers = List.map (\l -> {pid=l.pid, developer=l.developer, publisher=l.publisher}) model.prod - , notes = model.notes.data - } - -vnConfig : A.Config Msg GApi.ApiVNResult -vnConfig = { wrap = VNSearch, id = "vnadd", source = A.vnSource } - -producerConfig : A.Config Msg GApi.ApiProducerResult -producerConfig = { wrap = ProdSearch, id = "prodadd", source = A.producerSource } - -sub : Model -> Sub Msg -sub m = Sub.batch [ DD.sub m.langDd, DD.sub m.platDd ] - -type Msg - = Title String - | Original String - | RType String - | Patch Bool - | Freeware Bool - | Doujin Bool - | Lang String Bool - | LangOpen Bool - | Plat String Bool - | PlatOpen Bool - | MediaType Int String - | MediaQty Int Int - | MediaDel Int - | Gtin String - | Catalog String - | Released D.RDate - | Minage Int - | Uncensored Bool - | Resolution (A.Msg GRE.RecvResolutions) - | Voiced Int - | AniStory Int - | AniEro Int - | Website String - | Engine (A.Msg GRE.RecvEngines) - | ExtLinks (EL.Msg GRE.RecvExtlinks) - | VNDel Int - | VNSearch (A.Msg GApi.ApiVNResult) - | ProdDel Int - | ProdRole Int (Bool, Bool) - | ProdSearch (A.Msg GApi.ApiProducerResult) - | Notes (TP.Msg) - | Editsum Editsum.Msg - | Submit - | Submitted GApi.Response - - -update : Msg -> Model -> (Model, Cmd Msg) -update msg model = - case msg of - Title s -> ({ model | title = s }, Cmd.none) - Original s -> ({ model | original = s }, Cmd.none) - RType s -> ({ model | rtype = s }, Cmd.none) - Patch b -> ({ model | patch = b }, Cmd.none) - Freeware b -> ({ model | freeware = b }, Cmd.none) - Doujin b -> ({ model | doujin = b }, Cmd.none) - Lang s b -> ({ model | lang = if b then Set.insert s model.lang else Set.remove s model.lang }, Cmd.none) - LangOpen b -> ({ model | langDd = DD.toggle model.langDd b }, Cmd.none) - Plat s b -> ({ model | plat = if b then Set.insert s model.plat else Set.remove s model.plat }, Cmd.none) - PlatOpen b -> ({ model | platDd = DD.toggle model.platDd b }, Cmd.none) - MediaType n s -> ({ model | media = if s /= "unk" && n == List.length model.media then model.media ++ [{medium = s, qty = 1}] else modidx n (\m -> { m | medium = s }) model.media }, Cmd.none) - MediaQty n i -> ({ model | media = modidx n (\m -> { m | qty = i }) model.media }, Cmd.none) - MediaDel i -> ({ model | media = delidx i model.media }, Cmd.none) - Gtin s -> ({ model | gtin = s, gtinValid = s == "" || validateGtin s }, Cmd.none) - Catalog s -> ({ model | catalog = s }, Cmd.none) - Released d -> ({ model | released = d }, Cmd.none) - Minage i -> ({ model | minage = i }, Cmd.none) - Uncensored b->({ model | uncensored = b }, Cmd.none) - Resolution m-> - let (nm, c, en) = A.update model.resoConf m model.reso - nmod = { model | reso = Maybe.withDefault nm <| Maybe.map (\e -> A.clear nm e.resolution) en } - n2mod = case resoParse nmod.reso.value of - Just (x,y) -> { nmod | resoX = x, resoY = y } - Nothing -> nmod - in (n2mod, c) - Voiced i -> ({ model | voiced = i }, Cmd.none) - AniStory i -> ({ model | ani_story = i }, Cmd.none) - AniEro i -> ({ model | ani_ero = i }, Cmd.none) - Website s -> ({ model | website = s }, Cmd.none) - Engine m -> - let (nm, c, en) = A.update model.engineConf m model.engine - nmod = case en of - Just e -> A.clear nm e.engine - Nothing -> nm - in ({ model | engine = nmod }, c) - ExtLinks m -> ({ model | extlinks = EL.update m model.extlinks }, Cmd.none) - - VNDel i -> ({ model | vn = delidx i model.vn }, Cmd.none) - VNSearch m -> - let (nm, c, res) = A.update vnConfig m model.vnAdd - in case res of - Nothing -> ({ model | vnAdd = nm }, c) - Just v -> - if List.any (\vn -> vn.vid == v.id) model.vn - then ({ model | vnAdd = nm }, c) - else ({ model | vnAdd = A.clear nm "", vn = model.vn ++ [{ vid = v.id, title = v.title}] }, c) - - ProdDel i -> ({ model | prod = delidx i model.prod }, Cmd.none) - ProdRole i (d,p) -> ({ model | prod = modidx i (\e -> { e | developer = d, publisher = p }) model.prod }, Cmd.none) - ProdSearch m -> - let (nm, c, res) = A.update producerConfig m model.prodAdd - in case res of - Nothing -> ({ model | prodAdd = nm }, c) - Just p -> - if List.any (\e -> e.pid == p.id) model.prod - then ({ model | prodAdd = nm }, c) - else ({ model | prodAdd = A.clear nm "", prod = model.prod ++ [{ pid = p.id, name = p.name, developer = True, publisher = True}] }, c) - - Notes m -> let (nm, nc) = TP.update m model.notes in ({ model | notes = nm }, Cmd.map Notes nc) - Editsum m -> let (nm,nc) = Editsum.update m model.editsum in ({ model | editsum = nm }, Cmd.map Editsum nc) - - Submit -> ({ model | state = Api.Loading }, GRE.send (encode model) Submitted) - Submitted (GApi.Redirect s) -> (model, load s) - Submitted r -> ({ model | state = Api.Error r }, Cmd.none) - - -isValid : Model -> Bool -isValid model = not - ( model.title == model.original - || Set.isEmpty model.lang - || hasDuplicates (List.map (\m -> (m.medium, m.qty)) model.media) - || not model.gtinValid - || List.isEmpty model.vn - || resoParse model.reso.value == Nothing - ) - - -viewGen : Model -> Html Msg -viewGen model = - table [ class "formtable" ] - [ formField "title::Title (romaji)" - [ inputText "title" model.title Title (style "width" "500px" :: GRE.valTitle) - , if containsNonLatin model.title - then b [ class "standout" ] [ br [] [], text "This title field should only contain latin-alphabet characters, please put the \"actual\" title in the field below and the romanization above." ] - else text "" - ] - , formField "original::Original title" - [ inputText "original" model.original Original (style "width" "500px" :: GRE.valOriginal) - , if model.title /= "" && model.title == model.original - then b [ class "standout" ] [ br [] [], text "Should not be the same as the Title (romaji). Leave blank is the original title is already in the latin alphabet" ] - else if model.original /= "" && not (containsNonLatin model.original) - then b [ class "standout" ] [ br [] [], text "Original title does not seem to contain any non-latin characters. Leave this field empty if the title is already in the latin alphabet" ] - else if containsJapanese model.original && not (Set.isEmpty model.lang) && not (Set.member "ja" model.lang) - then b [ class "standout" ] [ br [] [], text "Non-Japanese releases should (probably) not have a Japanese original title." ] - else text "" - ] - - , tr [ class "newpart" ] [ td [] [] ] - , formField "rtype::Type" [ inputSelect "rtype" model.rtype RType [] GT.releaseTypes ] - , formField "minage::Age rating" [ inputSelect "minage" model.minage Minage [] GT.ageRatings, text " (*)" ] - , formField "" [ label [] [ inputCheck "" model.patch Patch , text " This release is a patch to another release.", text " (*)" ] ] - , formField "" [ label [] [ inputCheck "" model.freeware Freeware, text " Freeware (i.e. available at no cost)" ] ] - , if model.patch then text "" else - formField "" [ label [] [ inputCheck "" model.doujin Doujin , text " Doujin (self-published, not by a company)" ] ] - , formField "Release date" [ D.view model.released False Released, text " Leave month or day blank if they are unknown." ] - - , tr [ class "newpart" ] [ td [ colspan 2 ] [ text "Format" ] ] - , formField "Language(s)" - [ div [ class "elm_dd_input", style "width" "500px" ] [ DD.view model.langDd Api.Normal - (if Set.isEmpty model.lang - then b [ class "standout" ] [ text "No language selected" ] - else span [] <| List.intersperse (text ", ") <| List.map (\(l,t) -> span [ style "white-space" "nowrap" ] [ langIcon l, text t ]) <| List.filter (\(l,_) -> Set.member l model.lang) GT.languages) - <| \() -> [ ul [ style "columns" "2"] <| List.map (\(l,t) -> li [] [ linkRadio (Set.member l model.lang) (Lang l) [ langIcon l, text t ] ]) GT.languages ] - ] ] - , formField "Platform(s)" - [ div [ class "elm_dd_input", style "width" "500px" ] [ DD.view model.platDd Api.Normal - (if Set.isEmpty model.plat - then text "No platform selected" - else span [] <| List.intersperse (text ", ") <| List.map (\(p,t) -> span [ style "white-space" "nowrap" ] [ platformIcon p, text t ]) <| List.filter (\(p,_) -> Set.member p model.plat) GT.platforms) - <| \() -> [ ul [ style "columns" "2"] <| List.map (\(p,t) -> li [ classList [("separator", p == "web")] ] [ linkRadio (Set.member p model.plat) (Plat p) [ platformIcon p, text t ] ]) GT.platforms ] - ] ] - , formField "Media" - [ table [] <| List.indexedMap (\i m -> - let q = List.filter (\(s,_,_) -> m.medium == s) GT.media |> List.head |> Maybe.map (\(_,_,x) -> x) |> Maybe.withDefault False - in tr [] - [ td [] [ inputSelect "" m.medium (MediaType i) [] <| (if m.medium == "unk" then [("unk", "- Add medium -")] else []) ++ List.map (\(a,b,_) -> (a,b)) GT.media ] - , td [] [ if q then inputSelect "" m.qty (MediaQty i) [ style "width" "100px" ] <| List.map (\a -> (a,String.fromInt a)) <| List.range 1 20 else text "" ] - , td [] [ if m.medium == "unk" then text "" else inputButton "remove" (MediaDel i) [] ] - ] - ) <| model.media ++ [{medium = "unk", qty = 0}] - , if hasDuplicates (List.map (\m -> (m.medium, m.qty)) model.media) - then b [ class "standout" ] [ text "List contains duplicates", br [] [] ] - else text "" - ] - - , if model.patch then text "" else - formField "engine::Engine" [ A.view model.engineConf model.engine [] ] - , if model.patch then text "" else - formField "resolution::Resolution" - [ A.view model.resoConf model.reso [] - , if resoParse model.reso.value == Nothing then b [ class "standout" ] [ text " Invalid resolution" ] else text "" - ] - , if model.patch then text "" else - formField "voiced::Voiced" [ inputSelect "voiced" model.voiced Voiced [] GT.voiced ] - , if model.patch then text "" else - formField "ani_story::Animations" - [ inputSelect "ani_story" model.ani_story AniStory [] GT.animated - , if model.minage == 18 then text " <= story | ero scenes => " else text "" - , if model.minage == 18 then inputSelect "" model.ani_ero AniEro [] GT.animated else text "" - ] - , if model.minage /= 18 then text "" else - formField "" [ label [] [ inputCheck "" model.uncensored Uncensored, text " Uncensored (No mosaic or other optical censoring, only check if this release has erotic content)" ] ] - - , tr [ class "newpart" ] [ td [ colspan 2 ] [ text "External identifiers & links" ] ] - , formField "gtin::JAN/UPC/EAN" - [ inputText "gtin" model.gtin Gtin [pattern "[0-9]+"] - , if not model.gtinValid then b [ class "standout" ] [ text "Invalid GTIN code" ] else text "" - ] - , formField "catalog::Catalog number" [ inputText "catalog" model.catalog Catalog GRE.valCatalog ] - , formField "website::Website" [ inputText "website" model.website Website (style "width" "500px" :: GRE.valWebsite) ] - , tr [ class "newpart" ] [ td [ colspan 2 ] [] ] - , formField "External Links" [ Html.map ExtLinks (EL.view model.extlinks) ] - - , tr [ class "newpart" ] [ td [ colspan 2 ] [ text "Database relations" ] ] - , formField "Visual novels" - [ if List.isEmpty model.vn then b [ class "standout" ] [ text "No visual novels selected.", br [] [] ] - else table [] <| List.indexedMap (\i v -> tr [] - [ td [ style "text-align" "right" ] [ b [ class "grayedout" ] [ text <| "v" ++ String.fromInt v.vid ++ ":" ] ] - , td [] [ a [ href <| "/v" ++ String.fromInt v.vid ] [ text v.title ] ] - , td [] [ inputButton "remove" (VNDel i) [] ] - ] - ) model.vn - , A.view vnConfig model.vnAdd [placeholder "Add visual novel..."] - ] - , tr [ class "newpart" ] [ td [ colspan 2 ] [] ] - , formField "Producers" - [ table [ class "compact" ] <| List.indexedMap (\i p -> tr [] - [ td [ style "text-align" "right" ] [ b [ class "grayedout" ] [ text <| "p" ++ String.fromInt p.pid ++ ":" ] ] - , td [] [ a [ href <| "/p" ++ String.fromInt p.pid ] [ text p.name ] ] - , td [] [ inputSelect "" (p.developer, p.publisher) (ProdRole i) [style "width" "100px"] [((True,False), "Developer"), ((False,True), "Publisher"), ((True,True), "Both")] ] - , td [] [ inputButton "remove" (ProdDel i) [] ] - ] - ) model.prod - , A.view producerConfig model.prodAdd [placeholder "Add producer..."] - ] - - , tr [ class "newpart" ] [ td [ colspan 2 ] [] ] - , formField "notes::Notes" - [ TP.view "notes" model.notes Notes 700 [] [ b [ class "standout" ] [ text " (English please!) " ] ] - , text "Miscellaneous notes/comments, information that does not fit in the above fields. E.g.: Types of censoring or for which releases this patch applies." - ] - ] - -view : Model -> Html Msg -view model = - form_ Submit (model.state == Api.Loading) - [ div [ class "mainbox" ] - [ h1 [] [ text "General info" ] - , viewGen model - ] - , div [ class "mainbox" ] - [ fieldset [ class "submit" ] - [ Html.map Editsum (Editsum.view model.editsum) - , submitButton "Submit" model.state (isValid model) - ] - ] - ] diff --git a/elm/Reviews/Edit.elm b/elm/Reviews/Edit.elm new file mode 100644 index 00000000..b122d1ba --- /dev/null +++ b/elm/Reviews/Edit.elm @@ -0,0 +1,199 @@ +module Reviews.Edit exposing (main) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Browser +import Browser.Navigation exposing (load) +import Lib.Html exposing (..) +import Lib.TextPreview as TP +import Lib.Api as Api +import Lib.Util exposing (..) +import Lib.RDate as RDate +import Gen.Api as GApi +import Gen.ReviewsEdit as GRE +import Gen.ReviewsDelete as GRD + + +main : Program GRE.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 + , id : Maybe String + , vid : String + , vntitle : String + , rid : Maybe String + , spoiler : Bool + , locked : Bool + , isfull : Bool + , modnote : String + , text : TP.Model + , releases : List GRE.RecvReleases + , delete : Bool + , delState : Api.State + , mod : Bool + } + + +init : GRE.Recv -> Model +init d = + { state = Api.Normal + , id = d.id + , vid = d.vid + , vntitle = d.vntitle + , rid = d.rid + , spoiler = d.spoiler + , locked = d.locked + , isfull = d.isfull + , modnote = d.modnote + , text = TP.bbcode d.text + , releases = d.releases + , delete = False + , delState = Api.Normal + , mod = d.mod + } + + +encode : Model -> GRE.Send +encode m = + { id = m.id + , vid = m.vid + , rid = m.rid + , spoiler = m.spoiler + , locked = m.locked + , modnote = m.modnote + , isfull = m.isfull + , text = m.text.data + } + + +type Msg + = Release (Maybe String) + | Full Bool + | Spoiler Bool + | Locked Bool + | Modnote String + | Text TP.Msg + | Submit + | Submitted GApi.Response + | Delete Bool + | DoDelete + | Deleted GApi.Response + + +update : Msg -> Model -> (Model, Cmd Msg) +update msg model = + case msg of + Release i -> ({ model | rid = i }, Cmd.none) + Full b -> ({ model | isfull = b }, Cmd.none) + Spoiler b -> ({ model | spoiler = b }, Cmd.none) + Locked b -> ({ model | locked = b }, Cmd.none) + Modnote s -> ({ model | modnote = s }, Cmd.none) + Text m -> let (nm,nc) = TP.update m model.text in ({ model | text = nm }, Cmd.map Text nc) + + Submit -> ({ model | state = Api.Loading }, GRE.send (encode model) Submitted) + Submitted (GApi.Redirect s) -> (model, load s) + Submitted r -> ({ model | state = Api.Error r }, Cmd.none) + + Delete b -> ({ model | delete = b }, Cmd.none) + DoDelete -> ({ model | delState = Api.Loading }, GRD.send ({ id = Maybe.withDefault "" model.id }) Deleted) + Deleted GApi.Success -> (model, load <| "/" ++ model.vid) + Deleted r -> ({ model | delState = Api.Error r }, Cmd.none) + + +view : Model -> Html Msg +view model = + let minChars = if model.isfull then 1000 else 200 + maxChars = if model.isfull then 100000 else 800 + len = String.length model.text.data + in + form_ "" Submit (model.state == Api.Loading) + [ article [] + [ h1 [] [ text <| if model.id == Nothing then "Submit a review" else "Edit review" ] + , p [] [ strong [] [ text "Rules" ] ] + , ul [] + [ li [] [ text "Submit only reviews you have written yourself!" ] + , li [] [ text "Reviews must be in English." ] + , li [] [ text "Try to be as objective as possible." ] + , li [] [ text "If you have published the review elsewhere (e.g. a personal blog), feel free to include a link at the end of the review. Formatting tip: ", em [] [ text "[Originally published at <link>]" ] ] + , li [] [ text "Your vote (if any) will be displayed alongside the review, even if you have marked your list as private." ] + ] + , br [] [] + ] + , article [] + [ table [ class "formtable" ] + [ formField "Subject" [ a [ href <| "/"++model.vid ] [ text model.vntitle ] ] + , formField "" + [ inputSelect "" model.rid Release [style "width" "500px" ] <| + (Nothing, "No release selected") + :: List.map (\r -> (Just r.id, RDate.showrel r)) model.releases + ++ if model.rid == Nothing || List.any (\r -> Just r.id == model.rid) model.releases then [] else [(model.rid, "Deleted or moved release: r"++Maybe.withDefault "" model.rid)] + , br [] [] + , text "You do not have to select a release, but indicating which release your review is based on gives more context." + ] + , tr [ class "newpart" ] [ td [ colspan 2 ] [ text "" ] ] + , formField "Review type" + [ label [] [ inputRadio "type" (model.isfull == False) (\_ -> Full False), strong [] [ text " Mini review" ] + , text <| " - Recommendation-style, maximum 800 characters." ] + , br [] [] + , label [] [ inputRadio "type" (model.isfull == True ) (\_ -> Full True ), strong [] [ text " Full review" ] + , text " - Longer, more detailed." ] + , br [] [] + , small [] [ text "You can always switch between review types later." ] + ] + , tr [ class "newpart" ] [ td [ colspan 2 ] [ text "" ] ] + , formField "" + [ label [] [ inputCheck "" model.spoiler Spoiler, text " This review contains spoilers." ] + , br [] [] + , small [] [ text "You do not have to check this option if all spoilers in your review are marked with [spoiler] tags." ] + ] + , if not model.mod then text "" else + formField "" [ label [] [ inputCheck "" model.locked Locked, text " Locked for commenting." ] ] + , if not model.mod then text "" else + formField "modnote::Mod note" + [ inputText "modnote" model.modnote Modnote (style "width" "500px" :: GRE.valModnote) + , br [] [], text "Moderation note intended to inform readers of the review that its author may be biased and failed to disclose that." ] + + , tr [ class "newpart" ] [ td [ colspan 2 ] [ text "" ] ] + , formField "text::Review" + [ TP.view "sum" model.text Text 700 ([rows (if model.isfull then 30 else 10), cols 50] ++ GRE.valText) + [ a [ href "/d9#4" ] [ text "BBCode formatting supported" ] ] + , div [ style "width" "700px", style "text-align" "right" ] <| + let num c s = if c then b [] [ text s ] else text s + in + [ num (len < minChars) (String.fromInt minChars) + , text " / " + , strong [] [ text (String.fromInt len) ] + , text " / " + , num (len > maxChars) (if model.isfull then "∞" else String.fromInt maxChars) + ] + ] + ] + ] + , article [ class "submit" ] [ submitButton "Submit" model.state (len <= maxChars && len >= minChars) ] + , if model.id == Nothing then text "" else + article [] + [ h1 [] [ text "Delete review" ] + , table [ class "formtable" ] [ formField "" + [ label [] [ inputCheck "" model.delete Delete, text " Delete this review." ] + , if not model.delete then text "" else span [] + [ br [] [] + , b [] [ text "WARNING:" ] + , text " Deleting this review is a permanent action and can not be reverted!" + , br [] [] + , br [] [] + , inputButton "Confirm delete" DoDelete [] + , case model.delState of + Api.Loading -> span [ class "spinner" ] [] + Api.Error e -> b [] [ text <| Api.showResponse e ] + Api.Normal -> text "" + ] + ] ] + ] + ] diff --git a/elm/StaffEdit.elm b/elm/StaffEdit.elm deleted file mode 100644 index 134a409b..00000000 --- a/elm/StaffEdit.elm +++ /dev/null @@ -1,206 +0,0 @@ -module StaffEdit exposing (main) - -import Html exposing (..) -import Html.Events exposing (..) -import Html.Attributes exposing (..) -import Browser -import Browser.Navigation exposing (load) -import Lib.Util exposing (..) -import Lib.Html exposing (..) -import Lib.TextPreview as TP -import Lib.Api as Api -import Lib.Editsum as Editsum -import Gen.StaffEdit as GSE -import Gen.Types as GT -import Gen.Api as GApi - - -main : Program GSE.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 - , alias : List GSE.RecvAlias - , aliasDup : Bool - , aid : Int - , desc : TP.Model - , gender : String - , lang : String - , l_site : String - , l_wikidata : Maybe Int - , l_twitter : String - , l_anidb : Maybe Int - , l_pixiv : Int - , id : Maybe Int - } - - -init : GSE.Recv -> Model -init d = - { state = Api.Normal - , editsum = { authmod = d.authmod, editsum = TP.bbcode d.editsum, locked = d.locked, hidden = d.hidden } - , alias = d.alias - , aliasDup = False - , aid = d.aid - , desc = TP.bbcode d.desc - , gender = d.gender - , lang = d.lang - , l_site = d.l_site - , l_wikidata = d.l_wikidata - , l_twitter = d.l_twitter - , l_anidb = d.l_anidb - , l_pixiv = d.l_pixiv - , id = d.id - } - - -encode : Model -> GSE.Send -encode model = - { id = model.id - , editsum = model.editsum.editsum.data - , hidden = model.editsum.hidden - , locked = model.editsum.locked - , aid = model.aid - , alias = List.map (\e -> { aid = e.aid, name = e.name, original = e.original }) model.alias - , desc = model.desc.data - , gender = model.gender - , lang = model.lang - , l_site = model.l_site - , l_wikidata = model.l_wikidata - , l_twitter = model.l_twitter - , l_anidb = model.l_anidb - , l_pixiv = model.l_pixiv - } - - -newAid : Model -> Int -newAid model = - let id = Maybe.withDefault 0 <| List.minimum <| List.map .aid model.alias - in if id >= 0 then -1 else id - 1 - - -type Msg - = Editsum Editsum.Msg - | Submit - | Submitted GApi.Response - | Lang String - | Gender String - | Website String - | LWikidata (Maybe Int) - | LTwitter String - | LAnidb String - | LPixiv String - | Desc TP.Msg - | AliasDel Int - | AliasName Int String - | AliasOrig Int String - | AliasMain Int Bool - | AliasAdd - - -validate : Model -> Model -validate model = { model | aliasDup = hasDuplicates <| List.map (\e -> (e.name, e.original)) model.alias } - - -update : Msg -> Model -> (Model, Cmd Msg) -update msg model = - case msg of - Editsum m -> let (nm,nc) = Editsum.update m model.editsum in ({ model | editsum = nm }, Cmd.map Editsum nc) - Lang s -> ({ model | lang = s }, Cmd.none) - Gender s -> ({ model | gender = s }, Cmd.none) - Website s -> ({ model | l_site = s }, Cmd.none) - LWikidata n-> ({ model | l_wikidata= n }, Cmd.none) - LTwitter s -> ({ model | l_twitter = s }, Cmd.none) - LAnidb s -> ({ model | l_anidb = if s == "" then Nothing else String.toInt s }, Cmd.none) - LPixiv s -> ({ model | l_pixiv = Maybe.withDefault model.l_pixiv (String.toInt s) }, Cmd.none) - Desc m -> let (nm,nc) = TP.update m model.desc in ({ model | desc = nm }, Cmd.map Desc nc) - - AliasDel i -> (validate { model | alias = delidx i model.alias }, Cmd.none) - AliasName i s -> (validate { model | alias = modidx i (\e -> { e | name = s }) model.alias }, Cmd.none) - AliasOrig i s -> (validate { model | alias = modidx i (\e -> { e | original = s }) model.alias }, Cmd.none) - AliasMain n _ -> ({ model | aid = n }, Cmd.none) - AliasAdd -> ({ model | alias = model.alias ++ [{ aid = newAid model, name = "", original = "", inuse = False, wantdel = False }] }, Cmd.none) - - Submit -> ({ model | state = Api.Loading }, GSE.send (encode model) Submitted) - Submitted (GApi.Redirect s) -> (model, load s) - Submitted r -> ({ model | state = Api.Error r }, Cmd.none) - - -isValid : Model -> Bool -isValid model = not (model.aliasDup || List.any (\l -> l.name == l.original) model.alias) - - -view : Model -> Html Msg -view model = - let - nameEntry n e = - tr [] - [ td [ class "tc_id" ] [ inputRadio "main" (e.aid == model.aid) (AliasMain e.aid) ] - , td [ class "tc_name" ] [ inputText "" e.name (AliasName n) GSE.valAliasName ] - , td [ class "tc_original" ] - [ inputText "" e.original (AliasOrig n) GSE.valAliasOriginal - , if e.name /= "" && e.name == e.original then b [ class "standout" ] [ text "May not be the same as Name (romaji)" ] else text "" - ] - , td [ class "tc_add" ] - [ if model.aid == e.aid then b [ class "grayedout" ] [ text " primary" ] - else if e.wantdel then b [ class "standout" ] [ text " still referenced" ] - else if e.inuse then b [ class "grayedout" ] [ text " referenced" ] - else inputButton "remove" (AliasDel n) [] - ] - ] - - names = - table [ class "names" ] <| - [ thead [] - [ tr [] - [ td [ class "tc_id" ] [] - , td [ class "tc_name" ] [ text "Name (romaji)" ] - , td [ class "tc_original" ] [ text "Original" ] - , td [] [] - ] - ] - ] ++ List.indexedMap nameEntry model.alias ++ - [ tr [ class "alias_new" ] - [ td [] [] - , td [ colspan 3 ] - [ if not model.aliasDup then text "" - else b [ class "standout" ] [ text "The list contains duplicate aliases.", br_ 1 ] - , a [ onClick AliasAdd ] [ text "Add alias" ] - ] - ] - ] - - in - form_ Submit (model.state == Api.Loading) - [ div [ class "mainbox staffedit" ] - [ h1 [] [ text "General info" ] - , table [ class "formtable" ] - [ formField "Names" [ names, br_ 1 ] - , formField "desc::Biography" [ TP.view "desc" model.desc Desc 500 GSE.valDesc [ b [ class "standout" ] [ text "English please!" ] ] ] - , formField "gender::Gender" [ inputSelect "gender" model.gender Gender [] - [ ("unknown", "Unknown or N/A") - , ("f", "Female") - , ("m", "Male") - ] ] - , formField "lang::Primary Language" [ inputSelect "lang" model.lang Lang [] GT.languages ] - , formField "l_site::Official page" [ inputText "l_site" model.l_site Website (style "width" "400px" :: GSE.valL_Site) ] - , formField "l_wikidata::Wikidata ID" [ inputWikidata "l_wikidata" model.l_wikidata LWikidata ] - , formField "l_twitter::Twitter username" [ inputText "l_twitter" model.l_twitter LTwitter GSE.valL_Twitter ] - , formField "l_anidb::AniDB Creator ID" [ inputText "l_anidb" (Maybe.withDefault "" (Maybe.map String.fromInt model.l_anidb)) LAnidb GSE.valL_Anidb ] - , formField "l_pixiv::Pixiv ID" [ inputText "l_pixiv" (if model.l_pixiv == 0 then "" else String.fromInt model.l_pixiv) LPixiv GSE.valL_Pixiv ] - ] - ] - , div [ class "mainbox" ] - [ fieldset [ class "submit" ] - [ Html.map Editsum (Editsum.view model.editsum) - , submitButton "Submit" model.state (isValid model) - ] - ] - ] diff --git a/elm/Tagmod.elm b/elm/Tagmod.elm index 1e0cb408..de82f77f 100644 --- a/elm/Tagmod.elm +++ b/elm/Tagmod.elm @@ -29,19 +29,21 @@ type alias Tag = GT.RecvTags type Sel = NoSel | Vote Int + | Over | Spoil (Maybe Int) + | Lie (Maybe Bool) | Note | NoteSet type alias Model = { state : Api.State , title : String - , id : Int + , id : String , mod : Bool , tags : List Tag , saved : List Tag , changed : Bool - , selId : Int + , selId : String , selType : Sel , negCount : Int , negShow : Bool @@ -59,7 +61,7 @@ init f = , tags = f.tags , saved = f.tags , changed = False - , selId = 0 + , selId = "" , selType = NoSel , negCount = List.length <| List.filter (\t -> t.rating <= 0) f.tags , negShow = False @@ -73,11 +75,12 @@ searchConfig = { wrap = TagSearch, id = "tagadd", source = A.tagSource } type Msg = Noop - | SetSel Int Sel - | SetVote Int Int - | SetOver Int Bool - | SetSpoil Int (Maybe Int) - | SetNote Int String + | SetSel String Sel + | SetVote String Int + | SetOver String Bool + | SetSpoil String (Maybe Int) + | SetLie String (Maybe Bool) + | SetNote String String | NegShow Bool | TagSearch (A.Msg GApi.ApiTagResult) | Submit @@ -99,6 +102,7 @@ update msg model = SetVote id v -> (modtag id (\t -> { t | vote = v }), Cmd.none) SetOver id b -> (modtag id (\t -> { t | overrule = b }), Cmd.none) SetSpoil id s -> (modtag id (\t -> { t | spoil = s }), Cmd.none) + SetLie id s -> (modtag id (\t -> { t | lie = s }), Cmd.none) SetNote id s -> (modtag id (\t -> { t | notes = s }), Cmd.none) NegShow b -> ({ model | negShow = b }, Cmd.none) @@ -108,101 +112,118 @@ update msg model = Nothing -> ({ model | add = nm }, c) Just t -> let (nl, ms) = - if t.state == 1 then ([], "Can't add deleted tags") + if t.hidden && t.locked then ([], "Can't add deleted tags") else if not t.applicable then ([], "Tag is not applicable") else if List.any (\it -> it.id == t.id) model.tags then ([], "Tag is already in the list") - else ([{ id = t.id, vote = 2, spoil = Nothing, overrule = False, notes = "", cat = "new", name = t.name - , rating = 0, count = 0, spoiler = 0, overruled = False, othnotes = "", state = t.state, applicable = t.applicable }], "") + else ([{ id = t.id, vote = 0, spoil = Nothing, lie = Nothing, overrule = False, notes = "", cat = "new", name = t.name + , rating = 0, count = 0, spoiler = 0, islie = False, overruled = False, othnotes = "", hidden = t.hidden, locked = t.locked, applicable = t.applicable }], "") in (changed { model | add = if ms == "" then A.clear nm "" else nm, tags = model.tags ++ nl, addMsg = ms }, c) Submit -> ( { model | state = Api.Loading, addMsg = "" } - , GT.send { id = model.id, tags = List.map (\t -> { id = t.id, vote = t.vote, spoil = t.spoil, overrule = t.overrule, notes = t.notes }) model.tags } Submitted) + , GT.send { id = model.id, tags = List.map (\t -> { id = t.id, vote = t.vote, spoil = t.spoil, lie = t.lie, overrule = t.overrule, notes = t.notes }) model.tags } Submitted) Submitted GApi.Success -> (model, reload) Submitted r -> ({ model | state = Api.Error r }, Cmd.none) -viewTag : Tag -> Sel -> Int -> Bool -> Html Msg +viewTag : Tag -> Sel -> String -> Bool -> Html Msg viewTag t sel vid mod = let -- Similar to VNWeb::Tags::Lib::tagscore_ tagscore s = - div [ class "tagscore", classList [("negative", s < 0)] ] + div [ class "tagscore", classList [("negative", s <= 0)] ] [ span [] [ text <| Ffi.fmtFloat s 1 ] , div [ style "width" <| String.fromFloat (abs (s/3*30)) ++ "px" ] [] ] - + msg s = [ td [ colspan 4 ] [ text s ] ] vote = case sel of Vote v -> v _ -> t.vote spoil = case sel of Spoil s -> s _ -> t.spoil + lie = case sel of Lie l -> l + _ -> t.lie in tr [] <| [ td [ class "tc_tagname" ] - [ a [ href <| "/g"++String.fromInt t.id, style "text-decoration" (if t.applicable && t.state /= 1 then "none" else "line-through") ] [ text t.name ] - , case (t.state, t.applicable) of - (0, _) -> b [ class "grayedout" ] [ text " (awaiting approval)" ] - (1, _) -> b [ class "grayedout" ] [ text " (deleted)" ] - (_, False) -> b [ class "grayedout" ] [ text " (not applicable)" ] + [ a [ href <| "/"++t.id, style "text-decoration" (if t.applicable && not (t.hidden && t.locked) then "none" else "line-through") ] [ text t.name ] + , case (t.hidden, t.locked, t.applicable) of + (True, False, _) -> small [] [ text " (awaiting approval)" ] + (True, True, _) -> small [] [ text " (deleted)" ] + (_, _, False) -> small [] [ text " (not applicable)" ] _ -> text "" ] , td [ class "tc_myvote buts" ] - [ a [ href "#", onMouseOver (SetSel t.id (Vote -3)), onMouseOut (SetSel 0 NoSel), onClickD (SetVote t.id -3), classList [("ld", vote < 0)], title "Downvote" ] [] - , a [ href "#", onMouseOver (SetSel t.id (Vote 0)), onMouseOut (SetSel 0 NoSel), onClickD (SetVote t.id 0), classList [("l0", vote == 0)], title "Remove vote" ] [] - , a [ href "#", onMouseOver (SetSel t.id (Vote 1)), onMouseOut (SetSel 0 NoSel), onClickD (SetVote t.id 1), classList [("l1", vote >= 1)], title "+1" ] [] - , a [ href "#", onMouseOver (SetSel t.id (Vote 2)), onMouseOut (SetSel 0 NoSel), onClickD (SetVote t.id 2), classList [("l2", vote >= 2)], title "+2" ] [] - , a [ href "#", onMouseOver (SetSel t.id (Vote 3)), onMouseOut (SetSel 0 NoSel), onClickD (SetVote t.id 3), classList [("l3", vote == 3)], title "+3" ] [] + [ a [ href "#", onMouseOver (SetSel t.id (Vote -3)), onMouseOut (SetSel "" NoSel), onClickD (SetVote t.id -3), classList [("ld", vote < 0)], title "Downvote" ] [] + , a [ href "#", onMouseOver (SetSel t.id (Vote 0)), onMouseOut (SetSel "" NoSel), onClickD (SetVote t.id 0), classList [("l0", vote == 0)], title "Remove vote" ] [] + , a [ href "#", onMouseOver (SetSel t.id (Vote 1)), onMouseOut (SetSel "" NoSel), onClickD (SetVote t.id 1), classList [("l1", vote >= 1)], title "+1" ] [] + , a [ href "#", onMouseOver (SetSel t.id (Vote 2)), onMouseOut (SetSel "" NoSel), onClickD (SetVote t.id 2), classList [("l2", vote >= 2)], title "+2" ] [] + , a [ href "#", onMouseOver (SetSel t.id (Vote 3)), onMouseOut (SetSel "" NoSel), onClickD (SetVote t.id 3), classList [("l3", vote == 3)], title "+3" ] [] ] - , td [ class "tc_myover" ] [ if mod && t.vote /= 0 then inputCheck "" t.overrule (SetOver t.id) else text "" ] + ] ++ (if t.vote == 0 && t.count == 0 then + [ td [ colspan 4 ] [ text "<- don't forget to rate" ] + ] else + [ td [ class "tc_myover buts" ] <| + if t.vote == 0 || not mod then [] else + [ a [ href "#", onMouseOver (SetSel t.id Over), onMouseOut (SetSel "" NoSel), onClickD (SetOver t.id (not t.overrule)), classList [("ov", t.overrule || sel == Over)], title "Overrule" ] [] ] , td [ class "tc_myspoil buts" ] <| if t.vote <= 0 then [] else - [ a [ href "#", onMouseOver (SetSel t.id (Spoil Nothing)), onMouseOut (SetSel 0 NoSel), onClickD (SetSpoil t.id Nothing), classList [("sn", spoil == Nothing)], title "Unknown" ] [] - , a [ href "#", onMouseOver (SetSel t.id (Spoil (Just 0))), onMouseOut (SetSel 0 NoSel), onClickD (SetSpoil t.id (Just 0)), classList [("s0", spoil == Just 0 )], title "Not a spoiler" ] [] - , a [ href "#", onMouseOver (SetSel t.id (Spoil (Just 1))), onMouseOut (SetSel 0 NoSel), onClickD (SetSpoil t.id (Just 1)), classList [("s1", spoil == Just 1 )], title "Minor spoiler" ] [] - , a [ href "#", onMouseOver (SetSel t.id (Spoil (Just 2))), onMouseOut (SetSel 0 NoSel), onClickD (SetSpoil t.id (Just 2)), classList [("s2", spoil == Just 2 )], title "Major spoiler" ] [] + [ a [ href "#", onMouseOver (SetSel t.id (Spoil Nothing)), onMouseOut (SetSel "" NoSel), onClickD (SetSpoil t.id Nothing), classList [("sn", spoil == Nothing)], title "Unknown" ] [] + , a [ href "#", onMouseOver (SetSel t.id (Spoil (Just 0))), onMouseOut (SetSel "" NoSel), onClickD (SetSpoil t.id (Just 0)), classList [("s0", spoil == Just 0 )], title "Not a spoiler" ] [] + , a [ href "#", onMouseOver (SetSel t.id (Spoil (Just 1))), onMouseOut (SetSel "" NoSel), onClickD (SetSpoil t.id (Just 1)), classList [("s1", spoil == Just 1 )], title "Minor spoiler" ] [] + , a [ href "#", onMouseOver (SetSel t.id (Spoil (Just 2))), onMouseOut (SetSel "" NoSel), onClickD (SetSpoil t.id (Just 2)), classList [("s2", spoil == Just 2 )], title "Major spoiler" ] [] + ] + , td [ class "tc_mylie buts" ] <| + if t.vote <= 0 then [] else + [ a [ href "#", onMouseOver (SetSel t.id (Lie Nothing)), onMouseOut (SetSel "" NoSel), onClickD (SetLie t.id Nothing ), classList [("fn", lie == Nothing )], title "Unknown" ] [] + , a [ href "#", onMouseOver (SetSel t.id (Lie (Just False))), onMouseOut (SetSel "" NoSel), onClickD (SetLie t.id (Just False)), classList [("f0", lie == Just False)], title "This tag is not a lie" ] [] + , a [ href "#", onMouseOver (SetSel t.id (Lie (Just True))), onMouseOut (SetSel "" NoSel), onClickD (SetLie t.id (Just True )), classList [("f1", lie == Just True )], title "This tag is a lie"] [] ] , td [ class "tc_mynote" ] <| if t.vote == 0 then [] else [ span [ onMouseOver (SetSel t.id Note) - , onMouseOut (SetSel 0 NoSel) + , onMouseOut (SetSel "" NoSel) , onClickD (SetSel t.id NoteSet) - , title <| if t.notes == "" then "set note" else t.notes , style "opacity" <| if t.notes == "" then "0.5" else "1.0" ] [ text "💬" ] ] - ] ++ + ]) ++ case sel of - Vote 0 -> [ td [ colspan 3 ] [ text "Remove vote" ] ] - Vote 1 -> [ td [ colspan 3 ] [ text "Vote +1" ] ] - Vote 2 -> [ td [ colspan 3 ] [ text "Vote +2" ] ] - Vote 3 -> [ td [ colspan 3 ] [ text "Vote +3" ] ] - Vote _ -> [ td [ colspan 3 ] [ text "Downvote (-3)" ] ] - Spoil Nothing -> [ td [ colspan 3 ] [ text "Spoiler status not known" ] ] - Spoil (Just 0) -> [ td [ colspan 3 ] [ text "This is not spoiler" ] ] - Spoil (Just 1) -> [ td [ colspan 3 ] [ text "This is a minor spoiler" ] ] - Spoil (Just 2) -> [ td [ colspan 3 ] [ text "This is a major spoiler" ] ] - Note -> [ td [ colspan 3 ] [ if t.notes == "" then text "Set note" else div [ class "noteview" ] [ text t.notes ] ] ] + Vote 0 -> msg "Remove vote" + Vote 1 -> msg "Vote +1" + Vote 2 -> msg "Vote +2" + Vote 3 -> msg "Vote +3" + Vote _ -> msg "Downvote (-3)" + Over -> msg "Mod overrule (only your vote counts)" + Spoil Nothing -> msg "Spoiler status not known" + Spoil (Just 0) -> msg "This is not a spoiler" + Spoil (Just 1) -> msg "This is a minor spoiler" + Spoil (Just 2) -> msg "This is a major spoiler" + Lie Nothing -> msg "Truth status not known" + Lie (Just True)-> msg "This tag turns out to be false" + Lie (Just False)->msg "This tag is not a lie" + Note -> [ td [ colspan 4 ] [ if t.notes == "" then text "Set note" else div [ class "noteview" ] [ text t.notes ] ] ] NoteSet -> - [ td [ colspan 3, class "compact" ] + [ td [ colspan 4, class "compact" ] [ Html.form [ onSubmit (SetSel t.id NoSel) ] [ inputText "tag_note" t.notes (SetNote t.id) (onBlur (SetSel t.id NoSel) :: style "width" "400px" :: style "position" "absolute" :: placeholder "Set note..." :: GT.valTagsNotes) ] ] ] _ -> - if t.count == 0 then [ td [ colspan 3 ] [] ] + if t.count == 0 then [ td [ colspan 4 ] [] ] else [ td [ class "tc_allvote" ] [ tagscore t.rating , i [ classList [("grayedout", t.overruled)] ] [ text <| " (" ++ String.fromInt t.count ++ ")" ] , if not t.overruled then text "" - else b [ class "standout", style "font-weight" "bold", title "Tag overruled. All votes other than that of the moderator who overruled it will be ignored." ] [ text "!" ] + else strong [ class "standout", title "Tag overruled. All votes other than that of the moderator who overruled it will be ignored." ] [ text "!" ] ] , td [ class "tc_allspoil"] [ text <| Ffi.fmtFloat t.spoiler 2 ] + , td [ class "tc_alllie"] [ text <| if t.islie then "lie" else "" ] , td [ class "tc_allwho" ] [ span [ style "opacity" <| if t.othnotes == "" then "0" else "1", style "cursor" "default", title t.othnotes ] [ text "💬 " ] - , a [ href <| "/g/links?v="++String.fromInt vid++"&t="++String.fromInt t.id ] [ text "Who?" ] + , a [ href <| "/g/links?v="++vid++"&t="++t.id ] [ text "Who?" ] ] ] @@ -213,30 +234,32 @@ viewHead mod negCount negShow = [ td [ style "font-weight" "normal", style "text-align" "right" ] <| if negCount == 0 then [] else [ linkRadio negShow NegShow [ text "Show downvoted tags " ], i [] [ text <| " (" ++ String.fromInt negCount ++ ")" ] ] - , td [ colspan 4, class "tc_you" ] [ text "You" ] - , td [ colspan 3, class "tc_others" ] [ text "Others" ] + , td [ colspan 5, class "tc_you" ] [ text "You" ] + , td [ colspan 4, class "tc_others" ] [ text "Others" ] ] , tr [] [ td [ class "tc_tagname" ] [ text "Tag" ] , td [ class "tc_myvote" ] [ text "Rating" ] , td [ class "tc_myover" ] [ text (if mod then "O" else "") ] , td [ class "tc_myspoil" ] [ text "Spoiler" ] + , td [ class "tc_mylie" ] [ text "Lie" ] , td [ class "tc_mynote" ] [] , td [ class "tc_allvote" ] [ text "Rating" ] , td [ class "tc_allspoil"] [ text "Spoiler" ] + , td [ class "tc_alllie" ] [] , td [ class "tc_allwho" ] [] ] ] viewFoot : Api.State -> Bool -> A.Model GApi.ApiTagResult -> String -> Html Msg viewFoot state changed add addMsg = - tfoot [] [ tr [] [ td [ colspan 8 ] + tfoot [] [ tr [] [ td [ colspan 10 ] [ div [ style "display" "flex", style "justify-content" "space-between" ] [ A.view searchConfig add [placeholder "Add tags..."] , if addMsg /= "" - then b [ class "standout" ] [ text addMsg ] + then b [] [ text addMsg ] else if changed - then b [ class "standout" ] [ text "You have unsaved changes" ] + then b [] [ text "You have unsaved changes" ] else text "" , submitButton "Save changes" state True ] @@ -249,8 +272,8 @@ viewFoot state changed add addMsg = -- The table has a lot of interactivity, the use of Html.Lazy is absolutely necessary for good responsiveness. view : Model -> Html Msg view model = - form_ Submit (model.state == Api.Loading) - [ div [ class "mainbox" ] + form_ "" Submit (model.state == Api.Loading) + [ article [] [ h1 [] [ text <| "Edit tags for " ++ model.title ] , p [] [ text "This is where you can add tags to the visual novel and vote on the existing tags." @@ -268,7 +291,7 @@ view model = in if List.length lst == 0 then [] - else tr [class "tagmod_cat"] [ td [] [text nam], td [ class "tc_you", colspan 4 ] [], td [ class "tc_others", colspan 3 ] [] ] + else tr [class "tagmod_cat"] [ td [] [text nam], td [ class "tc_you", colspan 5 ] [], td [ class "tc_others", colspan 4 ] [] ] :: List.map (\t -> Html.Lazy.lazy4 viewTag t (if t.id == model.selId then model.selType else NoSel) model.id model.mod) lst) [ ("cont", "Content") , ("ero", "Sexual content") diff --git a/elm/UList/DateEdit.elm b/elm/UList/DateEdit.elm index d20dbba7..72f1b87d 100644 --- a/elm/UList/DateEdit.elm +++ b/elm/UList/DateEdit.elm @@ -1,4 +1,4 @@ -module UList.DateEdit exposing (main) +module UList.DateEdit exposing (main,init,view,update,Model,Msg) import Html exposing (..) import Html.Attributes exposing (..) @@ -76,7 +76,7 @@ view : Model -> Html Msg view model = div (class "compact" :: if model.visible then [] else [onMouseOver Show]) <| case model.state of Api.Loading -> [ span [ class "spinner" ] [] ] - Api.Error _ -> [ b [ class "standout" ] [ text "error" ] ] -- Argh + Api.Error _ -> [ b [] [ text "error" ] ] -- Argh Api.Normal -> [ if model.visible then input ([ type_ "date", class "text", value model.val, onInputValidation Val, onBlur (Save model.debnum), placeholder "yyyy-mm-dd" ] ++ GDE.valDate) [] diff --git a/elm/UList/LabelEdit.elm b/elm/UList/LabelEdit.elm index 1011d950..153fad8c 100644 --- a/elm/UList/LabelEdit.elm +++ b/elm/UList/LabelEdit.elm @@ -12,6 +12,7 @@ import Lib.Html exposing (..) import Lib.Api as Api import Lib.DropDown as DD import Gen.Api as GApi +import Gen.UListLabelAdd as GLA import Gen.UListLabelEdit as GLE @@ -26,29 +27,36 @@ main = Browser.element port ulistLabelChanged : Bool -> Cmd msg type alias Model = - { uid : Int - , vid : Int + { uid : String + , vid : String , labels : List GLE.RecvLabels , sel : Set Int -- Set of label IDs applied on the server , tsel : Set Int -- Set of label IDs applied on the client , state : Dict Int Api.State -- Only for labels that are being changed , dd : DD.Config Msg + , custom : String + , customSt : Api.State } init : GLE.Recv -> Model init f = { uid = f.uid , vid = f.vid - , labels = f.labels + , labels = List.filter (\l -> l.id > 0) f.labels , sel = Set.fromList f.selected , tsel = Set.fromList f.selected , state = Dict.empty - , dd = DD.init ("ulist_labeledit_dd" ++ String.fromInt f.vid) Open + , dd = DD.init ("ulist_labeledit_dd" ++ f.vid) Open + , custom = "" + , customSt = Api.Normal } type Msg = Open Bool | Toggle Int Bool Bool + | Custom String + | CustomSubmit + | CustomSaved GApi.Response | Saved Int Bool GApi.Response @@ -69,10 +77,21 @@ update msg model = GLE.send { uid = model.uid, vid = model.vid, label = l, applied = b } (Saved l b) -- Unselect other progress labels (1..4) when setting a progress label :: if cascade - then (List.map (\i -> selfCmd (Toggle i False False)) <| List.filter (\i -> l >= 0 && l <= 4 && i >= 0 && i <= 4 && i /= l) <| Set.toList model.tsel) + then (List.map (\i -> selfCmd (Toggle i False False)) <| List.filter (\i -> l >= 1 && l <= 4 && i >= 1 && i <= 4 && i /= l) <| Set.toList model.tsel) else [] ) + Custom t -> ({ model | custom = t }, Cmd.none) + CustomSubmit -> ({ model | customSt = Api.Loading }, GLA.send { uid = model.uid, vid = model.vid, label = model.custom } CustomSaved) + CustomSaved (GApi.LabelId id) -> + let new = List.filter (\l -> l.id == id) model.labels |> List.isEmpty + in ({ model | labels = if new then model.labels ++ [{ id = id, label = model.custom, private = True }] else model.labels + , customSt = Api.Normal, custom = "" + , sel = Set.insert id model.sel + , tsel = Set.insert id model.tsel + }, Cmd.none) + CustomSaved e -> ({ model | customSt = Api.Error e }, Cmd.none) + Saved l b (GApi.Success) -> let nmodel = { model | sel = if b then Set.insert l model.sel else Set.remove l model.sel, state = Dict.remove l model.state } in (nmodel, ulistLabelChanged (isPublic nmodel)) @@ -82,21 +101,34 @@ update msg model = view : Model -> String -> Html Msg view model txt = let - str = String.join ", " <| List.filterMap (\l -> if l.id /= 7 && Set.member l.id model.sel then Just l.label else Nothing) model.labels + lbl = List.intersperse (text ", ") <| List.filterMap (\l -> + if l.id /= 7 && Set.member l.id model.sel + then Just <| span [] + [ if l.id <= 6 && txt /= "-" then ulistIcon l.id l.label else text "" + , text (" " ++ l.label) ] + else Nothing) model.labels item l = li [ ] [ linkRadio (Set.member l.id model.tsel) (Toggle l.id True) [ text l.label , text " " - , span [ class "spinner", classList [("invisible", Dict.get l.id model.state /= Just Api.Loading)] ] [] , case Dict.get l.id model.state of - Just (Api.Error _) -> b [ class "standout" ] [ text "error" ] -- Need something better - _ -> text "" + Just Api.Loading -> span [ class "spinner" ] [] + Just (Api.Error _) -> b [] [ text "error" ] -- Need something better + _ -> if l.id <= 6 then ulistIcon l.id l.label else text "" ] ] + + custom = + li [] [ + case model.customSt of + Api.Normal -> Html.form [ onSubmit CustomSubmit ] + [ inputText "" model.custom Custom ([placeholder "new label", style "width" "150px"] ++ GLA.valLabel) ] + Api.Loading -> span [ class "spinner" ] [] + Api.Error _ -> b [] [ text "error" ] ] in DD.view model.dd (if List.any (\s -> s == Api.Loading) <| Dict.values model.state then Api.Loading else Api.Normal) - (text <| if str == "" then txt else str) - (\_ -> [ ul [] <| List.map item <| List.filter (\l -> l.id /= 7) model.labels ]) + (if List.isEmpty lbl then text txt else span [] lbl) + (\_ -> [ ul [] <| List.map item (List.filter (\l -> l.id /= 7) model.labels) ++ [ custom ] ]) diff --git a/elm/UList/LabelEdit.js b/elm/UList/LabelEdit.js deleted file mode 100644 index 156ae08f..00000000 --- a/elm/UList/LabelEdit.js +++ /dev/null @@ -1,10 +0,0 @@ -wrap_elm_init('UList.LabelEdit', function(init, opt) { - opt.flags.uid = pageVars.uid; - opt.flags.labels = pageVars.labels; - var app = init(opt); - app.ports.ulistLabelChanged.subscribe(function(pub) { - var l = document.getElementById('ulist_public_'+opt.flags.vid); - l.setAttribute('data-publabel', pub?1:''); - l.classList.toggle('invisible', !((l.getAttribute('data-voted') && !pageVars.voteprivate) || l.getAttribute('data-publabel'))) - }); -}); diff --git a/elm/UList/ManageLabels.elm b/elm/UList/ManageLabels.elm index 61b7ebe3..8a5533d7 100644 --- a/elm/UList/ManageLabels.elm +++ b/elm/UList/ManageLabels.elm @@ -24,7 +24,7 @@ main = Browser.element } type alias Model = - { uid : Int + { uid : String , state : Api.State , labels : List GML.SendLabels , editing : Maybe Int @@ -34,7 +34,7 @@ init : GML.Send -> Model init d = { uid = d.uid , state = Api.Normal - , labels = d.labels + , labels = List.filter (\l -> l.id > 0) d.labels , editing = Nothing } @@ -76,8 +76,8 @@ view model = ] , td [ ] [ linkRadio l.private (Private n) [ text "private" ] ] , td [ class "stealth" ] - [ if l.id == 7 then b [ class "grayedout" ] [ text "applied when you vote" ] - else if l.id > 0 && l.id < 10 then b [ class "grayedout" ] [ text "built-in" ] + [ if l.id == 7 then small [] [ text "applied when you vote" ] + else if l.id > 0 && l.id < 10 then small [] [ text "built-in" ] else if l.delete == Nothing then a [ onClick (Delete n (Just 1)) ] [ text "remove" ] else inputSelect "" l.delete (Delete n) [] [ (Nothing, "Keep label") @@ -92,7 +92,7 @@ view model = in Html.form [ onSubmit Submit, class "managelabels hidden" ] [ div [ ] - [ b [] [ text "How to use labels" ] + [ strong [] [ text "How to use labels" ] , ul [] [ li [] [ text "You can assign multiple labels to a visual novel" ] , li [] [ text "You can create custom labels or just use the built-in labels" ] @@ -110,14 +110,14 @@ view model = , tfoot [] [ if List.any (\l -> l.id == 7 && l.private) model.labels && List.any (\l -> not l.private) model.labels then tr [] [ td [ colspan 4 ] - [ b [ class "standout" ] [ text "WARNING: " ] + [ b [] [ text "WARNING: " ] , text "Your vote is still public if you assign a non-private label to the visual novel." ] ] else text "" , tr [] [ td [] [] , td [ colspan 3 ] - [ a [ onClick Add ] [ text "New label" ] + [ if List.length model.labels < 500 then inputButton "New label" Add [] else text "" , submitButton "Save changes" model.state (not hasDup) ] ] diff --git a/elm/UList/ManageLabels.js b/elm/UList/ManageLabels.js deleted file mode 100644 index f9f8c68b..00000000 --- a/elm/UList/ManageLabels.js +++ /dev/null @@ -1,12 +0,0 @@ -document.querySelectorAll('#managelabels').forEach(function(b) { - b.onclick = function() { - document.querySelectorAll('.managelabels').forEach(function(e) { e.classList.toggle('hidden') }) - document.querySelectorAll('.savedefault').forEach(function(e) { e.classList.add('hidden') }) - }; - return false; -}); - -wrap_elm_init('UList.ManageLabels', function(init, opt) { - opt.flags = { uid: pageVars.uid, labels: pageVars.labels }; - init(opt); -}); diff --git a/elm/UList/Opt.elm b/elm/UList/Opt.elm index 87b123fa..e909f2d8 100644 --- a/elm/UList/Opt.elm +++ b/elm/UList/Opt.elm @@ -41,8 +41,8 @@ type alias Model = , notesRev : Int , notesState : Api.State , rels : List RE.Model - , relNfo : Dict Int GApi.ApiReleases - , relOptions : Maybe (List (Int, String)) + , relNfo : Dict String GApi.ApiReleases + , relOptions : Maybe (List (String, String)) , relState : Api.State } @@ -69,14 +69,10 @@ type Msg | Notes String | NotesSave Int | NotesSaved Int GApi.Response - | Rel Int RE.Msg + | Rel String RE.Msg | RelLoad | RelLoaded GApi.Response - | RelAdd Int - - -showrel : GApi.ApiReleases -> String -showrel r = "[" ++ (RDate.format (RDate.expand r.released)) ++ " " ++ (String.join "," r.lang) ++ "] " ++ r.title ++ " (r" ++ String.fromInt r.id ++ ")" + | RelAdd String update : Msg -> Model -> (Model, Cmd Msg) @@ -128,11 +124,11 @@ update msg model = ( { model | relState = Api.Normal , relNfo = Dict.union (Dict.fromList <| List.map (\r -> (r.id, r)) rels) model.relNfo - , relOptions = Just <| List.map (\r -> (r.id, showrel r)) rels + , relOptions = Just <| List.map (\r -> (r.id, RDate.showrel r)) rels }, Cmd.none) RelLoaded e -> ({ model | relState = Api.Error e }, Cmd.none) RelAdd rid -> - ( { model | rels = model.rels ++ (if rid == 0 then [] else [RE.init model.flags.vid { rid = rid, uid = model.flags.uid, status = Just 2, empty = "" }]) } + ( { model | rels = model.rels ++ (if rid == "" then [] else [RE.init model.flags.vid { rid = rid, uid = model.flags.uid, status = Just 2, empty = "" }]) } , Task.perform (always <| Rel rid <| RE.Set (Just 2) True) <| Task.succeed True) @@ -156,7 +152,7 @@ view model = else [] ) ++ ( case model.notesState of - Api.Error e -> [ br [] [], b [ class "standout" ] [ text <| Api.showResponse e ] ] + Api.Error e -> [ br [] [], b [] [ text <| Api.showResponse e ] ] _ -> [] ) ] @@ -169,11 +165,11 @@ view model = -- TODO: This <select> solution is ugly as hell, a Lib.DropDown-based solution would be nicer. -- Or just throw all releases in the table and use the status field for add stuff. case (model.relOptions, model.relState) of - (Just opts, _) -> [ inputSelect "" 0 RelAdd [ style "width" "500px" ] - <| (0, "-- add release --") :: List.filter (\(rid,_) -> not <| List.any (\r -> r.rid == rid) model.rels) opts ] + (Just opts, _) -> [ inputSelect "" "" RelAdd [ style "width" "500px" ] + <| ("", "-- add release --") :: List.filter (\(rid,_) -> not <| List.any (\r -> r.rid == rid) model.rels) opts ] (_, Api.Normal) -> [] (_, Api.Loading) -> [ span [ class "spinner" ] [], text "Loading releases..." ] - (_, Api.Error e) -> [ b [ class "standout" ] [ text <| Api.showResponse e ], text ". ", a [ href "#", onClickD RelLoad ] [ text "Try again" ] ] + (_, Api.Error e) -> [ b [] [ text <| Api.showResponse e ], text ". ", a [ href "#", onClickD RelLoad ] [ text "Try again" ] ] ] ] ] @@ -191,7 +187,7 @@ view model = <| List.map platformIcon nfo.platforms ++ List.map langIcon nfo.lang ++ [ releaseTypeIcon nfo.rtype ] - , td [ class "tco4" ] [ a [ href ("/r"++String.fromInt nfo.id), title nfo.original ] [ text nfo.title ] ] + , td [ class "tco4" ] [ a [ href ("/"++nfo.id), title nfo.alttitle ] [ text nfo.title ] ] ] confirm = @@ -206,4 +202,4 @@ view model = (False, _) -> table [] <| (if model.flags.own then opt else []) ++ List.map rel model.rels (_, Api.Normal) -> confirm (_, Api.Loading) -> div [ class "spinner" ] [] - (_, Api.Error e) -> b [ class "standout" ] [ text <| "Error removing item: " ++ Api.showResponse e ] + (_, Api.Error e) -> b [] [ text <| "Error removing item: " ++ Api.showResponse e ] diff --git a/elm/UList/Opt.js b/elm/UList/Opt.js deleted file mode 100644 index 7a80884a..00000000 --- a/elm/UList/Opt.js +++ /dev/null @@ -1,34 +0,0 @@ -var actualInit = function(init, opt) { - var app = init(opt); - - app.ports.ulistVNDeleted.subscribe(function(b) { - var e = document.getElementById('ulist_tr_'+opt.flags.vid); - e.parentNode.removeChild(e.nextElementSibling); - e.parentNode.removeChild(e); - - // Have to restripe after deletion :( - var rows = document.querySelectorAll('.ulist > table > tbody > tr'); - for(var i=0; i<rows.length; i++) - rows[i].classList.toggle('odd', Math.floor(i/2) % 2 == 0); - }); - - app.ports.ulistNotesChanged.subscribe(function(n) { - document.getElementById('ulist_notes_'+opt.flags.vid).innerText = n; - }); - - app.ports.ulistRelChanged.subscribe(function(rels) { - var e = document.getElementById('ulist_relsum_'+opt.flags.vid); - e.classList.toggle('todo', rels[0] != rels[1]); - e.classList.toggle('done', rels[1] > 0 && rels[0] == rels[1]); - e.innerText = rels[0] + '/' + rels[1]; - }); -}; - -// This module is typically hidden, lazily load it only when the module is visible to speed up page load time. -wrap_elm_init('UList.Opt', function(init, opt) { - var e = document.getElementById('collapse_vid'+opt.flags.vid); - if(e.checked) - actualInit(init, opt); - else - e.addEventListener('click', function() { actualInit(init, opt) }, { once: true }); -}); diff --git a/elm/UList/ReleaseEdit.elm b/elm/UList/ReleaseEdit.elm index 5373e316..7f901d67 100644 --- a/elm/UList/ReleaseEdit.elm +++ b/elm/UList/ReleaseEdit.elm @@ -15,29 +15,29 @@ import Gen.UListRStatus as GRS main : Program GRS.Send Model Msg main = Browser.element - { init = \f -> (init 0 f, Cmd.none) + { init = \f -> (init "" f, Cmd.none) , subscriptions = \model -> DD.sub model.dd , view = view , update = update } type alias Model = - { uid : Int - , rid : Int + { uid : String + , rid : String , status : Maybe Int , empty : String , state : Api.State , dd : DD.Config Msg } -init : Int -> GRS.Send -> Model +init : String -> GRS.Send -> Model init vid f = { uid = f.uid , rid = f.rid , status = f.status , empty = f.empty , state = Api.Normal - , dd = DD.init ("ulist_reldd" ++ String.fromInt vid ++ "_" ++ String.fromInt f.rid) Open + , dd = DD.init ("ulist_reldd" ++ vid ++ "_" ++ f.rid) Open } type Msg diff --git a/elm/UList/SaveDefault.elm b/elm/UList/SaveDefault.elm index a0945c4b..cf7ab13b 100644 --- a/elm/UList/SaveDefault.elm +++ b/elm/UList/SaveDefault.elm @@ -21,7 +21,7 @@ main = Browser.element type alias Model = { state : Api.State - , uid : Int + , uid : String , opts : GUSD.SendOpts , field : String -- Ewwww stringly typed enum , hid : Bool @@ -56,9 +56,9 @@ update msg model = view : Model -> Html Msg view model = - form_ Submit (model.state == Api.Loading) + form_ "" Submit (model.state == Api.Loading) [ div [ classList [("savedefault", True), ("hidden", model.hid)] ] - [ b [] [ text "Save as default" ] + [ strong [] [ text "Save as default" ] , br [] [] , text "This will change the default label selection, visible columns and table sorting options for the selected page to the currently applied settings." , text " The saved view will also apply to users visiting your lists." diff --git a/elm/UList/SaveDefault.js b/elm/UList/SaveDefault.js deleted file mode 100644 index a253680f..00000000 --- a/elm/UList/SaveDefault.js +++ /dev/null @@ -1,7 +0,0 @@ -document.querySelectorAll('#savedefault').forEach(function(b) { - b.onclick = function() { - document.querySelectorAll('.savedefault').forEach(function(e) { e.classList.toggle('hidden') }) - document.querySelectorAll('.managelabels').forEach(function(e) { e.classList.add('hidden') }) - }; - return false; -}); diff --git a/elm/UList/VNPage.elm b/elm/UList/VNPage.elm index 64c5f99a..63a1136d 100644 --- a/elm/UList/VNPage.elm +++ b/elm/UList/VNPage.elm @@ -1,182 +1,70 @@ +-- This is basically the same thing as UList.Widget, but with a slightly different UI. +-- Release options are not available in this mode, as VN pages have a separate +-- release listing anyway. module UList.VNPage exposing (main) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) import Browser -import Browser.Dom exposing (focus) import Task -import Process -import Set +import Date import Lib.Html exposing (..) import Lib.Util exposing (..) import Lib.Api as Api import Lib.DropDown as DD -import Gen.Api as GApi +import Gen.UListWidget as GUW import Gen.UListVNNotes as GVN -import Gen.UListDel as GDE import UList.LabelEdit as LE import UList.VoteEdit as VE +import UList.DateEdit as DE +import UList.Widget as UW --- We don't have a Gen.* module for this (yet), so define these manually -type alias RecvLabels = - { id : Int - , label : String - , private : Bool - } - -type alias Recv = - { uid : Int - , vid : Int - , onlist : Bool - , canvote : Bool - , vote : Maybe String - , labels : List RecvLabels - , selected : List Int - , notes : String - } - - -main : Program Recv Model Msg +main : Program GUW.Recv UW.Model UW.Msg main = Browser.element - { init = \f -> (init f, Cmd.none) - , subscriptions = \model -> Sub.batch [ Sub.map Labels (DD.sub model.labels.dd), Sub.map Vote (DD.sub model.vote.dd) ] + { init = \f -> (UW.init f, Date.today |> Task.perform UW.Today) + , subscriptions = \m -> Sub.batch + [ Sub.map UW.Label (DD.sub m.labels.dd) + , Sub.map UW.Vote (DD.sub m.vote.dd) ] , view = view - , update = update - } - -type alias Model = - { flags : Recv - , onlist : Bool - , del : Bool - , state : Api.State -- For adding/deleting; Vote and label edit widgets have their own state - , labels : LE.Model - , vote : VE.Model - , notes : String - , notesRev : Int - , notesState : Api.State - , notesVis : Bool - } - -init : Recv -> Model -init f = - { flags = f - , onlist = f.onlist - , del = False - , state = Api.Normal - , labels = LE.init { uid = f.uid, vid = f.vid, labels = f.labels, selected = f.selected } - , vote = VE.init { uid = f.uid, vid = f.vid, vote = f.vote } - , notes = f.notes - , notesRev = 0 - , notesState = Api.Normal - , notesVis = f.notes /= "" + , update = UW.update } -type Msg - = Noop - | Labels LE.Msg - | Vote VE.Msg - | NotesToggle - | Notes String - | NotesSave Int - | NotesSaved Int GApi.Response - | Del Bool - | Delete - | Deleted GApi.Response - - -setOnList : Model -> Model -setOnList model = { model | onlist = model.onlist || model.vote.ovote /= Nothing || not (Set.isEmpty model.labels.sel) || model.notes /= "" } - -update : Msg -> Model -> (Model, Cmd Msg) -update msg model = - case msg of - Noop -> (model, Cmd.none) - Labels m -> let (nm, cmd) = LE.update m model.labels in (setOnList { model | labels = nm}, Cmd.map Labels cmd) - Vote m -> let (nm, cmd) = VE.update m model.vote in (setOnList { model | vote = nm}, Cmd.map Vote cmd) - NotesToggle -> - ( { model | notesVis = not model.notesVis } - , if model.notesVis then Cmd.none else Task.attempt (always Noop) (focus "uvn_notes")) - Notes s -> - if s == model.notes then (model, Cmd.none) - else ( { model | notes = s, notesRev = model.notesRev + 1 } - , Task.perform (\_ -> NotesSave (model.notesRev+1)) <| Process.sleep 1000) - NotesSave rev -> - if rev /= model.notesRev || model.notes == model.flags.notes - then (model, Cmd.none) - else ( { model | notesState = Api.Loading } - , GVN.send { uid = model.flags.uid, vid = model.flags.vid, notes = model.notes } (NotesSaved rev)) - NotesSaved rev GApi.Success -> - let f = model.flags - nf = { f | notes = model.notes } - in if model.notesRev /= rev - then (model, Cmd.none) - else (setOnList {model | flags = nf, notesState = Api.Normal }, Cmd.none) - NotesSaved _ e -> ({ model | notesState = Api.Error e }, Cmd.none) - - Del b -> ({ model | del = b }, Cmd.none) - Delete -> ({ model | state = Api.Loading }, GDE.send { uid = model.flags.uid, vid = model.flags.vid } Deleted) - Deleted GApi.Success -> - ( { model - | state = Api.Normal, onlist = False, del = False - , labels = LE.init { uid = model.flags.uid, vid = model.flags.vid, labels = model.flags.labels, selected = [] } - , vote = VE.init { uid = model.flags.uid, vid = model.flags.vid, vote = Nothing } - , notes = "", notesVis = False - } - , Cmd.none) - Deleted e -> ({ model | state = Api.Error e }, Cmd.none) - - -isPublic : Model -> Bool -isPublic model = - LE.isPublic model.labels - || (isJust model.vote.vote && List.any (\l -> l.id == 7 && not l.private) model.labels.labels) - - -view : Model -> Html Msg +view : UW.Model -> Html UW.Msg view model = - div [ class "ulistvn elm_dd_input" ] - [ span [] <| - case (model.state, model.del, model.onlist) of - (Api.Loading, _, _) -> [ span [ class "spinner" ] [] ] - (Api.Error e, _, _) -> [ b [ class "standout" ] [ text <| Api.showResponse e ] ] - (Api.Normal, _, False) -> [ b [ class "grayedout" ] [ text "not on your list" ] ] - (Api.Normal, True, _) -> - [ a [ onClickD Delete ] [ text "Yes, delete" ] - , text " | " - , a [ onClickD (Del False) ] [ text "Cancel" ] + let notesBut = + [ a [ href "#", onClickD UW.NotesToggle ] [ text "💬" ] + , span [ class "spinner", classList [("hidden", model.notesState /= Api.Loading)] ] [] + , case model.notesState of + Api.Error e -> b [] [ text <| Api.showResponse e ] + _ -> text "" ] - (Api.Normal, False, True) -> - [ span [ classList [("hidden", not (isPublic model))], title "This visual novel is on your public list" ] [ text "👁 " ] - , text "On your list | " - , a [ onClickD (Del True) ] [ text "Remove from list" ] - ] - , b [] [ text "User options" ] - , table [ style "margin" "4px 0 0 0" ] + in + div [ class "ulistvn elm_dd_input" ] + [ span [] (UW.viewStatus model) + , strong [] [ text "User options" ] + , table [ style "margin" "4px 0 0 0", style "width" "100%" ] <| [ tr [ class "odd" ] [ td [ class "key" ] [ text "My labels" ] - , td [ colspan 2 ] [ Html.map Labels (LE.view model.labels "- select label -") ] + , td [ colspan (if model.canvote then 2 else 1) ] [ Html.map UW.Label (LE.view model.labels "- select label -") ] + , if model.canvote then text "" else td [] notesBut ] - , if model.flags.canvote || (Maybe.withDefault "-" model.flags.vote /= "-") + , if model.canvote then tr [ class "nostripe compact" ] [ td [] [ text "My vote" ] - , td [ style "width" "80px" ] [ Html.map Vote (VE.view model.vote "- vote -") ] - , td [] - [ a [ href "#", onClickD NotesToggle ] [ text "💬" ] - , span [ class "spinner", classList [("hidden", model.notesState /= Api.Loading)] ] [] - , case model.notesState of - Api.Error e -> b [ class "standout" ] [ text <| Api.showResponse e ] - _ -> text "" - ] - ] - else text "" - , if model.notesVis - then tr [ class "nostripe compact" ] - [ td [] [ text "Notes" ] - , td [ colspan 2 ] - [ textarea ([ id "uvn_notes", placeholder "Notes", rows 2, cols 30, onInput Notes, onBlur (NotesSave model.notesRev)] ++ GVN.valNotes) [ text model.notes ] ] + , td [ style "width" "80px" ] [ Html.map UW.Vote (VE.view model.vote "- vote -") ] + , td [] <| notesBut ++ [ UW.viewReviewLink model ] ] else text "" + ] ++ if not model.notesVis then [] else + [ tr [ class "nostripe compact" ] + [ td [] [ text "Notes" ] + , td [ colspan 2 ] + [ textarea ([ id "widget-notes", placeholder "Notes", rows 2, cols 30, onInput UW.Notes, onBlur (UW.NotesSave model.notesRev)] ++ GVN.valNotes) [ text model.notes ] ] + ] + ] ++ if not model.onlist then [] else + [ tr [] [ td [] [ text "Start date" ], td [ colspan 2, class "date" ] [ Html.map UW.Started (DE.view model.started ) ] ] + , tr [] [ td [] [ text "Finish date" ], td [ colspan 2, class "date" ] [ Html.map UW.Finished (DE.view model.finished) ] ] ] ] diff --git a/elm/UList/VoteEdit.elm b/elm/UList/VoteEdit.elm index 2ecdde10..2f57dca8 100644 --- a/elm/UList/VoteEdit.elm +++ b/elm/UList/VoteEdit.elm @@ -42,12 +42,12 @@ init f = in { state = Api.Normal , flags = f - , dd = DD.init ("vote_edit_dd_" ++ String.fromInt f.vid) Open + , dd = DD.init ("vote_edit_dd_" ++ f.vid) Open , text = if List.any (\n -> v == Just (String.fromInt n)) (List.indexedMap (\a b -> a+1) ratings) then "" else Maybe.withDefault "" v , vote = v , ovote = v , isvalid = True - , fieldId = "vote_edit_" ++ String.fromInt f.vid + , fieldId = "vote_edit_" ++ f.vid } type Msg diff --git a/elm/UList/VoteEdit.js b/elm/UList/VoteEdit.js deleted file mode 100644 index a7ebfb74..00000000 --- a/elm/UList/VoteEdit.js +++ /dev/null @@ -1,8 +0,0 @@ -wrap_elm_init('UList.VoteEdit', function(init, opt) { - var app = init(opt); - app.ports.ulistVoteChanged.subscribe(function(voted) { - var l = document.getElementById('ulist_public_'+opt.flags.vid); - l.setAttribute('data-voted', voted?1:''); - l.classList.toggle('invisible', !((l.getAttribute('data-voted') && !pageVars.voteprivate) || l.getAttribute('data-publabel'))) - }); -}); diff --git a/elm/UList/Widget.elm b/elm/UList/Widget.elm new file mode 100644 index 00000000..ac5e0d70 --- /dev/null +++ b/elm/UList/Widget.elm @@ -0,0 +1,316 @@ +-- This module provides a ulist management widget. By default it shows as a +-- small icon indicating the list status, which can be clicked on to open a +-- full management modal for the VN. +-- +-- It is also used by UList.VNPage to provide a different view for essentially +-- the same functionality. +module UList.Widget exposing (Model, Msg(..), main, init, update, viewStatus, viewReviewLink) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import Browser +import Browser.Dom exposing (focus) +import Task +import Process +import Set +import Date +import Dict exposing (Dict) +import Lib.Util exposing (..) +import Lib.Html exposing (..) +import Lib.Ffi as Ffi +import Lib.Api as Api +import Lib.RDate as RDate +import Lib.DropDown as DD +import Gen.Api as GApi +import Gen.UListWidget as UW +import Gen.UListVNNotes as GVN +import Gen.UListDel as GDE +import UList.LabelEdit as LE +import UList.VoteEdit as VE +import UList.DateEdit as DE +import UList.ReleaseEdit as RE + + +main : Program UW.Recv Model Msg +main = Browser.element + { init = \f -> (init f, Date.today |> Task.perform Today) + , subscriptions = \m -> if not m.open then Sub.none else Sub.batch <| + [ DD.onClickOutside "ulist-widget-box" (Open False) + , Sub.map Label (DD.sub m.labels.dd) + , Sub.map Vote (DD.sub m.vote.dd) + ] ++ List.map (\r -> Sub.map (Rel r.rid) (DD.sub r.dd)) m.rels + , view = view + , update = update + } + +type alias Model = + { uid : String + , vid : String + , loadState : Api.State + , today : Date.Date + , title : Maybe String -- Nothing is used here to indicate that we haven't loaded the full data yet. + , open : Bool + , onlist : Bool + , del : Bool + , labels : LE.Model + , vote : VE.Model + , canvote : Bool + , canreview : Bool + , review : Maybe String + , notes : String + , notesRev : Int + , notesSaved : String + , notesState : Api.State + , notesVis : Bool -- For UList.VNPage + , started : DE.Model + , finished : DE.Model + , rels : List RE.Model + , relNfo : Dict String GApi.ApiReleases + , relOptions : List (String, String) + } + +init : UW.Recv -> Model +init f = + { uid = f.uid + , vid = f.vid + , loadState = Api.Normal + , today = Date.fromOrdinalDate 2100 1 + , title = Maybe.map (\full -> full.title) f.full + , open = False + , onlist = f.labels /= Nothing + , del = False + -- TODO: LabelEdit and VoteEdit create an internal vid-based ID, so this widget can't be used on VN pages or UList listings. Need to fix that. + , labels = LE.init + { uid = f.uid + , vid = f.vid + , selected = List.map (\l -> l.id) (Maybe.withDefault [] f.labels) + , labels = Maybe.withDefault + (List.map (\l -> {id = l.id, label = l.label, private = True}) (Maybe.withDefault [] f.labels)) + (Maybe.map (\full -> full.labels) f.full) + } + , vote = VE.init { uid = f.uid, vid = f.vid, vote = Maybe.andThen (\full -> full.vote) f.full } + , canvote = Maybe.map (\full -> full.canvote ) f.full |> Maybe.withDefault False + , canreview = Maybe.map (\full -> full.canreview ) f.full |> Maybe.withDefault False + , review = Maybe.andThen (\full -> full.review) f.full + , notes = Maybe.map (\full -> full.notes ) f.full |> Maybe.withDefault "" + , notesRev = 0 + , notesSaved = Maybe.map (\full -> full.notes ) f.full |> Maybe.withDefault "" + , notesState = Api.Normal + , notesVis = Maybe.map (\full -> full.notes /= "") f.full == Just True + , started = let m = DE.init { uid = f.uid, vid = f.vid, date = Maybe.map (\full -> full.started ) f.full |> Maybe.withDefault "", start = True } in { m | visible = True } + , finished = let m = DE.init { uid = f.uid, vid = f.vid, date = Maybe.map (\full -> full.finished) f.full |> Maybe.withDefault "", start = False } in { m | visible = True } + , rels = List.map (\st -> RE.init ("widget-" ++ f.vid) { uid = f.uid, rid = st.id, status = Just st.status, empty = "" }) <| Maybe.withDefault [] <| Maybe.map (\full -> full.rlist) f.full + , relNfo = Dict.fromList <| List.map (\r -> (r.id, r)) <| Maybe.withDefault [] <| Maybe.map (\full -> full.releases) f.full + , relOptions = Maybe.withDefault [] <| Maybe.map (\full -> List.map (\r -> (r.id, RDate.showrel r)) full.releases) f.full + } + +reset : Model -> Model +reset m = init + { uid = m.uid + , vid = m.vid + , labels = Nothing + , full = Maybe.map (\t -> + { title = t + , labels = m.labels.labels + , canvote = m.canvote + , canreview = m.canreview + , vote = Nothing + , review = m.review + , notes = "" + , started = "" + , finished = "" + , releases = Dict.values m.relNfo + , rlist = [] + }) m.title + } + + +type Msg + = Noop + | Today Date.Date + | Open Bool + | Loaded GApi.Response + | Label LE.Msg + | Vote VE.Msg + | Notes String + | NotesSave Int + | NotesSaved Int GApi.Response + | NotesToggle + | Started DE.Msg + | Finished DE.Msg + | Del Bool + | Delete + | Deleted GApi.Response + | Rel String RE.Msg + | RelAdd String + + +setOnList : Model -> Model +setOnList model = + { model | onlist = model.onlist + || model.vote.ovote /= Nothing + || not (Set.isEmpty model.labels.sel) + || model.notes /= "" + || model.started.val /= "" + || model.finished.val /= "" + || not (List.isEmpty model.rels) + } + + +isPublic : Model -> Bool +isPublic model = + LE.isPublic model.labels + || (isJust model.vote.vote && List.any (\l -> l.id == 7 && not l.private) model.labels.labels) + + +update : Msg -> Model -> (Model, Cmd Msg) +update msg model = + case msg of + Noop -> (model, Cmd.none) + Today d -> ({ model | today = d }, Cmd.none) + Open b -> + if b && model.title == Nothing + then ({ model | open = b, loadState = Api.Loading }, UW.send { uid = model.uid, vid = model.vid } Loaded) + else ({ model | open = b }, Cmd.none) + + Loaded (GApi.UListWidget w) -> let m = init w in ({ m | open = True }, Cmd.none) + Loaded e -> ({ model | loadState = Api.Error e }, Cmd.none) + + Label m -> let (nm, nc) = LE.update m model.labels in (setOnList { model | labels = nm }, Cmd.map Label nc) + Vote m -> let (nm, nc) = VE.update m model.vote in (setOnList { model | vote = nm }, Cmd.map Vote nc) + Started m -> let (nm, nc) = DE.update m model.started in (setOnList { model | started = nm }, Cmd.map Started nc) + Finished m -> let (nm, nc) = DE.update m model.finished in (setOnList { model | finished = nm }, Cmd.map Finished nc) + + Notes s -> + ( { model | notes = s, notesRev = model.notesRev + 1 } + , Task.perform (\_ -> NotesSave (model.notesRev+1)) <| Process.sleep 1000) + NotesSave rev -> + if rev /= model.notesRev || model.notes == model.notesSaved + then (model, Cmd.none) + else ( { model | notesState = Api.Loading } + , GVN.send { uid = model.uid, vid = model.vid, notes = model.notes } (NotesSaved rev)) + NotesSaved rev GApi.Success -> + if model.notesRev /= rev + then (model, Cmd.none) + else (setOnList {model | notesSaved = model.notes, notesState = Api.Normal }, Cmd.none) + NotesSaved _ e -> ({ model | notesState = Api.Error e }, Cmd.none) + NotesToggle -> + ( { model | notesVis = not model.notesVis } + , if model.notesVis then Cmd.none else Task.attempt (always Noop) (focus "widget-notes")) + + Del b -> ({ model | del = b }, Cmd.none) + Delete -> ({ model | loadState = Api.Loading }, GDE.send { uid = model.uid, vid = model.vid } Deleted) + Deleted GApi.Success -> (reset model, Cmd.none) + Deleted e -> ({ model | loadState = Api.Error e }, Cmd.none) + + Rel rid m -> + case List.filterMap (\r -> if r.rid == rid then Just (RE.update m r) else Nothing) model.rels |> List.head of + Nothing -> (model, Cmd.none) + Just (rm, rc) -> + let + nr = if rm.state == Api.Normal && rm.status == Nothing + then List.filter (\r -> r.rid /= rid) model.rels + else List.map (\r -> if r.rid == rid then rm else r) model.rels + in ({ model | rels = nr }, Cmd.map (Rel rid) rc) + RelAdd rid -> + ( setOnList { model | rels = model.rels ++ (if rid == "" then [] else [RE.init model.vid { rid = rid, uid = model.uid, status = Just 2, empty = "" }]) } + , Task.perform (always <| Rel rid <| RE.Set (Just 2) True) <| Task.succeed True) + + +viewStatus : Model -> List (Html Msg) +viewStatus model = + case (model.loadState, model.del, model.onlist) of + (Api.Loading, _, _) -> [ span [ class "spinner" ] [] ] + (Api.Error e, _, _) -> [ b [] [ text <| Api.showResponse e ] ] + (_, _, False) -> [ small [] [ text "not on your list" ] ] + (_, True, _) -> + [ a [ onClickD Delete ] [ text "Yes, delete" ] + , text " | " + , a [ onClickD (Del False) ] [ text "Cancel" ] + ] + (_, False, True) -> + [ span [ classList [("hidden", not (isPublic model))], title "This visual novel is on your public list" ] [ text "👁 " ] + , text "On your list | " + , a [ onClickD (Del True) ] [ text "Remove from list" ] + ] + +viewReviewLink : Model -> Html Msg +viewReviewLink model = + case (model.vote.vote /= Nothing && model.canreview, model.review) of + (False, _) -> text "" + (True, Nothing) -> a [ href ("/" ++ model.vid ++ "/addreview") ] [ text " write a review »" ] + (True, Just w) -> a [ href ("/" ++ w ++ "/edit") ] [ text " edit review »" ] + + + +view : Model -> Html Msg +view model = + let + icon () = + let fn = if not model.onlist then -1 + else List.range 1 6 + |> List.filter (\n -> Set.member n model.labels.tsel) + |> List.maximum + |> Maybe.withDefault 0 + lbl = if not model.onlist then "Add to list" + else String.join ", " <| List.filterMap (\l -> if Set.member l.id model.labels.tsel && l.id /= 7 then Just l.label else Nothing) model.labels.labels + in span [ onClickN (Open True), class "ulist-widget-icon" ] [ ulistIcon fn lbl ] + + rel r = + case Dict.get r.rid model.relNfo of + Nothing -> text "" + Just nfo -> relnfo r nfo + + relnfo r nfo = + tr [] + [ td [ class "tco1" ] [ Html.map (Rel r.rid) (RE.view r) ] + , td [ class "tco2" ] [ RDate.display model.today nfo.released ] + , td [ class "tco3" ] + <| List.map platformIcon nfo.platforms + ++ List.map langIcon nfo.lang + ++ [ releaseTypeIcon nfo.rtype ] + , td [ class "tco4" ] [ a [ href ("/"++nfo.id), title nfo.alttitle ] [ text nfo.title ] ] + ] + + box () = + [ h2 [] [ text (Maybe.withDefault "" model.title) ] + , div [ style "text-align" "right", style "margin" "3px 0" ] (viewStatus model) + , table [] <| + [ tr [] [ td [] [ text "Labels" ], td [] [ Html.map Label (LE.view model.labels "- select label -") ] ] + , if not model.canvote then text "" else + tr [] + [ td [] [ text "Vote" ] + , td [] + [ div [ style "width" "80px", style "display" "inline-block" ] [ Html.map Vote (VE.view model.vote "- vote -") ] + , viewReviewLink model ] + ] + , tr [] [ td [] [ text "Start date" ], td [ class "date" ] [ Html.map Started (DE.view model.started ) ] ] + , tr [] [ td [] [ text "Finish date" ], td [ class "date" ] [ Html.map Finished (DE.view model.finished) ] ] + , tr [] + [ td [] [ text "Notes ", span [ class "spinner", classList [("hidden", model.notesState /= Api.Loading)] ] [] ] + , td [] <| + [ textarea ([ rows 2, cols 40, onInput Notes, onBlur (NotesSave model.notesRev)] ++ GVN.valNotes) [ text model.notes ] + ] ++ case model.notesState of + Api.Error e -> [ br [] [], b [] [ text <| Api.showResponse e ] ] + _ -> [] + ] + ] + , if List.isEmpty model.relOptions then text "" else h2 [] [ text "Releases" ] + , table [] <| + (if List.isEmpty model.relOptions then text "" else tfoot [] [ tr [] + [ td [] [] + , td [ colspan 3 ] + [ inputSelect "" "" RelAdd [] <| ("", "-- add release --") :: List.filter (\(rid,_) -> not <| List.any (\r -> r.rid == rid) model.rels) model.relOptions ] + ] ] + ) :: List.map rel model.rels + ] + in + if model.open + then div [ class "ulist-widget elm_dd_input" ] + [ div [ id "ulist-widget-box" ] <| + case model.loadState of + Api.Loading -> [ div [ class "spinner" ] [] ] + Api.Error e -> [ b [] [ text <| Api.showResponse e ] ] + Api.Normal -> box () ] + else icon () diff --git a/elm/UList/labelfilters.js b/elm/UList/labelfilters.js deleted file mode 100644 index dfec97c6..00000000 --- a/elm/UList/labelfilters.js +++ /dev/null @@ -1,17 +0,0 @@ -var p = document.querySelectorAll('.labelfilters')[0]; -if(p) { - var multi = document.getElementById('form_l_multi'); - multi.parentNode.classList.remove('hidden'); - var l = document.querySelectorAll('.labelfilters input[name=l]'); - l.forEach(function(el) { - el.addEventListener('click', function() { - if(multi.checked) - return true; - l.forEach(function(el2) { el2.checked = el2 == el }); - var n=el; - while(n && n.nodeName.toLowerCase() != 'form') - n=n.parentNode; - n.submit(); - }); - }); -} diff --git a/elm/User/Edit.elm b/elm/User/Edit.elm deleted file mode 100644 index c8ecdddb..00000000 --- a/elm/User/Edit.elm +++ /dev/null @@ -1,292 +0,0 @@ -module User.Edit exposing (main) - -import Bitwise exposing (..) -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) -import Html.Keyed as K -import Browser -import Browser.Navigation exposing (load) -import Lib.Html exposing (..) -import Lib.Api as Api -import Gen.Api as GApi -import Gen.Types as GT -import Gen.UserEdit as GUE - - -main : Program GUE.Recv Model Msg -main = Browser.element - { init = \e -> (init e, Cmd.none) - , view = view - , update = update - , subscriptions = always Sub.none - } - - -type alias PassData = - { cpass : Bool - , pass1 : String - , pass2 : String - , opass : String - } - -type alias Model = - { state : Api.State - , id : Int - , title : String - , username : String - , opts : GUE.RecvOpts - , admin : Maybe GUE.SendAdmin - , prefs : Maybe GUE.SendPrefs - , pass : Maybe PassData - , passNeq : Bool - , mailConfirm : Bool - } - - -init : GUE.Recv -> Model -init d = - { state = Api.Normal - , id = d.id - , title = d.title - , username = d.username - , opts = d.opts - , admin = d.admin - , prefs = d.prefs - , pass = Maybe.map (always { cpass = False, pass1 = "", pass2 = "", opass = "" }) d.prefs - , passNeq = False - , mailConfirm = False - } - - -type AdminMsg - = PermBoard Bool - | PermBoardmod Bool - | PermEdit Bool - | PermImgvote Bool - | PermImgmod Bool - | PermTag Bool - | PermDbmod Bool - | PermTagmod Bool - | PermUsermod Bool - | IgnVotes Bool - -type PrefMsg - = EMail String - | ShowNsfw Bool - | MaxSexual Int - | MaxViolence Int - | TraitsSexual Bool - | Spoilers Int - | TagsAll Bool - | TagsCont Bool - | TagsEro Bool - | TagsTech Bool - | Skin String - | Css String - | NoAds Bool - | NoFancy Bool - | Support Bool - | PubSkin Bool - | Uniname String - -type PassMsg - = CPass Bool - | OPass String - | Pass1 String - | Pass2 String - -type Msg - = Username String - | Admin AdminMsg - | Prefs PrefMsg - | Pass PassMsg - | Submit - | Submitted GApi.Response - - -updateAdmin : AdminMsg -> GUE.SendAdmin -> GUE.SendAdmin -updateAdmin msg model = - case msg of - PermBoard b -> { model | perm_board = b } - PermBoardmod b -> { model | perm_boardmod = b } - PermEdit b -> { model | perm_edit = b } - PermImgvote b -> { model | perm_imgvote = b } - PermImgmod b -> { model | perm_imgmod = b } - PermTag b -> { model | perm_tag = b } - PermDbmod b -> { model | perm_dbmod = b } - PermTagmod b -> { model | perm_tagmod = b } - PermUsermod b -> { model | perm_usermod = b } - IgnVotes b -> { model | ign_votes = b } - -updatePrefs : PrefMsg -> GUE.SendPrefs -> GUE.SendPrefs -updatePrefs msg model = - case msg of - EMail n -> { model | email = n } - ShowNsfw b -> { model | show_nsfw = b } - MaxSexual n-> { model | max_sexual = n } - MaxViolence n -> { model | max_violence = n } - TraitsSexual b -> { model | traits_sexual = b } - Spoilers n -> { model | spoilers = n } - TagsAll b -> { model | tags_all = b } - TagsCont b -> { model | tags_cont = b } - TagsEro b -> { model | tags_ero = b } - TagsTech b -> { model | tags_tech = b } - Skin n -> { model | skin = n } - Css n -> { model | customcss = n } - NoAds b -> { model | nodistract_noads = b } - NoFancy b -> { model | nodistract_nofancy = b } - Support b -> { model | support_enabled = b } - PubSkin b -> { model | pubskin_enabled = b } - Uniname n -> { model | uniname = n } - -updatePass : PassMsg -> PassData -> PassData -updatePass msg model = - case msg of - CPass b -> { model | cpass = b } - OPass n -> { model | opass = n } - Pass1 n -> { model | pass1 = n } - Pass2 n -> { model | pass2 = n } - - -encode : Model -> GUE.Send -encode model = - { id = model.id - , username = model.username - , admin = model.admin - , prefs = model.prefs - , password = Maybe.andThen (\p -> if p.cpass && p.pass1 == p.pass2 then Just { old = p.opass, new = p.pass1 } else Nothing) model.pass - } - - -update : Msg -> Model -> (Model, Cmd Msg) -update msg model = - case msg of - Admin m -> ({ model | admin = Maybe.map (updateAdmin m) model.admin }, Cmd.none) - Prefs m -> ({ model | prefs = Maybe.map (updatePrefs m) model.prefs }, Cmd.none) - Pass m -> ({ model | pass = Maybe.map (updatePass m) model.pass, passNeq = False }, Cmd.none) - Username s -> ({ model | username = s }, Cmd.none) - - Submit -> - if Maybe.withDefault False (Maybe.map (\p -> p.cpass && p.pass1 /= p.pass2) model.pass) - then ({ model | passNeq = True }, Cmd.none ) - else ({ model | state = Api.Loading }, GUE.send (encode model) Submitted) - - -- TODO: This reload is only necessary for the skin and customcss options to apply, but it's nicer to do that directly from JS. - Submitted GApi.Success -> (model, load <| "/u" ++ String.fromInt model.id ++ "/edit") - Submitted GApi.MailChange -> ({ model | mailConfirm = True, state = Api.Normal }, Cmd.none) - Submitted r -> ({ model | state = Api.Error r }, Cmd.none) - - - -view : Model -> Html Msg -view model = - let - opts = model.opts - perm b f = if opts.perm_usermod || b then f else text "" - - adminform m = - [ tr [ class "newpart" ] [ td [ colspan 2 ] [ text "Admin options" ] ] - , perm False <| formField "username::Username" [ inputText "username" model.username Username GUE.valUsername ] - , formField "Permissions" - [ text "Fields marked with * indicate permissions assigned to new users by default", br_ 1 - , perm opts.perm_boardmod <| label [] [ inputCheck "" m.perm_board (Admin << PermBoard), text " board*", br_ 1 ] - , perm False <| label [] [ inputCheck "" m.perm_boardmod (Admin << PermBoardmod), text " boardmod", br_ 1 ] - , perm opts.perm_dbmod <| label [] [ inputCheck "" m.perm_edit (Admin << PermEdit), text " edit*", br_ 1 ] - , perm opts.perm_imgmod <| label [] [ inputCheck "" m.perm_imgvote (Admin << PermImgvote), text " imgvote* (existing votes will stop counting when unset)", br_ 1 ] - , perm False <| label [] [ inputCheck "" m.perm_imgmod (Admin << PermImgmod), text " imgmod", br_ 1 ] - , perm opts.perm_tagmod <| label [] [ inputCheck "" m.perm_tag (Admin << PermTag), text " tag* (existing tag votes will stop counting when unset)", br_ 1 ] - , perm False <| label [] [ inputCheck "" m.perm_dbmod (Admin << PermDbmod), text " dbmod", br_ 1 ] - , perm False <| label [] [ inputCheck "" m.perm_tagmod (Admin << PermTagmod), text " tagmod", br_ 1 ] - , perm False <| label [] [ inputCheck "" m.perm_usermod (Admin << PermUsermod), text " usermod", br_ 1 ] - ] - , perm False <| formField "Other" [ label [] [ inputCheck "" m.ign_votes (Admin << IgnVotes), text " Ignore votes in VN statistics" ] ] - ] - - passform m = - [ formField "" [ label [] [ inputCheck "" m.cpass (Pass << CPass), text " Change password" ] ] - ] ++ if not m.cpass then [] else - [ tr [] [ K.node "td" [colspan 2] [("pass_change", table [] - [ formField "opass::Old password" [ inputPassword "opass" m.opass (Pass << OPass) GUE.valPasswordOld ] - , formField "pass1::New password" [ inputPassword "pass1" m.pass1 (Pass << Pass1) GUE.valPasswordNew ] - , formField "pass2::Repeat" - [ inputPassword "pass2" m.pass2 (Pass << Pass2) GUE.valPasswordNew - , br_ 1 - , if model.passNeq - then b [ class "standout" ] [ text "Passwords do not match" ] - else text "" - ] - ])]] - ] - - supportform m = - if not (opts.perm_usermod || opts.nodistract_can || opts.support_can || opts.uniname_can || opts.pubskin_can) then [] else - [ tr [ class "newpart" ] [ td [ colspan 2 ] [ text "Supporter options⭐" ] ] - , perm opts.nodistract_can <| formField "" [ label [] [ inputCheck "" m.nodistract_noads (Prefs << NoAds), text " Disable advertising and other distractions (only hides the support icons for the moment)" ] ] - , perm opts.nodistract_can <| formField "" [ label [] [ inputCheck "" m.nodistract_nofancy (Prefs << NoFancy), text " Disable supporters badges, custom display names and profile skins" ] ] - , perm opts.support_can <| formField "" [ label [] [ inputCheck "" m.support_enabled (Prefs << Support), text " Display my supporters badge" ] ] - , perm opts.pubskin_can <| formField "" [ label [] [ inputCheck "" m.pubskin_enabled (Prefs << PubSkin), text " Apply my skin and custom CSS when others visit my profile" ] ] - , perm opts.uniname_can <| formField "uniname::Display name" [ inputText "uniname" (if m.uniname == "" then model.username else m.uniname) (Prefs << Uniname) GUE.valPrefsUniname ] - ] - - prefsform m = - [ tr [ class "newpart" ] [ td [ colspan 2 ] [ text "Preferences" ] ] - , formField "NSFW" [ label [] [ inputCheck "" m.show_nsfw (Prefs << ShowNsfw), text " Show NSFW images by default" ] ] - , formField "" - [ b [ class "grayedout" ] [ text "The two options below are only used for character images at the moment, they will eventually replace the above checkbox and apply to all images on the site." ] - , br [] [] - , inputSelect "" m.max_sexual (Prefs << MaxSexual) [style "width" "400px"] - [ (-1,"Hide all images") - , (0, "Hide sexually suggestive or explicit images") - , (1, "Hide only sexually explicit images") - , (2, "Don't hide suggestive or explicit images") - ] - , br [] [] - , if m.max_sexual == -1 then text "" else - inputSelect "" m.max_violence (Prefs << MaxViolence) [style "width" "400px"] - [ (0, "Hide violent or brutal images") - , (1, "Hide only brutal images") - , (2, "Don't hide violent or brutal images") - ] - ] - , formField "" [ label [] [ inputCheck "" m.traits_sexual (Prefs << TraitsSexual), text " Show sexual traits by default on character pages" ], br_ 2 ] - , formField "Tags" [ label [] [ inputCheck "" m.tags_all (Prefs << TagsAll), text " Show all tags by default on visual novel pages (don't summarize)" ] ] - , formField "" - [ text "Default tag categories on visual novel pages:", br_ 1 - , label [] [ inputCheck "" m.tags_cont (Prefs << TagsCont), text " Content" ], br_ 1 - , label [] [ inputCheck "" m.tags_ero (Prefs << TagsEro ), text " Sexual content" ], br_ 1 - , label [] [ inputCheck "" m.tags_tech (Prefs << TagsTech), text " Technical" ] - ] - , formField "spoil::Spoiler level" - [ inputSelect "spoil" m.spoilers (Prefs << Spoilers) [] - [ (0, "Hide spoilers") - , (1, "Show only minor spoilers") - , (2, "Show all spoilers") - ] - ] - , formField "skin::Skin" [ inputSelect "skin" m.skin (Prefs << Skin) [ style "width" "300px" ] GT.skins ] - , formField "css::Custom CSS" [ inputTextArea "css" m.customcss (Prefs << Css) ([ rows 5, cols 60 ] ++ GUE.valPrefsCustomcss) ] - ] - - in form_ Submit (model.state == Api.Loading) - [ div [ class "mainbox" ] - [ h1 [] [ text model.title ] - , table [ class "formtable" ] <| - [ tr [ class "newpart" ] [ td [ colspan 2 ] [ text "Account settings" ] ] - , formField "Username" [ text model.username ] - , Maybe.withDefault (text "") <| Maybe.map (\m -> - formField "email::E-Mail" [ inputText "email" m.email (Prefs << EMail) GUE.valPrefsEmail ] - ) model.prefs - ] - ++ (Maybe.withDefault [] (Maybe.map passform model.pass)) - ++ (Maybe.withDefault [] (Maybe.map adminform model.admin)) - ++ (Maybe.withDefault [] (Maybe.map supportform model.prefs)) - ++ (Maybe.withDefault [] (Maybe.map prefsform model.prefs)) - ] - , div [ class "mainbox" ] - [ fieldset [ class "submit" ] [ submitButton "Submit" model.state (not model.passNeq) ] - , if not model.mailConfirm then text "" else - div [ class "notice" ] - [ text "A confirmation email has been sent to your new address. Your address will be updated after following the instructions in that mail." ] - ] - ] diff --git a/elm/User/Login.elm b/elm/User/Login.elm deleted file mode 100644 index 8b9c15c3..00000000 --- a/elm/User/Login.elm +++ /dev/null @@ -1,145 +0,0 @@ -module User.Login exposing (main) - -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) -import Browser -import Browser.Navigation exposing (load) -import Lib.Api as Api -import Gen.Api as GApi -import Gen.UserLogin as GUL -import Gen.UserChangePass as GUCP -import Gen.Types exposing (adminEMail) -import Lib.Html exposing (..) - - -main : Program String Model Msg -main = Browser.element - { init = \ref -> (init ref, Cmd.none) - , subscriptions = always Sub.none - , view = view - , update = update - } - - -type alias Model = - { ref : String - , username : String - , password : String - , newpass1 : String - , newpass2 : String - , state : Api.State - , insecure : Bool - , noteq : Bool - -- Extra Elm-side input validation, because apparently some login managers - -- bypass HTML5 validation or proper onChange messages fail to get invoked. - , invalid : Bool - } - - -init : String -> Model -init ref = - { ref = ref - , username = "" - , password = "" - , newpass1 = "" - , newpass2 = "" - , state = Api.Normal - , insecure = False - , noteq = False - , invalid = False - } - - -type Msg - = Username String - | Password String - | Newpass1 String - | Newpass2 String - | Submit - | Submitted GApi.Response - - -update : Msg -> Model -> (Model, Cmd Msg) -update msg model = - case msg of - Username n -> ({ model | invalid = False, username = String.toLower n }, Cmd.none) - Password n -> ({ model | invalid = False, password = n }, Cmd.none) - Newpass1 n -> ({ model | newpass1 = n, noteq = False }, Cmd.none) - Newpass2 n -> ({ model | newpass2 = n, noteq = False }, Cmd.none) - - Submit -> - if model.username == "" || model.password == "" - then ( { model | invalid = True }, Cmd.none) - else if not model.insecure - then ( { model | state = Api.Loading } - , GUL.send { username = model.username, password = model.password } Submitted ) - else if model.newpass1 /= model.newpass2 - then ( { model | noteq = True }, Cmd.none ) - else ( { model | state = Api.Loading } - , GUCP.send { username = model.username, oldpass = model.password, newpass = model.newpass1 } Submitted ) - - Submitted GApi.Success -> (model, load model.ref) - Submitted GApi.InsecurePass -> ({ model | insecure = True, state = if model.insecure then Api.Error GApi.InsecurePass else Api.Normal }, Cmd.none) - Submitted e -> ({ model | state = Api.Error e }, Cmd.none) - - -view : Model -> Html Msg -view model = - let - loginBox = - div [ class "mainbox" ] - [ h1 [] [ text "Login" ] - , table [ class "formtable" ] - [ formField "username::Username" - [ inputText "username" model.username Username GUL.valUsername - , br_ 1 - , a [ href "/u/register" ] [ text "No account yet?" ] - ] - , formField "password::Password" - [ inputPassword "password" model.password Password GUL.valPassword - , br_ 1 - , a [ href "/u/newpass" ] [ text "Forgot your password?" ] - ] - ] - , if model.state == Api.Normal || model.state == Api.Loading - then text "" - else div [ class "notice" ] - [ h2 [] [ text "Trouble logging in?" ] - , text "If you have not used this login form since October 2014, your account has likely been disabled. You can " - , a [ href "/u/newpass" ] [ text "reset your password" ] - , text " to regain access." - , br_ 2 - , text "Still having trouble? Send a mail to " - , a [ href <| "mailto:" ++ adminEMail ] [ text adminEMail ] - , text ". But keep in mind that I can only help you if the email address associated with your account is correct" - , text " and you still have access to it. Without that, there is no way to prove that the account is yours." - ] - ] - - changeBox = - div [ class "mainbox" ] - [ h1 [] [ text "Change your password" ] - , div [ class "warning" ] - [ h2 [] [ text "Your current password is not secure" ] - , text "Your current password is in a public database of leaked passwords. You need to change it before you can continue." - ] - , table [ class "formtable" ] - [ formField "newpass1::New password" [ inputPassword "newpass1" model.newpass1 Newpass1 GUCP.valNewpass ] - , formField "newpass2::Repeat" - [ inputPassword "newpass2" model.newpass2 Newpass2 GUCP.valNewpass - , br_ 1 - , if model.noteq then b [ class "standout" ] [ text "Passwords do not match" ] else text "" - ] - ] - ] - - in form_ Submit (model.state == Api.Loading) - [ if model.insecure then changeBox else loginBox - , div [ class "mainbox" ] - [ fieldset [ class "submit" ] - [ if model.invalid then b [ class "standout" ] [ text "Username or password is empty." ] else text "" - , submitButton "Submit" model.state (not model.invalid) - ] - ] - ] diff --git a/elm/User/PassReset.elm b/elm/User/PassReset.elm deleted file mode 100644 index 641767d4..00000000 --- a/elm/User/PassReset.elm +++ /dev/null @@ -1,77 +0,0 @@ -module User.PassReset exposing (main) - -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) -import Browser -import Lib.Api as Api -import Gen.Api as GApi -import Gen.UserPassReset as GUPR -import Lib.Html exposing (..) - - -main : Program () Model Msg -main = Browser.element - { init = always (init, Cmd.none) - , subscriptions = always Sub.none - , view = view - , update = update - } - - -type alias Model = - { email : String - , state : Api.State - , success : Bool - } - - -init : Model -init = - { email = "" - , state = Api.Normal - , success = False - } - - -type Msg - = EMail String - | Submit - | Submitted GApi.Response - - -update : Msg -> Model -> (Model, Cmd Msg) -update msg model = - case msg of - EMail n -> ({ model | email = n }, Cmd.none) - Submit -> ({ model | state = Api.Loading }, GUPR.send { email = model.email } Submitted) - Submitted GApi.Success -> ({ model | success = True }, Cmd.none) - Submitted e -> ({ model | state = Api.Error e }, Cmd.none) - - -view : Model -> Html Msg -view model = - if model.success - then - div [ class "mainbox" ] - [ h1 [] [ text "New password" ] - , div [ class "notice" ] - [ p [] [ text "Your password has been reset and instructions to set a new one should reach your mailbox in a few minutes." ] ] - ] - else - form_ Submit (model.state == Api.Loading) - [ div [ class "mainbox" ] - [ h1 [] [ text "Forgot Password" ] - , p [] - [ text "Forgot your password and can't login to VNDB anymore? " - , text "Don't worry! Just give us the email address you used to register on VNDB " - , text " and we'll send you instructions to set a new password within a few minutes!" - ] - , table [ class "formtable" ] - [ formField "email::E-Mail" [ inputText "email" model.email EMail GUPR.valEmail ] - ] - ] - , div [ class "mainbox" ] - [ fieldset [ class "submit" ] [ submitButton "Submit" model.state True ] - ] - ] diff --git a/elm/User/PassSet.elm b/elm/User/PassSet.elm deleted file mode 100644 index 618b4ba1..00000000 --- a/elm/User/PassSet.elm +++ /dev/null @@ -1,85 +0,0 @@ -module User.PassSet exposing (main) - -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) -import Browser -import Browser.Navigation exposing (load) -import Lib.Api as Api -import Gen.Api as GApi -import Gen.UserPassSet as GUPS -import Lib.Html exposing (..) - - -main : Program GUPS.Recv Model Msg -main = Browser.element - { init = \f -> (init f, Cmd.none) - , subscriptions = always Sub.none - , view = view - , update = update - } - - -type alias Model = - { token : String - , uid : Int - , newpass1 : String - , newpass2 : String - , state : Api.State - , noteq : Bool - } - - -init : GUPS.Recv -> Model -init f = - { token = f.token - , uid = f.uid - , newpass1 = "" - , newpass2 = "" - , state = Api.Normal - , noteq = False - } - - -type Msg - = Newpass1 String - | Newpass2 String - | Submit - | Submitted GApi.Response - - -update : Msg -> Model -> (Model, Cmd Msg) -update msg model = - case msg of - Newpass1 n -> ({ model | newpass1 = n, noteq = False }, Cmd.none) - Newpass2 n -> ({ model | newpass2 = n, noteq = False }, Cmd.none) - - Submit -> - if model.newpass1 /= model.newpass2 - then ( { model | noteq = True }, Cmd.none) - else ( { model | state = Api.Loading } - , GUPS.send { token = model.token, uid = model.uid, password = model.newpass1 } Submitted ) - - Submitted GApi.Success -> (model, load "/") - Submitted e -> ({ model | state = Api.Error e }, Cmd.none) - - -view : Model -> Html Msg -view model = - form_ Submit (model.state == Api.Loading) - [ div [ class "mainbox" ] - [ h1 [] [ text "Set your password" ] - , p [] [ text "Now you can set a password for your account. You will be logged in automatically after your password has been saved." ] - , table [ class "formtable" ] - [ formField "newpass1::New password" [ inputPassword "newpass1" model.newpass1 Newpass1 GUPS.valPassword ] - , formField "newpass2::Repeat" - [ inputPassword "newpass2" model.newpass2 Newpass2 GUPS.valPassword - , br_ 1 - , if model.noteq then b [ class "standout" ] [ text "Passwords do not match" ] else text "" - ] - ] - ] - , div [ class "mainbox" ] - [ fieldset [ class "submit" ] [ submitButton "Submit" model.state True ] - ] - ] diff --git a/elm/User/Register.elm b/elm/User/Register.elm deleted file mode 100644 index 9afdded4..00000000 --- a/elm/User/Register.elm +++ /dev/null @@ -1,97 +0,0 @@ -module User.Register exposing (main) - -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) -import Browser -import Lib.Api as Api -import Gen.Api as GApi -import Gen.UserRegister as GUR -import Lib.Html exposing (..) - - -main : Program () Model Msg -main = Browser.element - { init = always (init, Cmd.none) - , subscriptions = always Sub.none - , view = view - , update = update - } - - -type alias Model = - { username : String - , email : String - , vns : Int - , state : Api.State - , success : Bool - } - - -init : Model -init = - { username = "" - , email = "" - , vns = 0 - , state = Api.Normal - , success = False - } - - -type Msg - = Username String - | EMail String - | VNs String - | Submit - | Submitted GApi.Response - - -update : Msg -> Model -> (Model, Cmd Msg) -update msg model = - case msg of - Username n -> ({ model | username = String.toLower n }, Cmd.none) - EMail n -> ({ model | email = n }, Cmd.none) - VNs n -> ({ model | vns = Maybe.withDefault model.vns (String.toInt n) }, Cmd.none) - - Submit -> ( { model | state = Api.Loading } - , GUR.send { username = model.username, email = model.email, vns = model.vns } Submitted ) - - Submitted GApi.Success -> ({ model | success = True }, Cmd.none) - Submitted e -> ({ model | state = Api.Error e }, Cmd.none) - - -view : Model -> Html Msg -view model = - if model.success - then - div [ class "mainbox" ] - [ h1 [] [ text "Account created" ] - , div [ class "notice" ] - [ p [] [ text "Your account has been created! In a few minutes, you should receive an email with instructions to set your password." ] ] - ] - else - form_ Submit (model.state == Api.Loading) - [ div [ class "mainbox" ] - [ h1 [] [ text "Create an account" ] - , table [ class "formtable" ] - [ formField "username::Username" - [ inputText "username" model.username Username GUR.valUsername - , br_ 1 - , text "Preferred username. Must be lowercase, between 2 and 15 characters long and consist entirely of alphanumeric characters or a dash." - , text " Names that look like database identifiers (i.e. a single letter followed by several numbers) are also disallowed." - ] - , formField "email::E-Mail" - [ inputText "email" model.email EMail GUR.valEmail - , br_ 1 - , text "Your email address will only be used in case you lose your password. " - , text "We will never send spam or newsletters unless you explicitly ask us for it or we get hacked." - , br_ 3 - , text "Anti-bot question: How many visual novels do we have in the database? (Hint: look to your left)" - ] - , formField "vns::Answer" [ inputText "vns" (if model.vns == 0 then "" else String.fromInt model.vns) VNs [] ] - ] - ] - , div [ class "mainbox" ] - [ fieldset [ class "submit" ] [ submitButton "Submit" model.state True ] - ] - ] diff --git a/elm/VNEdit.elm b/elm/VNEdit.elm new file mode 100644 index 00000000..751cab61 --- /dev/null +++ b/elm/VNEdit.elm @@ -0,0 +1,788 @@ +port module VNEdit exposing (main) + +import Html exposing (..) +import Html.Events exposing (..) +import Html.Keyed as K +import Html.Attributes exposing (..) +import Browser +import Browser.Navigation exposing (load) +import Browser.Dom as Dom +import Dict +import Set +import Task +import Date +import Process +import File exposing (File) +import File.Select as FSel +import Lib.Ffi as Ffi +import Lib.Util exposing (..) +import Lib.Html exposing (..) +import Lib.TextPreview as TP +import Lib.Autocomplete as A +import Lib.RDate as RDate +import Lib.Api as Api +import Lib.Editsum as Editsum +import Lib.Image as Img +import Gen.VN as GV +import Gen.VNEdit as GVE +import Gen.Types as GT +import Gen.Api as GApi + + +main : Program GVE.Recv Model Msg +main = Browser.element + { init = \e -> (init e, Date.today |> Task.perform Today) + , view = view + , update = update + , subscriptions = always Sub.none + } + + +port ivRefresh : Bool -> Cmd msg + +type Tab + = General + | Image + | Staff + | Cast + | Screenshots + | All + +type alias Model = + { state : Api.State + , tab : Tab + , today : Int + , invalidDis : Bool + , editsum : Editsum.Model + , titles : List GVE.RecvTitles + , alias : String + , description : TP.Model + , devStatus : Int + , olang : String + , length : Int + , lWikidata : Maybe Int + , lRenai : String + , vns : List GVE.RecvRelations + , vnSearch : A.Model GApi.ApiVNResult + , anime : List GVE.RecvAnime + , animeSearch : A.Model GApi.ApiAnimeResult + , image : Img.Image + , editions : List GVE.RecvEditions + , staff : List GVE.RecvStaff + -- Search boxes matching the list of editions (n+1), first entry is for the NULL edition. + , staffSearch : List (A.Config Msg GApi.ApiStaffResult, A.Model GApi.ApiStaffResult) + , seiyuu : List GVE.RecvSeiyuu + , seiyuuSearch: A.Model GApi.ApiStaffResult + , seiyuuDef : String -- character id for newly added seiyuu + , screenshots : List (Int,Img.Image,Maybe String) -- internal id, img, rel + , scrQueue : List File + , scrUplRel : Maybe String + , scrUplNum : Maybe Int + , scrId : Int -- latest used internal id + , releases : List GVE.RecvReleases + , reltitles : List { id: String, title: String } + , chars : List GVE.RecvChars + , id : Maybe String + , dupCheck : Bool + , dupVNs : List GApi.ApiVNResult + } + + +init : GVE.Recv -> Model +init d = + { state = Api.Normal + , tab = General + , today = 0 + , invalidDis = False + , editsum = { authmod = d.authmod, editsum = TP.bbcode d.editsum, locked = d.locked, hidden = d.hidden, hasawait = False } + , titles = d.titles + , alias = d.alias + , description = TP.bbcode d.description + , devStatus = d.devstatus + , olang = d.olang + , length = d.length + , lWikidata = d.l_wikidata + , lRenai = d.l_renai + , vns = d.relations + , vnSearch = A.init "" + , anime = d.anime + , animeSearch = A.init "" + , image = Img.info d.image_info + , editions = d.editions + , staff = d.staff + , staffSearch = (staffConfig Nothing, A.init "") :: List.map (\e -> (staffConfig (Just e.eid), A.init "")) d.editions + , seiyuu = d.seiyuu + , seiyuuSearch= A.init "" + , seiyuuDef = Maybe.withDefault "" <| List.head <| List.map (\c -> c.id) d.chars + , screenshots = List.indexedMap (\n i -> (n, Img.info (Just i.info), i.rid)) d.screenshots + , scrQueue = [] + , scrUplRel = Nothing + , scrUplNum = Nothing + , scrId = 100 + , releases = d.releases + , reltitles = d.reltitles + , chars = d.chars + , id = d.id + , dupCheck = False + , dupVNs = [] + } + + +encode : Model -> GVE.Send +encode model = + { id = model.id + , editsum = model.editsum.editsum.data + , hidden = model.editsum.hidden + , locked = model.editsum.locked + , titles = model.titles + , alias = model.alias + , devstatus = model.devStatus + , description = model.description.data + , olang = model.olang + , length = model.length + , l_wikidata = model.lWikidata + , l_renai = model.lRenai + , relations = List.map (\v -> { vid = v.vid, relation = v.relation, official = v.official }) model.vns + , anime = List.map (\a -> { aid = a.aid }) model.anime + , image = model.image.id + , editions = model.editions + , staff = List.map (\s -> { aid = s.aid, eid = s.eid, note = s.note, role = s.role }) model.staff + , seiyuu = List.map (\s -> { aid = s.aid, cid = s.cid, note = s.note }) model.seiyuu + , screenshots = List.map (\(_,i,r) -> { scr = Maybe.withDefault "" i.id, rid = r }) model.screenshots + } + +vnConfig : A.Config Msg GApi.ApiVNResult +vnConfig = { wrap = VNSearch, id = "relationadd", source = A.vnSource } + +animeConfig : A.Config Msg GApi.ApiAnimeResult +animeConfig = { wrap = AnimeSearch, id = "animeadd", source = A.animeSource False } + +staffConfig : Maybe Int -> A.Config Msg GApi.ApiStaffResult +staffConfig eid = + { wrap = (StaffSearch eid) + , id = "staffadd-" ++ Maybe.withDefault "" (Maybe.map String.fromInt eid) + , source = A.staffSource + } + +seiyuuConfig : A.Config Msg GApi.ApiStaffResult +seiyuuConfig = { wrap = SeiyuuSearch, id = "seiyuuadd", source = A.staffSource } + +type Msg + = Noop + | Today Date.Date + | Editsum Editsum.Msg + | Tab Tab + | Invalid Tab + | InvalidEnable + | Submit + | Submitted GApi.Response + | Alias String + | Desc TP.Msg + | DevStatus Int + | Length Int + | LWikidata (Maybe Int) + | LRenai String + | TitleAdd String + | TitleDel Int + | TitleLang Int String + | TitleTitle Int String + | TitleLatin Int String + | TitleOfficial Int Bool + | TitleMain Int String + | VNDel Int + | VNRel Int String + | VNOfficial Int Bool + | VNSearch (A.Msg GApi.ApiVNResult) + | AnimeDel Int + | AnimeSearch (A.Msg GApi.ApiAnimeResult) + | ImageSet String Bool + | ImageSelect + | ImageSelected File + | ImageMsg Img.Msg + | EditionAdd + | EditionLang Int (Maybe String) + | EditionName Int String + | EditionOfficial Int Bool + | EditionDel Int Int + | StaffDel Int + | StaffRole Int String + | StaffNote Int String + | StaffSearch (Maybe Int) (A.Msg GApi.ApiStaffResult) + | SeiyuuDef String + | SeiyuuDel Int + | SeiyuuChar Int String + | SeiyuuNote Int String + | SeiyuuSearch (A.Msg GApi.ApiStaffResult) + | ScrUplRel (Maybe String) + | ScrUplSel + | ScrUpl File (List File) + | ScrMsg Int Img.Msg + | ScrRel Int (Maybe String) + | ScrDel Int + | DupSubmit + | DupResults GApi.Response + + +scrProcessQueue : (Model, Cmd Msg) -> (Model, Cmd Msg) +scrProcessQueue (model, msg) = + case model.scrQueue of + (f::fl) -> + if List.any (\(_,i,_) -> i.imgState == Img.Loading) model.screenshots + then (model, msg) + else + let (im,ic) = Img.upload Api.Sf f + in ( { model | scrQueue = fl, scrId = model.scrId + 1, screenshots = model.screenshots ++ [(model.scrId, im, model.scrUplRel)] } + , Cmd.batch [ msg, Cmd.map (ScrMsg model.scrId) ic ] ) + _ -> (model, msg) + + +update : Msg -> Model -> (Model, Cmd Msg) +update msg model = + case msg of + Noop -> (model, Cmd.none) + Today d -> ({ model | today = RDate.fromDate d |> RDate.compact }, Cmd.none) + Editsum m -> let (nm,nc) = Editsum.update m model.editsum in ({ model | editsum = nm }, Cmd.map Editsum nc) + Tab t -> ({ model | tab = t }, Cmd.none) + Invalid t -> if model.invalidDis || model.tab == All || model.tab == t then (model, Cmd.none) else + ({ model | tab = t, invalidDis = True }, Task.attempt (always InvalidEnable) (Ffi.elemCall "reportValidity" "mainform" |> Task.andThen (\_ -> Process.sleep 100))) + InvalidEnable -> ({ model | invalidDis = False }, Cmd.none) + Alias s -> ({ model | alias = s, dupVNs = [] }, Cmd.none) + Desc m -> let (nm,nc) = TP.update m model.description in ({ model | description = nm }, Cmd.map Desc nc) + DevStatus b-> ({ model | devStatus = b }, Cmd.none) + Length n -> ({ model | length = n }, Cmd.none) + LWikidata n-> ({ model | lWikidata = n }, Cmd.none) + LRenai s -> ({ model | lRenai = s }, Cmd.none) + + TitleAdd s -> + ({ model | titles = model.titles ++ [{ lang = s, title = "", latin = Nothing, official = True }], olang = if List.isEmpty model.titles then s else model.olang } + , Task.attempt (always Noop) (Dom.focus ("title_" ++ s))) + TitleDel i -> ({ model | titles = delidx i model.titles }, Cmd.none) + TitleLang i s -> ({ model | titles = modidx i (\e -> { e | lang = s }) model.titles }, Cmd.none) + TitleTitle i s -> ({ model | titles = modidx i (\e -> { e | title = s }) model.titles }, Cmd.none) + TitleLatin i s -> ({ model | titles = modidx i (\e -> { e | latin = if s == "" then Nothing else Just s }) model.titles }, Cmd.none) + TitleOfficial i s -> ({ model | titles = modidx i (\e -> { e | official = s }) model.titles }, Cmd.none) + TitleMain i s -> ({ model | olang = s, titles = modidx i (\e -> { e | official = True }) model.titles }, Cmd.none) + + VNDel idx -> ({ model | vns = delidx idx model.vns }, Cmd.none) + VNRel idx rel -> ({ model | vns = modidx idx (\v -> { v | relation = rel }) model.vns }, Cmd.none) + VNOfficial idx o -> ({ model | vns = modidx idx (\v -> { v | official = o }) model.vns }, Cmd.none) + VNSearch m -> + let (nm, c, res) = A.update vnConfig m model.vnSearch + in case res of + Nothing -> ({ model | vnSearch = nm }, c) + Just v -> + if List.any (\l -> l.vid == v.id) model.vns + then ({ model | vnSearch = A.clear nm "" }, c) + else ({ model | vnSearch = A.clear nm "", vns = model.vns ++ [{ vid = v.id, title = v.title, relation = "seq", official = True }] }, c) + + AnimeDel i -> ({ model | anime = delidx i model.anime }, Cmd.none) + AnimeSearch m -> + let (nm, c, res) = A.update animeConfig m model.animeSearch + in case res of + Nothing -> ({ model | animeSearch = nm }, c) + Just a -> + if List.any (\l -> l.aid == a.id) model.anime + then ({ model | animeSearch = A.clear nm "" }, c) + else ({ model | animeSearch = A.clear nm "", anime = model.anime ++ [{ aid = a.id, title = a.title, original = a.original }] }, c) + + ImageSet s b -> let (nm, nc) = Img.new b s in ({ model | image = nm }, Cmd.map ImageMsg nc) + ImageSelect -> (model, FSel.file ["image/png", "image/jpeg", "image/webp", "image/avif", "image/jxl"] ImageSelected) + ImageSelected f -> let (nm, nc) = Img.upload Api.Cv f in ({ model | image = nm }, Cmd.map ImageMsg nc) + ImageMsg m -> let (nm, nc) = Img.update m model.image in ({ model | image = nm }, Cmd.map ImageMsg nc) + + EditionAdd -> + let f n acc = + case acc of + Just x -> Just x + Nothing -> if not (List.isEmpty (List.filter (\i -> i.eid == n) model.editions)) then Nothing else Just n + newid = List.range 0 500 |> List.foldl f Nothing |> Maybe.withDefault 0 + in ({ model + | editions = model.editions ++ [{ eid = newid, lang = Nothing, name = "", official = True }] + , staffSearch = model.staffSearch ++ [(staffConfig (Just newid), A.init "")] + }, Cmd.none) + EditionDel idx eid -> + ({ model + | editions = delidx idx model.editions + , staffSearch = delidx (idx + 1) model.staffSearch + , staff = List.filter (\s -> s.eid /= Just eid) model.staff + }, Cmd.none) + EditionLang idx v -> ({ model | editions = modidx idx (\s -> { s | lang = v }) model.editions }, Cmd.none) + EditionName idx v -> ({ model | editions = modidx idx (\s -> { s | name = v }) model.editions }, Cmd.none) + EditionOfficial idx v -> ({ model | editions = modidx idx (\s -> { s | official = v }) model.editions }, Cmd.none) + + StaffDel idx -> ({ model | staff = delidx idx model.staff }, Cmd.none) + StaffRole idx v -> ({ model | staff = modidx idx (\s -> { s | role = v }) model.staff }, Cmd.none) + StaffNote idx v -> ({ model | staff = modidx idx (\s -> { s | note = v }) model.staff }, Cmd.none) + StaffSearch eid m -> + let idx = List.indexedMap Tuple.pair model.editions + |> List.filterMap (\(n,e) -> if Just e.eid == eid then Just (n+1) else Nothing) + |> List.head |> Maybe.withDefault 0 + in case List.drop idx model.staffSearch |> List.head of + Nothing -> (model, Cmd.none) + Just (sconfig, smodel) -> + let (nm, c, res) = A.update sconfig m smodel + nnm = if res == Nothing then nm else A.clear nm "" + nsearch = modidx idx (\(oc,om) -> (oc,nnm)) model.staffSearch + nstaff s = [{ id = s.id, aid = s.aid, eid = eid, title = s.title, alttitle = s.alttitle, role = "staff", note = "" }] + in case res of + Nothing -> ({ model | staffSearch = nsearch }, c) + Just s -> ({ model | staffSearch = nsearch, staff = model.staff ++ nstaff s }, c) + + SeiyuuDef c -> ({ model | seiyuuDef = c }, Cmd.none) + SeiyuuDel idx -> ({ model | seiyuu = delidx idx model.seiyuu }, Cmd.none) + SeiyuuChar idx v -> ({ model | seiyuu = modidx idx (\s -> { s | cid = v }) model.seiyuu }, Cmd.none) + SeiyuuNote idx v -> ({ model | seiyuu = modidx idx (\s -> { s | note = v }) model.seiyuu }, Cmd.none) + SeiyuuSearch m -> + let (nm, c, res) = A.update seiyuuConfig m model.seiyuuSearch + in case res of + Nothing -> ({ model | seiyuuSearch = nm }, c) + Just s -> ({ model | seiyuuSearch = A.clear nm "", seiyuu = model.seiyuu ++ [{ id = s.id, aid = s.aid, title = s.title, alttitle = s.alttitle, cid = model.seiyuuDef, note = "" }] }, c) + + ScrUplRel s -> ({ model | scrUplRel = s }, Cmd.none) + ScrUplSel -> (model, FSel.files ["image/png", "image/jpeg", "image/webp", "image/avif", "image/jxl"] ScrUpl) + ScrUpl f1 fl -> + if 1 + List.length fl > 10 - List.length model.screenshots + then ({ model | scrUplNum = Just (1 + List.length fl) }, Cmd.none) + else scrProcessQueue ({ model | scrQueue = (f1::fl), scrUplNum = Nothing }, Cmd.none) + ScrMsg id m -> + let f (i,s,r) = + if i /= id then ((i,s,r), Cmd.none) + else let (nm,nc) = Img.update m s in ((i,nm,r), Cmd.map (ScrMsg id) nc) + lst = List.map f model.screenshots + in scrProcessQueue ({ model | screenshots = List.map Tuple.first lst }, Cmd.batch (ivRefresh True :: List.map Tuple.second lst)) + ScrRel n s -> ({ model | screenshots = List.map (\(i,img,r) -> if i == n then (i,img,s) else (i,img,r)) model.screenshots }, Cmd.none) + ScrDel n -> ({ model | screenshots = List.filter (\(i,_,_) -> i /= n) model.screenshots }, ivRefresh True) + + DupSubmit -> + if List.isEmpty model.dupVNs + then ({ model | state = Api.Loading }, GV.send { hidden = True, search = (List.concatMap (\e -> [e.title, Maybe.withDefault "" e.latin]) model.titles) ++ String.lines model.alias } DupResults) + else ({ model | dupCheck = True, dupVNs = [] }, Cmd.none) + DupResults (GApi.VNResult vns) -> + if List.isEmpty vns + then ({ model | state = Api.Normal, dupCheck = True, dupVNs = [] }, Cmd.none) + else ({ model | state = Api.Normal, dupVNs = vns }, Cmd.none) + DupResults r -> ({ model | state = Api.Error r }, Cmd.none) + + Submit -> ({ model | state = Api.Loading }, GVE.send (encode model) Submitted) + Submitted (GApi.Redirect s) -> (model, load s) + Submitted r -> ({ model | state = Api.Error r }, Cmd.none) + + +-- TODO: Fuzzier matching? Exclude stuff like 'x Edition', etc. +relAlias : Model -> Maybe { id: String, title: String } +relAlias model = + let a = String.toLower model.alias |> String.lines |> List.filter (\l -> l /= "") |> Set.fromList + in List.filter (\r -> Set.member (String.toLower r.title) a) model.reltitles |> List.head + + +isValid : Model -> Bool +isValid model = not + ( List.any (\e -> e.title /= "" && Just e.title == e.latin) model.titles + || List.isEmpty model.titles + || relAlias model /= Nothing + || not (Img.isValid model.image) + || List.any (\(_,i,r) -> r == Nothing || not (Img.isValid i)) model.screenshots + || not (List.isEmpty model.scrQueue) + || hasDuplicates (List.map (\e -> (Maybe.withDefault "" e.lang, e.name)) model.editions) + || hasDuplicates (List.map (\s -> (s.aid, Maybe.withDefault -1 s.eid, s.role)) model.staff) + || hasDuplicates (List.map (\s -> (s.aid, s.cid)) model.seiyuu) + ) + + +view : Model -> Html Msg +view model = + let + title i e = tr [] + [ td [] [ langIcon e.lang ] + , td [] + [ inputText ("title_"++e.lang) e.title (TitleTitle i) (style "width" "500px" :: onInvalid (Invalid General) :: placeholder "Title (in the original script)" :: GVE.valTitlesTitle) + , if not (e.latin /= Nothing || containsNonLatin e.title) then text "" else span [] + [ br [] [] + , inputText "" (Maybe.withDefault "" e.latin) (TitleLatin i) (style "width" "500px" :: required True :: onInvalid (Invalid General) :: placeholder "Romanization" :: GVE.valTitlesLatin) + , case e.latin of + Just s -> if containsNonLatin s then b [] [ br [] [], text "Romanization should only consist of characters in the latin alphabet." ] else text "" + Nothing -> text "" + ] + , if List.length model.titles == 1 then text "" else span [] + [ br [] [] + , label [] [ inputRadio "olang" (e.lang == model.olang) (\_ -> TitleMain i e.lang), text " main title (the language the VN was originally written in)" ] + ] + , if e.lang == model.olang then text "" else span [] + [ br [] [] + , label [] [ inputCheck "" e.official (TitleOfficial i), text " official title (from the developer or licensed localization; not from a fan translation)" ] + , br [] [] + , inputButton "remove" (TitleDel i) [] + ] + , br_ 2 + ] + ] + + titles = + let lines = List.filter (\e -> e /= "") <| String.lines <| String.toLower model.alias + in + [ formField "Title(s)" + [ table [] <| List.indexedMap title model.titles + , inputSelect "" "" TitleAdd [] <| ("", "- Add title -") :: List.filter (\(l,_) -> not (List.any (\e -> e.lang == l) model.titles)) scriptLangs + , br_ 2 + ] + , formField "alias::Aliases" + [ inputTextArea "alias" model.alias Alias (rows 3 :: onInvalid (Invalid General) :: GVE.valAlias) + , br [] [] + , if hasDuplicates lines + then b [] [ text "List contains duplicate aliases.", br [] [] ] + else if contains lines <| List.map String.toLower <| List.concatMap (\e -> [e.title, Maybe.withDefault "" e.latin]) model.titles + then b [] [ text "Titles listed above should not also be added as alias.", br [] [] ] + else + case relAlias model of + Nothing -> text "" + Just r -> span [] + [ b [] [ text "Release titles should not be added as alias." ] + , br [] [] + , text "Release: " + , a [ href <| "/"++r.id ] [ text r.title ] + , br [] [], br [] [] + ] + , text "List of additional titles or abbreviations. One line for each alias. Can include both official (japanese/english) titles and unofficial titles used around net." + , br [] [] + , text "Titles that are listed in the releases should not be added here!" + ] + ] + + geninfo = titles ++ + [ formField "desc::Description" + [ TP.view "desc" model.description Desc 600 (style "height" "180px" :: onInvalid (Invalid General) :: GVE.valDescription) [ b [] [ text "English please!" ] ] + , text "Short description of the main story. Please do not include spoilers, and don't forget to list the source in case you didn't write the description yourself." + ] + , formField "devstatus::Development status" + [ inputSelect "devstatus" model.devStatus DevStatus [] GT.devStatus + , if model.devStatus == 0 + && not (List.isEmpty model.releases) + && List.isEmpty (List.filter (\r -> r.rtype == "complete" && r.released <= model.today) model.releases) + then span [] + [ br [] [] + , b [] [ text "Development is marked as finished, but there is no complete release in the database." ] + , br [] [] + , text "Please adjust the development status or ensure there is a completed release." + ] + else text "" + , if model.devStatus /= 0 + && not (List.isEmpty (List.filter (\r -> r.rtype == "complete" && r.released <= model.today) model.releases)) + then span [] + [ br [] [] + , b [] [ text "Development is not marked as finished, but there is a complete release in the database." ] + , br [] [] + , text "Please adjust the development status or set the release to partial or TBA." + ] + else text "" + ] + , formField "length::Length" + [ inputSelect "length" model.length Length [] GT.vnLengths + , text " (only displayed if there are no length votes)" ] + , formField "l_wikidata::Wikidata ID" [ inputWikidata "l_wikidata" model.lWikidata LWikidata [onInvalid (Invalid General)] ] + , formField "l_renai::Renai.us link" [ text "http://renai.us/game/", inputText "l_renai" model.lRenai LRenai (onInvalid (Invalid General) :: GVE.valL_Renai), text ".shtml" ] + + , tr [ class "newpart" ] [ td [ colspan 2 ] [ text "Database relations" ] ] + , formField "Related VNs" + [ if List.isEmpty model.vns then text "" + else table [] <| List.indexedMap (\i v -> tr [] + [ td [ style "text-align" "right" ] [ small [] [ text <| v.vid ++ ":" ] ] + , td [ style "text-align" "right"] [ a [ href <| "/" ++ v.vid ] [ text v.title ] ] + , td [] + [ text "is an " + , label [] [ inputCheck "" v.official (VNOfficial i), text " official" ] + , inputSelect "" v.relation (VNRel i) [] GT.vnRelations + , text " of this VN" + ] + , td [] [ inputButton "remove" (VNDel i) [] ] + ] + ) model.vns + , A.view vnConfig model.vnSearch [placeholder "Add visual novel..."] + ] + , tr [ class "newpart" ] [ td [ colspan 2 ] [] ] + , formField "Related anime" + [ if List.isEmpty model.anime then text "" + else table [] <| List.indexedMap (\i e -> tr [] + [ td [ style "text-align" "right" ] [ small [] [ text <| "a" ++ String.fromInt e.aid ++ ":" ] ] + , td [] [ a [ href <| "https://anidb.net/anime/" ++ String.fromInt e.aid ] [ text e.title ] ] + , td [] [ inputButton "remove" (AnimeDel i) [] ] + ] + ) model.anime + , A.view animeConfig model.animeSearch [placeholder "Add anime..."] + ] + ] + + image = + table [ class "formimage" ] [ tr [] + [ td [] [ Img.viewImg model.image ] + , td [] + [ h2 [] [ text "Image ID" ] + , input ([ type_ "text", class "text", tabindex 10, value (Maybe.withDefault "" model.image.id), onInputValidation ImageSet, onInvalid (Invalid Image) ] ++ GVE.valImage) [] + , br [] [] + , text "Use an image that already exists on the server or empty to remove the current image." + , br_ 2 + , h2 [] [ text "Upload new image" ] + , inputButton "Browse image" ImageSelect [] + , br [] [] + , text "Preferably the cover of the CD/DVD/package." + , br [] [] + , text "Supported file types: JPEG, PNG, WebP, AVIF or JXL, at most 10 MiB." + , br [] [] + , text "Images larger than 256x400 are automatically resized." + , case Img.viewVote model.image ImageMsg (Invalid Image) of + Nothing -> text "" + Just v -> + div [] + [ br [] [] + , text "Please flag this image: (see the ", a [ href "/d19" ] [ text "image flagging guidelines" ], text " for guidance)" + , v + ] + ] + ] ] + + staff = + let + head lst = + if List.isEmpty lst then text "" else + thead [] [ tr [] + [ td [] [] + , td [] [ text "Staff" ] + , td [] [ text "Role" ] + , td [] [ text "Note" ] + , td [] [] + ] ] + foot searchn lst (sconfig, smodel) = + tfoot [] [ tr [] [ td [] [], td [ colspan 4 ] + [ text "" + , if hasDuplicates (List.map (\(_,s) -> (s.aid, s.role)) lst) + then b [] [ text "List contains duplicate staff roles.", br [] [] ] + else text "" + , A.view sconfig smodel [placeholder "Add staff..."] + , if searchn > 0 then text "" else span [] + [ text "Can't find the person you're looking for? You can " + , a [ href "/s/new" ] [ text "create a new entry" ] + , text ", but " + , a [ href "/s/all" ] [ text "please check for aliasses first." ] + , br [] [] + , text "If one person performed several roles, you can add multiple entries with different major roles." + ] + ] ] ] + item (n,s) = tr [] + [ td [ style "text-align" "right" ] [ small [] [ text <| s.id ++ ":" ] ] + , td [] [ a [ href <| "/" ++ s.id ] [ text s.title ], text <| if s.alttitle == s.title then "" else " " ++ s.alttitle ] + , td [] [ inputSelect "" s.role (StaffRole n) [style "width" "150px" ] GT.creditTypes ] + , td [] [ inputText "" s.note (StaffNote n) (style "width" "300px" :: onInvalid (Invalid Staff) :: GVE.valStaffNote) ] + , td [] [ inputButton "remove" (StaffDel n) [] ] + ] + edition searchn edi = + let eid = Maybe.map (\e -> e.eid) edi + lst = List.indexedMap Tuple.pair model.staff |> List.filter (\(_,s) -> s.eid == eid) + sch = List.drop searchn model.staffSearch |> List.head + in div [style "margin" "0 0 30px 0"] + [ Maybe.withDefault (if List.isEmpty model.editions then text "" else h2 [] [ text "Original edition" ]) + <| Maybe.map (\e -> h2 [] [ text (if e.name == "" then "New edition" else e.name) ]) edi + , case edi of + Nothing -> text "" + Just e -> + div [style "margin" "5px 0 0 15px"] + [ inputText "" e.name (EditionName (searchn-1)) (placeholder "Edition title" :: style "width" "300px" :: onInvalid (Invalid Staff) :: GVE.valEditionsName) + , inputSelect "" e.lang (EditionLang (searchn-1)) [style "width" "150px"] + ((Nothing, "Original language") :: List.map (\(i,l) -> (Just i, l)) scriptLangs) + , text " ", label [] [ inputCheck "" e.official (EditionOfficial (searchn-1)), text " official" ] + , inputButton "remove edition" (EditionDel (searchn-1) e.eid) [style "margin-left" "30px"] + ] + , table [style "margin" "5px 0 0 15px"] + <| head lst + :: Maybe.withDefault (text "") (Maybe.map (foot searchn lst) sch) + :: List.map item lst + ] + in edition 0 Nothing + :: List.indexedMap (\n e -> edition (n+1) (Just e)) model.editions + ++ [ br [] [], inputButton "Add edition" EditionAdd [] ] + + + + cast = + let + chars = List.map (\c -> (c.id, c.title ++ " (" ++ c.id ++ ")")) model.chars + head = + if List.isEmpty model.seiyuu then [] else [ + thead [] [ tr [] + [ td [] [ text "Character" ] + , td [] [ text "Cast" ] + , td [] [ text "Note" ] + , td [] [] + ] ] ] + foot = + tfoot [] [ tr [] [ td [ colspan 4 ] + [ br [] [] + , strong [] [ text "Add cast" ] + , br [] [] + , if hasDuplicates (List.map (\s -> (s.aid, s.cid)) model.seiyuu) + then b [] [ text "List contains duplicate cast roles.", br [] [] ] + else text "" + , inputSelect "" model.seiyuuDef SeiyuuDef [] chars + , text " voiced by " + , div [ style "display" "inline-block" ] [ A.view seiyuuConfig model.seiyuuSearch [] ] + , br [] [] + , text "Can't find the person you're looking for? You can " + , a [ href "/s/new" ] [ text "create a new entry" ] + , text ", but " + , a [ href "/s/all" ] [ text "please check for aliasses first." ] + ] ] ] + item n s = tr [] + [ td [] [ inputSelect "" s.cid (SeiyuuChar n) [] + <| chars ++ if List.any (\c -> c.id == s.cid) model.chars then [] else [(s.cid, "[deleted/moved character: " ++ s.cid ++ "]")] ] + , td [] + [ small [] [ text <| s.id ++ ":" ] + , a [ href <| "/" ++ s.id ] [ text s.title ], text <| if s.title == s.alttitle then "" else " " ++ s.alttitle ] + , td [] [ inputText "" s.note (SeiyuuNote n) (style "width" "300px" :: onInvalid (Invalid Cast) :: GVE.valSeiyuuNote) ] + , td [] [ inputButton "remove" (SeiyuuDel n) [] ] + ] + in + if model.id == Nothing + then text <| "Voice actors can be added to this visual novel once it has character entries associated with it. " + ++ "To do so, first create this entry without cast, then create the appropriate character entries, and finally come back to this form by editing the visual novel." + else if List.isEmpty model.chars && List.isEmpty model.seiyuu + then p [] + [ text "This visual novel does not have any characters associated with it (yet). Please " + , a [ href <| "/" ++ Maybe.withDefault "" model.id ++ "/addchar" ] [ text "add the appropriate character entries" ] + , text " first and then come back to this form to assign voice actors." + ] + else table [] <| head ++ [ foot ] ++ List.indexedMap item model.seiyuu + + screenshots = + let + rellist = List.map (\r -> (Just r.id, RDate.showrel r)) model.releases + scr n (id, i, rel) = (String.fromInt id, tr [] <| + let getdim img = Maybe.map (\nfo -> (nfo.width, nfo.height)) img |> Maybe.withDefault (0,0) + imgdim = getdim i.img + relnfo = List.filter (\r -> Just r.id == rel) model.releases |> List.head + reldim = relnfo |> Maybe.andThen (\r -> if r.reso_x == 0 then Nothing else Just (r.reso_x, r.reso_y)) + dimstr (x,y) = String.fromInt x ++ "x" ++ String.fromInt y + in + [ td [] [ Img.viewImg i ] + , td [] [ Img.viewVote i (ScrMsg id) (Invalid Screenshots) |> Maybe.withDefault (text "") ] + , td [] + [ strong [] [ text <| "Screenshot #" ++ String.fromInt (n+1) ] + , text " (", a [ href "#", onClickD (ScrDel id) ] [ text "remove" ], text ")" + , br [] [] + , text <| "Image resolution: " ++ dimstr imgdim + , br [] [] + , text <| Maybe.withDefault "" <| Maybe.map (\dim -> "Release resolution: " ++ dimstr dim) reldim + , span [] <| + if reldim == Just imgdim then [ text " ✔", br [] [] ] + else if reldim /= Nothing + then [ text " ❌" + , br [] [] + , b [] [ text "WARNING: Resolutions do not match, please take screenshots with the correct resolution and make sure to crop them correctly!" ] + ] + else if i.img /= Nothing && rel /= Nothing && List.any (\(_,si,sr) -> sr == rel && si.img /= Nothing && imgdim /= getdim si.img) model.screenshots + then [ b [] [ text "WARNING: Inconsistent image resolutions for the same release, please take screenshots with the correct resolution and make sure to crop them correctly!" ] + , br [] [] + ] + else [ br [] [] ] + , br [] [] + , inputSelect "" rel (ScrRel id) [style "width" "500px"] <| rellist ++ + case (relnfo, rel) of + (_, Nothing) -> [(Nothing, "[No release selected]")] + (Nothing, Just r) -> [(Just r, "[Deleted or unlinked release: " ++ r ++ "]")] + _ -> [] + ] + ]) + + add = + let free = 10 - List.length model.screenshots + in + if not (List.isEmpty model.scrQueue) + then [ strong [] [ text "Uploading screenshots" ] + , br [] [] + , text <| (String.fromInt (List.length model.scrQueue)) ++ " remaining... " + , span [ class "spinner" ] [] + ] + else if free <= 0 + then [ strong [] [ text "Enough screenshots" ] + , br [] [] + , text "The limit of 10 screenshots per visual novel has been reached. If you want to add a new screenshot, please remove an existing one first." + ] + else + [ strong [] [ text "Add screenshots" ] + , br [] [] + , text <| String.fromInt free ++ " more screenshot" ++ (if free == 1 then "" else "s") ++ " can be added." + , br [] [] + , inputSelect "" model.scrUplRel ScrUplRel [style "width" "500px"] ((Nothing, "-- select release --") :: rellist) + , br [] [] + , if model.scrUplRel == Nothing then text "" else span [] + [ inputButton "Select images" ScrUplSel [] + , case model.scrUplNum of + Just num -> text " Too many images selected." + Nothing -> text "" + , br [] [] + ] + , br [] [] + , strong [] [ text "Important reminder" ] + , ul [] + [ li [] [ text "Screenshots must be in the native resolution of the game" ] + , li [] [ text "Screenshots must not include window borders and should not have copyright markings" ] + , li [] [ text "Don't only upload event CGs" ] + ] + , text "Read the ", a [ href "/d2#6" ] [ text "full guidelines" ], text " for more information." + ] + in + if model.id == Nothing + then text <| "Screenshots can be uploaded to this visual novel once it has a release entry associated with it. " + ++ "To do so, first create this entry without screenshots, then create the appropriate release entries, and finally come back to this form by editing the visual novel." + else if List.isEmpty model.screenshots && List.isEmpty model.releases + then p [] + [ text "This visual novel does not have any releases associated with it (yet). Please " + , a [ href <| "/" ++ Maybe.withDefault "" model.id ++ "/add" ] [ text "add the appropriate release entries" ] + , text " first and then come back to this form to upload screenshots." + ] + else + table [ class "vnedit_scr" ] + [ tfoot [] [ tr [] [ td [] [], td [ colspan 2 ] add ] ] + , K.node "tbody" [] <| List.indexedMap scr model.screenshots + ] + + newform () = + form_ "" DupSubmit (model.state == Api.Loading) + [ article [] [ h1 [] [ text "Add a new visual novel" ], table [ class "formtable" ] titles ] + , if List.isEmpty model.dupVNs then text "" else + article [] + [ div [] + [ h1 [] [ text "Possible duplicates" ] + , text "The following is a list of visual novels that match the title(s) you gave. " + , text "Please check this list to avoid creating a duplicate visual novel entry. " + , text "Be especially wary of items that have been deleted! To see why an entry has been deleted, click on its title." + , ul [] <| List.map (\v -> li [] + [ a [ href <| "/" ++ v.id ] [ text v.title ] + , if v.hidden then b [] [ text " (deleted)" ] else text "" + ] + ) model.dupVNs + ] + ] + , article [ class "submit" ] [ submitButton (if List.isEmpty model.dupVNs then "Continue" else "Continue anyway") model.state (isValid model) ] + ] + + fullform () = + form_ "mainform" Submit (model.state == Api.Loading) + [ nav [] + [ menu [] + [ li [ classList [("tabselected", model.tab == General )] ] [ a [ href "#", onClickD (Tab General ) ] [ text "General info" ] ] + , li [ classList [("tabselected", model.tab == Image )] ] [ a [ href "#", onClickD (Tab Image ) ] [ text "Image" ] ] + , li [ classList [("tabselected", model.tab == Staff )] ] [ a [ href "#", onClickD (Tab Staff ) ] [ text "Staff" ] ] + , li [ classList [("tabselected", model.tab == Cast )] ] [ a [ href "#", onClickD (Tab Cast ) ] [ text "Cast" ] ] + , li [ classList [("tabselected", model.tab == Screenshots)] ] [ a [ href "#", onClickD (Tab Screenshots) ] [ text "Screenshots" ] ] + , li [ classList [("tabselected", model.tab == All )] ] [ a [ href "#", onClickD (Tab All ) ] [ text "All items" ] ] + ] + ] + , article [ classList [("hidden", model.tab /= General && model.tab /= All)] ] [ h1 [] [ text "General info" ], table [ class "formtable" ] geninfo ] + , article [ classList [("hidden", model.tab /= Image && model.tab /= All)] ] [ h1 [] [ text "Image" ], image ] + , article [ classList [("hidden", model.tab /= Staff && model.tab /= All)] ] ( h1 [] [ text "Staff" ] :: staff ) + , article [ classList [("hidden", model.tab /= Cast && model.tab /= All)] ] [ h1 [] [ text "Cast" ], cast ] + , article [ classList [("hidden", model.tab /= Screenshots && model.tab /= All)] ] [ h1 [] [ text "Screenshots" ], screenshots ] + , article [ class "submit" ] + [ Html.map Editsum (Editsum.view model.editsum) + , submitButton "Submit" model.state (isValid model) + ] + ] + in if model.id == Nothing && not model.dupCheck then newform () else fullform () diff --git a/elm/VNLengthVote.elm b/elm/VNLengthVote.elm new file mode 100644 index 00000000..ceafe05a --- /dev/null +++ b/elm/VNLengthVote.elm @@ -0,0 +1,216 @@ +module VNLengthVote exposing (main) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import Browser +import Browser.Dom exposing (focus) +import Task +import Date +import Lib.Html exposing (..) +import Lib.Util exposing (..) +import Lib.Api as Api +import Lib.RDate as RDate +import Gen.Api as GApi +import Gen.VNLengthVote as GV +import Gen.Release as GR + + +main : Program GV.Send Model Msg +main = Browser.element + { init = \e -> (init e, Date.today |> Task.perform Today) + , view = view + , update = update + , subscriptions = always Sub.none + } + +type alias Model = + { state : Api.State + , open : Bool + , today : Int + , uid : String + , vid : String + , rid : List String + , maycount: Bool + , defrid : String + , hours : Maybe Int + , minutes : Maybe Int + , speed : Maybe Int + , length : Int -- last saved length + , notes : String + , rels : Maybe (List (String, String)) + } + +init : GV.Send -> Model +init f = + { state = Api.Normal + , today = 0 + , open = False + , uid = f.uid + , vid = f.vid + , rid = Maybe.map (\v -> v.rid) f.vote |> Maybe.withDefault [] + , maycount= f.maycount + , defrid = "" + , hours = Maybe.map (\v -> v.length // 60 ) f.vote + , minutes = Maybe.andThen (\v -> let n = modBy 60 v.length in if n == 0 then Nothing else Just n) f.vote + , speed = Maybe.map (\v -> if v.private then Just 8 else v.speed) f.vote |> Maybe.withDefault (Just 9) + , length = Maybe.map (\v -> v.length) f.vote |> Maybe.withDefault 0 + , notes = Maybe.map (\v -> v.notes) f.vote |> Maybe.withDefault "" + , rels = Nothing + } + +enclen : Model -> Int +enclen m = (Maybe.withDefault 0 m.hours) * 60 + Maybe.withDefault 0 m.minutes + +encode : Model -> GV.Send +encode m = + { uid = m.uid + , vid = m.vid + , maycount = m.maycount + , vote = if enclen m == 0 then Nothing else Just + { rid = m.rid + , notes = m.notes + , speed = if m.speed == Just 8 then Nothing else m.speed + , length = enclen m + , private = m.speed == Just 8 + } + } + +type Msg + = Noop + | Open Bool + | Today Date.Date + | Hours (Maybe Int) + | Minutes (Maybe Int) + | Speed (Maybe Int) + | Release Int String + | ReleaseAdd + | ReleaseDel Int + | Notes String + | RelLoaded GApi.Response + | Delete + | Submit + | Submitted GApi.Response + + +update : Msg -> Model -> (Model, Cmd Msg) +update msg model = + case msg of + Noop -> (model, Cmd.none) + Open b -> + if b && model.rels == Nothing + then ({ model | open = b, state = Api.Loading }, GR.send { vid = model.vid } RelLoaded) + else ({ model | open = b }, Cmd.none) + Today d -> ({ model | today = RDate.fromDate d |> RDate.compact }, Cmd.none) + Hours n -> ({ model | hours = n }, Cmd.none) + Minutes n -> ({ model | minutes = n }, Cmd.none) + Speed n -> ({ model | speed = n }, Cmd.none) + Release n s -> ({ model | rid = modidx n (always s) model.rid }, Cmd.none) + ReleaseAdd -> ({ model | rid = model.rid ++ [""] }, Cmd.none) + ReleaseDel n -> ({ model | rid = delidx n model.rid }, Cmd.none) + Notes s -> ({ model | notes = s }, Cmd.none) + RelLoaded (GApi.Releases rels) -> + let rel r = if r.rtype /= "trial" && r.released <= model.today then Just (r.id, RDate.showrel r) else Nothing + frels = List.filterMap rel rels + def = case frels of + [(r,_)] -> r + _ -> "" + in ({ model | state = Api.Normal + , rels = Just frels + , defrid = def + , rid = if not (List.isEmpty model.rid) then model.rid else [def] + }, if model.hours == Nothing then Task.attempt (always Noop) (focus "vnlengthhours") else Cmd.none) + RelLoaded e -> ({ model | state = Api.Error e }, Cmd.none) + Delete -> let m = { model | hours = Nothing, minutes = Nothing, rid = [model.defrid], notes = "", state = Api.Loading } in (m, GV.send (encode m) Submitted) + Submit -> ({ model | state = Api.Loading }, GV.send (encode model) Submitted) + Submitted (GApi.Success) -> ({ model | open = False, state = Api.Normal, length = enclen model }, Cmd.none) + Submitted r -> ({ model | state = Api.Error r }, Cmd.none) + + +view : Model -> Html Msg +view model = div [class "lengthvotefrm"] <| + let + selcounted = + [ (Just 9, "-- how do you estimate your read/play speed? --") + , (Just 0, "Slow (e.g. low language proficiency or extra time spent on gameplay)") + , (Just 1, "Normal (no content skipped, all voices listened to end)") + , (Just 2, "Fast (e.g. fast reader or skipping through voices and gameplay)") + , (Nothing, "Don't count my play time (public)") + , (Just 8, "Don't count my play time (private)") + ] + seluncounted = + [ (Just 9, "-- visibility --") + , (Nothing, "Public (everyone can see your vote)") + , (Just 8, "Private (for your own administration)") + ] + cansubmit = enclen model > 0 && model.speed /= Just 9 + && not (List.isEmpty model.rid) + && not (List.any (\r -> r == "") model.rid) + rels = Maybe.withDefault [] model.rels + frm = [ form_ "" (if cansubmit then Submit else Noop) False + [ br [] [] + , if model.maycount then text "" else span [] + [ b [] [ text "This visual novel is still in development." ] + , br [] [] + , text "Which means your vote will not count towards the VN's length statistics." + , br_ 2 + ] + , text "How long did you take to finish this VN?" + , br [] [] + , text "Play time: " + , inputNumber "vnlengthhours" model.hours Hours [ Html.Attributes.min "0", Html.Attributes.max "435" ] + , text " hours " + , inputNumber "" model.minutes Minutes [ Html.Attributes.min "0", Html.Attributes.max "59" ] + , text " minutes" + , br [] [] + , if model.defrid /= "" then text "" else table [] <| List.indexedMap (\n rid -> tr [] + [ td [] [ + inputSelect "" rid (Release n) [] + <| ("", "-- select release --") :: rels + ++ if rid == "" || List.any (\(r,_) -> r == rid) rels then [] else [(rid, "[deleted/moved release: " ++ rid ++ "]")] + ] + , td [] + [ if n == 0 + then inputButton "+" ReleaseAdd [title "Add release"] + else inputButton "-" (ReleaseDel n) [title "Remove release"] + ] + ]) model.rid + , inputSelect "" model.speed Speed [] (if model.maycount then selcounted else seluncounted) + , case model.speed of + Just 9 -> span [] [] + Just 8 -> span [] + [ text "Your play time is not counted towards the VN's average and is not visible in the listings." + , text " It is only saved for your own administration and counted towards the personal play time displayed on your profile." + , br [] [] + ] + Nothing -> span [] + [ text "Your play time is not counted towards the VN's average, but is still visible in the listings and saved for your own administration." + , br [] [] + ] + _ -> span [] + [ text "- Only vote if you've completed all normal/true endings." + , br [] [] + , text "- Exact measurements preferred, but rough estimates are accepted too." + , br [] [] + ] + , inputTextArea "" model.notes Notes + [rows 2, cols 30, style "width" "100%", placeholder "(Optional) comments that may be helpful. For example, did you complete all the bad endings, how did you measure? etc." ] + , if model.length == 0 then text "" else inputButton "Delete my vote" Delete [style "float" "right"] + , if cansubmit then submitButton "Save" model.state True else text "" + , inputButton "Cancel" (Open False) [] + , br_ 2 + ] ] + in + [ text " " + , a [ onClickD (Open (not model.open)), href "#" ] + [ text <| if model.length == 0 then "Vote »" + else "My vote: " ++ String.fromInt (model.length // 60) ++ "h" + ++ if modBy 60 model.length /= 0 then String.fromInt (modBy 60 model.length) ++ "m" else "" ] + ] ++ case (model.open, model.state) of + (False, _) -> [] + (_, Api.Normal) -> + if model.length == 0 && List.isEmpty (Maybe.withDefault [] model.rels) + then [ br_ 2, b [] [ text "There are no releases eligible for voting." ] ] + else frm + (_, Api.Error e) -> [ br_ 2, b [] [ text ("Error: " ++ Api.showResponse e) ] ] + (_, Api.Loading) -> [ span [ style "float" "right", class "spinner" ] [] ] diff --git a/elm/checkall.js b/elm/checkall.js deleted file mode 100644 index bc87bad4..00000000 --- a/elm/checkall.js +++ /dev/null @@ -1,16 +0,0 @@ -//order:9 - After Elm initialization - -/* "checkall" checkbox, usage: - * - * <input type="checkbox" class="checkall" name="$somename"> - * - * Checking that will synchronize all other checkboxes with name="$somename". - */ -document.querySelectorAll('input[type=checkbox].checkall').forEach(function(el) { - el.addEventListener('click', function() { - document.querySelectorAll('input[type=checkbox][name="'+el.name+'"]').forEach(function(el2) { - if(el2.checked != el.checked) - el2.click(); - }); - }); -}); diff --git a/elm/checkhidden.js b/elm/checkhidden.js deleted file mode 100644 index 486b3c1d..00000000 --- a/elm/checkhidden.js +++ /dev/null @@ -1,17 +0,0 @@ -//order:9 - After Elm initialization - -/* "checkhidden" checkbox, usage: - * - * <input type="checkbox" class="checkhidden" value="$somename"> - * - * Checking that will toggle the 'hidden' class of all elements with the "$somename" class. - */ -document.querySelectorAll('input[type=checkbox].checkhidden').forEach(function(el) { - var f = function() { - document.querySelectorAll('.'+el.value).forEach(function(el2) { - el2.classList.toggle('hidden', !el.checked); - }); - }; - f(); - el.addEventListener('click', f); -}); diff --git a/elm/elm-init.js b/elm/elm-init.js deleted file mode 100644 index d9978111..00000000 --- a/elm/elm-init.js +++ /dev/null @@ -1,34 +0,0 @@ -//order:8 - After all regular JS, as other files may modify pageVars or modules in the Elm.* namespace. - -/* 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; - }; -})(); - - -/* Load all Elm modules listed in the pageVars.elm array */ -if(pageVars.elm) { - //var t0 = performance.now(); - for(var i=0; i<pageVars.elm.length; i++) { - var e = pageVars.elm[i]; - //if(e[0] != 'UList.DateEdit') continue; - var mod = e[0].split('.').reduce(function(p, c) { return p[c] }, window.Elm); - var node = document.getElementById('elm'+i); - if(e.length > 1) - mod.init({ node: node, flags: e[1] }); - else - mod.init({ node: node }); - } - //console.log("Elm modules initialized in " + (performance.now() - t0) + " milliseconds."); -} diff --git a/elm/elm.json b/elm/elm.json index 3db9993a..6c052936 100644 --- a/elm/elm.json +++ b/elm/elm.json @@ -6,7 +6,6 @@ "elm-version": "0.19.1", "dependencies": { "direct": { - "RomanErnst/erl": "2.1.1", "elm/browser": "1.0.1", "elm/core": "1.0.2", "elm/file": "1.0.1", diff --git a/elm/iv.js b/elm/iv.js deleted file mode 100644 index 5892bef8..00000000 --- a/elm/iv.js +++ /dev/null @@ -1,190 +0,0 @@ -//order:8 - After all regular JS, as other files may modify pageVars or modules in the Elm.* namespace. -/* Simple image viewer widget. Usage: - * - * <a href="full_image.jpg" data-iv="{width}x{height}:{category}">..</a> - * - * Clicking on the above link will cause the image viewer to open - * full_image.jpg. The {category} part can be empty or absent. If it is not - * empty, next/previous links will show up to point to the other images within - * the same category. - * - * ivInit() should be called when links with "data-iv" attributes are - * dynamically added or removed from the DOM. - */ - -// Cache of image categories and the list of associated link objects. Used to -// quickly generate the next/prev links. -var cats; - -// DOM elements, lazily initialized in create_div() -var ivparent = null; -var ivimg; -var ivfull; -var ivnext; -var ivprev; -var ivload; -var ivclose; - -var imgw; -var imgh; - -function create_div() { - if(ivparent) - return; - ivparent = document.createElement('div'); - ivparent.className = 'ivview'; - ivparent.style.display = 'none'; - ivparent.onclick = function(ev) { ev.stopPropagation(); return true }; - - ivload = document.createElement('div'); - ivload.className = 'spinner'; - ivload.style.display = 'none'; - ivparent.appendChild(ivload); - - ivimg = document.createElement('div'); - ivparent.appendChild(ivimg); - - ivfull = document.createElement('a'); - ivparent.appendChild(ivfull); - - ivclose = document.createElement('a'); - ivclose.href = '#'; - ivclose.onclick = ivClose; - ivclose.textContent = 'close'; - ivparent.appendChild(ivclose); - - ivprev = document.createElement('a'); - ivprev.onclick = show; - ivprev.textContent = '« previous'; - ivparent.appendChild(ivprev); - - ivnext = document.createElement('a'); - ivnext.onclick = show; - ivnext.textContent = 'next »'; - ivparent.appendChild(ivnext); - - document.querySelector('body').appendChild(ivparent); -} - - -// Find the next (dir=1) or previous (dir=-1) non-hidden link object for the category. -function findnav(cat, i, dir) { - for(var j=i+dir; j>=0 && j<cats[cat].length; j+=dir) - if(cats[cat][j].offsetWidth > 0 && cats[cat][j].offsetHeight > 0) - return cats[cat][j]; - return 0 -} - - -// fix properties of the prev/next links -function fixnav(lnk, cat, i, dir) { - var a = cat ? findnav(cat, i, dir) : 0; - lnk.style.visibility = a ? 'visible' : 'hidden'; - lnk.href = a ? a.href : '#'; - lnk.iv_i = a ? a.iv_i : 0; - lnk.setAttribute('data-iv', a ? a.getAttribute('data-iv') : ''); -} - - -function keydown(e) { - if(e.key == 'ArrowLeft' && ivprev.style.visibility == 'visible') - ivprev.click(); - else if(e.key == 'ArrowRight' && ivnext.style.visibility == 'visible') - ivnext.click(); - else if(e.key == 'Escape' || e.key == 'Esc') - ivClose(); -} - - -function resize() { - var w = imgw; - var h = imgh; - var ww = typeof(window.innerWidth) == 'number' ? window.innerWidth : document.documentElement.clientWidth; - var wh = typeof(window.innerHeight) == 'number' ? window.innerHeight : document.documentElement.clientHeight; - if(w+100 > ww || imgh+70 > wh) { - ivfull.textContent = w+'x'+h; - ivfull.style.visibility = 'visible'; - if(w/h > ww/wh) { // width++ - h *= (ww-100)/w; - w = ww-100; - } else { // height++ - w *= (wh-70)/h; - h = wh-70; - } - } else - ivfull.style.visibility = 'hidden'; - var dw = w; - var dh = h+20; - dw = dw < 200 ? 200 : dw; - - ivparent.style.width = dw+'px'; - ivparent.style.height = dh+'px'; - ivparent.style.left = ((ww - dw) / 2 - 10)+'px'; - ivparent.style.top = ((wh - dh) / 2 - 20)+'px'; - var img = ivimg.querySelector('img'); - img.style.width = w+'px'; - img.style.height = h+'px'; -} - - -function show(ev) { - var u = this.href; - var opt = this.getAttribute('data-iv').split(':'); - var idx = this.iv_i; - imgw = Math.floor(opt[0].split('x')[0]); - imgh = Math.floor(opt[0].split('x')[1]); - - create_div(); - - var img = document.createElement('img'); - img.src = u; - ivfull.href = u; - img.onclick = ivClose; - img.onload = function() { ivload.style.display = 'none' }; - ivimg.textContent = ''; - ivimg.appendChild(img); - - ivparent.style.display = 'block'; - ivload.style.display = 'block'; - fixnav(ivprev, opt[1], idx, -1); - fixnav(ivnext, opt[1], idx, 1); - resize(); - - document.addEventListener('click', ivClose); - document.addEventListener('keydown', keydown); - window.addEventListener('resize', resize); - ev.preventDefault(); -} - - -window.ivClose = function(ev) { - var targetlink = ev ? ev.target : null; - while(targetlink && targetlink.nodeName.toLowerCase() != 'a') - targetlink = targetlink.parentNode; - if(targetlink && targetlink.getAttribute('data-iv')) - return false; - document.removeEventListener('click', ivClose); - document.removeEventListener('keydown', keydown); - window.removeEventListener('resize', resize); - ivparent.style.display = 'none'; - ivimg.textContent = ''; - return false; -}; - - -window.ivInit = function() { - cats = {}; - document.querySelectorAll('a[data-iv]').forEach(function(o) { - if(o == ivnext || o == ivprev) - return; - o.addEventListener('click', show); - var cat = o.getAttribute('data-iv').split(':')[1]; - if(cat) { - if(!cats[cat]) - cats[cat] = []; - o.iv_i = cats[cat].length; - cats[cat].push(o); - } - }); -}; -ivInit(); diff --git a/elm/lib.js b/elm/lib.js deleted file mode 100644 index 859cfc22..00000000 --- a/elm/lib.js +++ /dev/null @@ -1,15 +0,0 @@ -//order:0 - Before anything else that may use these functions. - -/* Load global page-wide variables from <script id="pagevars">...</script> and store them into window.pageVars */ -var e = document.getElementById('pagevars'); -window.pageVars = e ? JSON.parse(e.innerHTML) : {}; - - -// Utlity function to wrap the init() function of an Elm module. -window.wrap_elm_init = function(mod, newinit) { - mod = mod.split('.').reduce(function(p, c) { return p ? p[c] : null }, window.Elm); - if(mod) { - var oldinit = mod.init; - mod.init = function(opt) { newinit(oldinit, opt) }; - } -}; diff --git a/elm/mainbox-summarize.js b/elm/mainbox-summarize.js deleted file mode 100644 index 5f940ed5..00000000 --- a/elm/mainbox-summarize.js +++ /dev/null @@ -1,33 +0,0 @@ -// Adds a "more"/"less" link to the bottom of a mainbox depending on the -// height of its contents. -// -// Usage: -// -// <div class="mainbox" data-mainbox-summarize="200"> .. </div> - -function set(d, h) { - var expanded = true; - var a = document.createElement('a'); - a.href = '#'; - - var toggle = function() { - expanded = !expanded; - d.style.maxHeight = expanded ? null : h+'px'; - d.style.overflowY = expanded ? null : 'hidden'; - a.textContent = expanded ? '⇑ less ⇑' : '⇓ more ⇓'; - return false; - }; - - a.onclick = toggle; - var t = document.createElement('div'); - t.className = 'summarize_more'; - t.appendChild(a); - d.parentNode.insertBefore(t, d.nextSibling); - toggle(); -} - -document.querySelectorAll('.mainbox[data-mainbox-summarize]').forEach(function(d) { - var h = Math.floor(d.getAttribute('data-mainbox-summarize')); - if(d.offsetHeight > h+100) - set(d, h) -}); diff --git a/elm/polyfills.js b/elm/polyfills.js deleted file mode 100644 index 4bb85105..00000000 --- a/elm/polyfills.js +++ /dev/null @@ -1,33 +0,0 @@ -//order:0 - Must be loaded before anything else. - -/* 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; -} |