summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--elm/CharEdit.elm120
-rw-r--r--lib/VNWeb/Chars/Edit.pm38
-rw-r--r--lib/VNWeb/Elm.pm1
-rw-r--r--lib/VNWeb/Releases/Elm.pm2
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(