module CharEdit 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 Dict import Set import File exposing (File) import File.Select as FSel import Lib.Util exposing (..) import Lib.Html exposing (..) 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 Lib.Image as Img import Gen.Release as GR import Gen.CharEdit as GCE import Gen.Types as GT import Gen.Api as GApi main : Program GCE.Recv Model Msg main = Browser.element { init = \e -> (init e, Cmd.none) , view = view , update = update , subscriptions = always Sub.none } type Tab = General | Image | Traits | VNs | All type alias Model = { state : Api.State , tab : Tab , editsum : Editsum.Model , name : String , original : String , alias : String , desc : TP.Model , gender : String , spoilGender : Maybe String , bMonth : Int , bDay : Int , age : Maybe Int , sBust : Int , sWaist : Int , sHip : Int , height : Int , weight : Maybe Int , bloodt : String , cupSize : String , main : Maybe Int , mainRef : Bool , mainHas : Bool , mainName : String , mainSearch : A.Model GApi.ApiCharResult , mainSpoil : Int , image : Img.Image , 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 } 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 } , name = d.name , original = d.original , alias = d.alias , desc = TP.bbcode d.desc , gender = d.gender , spoilGender = d.spoil_gender , bMonth = d.b_month , bDay = if d.b_day == 0 then 1 else d.b_day , age = d.age , sBust = d.s_bust , sWaist = d.s_waist , sHip = d.s_hip , height = d.height , weight = d.weight , bloodt = d.bloodt , cupSize = d.cup_size , main = d.main , mainRef = d.main_ref , mainHas = d.main /= Nothing , mainName = d.main_name , mainSearch = A.init "" , mainSpoil = d.main_spoil , image = Img.info d.image_info , 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 } encode : Model -> GCE.Send encode model = { id = model.id , editsum = model.editsum.editsum.data , hidden = model.editsum.hidden , locked = model.editsum.locked , name = model.name , original = model.original , alias = model.alias , desc = model.desc.data , gender = model.gender , spoil_gender= model.spoilGender , b_month = model.bMonth , b_day = model.bDay , age = model.age , s_bust = model.sBust , s_waist = model.sWaist , s_hip = model.sHip , height = model.height , weight = model.weight , bloodt = model.bloodt , cup_size = model.cupSize , main = if model.mainHas then model.main else Nothing , main_spoil = model.mainSpoil , image = model.image.id , 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 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 | Submit | Submitted GApi.Response | Name String | Original String | Alias String | Desc TP.Msg | Gender String | SpoilGender (Maybe String) | BMonth Int | BDay Int | Age (Maybe Int) | SBust (Maybe Int) | SWaist (Maybe Int) | SHip (Maybe Int) | Height (Maybe Int) | Weight (Maybe Int) | BloodT String | CupSize String | MainHas Bool | MainSearch (A.Msg GApi.ApiCharResult) | MainSpoil Int | ImageSet String Bool | ImageSelect | ImageSelected File | ImageMsg Img.Msg | TraitDel Int | 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) 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) Name s -> ({ model | name = s }, Cmd.none) Original s -> ({ model | original = 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) Gender s -> ({ model | gender = s }, Cmd.none) SpoilGender s->({model | spoilGender = s }, Cmd.none) BMonth n -> ({ model | bMonth = n }, Cmd.none) BDay n -> ({ model | bDay = n }, Cmd.none) Age s -> ({ model | age = s }, Cmd.none) SBust s -> ({ model | sBust = Maybe.withDefault 0 s }, Cmd.none) SWaist s -> ({ model | sWaist = Maybe.withDefault 0 s }, Cmd.none) SHip s -> ({ model | sHip = Maybe.withDefault 0 s }, Cmd.none) Height s -> ({ model | height = Maybe.withDefault 0 s }, Cmd.none) Weight s -> ({ model | weight = s }, Cmd.none) BloodT s -> ({ model | bloodt = s }, Cmd.none) CupSize s -> ({ model | cupSize= s }, Cmd.none) MainHas b -> ({ model | mainHas = b }, Cmd.none) MainSearch m -> let (nm, c, res) = A.update mainConfig m model.mainSearch in case res of 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) MainSpoil n -> ({ model | mainSpoil = n }, 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/jpg"] 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) TraitSpoil idx spl -> ({ model | traits = modidx idx (\t -> { t | spoil = spl }) 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 }] }, 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) 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" }] } , 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 Submit -> ({ model | state = Api.Loading }, GCE.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.name /= "" && model.name == model.original) || hasDuplicates (List.map (\v -> (v.vid, Maybe.withDefault 0 v.rid)) model.vns) || not (Img.isValid model.image) ) spoilOpts = [ (0, "Not a spoiler") , (1, "Minor spoiler") , (2, "Major spoiler") ] 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 "alias::Aliases" [ inputTextArea "alias" model.alias Alias (rows 3 :: 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 "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") ] , 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" ] , tr [ class "newpart" ] [ td [ colspan 2 ] [ text "Body" ] ] , formField "gender::Sex" [ inputSelect "gender" model.gender Gender [] GT.genders , label [] [ inputCheck "" (isJust model.spoilGender) (\b -> SpoilGender <| if b then (Just "unknown") else Nothing), text " spoiler" ] , case model.spoilGender of Nothing -> text "" Just gen -> span [] [ br [] [] , text "▲ apparent (non-spoiler) sex" , br [] [] , text "▼ actual (spoiler) sex" , br [] [] , 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 ] , tr [ class "newpart" ] [ td [ colspan 2 ] [ text "Instance" ] ] ] ++ if model.mainRef then [ formField "" [ text "This character is already used as an instance for another character. If you want to link more characters to this one, please edit the other characters instead." ] ] else [ formField "" [ label [] [ inputCheck "" model.mainHas MainHas, text " This character is an instance of another character." ] ] , formField "" <| if not model.mainHas then [] else [ 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 ] ]) model.main , br [] [] , A.view mainConfig model.mainSearch [placeholder "Set character..."] ] ] 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 ] ++ 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 [] , br [] [] , text "Image must be in JPEG or PNG format and at most 10 MiB. Images larger than 256x300 will automatically be resized." , case Img.viewVote model.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)" , Html.map ImageMsg 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, 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 [ 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" ] [] ] , td [] [ case (t.tid == model.traitSelId, lookup model.traitSelSpl spoilOpts) of (True, Just s) -> text s _ -> a [ href "#", onClickD (TraitDel i)] [ text "remove" ] ] ]) in K.node "table" [ class "formtable chare_traits" ] <| (if List.isEmpty old then [] else ("head", tr [ class "newpart" ] [ td [ colspan 3 ] [text "Current traits" ]]) :: List.map trait old) ++ (if List.isEmpty new then [] else ("added", tr [ class "newpart" ] [ td [ colspan 3 ] [text "Newly added traits" ]]) :: List.map trait new) ++ [ ("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 "" <| 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 1 /= List.length (List.filter (\(_,r) -> isJust r.rid) lst) then [] else [ ( String.fromInt vid ++ "warn" , tr [] [ td [ colspan 4, style "padding" "0 15px" ] [ b [ class "standout" ] [ 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" , 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" ] [ ul [] [ 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) ] ] ]