diff options
-rw-r--r-- | elm/CharEdit.elm | 120 | ||||
-rw-r--r-- | lib/VNWeb/Chars/Edit.pm | 38 | ||||
-rw-r--r-- | lib/VNWeb/Elm.pm | 1 | ||||
-rw-r--r-- | lib/VNWeb/Releases/Elm.pm | 2 |
4 files changed, 152 insertions, 9 deletions
diff --git a/elm/CharEdit.elm b/elm/CharEdit.elm index 9d760779..56aadb81 100644 --- a/elm/CharEdit.elm +++ b/elm/CharEdit.elm @@ -6,6 +6,8 @@ import Html.Keyed as K import Html.Attributes exposing (..) import Browser import Browser.Navigation exposing (load) +import Dict +import Set import File exposing (File) import File.Select as FSel import Lib.Util exposing (..) @@ -14,6 +16,8 @@ import Lib.TextPreview as TP import Lib.Autocomplete as A import Lib.Api as Api import Lib.Editsum as Editsum +import Lib.RDate as RDate +import Gen.Release as GR import Gen.CharEdit as GCE import Gen.Types as GT import Gen.Api as GApi @@ -32,6 +36,7 @@ type Tab = General | Image | Traits + | VNs | All type alias Model = @@ -58,12 +63,16 @@ type alias Model = , mainHas : Bool , mainName : String , mainSearch : A.Model GApi.ApiCharResult + , mainSpoil : Int , image : Maybe String , imageState : Api.State , traits : List GCE.RecvTraits , traitSearch : A.Model GApi.ApiTraitResult , traitSelId : Int , traitSelSpl : Int + , vns : List GCE.RecvVns + , vnSearch : A.Model GApi.ApiVNResult + , releases : Dict.Dict Int (List GCE.RecvReleasesRels) -- vid -> list of releases , id : Maybe Int } @@ -93,12 +102,16 @@ init d = , mainHas = d.main /= Nothing , mainName = d.main_name , mainSearch = A.init "" + , mainSpoil = d.main_spoil , image = d.image , imageState = Api.Normal , traits = d.traits , traitSearch = A.init "" , traitSelId = 0 , traitSelSpl = 0 + , vns = d.vns + , vnSearch = A.init "" + , releases = Dict.fromList <| List.map (\v -> (v.id, v.rels)) d.releases , id = d.id } @@ -125,8 +138,10 @@ encode model = , bloodt = model.bloodt , cup_size = model.cupSize , main = if model.mainHas then model.main else Nothing + , main_spoil = model.mainSpoil , image = model.image , traits = List.map (\t -> { tid = t.tid, spoil = t.spoil }) model.traits + , vns = List.map (\v -> { vid = v.vid, rid = v.rid, spoil = v.spoil, role = v.role }) model.vns } mainConfig : A.Config Msg GApi.ApiCharResult @@ -135,6 +150,9 @@ mainConfig = { wrap = MainSearch, id = "mainadd", source = A.charSource } traitConfig : A.Config Msg GApi.ApiTraitResult traitConfig = { wrap = TraitSearch, id = "traitadd", source = A.traitSource } +vnConfig : A.Config Msg GApi.ApiVNResult +vnConfig = { wrap = VnSearch, id = "vnadd", source = A.vnSource } + type Msg = Editsum Editsum.Msg | Tab Tab @@ -157,6 +175,7 @@ type Msg | CupSize String | MainHas Bool | MainSearch (A.Msg GApi.ApiCharResult) + | MainSpoil Int | ImageSet String | ImageSelect | ImageSelected File @@ -165,6 +184,13 @@ type Msg | TraitSel Int Int | TraitSpoil Int Int | TraitSearch (A.Msg GApi.ApiTraitResult) + | VnRel Int (Maybe Int) + | VnRole Int String + | VnSpoil Int Int + | VnDel Int + | VnRelAdd Int String + | VnSearch (A.Msg GApi.ApiVNResult) + | VnRelGet Int GApi.Response update : Msg -> Model -> (Model, Cmd Msg) @@ -197,6 +223,7 @@ update msg model = 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) + 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) @@ -213,8 +240,27 @@ update msg model = 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 = nm }, c) - else ({ model | traitSearch = nm, traits = model.traits ++ [{ tid = t.id, spoil = t.defaultspoil, name = t.name, group = t.group_name, applicable = t.applicable, new = True }] }, Cmd.none) + 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) + + 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) + VnSpoil idx n -> ({ model | vns = modidx idx (\v -> { v | spoil = n }) model.vns }, Cmd.none) + VnDel idx -> ({ model | vns = delidx idx model.vns }, Cmd.none) + VnRelAdd vid title -> + let rid = Dict.get vid model.releases |> Maybe.andThen (\rels -> List.filter (\r -> not (List.any (\v -> v.vid == vid && v.rid == Just r.id) model.vns)) rels |> List.head |> Maybe.map (\r -> r.id)) + in ({ model | vns = model.vns ++ [{ vid = vid, title = title, rid = rid, spoil = 0, role = "primary" }] }, Cmd.none) + VnSearch m -> + let (nm, c, res) = A.update vnConfig m model.vnSearch + in case res of + Nothing -> ({ model | vnSearch = nm }, c) + Just vn -> + 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)) + 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 Submit -> ({ model | state = Api.Loading }, GCE.send (encode model) Submitted) Submitted (GApi.Redirect s) -> (model, load s) @@ -224,9 +270,17 @@ update msg model = isValid : Model -> Bool isValid model = not ( model.name == model.original + || hasDuplicates (List.map (\v -> (v.vid, Maybe.withDefault 0 v.rid)) model.vns) ) +spoilOpts = + [ (0, "Not a spoiler") + , (1, "Minor spoiler") + , (2, "Major spoiler") + ] + + view : Model -> Html Msg view model = let @@ -282,7 +336,9 @@ view model = else [ formField "" [ label [] [ inputCheck "" model.mainHas MainHas, text " This character is an instance of another character." ] ] , formField "" <| if not model.mainHas then [] else - [ Maybe.withDefault (text "No character selected") <| Maybe.map (\m -> span [] + [ inputSelect "" model.mainSpoil MainSpoil [] spoilOpts + , 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 ] @@ -336,10 +392,8 @@ view model = , a [ href "#", onMouseOver (TraitSel t.tid 2), onMouseOut (TraitSel 0 0), onClickD (TraitSpoil i 2), classList [("s2", spoil t == 2 )], title "Major spoiler" ] [] ] , td [] - [ case (t.tid == model.traitSelId, model.traitSelSpl) of - (True, 0) -> text "Not a spoiler" - (True, 1) -> text "Minor spoiler" - (True, 2) -> text "Major spoiler" + [ case (t.tid == model.traitSelId, lookup model.traitSelSpl spoilOpts) of + (True, Just s) -> text s _ -> a [ href "#", onClickD (TraitDel i)] [ text "remove" ] ] ]) @@ -354,6 +408,56 @@ view model = [ ("add", tr [] [ td [ colspan 3 ] [ br_ 1, A.view traitConfig model.traitSearch [placeholder "Add trait..."] ] ]) ] + -- XXX: This function has quite a few nested loops, prolly rather slow with many VNs/releases + vns = + let + uniq lst set = + 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 + , 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 ] + ]] + ) + ] ++ List.map (\(idx,item) -> + ( String.fromInt vid ++ "i" ++ String.fromInt (Maybe.withDefault 0 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 + ++ 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 [] + ] + , td [] [ inputSelect "" item.role (VnRole idx) [] GT.charRoles ] + , td [] [ inputSelect "" item.spoil (VnSpoil idx) [ style "width" "130px", style "margin" "0 5px" ] spoilOpts ] + , td [] [ inputButton "remove" (VnDel idx) [] ] + ] + ) + ) 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.length lst > List.length rels then [] else [ + ( String.fromInt vid ++ "add" + , tr [] [ td [ colspan 4 ] [ inputButton "add release" (VnRelAdd vid title) [style "margin" "0 15px"] ] ] + ) + ]) + in + K.node "table" [ class "formtable" ] <| + List.concatMap + (\vid -> vn vid (List.filter (\(_,r) -> r.vid == vid) (List.indexedMap (\i r -> (i,r)) model.vns)) (Maybe.withDefault [] (Dict.get vid model.releases))) + (uniq (List.map (\v -> v.vid) model.vns) Set.empty) + ++ + [ ("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" ] @@ -361,12 +465,14 @@ view model = [ 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" ] ] + , li [ classList [("tabselected", model.tab == VNs )] ] [ a [ href "#", onClickD (Tab VNs ) ] [ text "Visual Novels"] ] , 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) diff --git a/lib/VNWeb/Chars/Edit.pm b/lib/VNWeb/Chars/Edit.pm index 95740b17..ae8fb564 100644 --- a/lib/VNWeb/Chars/Edit.pm +++ b/lib/VNWeb/Chars/Edit.pm @@ -21,6 +21,7 @@ my $FORM = { bloodt => { default => 'unknown', enum => \%BLOOD_TYPE }, cup_size => { required => 0, default => '', enum => \%CUP_SIZE }, main => { required => 0, id => 1 }, + main_spoil => { uint => 1, range => [0,2] }, main_ref => { _when => 'out', anybool => 1 }, main_name => { _when => 'out', default => '' }, image => { required => 0, regex => qr/ch[1-9][0-9]{0,6}/ }, @@ -32,11 +33,22 @@ my $FORM = { applicable => { _when => 'out', anybool => 1 }, new => { _when => 'out', anybool => 1 }, } }, + vns => { sort_keys => ['vid', 'rid'], aoh => { + vid => { id => 1 }, + rid => { id => 1, required => 0 }, + spoil => { uint => 1, range => [0,2] }, + role => { enum => \%CHAR_ROLE }, + title => { _when => 'out' }, + } }, hidden => { anybool => 1 }, locked => { anybool => 1 }, authmod => { _when => 'out', anybool => 1 }, editsum => { _when => 'in out', editsum => 1 }, + releases => { _when => 'out', aoh => { + id => { id => 1 }, + rels => $VNWeb::Elm::apis{Releases}[0] + } }, }; my $FORM_OUT = form_compile out => $FORM; @@ -54,6 +66,21 @@ TUWF::get qr{/$RE{crev}/edit} => sub { enrich_merge tid => 'SELECT t.id AS tid, t.name, t.applicable, g.name AS group, g.order AS order, false AS new FROM traits t LEFT JOIN traits g ON g.id = t.group WHERE t.id IN', $e->{traits}; $e->{traits} = [ sort { ($a->{order}//99) <=> ($b->{order}//99) || $a->{name} cmp $b->{name} } $e->{traits}->@* ]; + enrich_merge vid => 'SELECT id AS vid, title FROM vn WHERE id IN', $e->{vns}; + $e->{vns} = [ sort { $a->{title} cmp $b->{title} || $a->{vid} <=> $b->{vid} || ($a->{rid}||0) <=> ($b->{rid}||0) } $e->{vns}->@* ]; + my %vns; + $e->{releases} = [ map !$vns{$_->{vid}}++ ? { id => $_->{vid} } : (), $e->{vns}->@* ]; + + enrich rels => id => vid => sub { sql ' + SELECT rv.vid, r.id, r.title, r.original, r.released, r.type as rtype + FROM releases r + JOIN releases_vn rv ON rv.id = r.id + WHERE NOT r.hidden AND rv.vid IN', $_, ' + ORDER BY r.released, r.title, r.id' + }, $e->{releases}; + enrich_flatten lang => id => id => sub { sql('SELECT id, lang FROM releases_lang WHERE id IN', $_, 'ORDER BY lang') }, map $_->{rels}, $e->{releases}->@*; + enrich_flatten platforms => id => id => sub { sql('SELECT id, platform FROM releases_platforms WHERE id IN', $_, 'ORDER BY platform') }, map $_->{rels}, $e->{releases}->@*; + $e->{authmod} = auth->permDbmod; $e->{editsum} = $e->{chrev} == $e->{maxrev} ? '' : "Reverted to revision c$e->{id}.$e->{chrev}"; @@ -97,12 +124,21 @@ elm_api CharEdit => $FORM_OUT, $FORM_IN, sub { die "Attempt to set main while this character is already referenced." if $data->{main} && tuwf->dbVali('SELECT 1 AS ref FROM chars WHERE main =', \$e->{id}); # It's possible that the referenced character has been deleted since it was added as main, so don't die() on this one, just unset main. $data->{main} = undef if $data->{main} && !tuwf->dbVali('SELECT 1 FROM chars WHERE NOT hidden AND main IS NULL AND id =', \$data->{main}); + $data->{main_spoil} = 0 if !$data->{main}; # Allow non-applicable traits only when they were already applied to this character. validate_dbid - sql('SELECT id FROM traits t WHERE state = 2 AND (applicable OR EXISTS(SELECT 1 FROM chars_traits ct WHERE ct.tid = t.id AND ct.id =', \$e->{id}, ')) AND id IN'), + sql('SELECT id FROM traits t WHERE state = 1+1 AND (applicable OR EXISTS(SELECT 1 FROM chars_traits ct WHERE ct.tid = t.id AND ct.id =', \$e->{id}, ')) AND id IN'), map $_->{tid}, $data->{traits}->@*; + validate_dbid 'SELECT id FROM vn WHERE id IN', map $_->{vid}, $data->{vns}->@*; + # XXX: This will also die when the release has been moved to a different VN + # and the char hasn't been updated yet. Would be nice to give a better + # error message in that case. + for($data->{vns}->@*) { + die "Bad release for v$_->{vid}: r$_->{rid}\n" if defined $_->{rid} && !tuwf->dbVali('SELECT 1 FROM releases_vn WHERE id =', \$_->{rid}, 'AND vid =', \$_->{vid}); + } + return elm_Unchanged if !$new && !form_changed $FORM_CMP, $data, $e; my($id,undef,$rev) = db_edit c => $e->{id}, $data; elm_Redirect "/c$id.$rev"; diff --git a/lib/VNWeb/Elm.pm b/lib/VNWeb/Elm.pm index 5b037b07..788bfe3a 100644 --- a/lib/VNWeb/Elm.pm +++ b/lib/VNWeb/Elm.pm @@ -391,6 +391,7 @@ sub write_types { $data .= def genders => 'List (String, String)' => list map tuple(string $_, string $GENDER{$_}), keys %GENDER; $data .= def cupSizes => 'List (String, String)' => list map tuple(string $_, string $CUP_SIZE{$_}), keys %CUP_SIZE; $data .= def bloodTypes => 'List (String, String)' => list map tuple(string $_, string $BLOOD_TYPE{$_}), keys %BLOOD_TYPE; + $data .= def charRoles => 'List (String, String)' => list map tuple(string $_, string $CHAR_ROLE{$_}{txt}), keys %CHAR_ROLE; $data .= def curYear => Int => (gmtime)[5]+1900; write_module Types => $data; diff --git a/lib/VNWeb/Releases/Elm.pm b/lib/VNWeb/Releases/Elm.pm index 32dd89ca..b151de41 100644 --- a/lib/VNWeb/Releases/Elm.pm +++ b/lib/VNWeb/Releases/Elm.pm @@ -3,7 +3,7 @@ package VNWeb::Releases::Elm; use VNWeb::Prelude; -# Used by UList.Opt to fetch releases from a VN id. +# Used by UList.Opt and CharEdit to fetch releases from a VN id. elm_api Release => undef, { vid => { id => 1 } }, sub { my($data) = @_; my $l = tuwf->dbAlli( |