diff options
-rw-r--r-- | elm/AdvSearch/Fields.elm | 17 | ||||
-rw-r--r-- | elm/AdvSearch/Main.elm | 3 | ||||
-rw-r--r-- | elm/AdvSearch/Producers.elm | 2 | ||||
-rw-r--r-- | elm/AdvSearch/Query.elm | 55 | ||||
-rw-r--r-- | elm/AdvSearch/Set.elm | 10 | ||||
-rw-r--r-- | lib/VNDB/Func.pm | 3 | ||||
-rw-r--r-- | lib/VNWeb/AdvSearch.pm | 163 | ||||
-rw-r--r-- | lib/VNWeb/Elm.pm | 29 | ||||
-rw-r--r-- | lib/VNWeb/VN/List.pm | 9 |
9 files changed, 155 insertions, 136 deletions
diff --git a/elm/AdvSearch/Fields.elm b/elm/AdvSearch/Fields.elm index 65951b16..64f9399a 100644 --- a/elm/AdvSearch/Fields.elm +++ b/elm/AdvSearch/Fields.elm @@ -7,7 +7,6 @@ import Lib.Util exposing (..) import Lib.Html exposing (..) import Lib.DropDown as DD import Lib.Api as Api -import Gen.AdvSearch exposing (QType(..)) import AdvSearch.Set as AS import AdvSearch.Producers as AP import AdvSearch.Query exposing (..) @@ -82,8 +81,8 @@ nestToQuery : NestModel -> Maybe Query nestToQuery model = case (model.ntype, List.filterMap fieldToQuery model.fields) of (_, [] ) -> Nothing - (NRel, [x]) -> Just (QQuery "release" Eq x) - (NRelNeg, [x]) -> Just (QQuery "release" Ne x) + (NRel, [x]) -> Just (QQuery 50 Eq x) + (NRelNeg, [x]) -> Just (QQuery 50 Ne x) (_, [x]) -> Just x (NAnd, xs ) -> Just (QAnd xs) (NOr, xs ) -> Just (QOr xs) @@ -102,7 +101,7 @@ nestFromQuery ntype qtype dat q = Ne -> Just (init ntNeg qt [val]) _ -> Nothing in case (qtype, ntype, q) of - (V, NRel, QQuery "release" op r) -> initSub op NRel NRelNeg R r + (V, NRel, QQuery 50 op r) -> initSub op NRel NRelNeg R r (_, NAnd, QAnd l) -> Just (init NAnd qtype l) (_, NOr, QOr l) -> Just (init NOr qtype l) _ -> Nothing @@ -312,11 +311,11 @@ fieldToQuery (_, _, model) = case model of FMCustom m -> Just m FMNest m -> nestToQuery m - FMLang m -> AS.toQuery (QStr "lang" ) m - FMOLang m -> AS.toQuery (QStr "olang") m - FMPlatform m -> AS.toQuery (QStr "platform") m - FMLength m -> AS.toQuery (QInt "length") m - FMDeveloper m-> AP.toQuery (QInt "developer") m + FMLang m -> AS.toQuery (QStr 2) m + FMOLang m -> AS.toQuery (QStr 3) m + FMPlatform m -> AS.toQuery (QStr 4) m + FMLength m -> AS.toQuery (QInt 5) m + FMDeveloper m-> AP.toQuery (QInt 6) m fieldCreate : Int -> (Data,FieldModel) -> (Data,Field) diff --git a/elm/AdvSearch/Main.elm b/elm/AdvSearch/Main.elm index 8e5156b4..044ac657 100644 --- a/elm/AdvSearch/Main.elm +++ b/elm/AdvSearch/Main.elm @@ -10,7 +10,6 @@ import Array as A import Json.Encode as JE import Json.Decode as JD import Gen.Api as GApi -import Gen.AdvSearch exposing (QType(..)) import AdvSearch.Query exposing (..) import AdvSearch.Fields exposing (..) @@ -108,7 +107,7 @@ update msg model = view : Model -> Html Msg view model = div [ class "advsearch" ] - [ input [ type_ "hidden", id "f", name "f", value <| Maybe.withDefault "" <| Maybe.map (encQuery model.qtype) (fieldToQuery model.query) ] [] + [ input [ type_ "hidden", id "f", name "f", value <| Maybe.withDefault "" <| Maybe.map encQuery (fieldToQuery model.query) ] [] , Html.map Field (nestFieldView model.data model.query) , input [ type_ "submit", class "submit", value "Search" ] [] ] diff --git a/elm/AdvSearch/Producers.elm b/elm/AdvSearch/Producers.elm index 096ccdf2..ab36f74a 100644 --- a/elm/AdvSearch/Producers.elm +++ b/elm/AdvSearch/Producers.elm @@ -64,7 +64,7 @@ fromQuery f dat q = devFromQuery = fromQuery (\q -> case q of - QInt "developer" op v -> Just (op, v) + QInt 6 op v -> Just (op, v) _ -> Nothing) diff --git a/elm/AdvSearch/Query.elm b/elm/AdvSearch/Query.elm index ca15a546..686580f1 100644 --- a/elm/AdvSearch/Query.elm +++ b/elm/AdvSearch/Query.elm @@ -4,17 +4,18 @@ import Json.Encode as JE import Json.Decode as JD import Dict import Gen.Api as GApi -import Gen.AdvSearch as GAdv -- Generic dynamically typed representation of a query. -- Used only as an intermediate format to help with encoding/decoding. +-- Corresponds to the compact JSON encoding, i.e. with field names and VNDBIDs encoded and integers. +type QType = V | R type Op = Eq | Ne | Ge | Le type Query = QAnd (List Query) | QOr (List Query) - | QInt String Op Int - | QStr String Op String - | QQuery String Op Query + | QInt Int Op Int + | QStr Int Op String + | QQuery Int Op Query encodeOp : Op -> JE.Value @@ -28,11 +29,11 @@ encodeOp o = JE.string <| encodeQuery : Query -> JE.Value encodeQuery q = case q of - QAnd l -> JE.list identity (JE.string "and" :: List.map encodeQuery l) - QOr l -> JE.list identity (JE.string "or" :: List.map encodeQuery l) - QInt s o a -> JE.list identity [JE.string s, encodeOp o, JE.int a] - QStr s o a -> JE.list identity [JE.string s, encodeOp o, JE.string a] - QQuery s o a -> JE.list identity [JE.string s, encodeOp o, encodeQuery a] + 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] @@ -56,10 +57,10 @@ decodeOp = JD.string |> JD.andThen (\s -> _ -> JD.fail "Invalid operator") decodeQuery : JD.Decoder Query -decodeQuery = JD.index 0 JD.string |> JD.andThen (\s -> +decodeQuery = JD.index 0 JD.int |> JD.andThen (\s -> case s of - "and" -> JD.map QAnd decodeQList - "or" -> JD.map QOr decodeQList + 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) @@ -85,8 +86,8 @@ encInt n = if n < 0 then Nothing 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 if n < 1090785969 then Just <| "_" ++ encIntRaw 5 (n-17044145) + else if n < 69810262705 then Just <| "-" ++ encIntRaw 6 (n-1090785969) else Nothing @@ -97,14 +98,10 @@ encStr : String -> String encStr = String.foldl (\c s -> s ++ Maybe.withDefault (String.fromChar c) (Dict.get c encStrMap)) "" --- XXX: Queries with unknown fields or invalid value types are silently discarded -encQuery : GAdv.QType -> Query -> String -encQuery qt query = +encQuery : Query -> String +encQuery query = let fint n = Maybe.withDefault "" (encInt n) - lst n l = - let nl = List.map (encQuery qt) l |> List.filter (\s -> s /= "") - in if List.isEmpty nl then "" else fint n ++ fint (List.length nl) ++ String.concat nl - fieldByName n = List.filter (\f -> f.qtype == qt && f.name == n) GAdv.fields |> List.head + 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 @@ -112,20 +109,16 @@ encQuery qt query = Ge -> 2 Le -> 3 encTypeOp o t = Maybe.withDefault "" <| encInt <| encOp o + 4*t - encStrField o v f = let s = encStr v in fint f.num ++ encTypeOp o (String.length s + 9) ++ s + encStrField n o v = let s = encStr v in fint n ++ encTypeOp o (String.length s + 9) ++ s in case query of QAnd l -> lst 0 l QOr l -> lst 1 l - QInt n o v -> fieldByName n |> Maybe.map (\f -> + 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 f.num ++ encTypeOp o 0 ++ s - Nothing -> encStrField o (String.fromInt v) f) |> Maybe.withDefault "" - QStr n o v -> fieldByName n |> Maybe.map (encStrField o v) |> Maybe.withDefault "" - QQuery n o q -> fieldByName n |> Maybe.andThen (\f -> - case f.vtype of - GAdv.QVQuery t -> Just (fint f.num ++ encTypeOp o 1 ++ encQuery t q) - _ -> Nothing) |> Maybe.withDefault "" - + 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 diff --git a/elm/AdvSearch/Set.elm b/elm/AdvSearch/Set.elm index 94312d13..0d58f02e 100644 --- a/elm/AdvSearch/Set.elm +++ b/elm/AdvSearch/Set.elm @@ -59,7 +59,7 @@ toQuery f m = -- Only recognizes queries generated by setToQuery, doesn't handle alternative query structures. -- Usage: -- setFromQuery (\q -> case q of --- QStr "lang" op v -> Just (op, v) +-- QStr 2 op v -> Just (op, v) -- _ -> Nothing) model fromQuery : (Query -> Maybe (Op,comparable)) -> Data -> Query -> Maybe (Data, Model comparable) fromQuery f dat q = @@ -116,12 +116,12 @@ langView orig model = langFromQuery = fromQuery (\q -> case q of - QStr "lang" op v -> Just (op, v) + QStr 2 op v -> Just (op, v) _ -> Nothing) olangFromQuery = fromQuery (\q -> case q of - QStr "olang" op v -> Just (op, v) + QStr 3 op v -> Just (op, v) _ -> Nothing) @@ -147,7 +147,7 @@ platformView model = platformFromQuery = fromQuery (\q -> case q of - QStr "platform" op v -> Just (op, v) + QStr 4 op v -> Just (op, v) _ -> Nothing) @@ -170,5 +170,5 @@ lengthView model = lengthFromQuery = fromQuery (\q -> case q of - QInt "length" op v -> Just (op, v) + QInt 5 op v -> Just (op, v) _ -> Nothing) diff --git a/lib/VNDB/Func.pm b/lib/VNDB/Func.pm index 508b2272..accf3df7 100644 --- a/lib/VNDB/Func.pm +++ b/lib/VNDB/Func.pm @@ -309,11 +309,12 @@ sub form_compare { } -# Encode query parameters. Takes a hash or hashref with key/values, supports array values. +# Encode query parameters. Takes a hash or hashref with key/values, supports array values and objects that implement query_encode(). sub query_encode { my $o = @_ == 1 ? $_[0] : {@_}; return join '&', map { my($k, $v) = ($_, $o->{$_}); + $v = $v->query_encode() if ref $v && ref $v ne 'ARRAY'; !defined $v ? () : ref $v ? map "$k=".uri_escape($_), sort @$v : "$k=".uri_escape($v) } sort keys %$o; } diff --git a/lib/VNWeb/AdvSearch.pm b/lib/VNWeb/AdvSearch.pm index aed43b45..8385a0fd 100644 --- a/lib/VNWeb/AdvSearch.pm +++ b/lib/VNWeb/AdvSearch.pm @@ -1,21 +1,27 @@ package VNWeb::AdvSearch; +# This module comes with query definitions and helper functions to handle +# advanced search queries. Usage is as follows: +# +# my $q = tuwf->validate(get => f => { advsearch => 'v' })->data; +# +# $q->sql_where; # Returns an SQL condition for use in a where clause. +# $q->elm_; # Instantiate an Elm widget + + use v5.26; use warnings; +use B; use TUWF; -use Exporter 'import'; use VNWeb::DB; use VNWeb::Validation; -use VNWeb::HTML; use VNDB::Types; -our @EXPORT = qw/ as_tosql as_elm_ /; - # Search query (JSON): # # $Query = $Combinator || $Predicate -# $Combinator = [ 'and'||'or', $Query, .. ] +# $Combinator = [ 'and'||'or'||0||1, $Query, .. ] # $Predicate = [ $Field, $Op, $Value ] # $Op = '=', '!=', '>=', '<=' # $Value = $integer || $string || $Query @@ -24,7 +30,7 @@ our @EXPORT = qw/ as_tosql as_elm_ /; # $Field can be referred to by name or number, the latter is used for the # compact encoding. # -# e.g. +# e.g. normalized JSON form: # # [ 'and' # , [ 'or' # No support for array values, so IN() queries need explicit ORs. @@ -122,14 +128,20 @@ our @EXPORT = qw/ as_tosql as_elm_ /; # $Type. Type=9 is used for the empty string, Type=10 for strings of length # 1, etc. String lengths up to 3 can be represented by a single $TypedOp # character. -# -# (Only a decoder is implemented for now, encoding is done in Elm) + my @alpha = (0..9, 'a'..'z', 'A'..'Z', '_', '-'); my %alpha = map +($alpha[$_],$_), 0..$#alpha; + +# Assumption: @escape has less than 49 characters. my @escape = split //, " !\"#\$%&'()*+,-./:;<=>?@[\\]^_`{|}~"; +my %escape = map +($escape[$_],$alpha[$_]), 0..$#escape; +my $escape_re = qr{([${\quotemeta join '', @escape}])}; -sub dec_int { +sub _unescape_str { $_[0] =~ s{_(.)}{ $escape[$alpha{$1} // return] // return }reg } +sub _escape_str { $_[0] =~ s/$escape_re/_$escape{$1}/rg } + +sub _dec_int { my($s, $i) = @_; my $c1 = ($alpha{substr $s, $$i++, 1} // return); return $c1 if $c1 < 49; @@ -139,23 +151,48 @@ sub dec_int { $n + (689, 4785, 266929, 17044145, 1090785969)[$c1-59] } -# Assumption: @escape has less than 49 characters. -sub unescape_str { $_[0] =~ s{_(.)}{ $escape[$alpha{$1} // return] // return }reg } - -sub dec_query { +sub _dec_query { my($s, $i) = @_; - my $c1 = dec_int($s, $i) // return; - my $c2 = dec_int($s, $i) // return; - return [ $c1 ? 'or' : 'and', map +(dec_query($s, $i) // return), 1..$c2 ] if $c1 <= 1; + my $c1 = _dec_int($s, $i) // return; + my $c2 = _dec_int($s, $i) // return; + return [ $c1, map +(_dec_query($s, $i) // return), 1..$c2 ] if $c1 <= 1; my($op, $type) = ($c2 % 4, int ($c2 / 4)); [ $c1, ('=','!=', '>=', '<=')[$op], - $type == 0 ? (dec_int($s, $i) // return) : - $type == 1 ? (dec_query($s, $i) // return) : - $type >= 9 ? do { my $v = unescape_str(substr $s, $$i, $type-9) // return; $$i += $type-9; $v } : undef ]; + $type == 0 ? (_dec_int($s, $i) // return) : + $type == 1 ? (_dec_query($s, $i) // return) : + $type >= 9 ? do { my $v = _unescape_str(substr $s, $$i, $type-9) // return; $$i += $type-9; $v } : undef ]; +} + +sub _enc_int { + my($n) = @_; + return if $n < 0; + return $alpha[$n] if $n < 49; + return $alpha[49 + int(($n-49)/64)] . $alpha[($n-49)%64] if $n < 689; + sub r { ($_[0] > 1 ? r($_[0]-1,int $_[1]/64) : '').$alpha[$_[1]%64] } + return 'X'.r 2, $n - 689 if $n < 4785; + return 'Y'.r 3, $n - 4785 if $n < 266929; + return 'Z'.r 4, $n - 266929 if $n < 17044145; + return '_'.r 5, $n - 17044145 if $n < 1090785969; + return '-'.r 6, $n - 1090785969 if $n < 69810262705; +} + +# Assumes that the query is already in compact JSON form. +sub _enc_query { + my($q) = @_; + return ($alpha[$q->[0]])._enc_int($#$q).join '', map _enc_query($_), @$q[1..$#$q] if $q->[0] <= 1; + my sub r { _enc_int($q->[0])._enc_int({qw/= 0 != 1 >= 2 <= 3/}->{$q->[1]} + 4*$_[0]) } + return r(1)._enc_query($q->[2]) if ref $q->[2]; + if(!(B::svref_2object(\$q->[2])->FLAGS & B::SVp_POK)) { + my $s = _enc_int $q->[2]; + return r(0).$s if defined $s; + } + my $esc = _escape_str $q->[2]; + r(9+length $esc).$esc; } + # Define a $Field, args: # $type -> 'v', 'c', etc. # $name -> $Field name, must be stable and unique for the $type. @@ -165,7 +202,7 @@ sub dec_query { # $op=>$sql -> Operator definitions and sql() generation functions. # # An implementation for the '!=' operator will be supplied automatically if it's not explicitely defined. -our(%FIELDS, %NUMFIELDS); +my(%FIELDS, %NUMFIELDS); sub f { my($t, $num, $n, $v, %op) = @_; my %f = ( @@ -192,11 +229,11 @@ f v => 50 => 'release', 'r', '=' => sub { sql 'v.id IN(SELECT rv.vid FROM relea f r => 2 => 'lang', { enum => \%LANGUAGE }, '=' => sub { sql 'r.id IN(SELECT id FROM releases_lang WHERE lang =', \$_, ')' }; f r => 4 => 'platform', { enum => \%PLATFORM }, '=' => sub { sql 'r.id IN(SELECT id FROM releases_platforms WHERE platform =', \$_, ')' }; -f r => 3 => 'developer',{ vndbid => 'p' }, '=' => sub { sql 'r.id IN(SELECT id FROM releases_producers WHERE developer AND pid = vndbid_num(', \$_, '))' }; +f r => 6 => 'developer',{ vndbid => 'p' }, '=' => sub { sql 'r.id IN(SELECT id FROM releases_producers WHERE developer AND pid = vndbid_num(', \$_, '))' }; -sub validate { +sub _validate { my($t, $q) = @_; return { msg => 'Invalid query' } if ref $q ne 'ARRAY' || @$q < 2 || !defined $q->[0] || ref $q->[0]; @@ -207,7 +244,7 @@ sub validate { # combinator if($q->[0] eq 'and' || $q->[0] eq 'or') { for(@$q[1..$#$q]) { - my $r = validate($t, $_); + my $r = _validate($t, $_); return $r if !$r || ref $r; } return 1; @@ -218,7 +255,7 @@ sub validate { my $f = $FIELDS{$t}{$q->[0]}; return { msg => 'Unknown field', field => $q->[0] } if !$f; return { msg => 'Invalid operator', field => $q->[0], op => $q->[1] } if !$f->{op}{$q->[1]}; - return validate($f->{value}, $q->[2]) if !ref $f->{value}; + return _validate($f->{value}, $q->[2]) if !ref $f->{value}; my $r = $f->{value}->validate($q->[2]); return { msg => 'Invalid value', field => $q->[0], value => $q->[2], error => $r->err } if $r->err; $q->[2] = $r->data; @@ -227,72 +264,94 @@ sub validate { # 'advsearch' validation, accepts either a compact encoded string, JSON string or an already decoded array. -TUWF::set('custom_validations')->{advsearch} = sub { my($t) = @_; +{ required => 0, type => 'any', func => sub { +TUWF::set('custom_validations')->{advsearch} = sub { my($t) = @_; +{ required => 0, type => 'any', default => bless({type=>$t}, __PACKAGE__), func => sub { return { msg => 'Invalid JSON', error => $@ =~ s{[\s\r\n]* at /[^ ]+ line.*$}{}smr } if !ref $_[0] && $_[0] =~ /^\[/ && !eval { $_[0] = JSON::XS->new->decode($_[0]); 1 }; if(!ref $_[0]) { my($v,$i) = ($_[0],0); - return { msg => 'Invalid compact encoded form', character_index => $i } if !($_[0] = dec_query($v, \$i)); + return { msg => 'Invalid compact encoded form', character_index => $i } if !($_[0] = _dec_query($v, \$i)); return { msg => 'Trailing garbage' } if $i != length $v; } - validate($t, @_) + my $v = _validate($t, @_); + $_[0] = bless { type => $t, query => $_[0] }, __PACKAGE__ if $v; + $v } } }; -sub as_tosql { +sub _sql_where { my($t, $q) = @_; - return sql_and map as_tosql($t, $_), @$q[1..$#$q] if $q->[0] eq 'and'; - return sql_or map as_tosql($t, $_), @$q[1..$#$q] if $q->[0] eq 'or'; + return sql_and map _sql_where($t, $_), @$q[1..$#$q] if $q->[0] eq 'and'; + return sql_or map _sql_where($t, $_), @$q[1..$#$q] if $q->[0] eq 'or'; my $f = $FIELDS{$t}{$q->[0]}; - local $_ = ref $f->{value} ? $q->[2] : as_tosql($f->{value}, $q->[2]); + local $_ = ref $f->{value} ? $q->[2] : _sql_where($f->{value}, $q->[2]); $f->{op}{$q->[1]}->(); } -sub coerce_for_json { +sub sql_where { + my($self) = @_; + $self->{query} ? _sql_where($self->{type}, $self->{query}) : '1=1'; +} + + +sub _compact_json { my($t, $q) = @_; - if($q->[0] eq 'and' || $q->[0] eq 'or') { - coerce_for_json($t, $_) for @$q[1..$#$q]; - } else { - my $f = $FIELDS{$t}{$q->[0]}; - # VNDBIDs are represented as ints for Elm - $q->[2] = $f->{vndbid} ? int ($q->[2] =~ s/^$f->{vndbid}//rg) - : $f->{int} ? int $q->[2] - : ref $f->{value} ? "$q->[2]" : coerce_for_json($f->{value}, $q->[2]); - } - $q + return [ $q->[0] eq 'and' ? 0 : 1, map _compact_json($t, $_), @$q[1..$#$q] ] if $q->[0] eq 'and' || $q->[0] eq 'or'; + + my $f = $FIELDS{$t}{$q->[0]}; + [ int $f->{num}, $q->[1], + # VNDBIDs are represented as ints in compact form + $f->{vndbid} ? int ($q->[2] =~ s/^$f->{vndbid}//rg) + : $f->{int} ? int $q->[2] + : ref $f->{value} ? "$q->[2]" : _compact_json($f->{value}, $q->[2]) + ] +} + + +sub compact_json { + my($self) = @_; + $self->{compact} //= $self->{query} && _compact_json($self->{type}, $self->{query}); + $self->{compact}; } -sub extract_ids { +sub _extract_ids { my($t,$q,$ids) = @_; if($q->[0] eq 'and' || $q->[0] eq 'or') { - extract_ids($t, $_, $ids) for @$q[1..$#$q]; + _extract_ids($t, $_, $ids) for @$q[1..$#$q]; } else { my $f = $FIELDS{$t}{$q->[0]}; $ids->{$q->[2]} = 1 if $f->{vndbid}; - extract_ids($f->{value}, $q->[2], $ids) if !ref $f->{value}; + _extract_ids($f->{value}, $q->[2], $ids) if !ref $f->{value}; } } -sub as_elm_ { - my($t, $q) = @_; +sub elm_ { + my($self) = @_; my(%o,%ids); - extract_ids($t, $q, \%ids) if $q; + _extract_ids($self->{type}, $self->{query}, \%ids) if $self->{query}; $o{producers} = [ map +{id => $_=~s/^p//rg}, grep /^p/, keys %ids ]; enrich_merge id => 'SELECT id, name, original, hidden FROM producers WHERE id IN', $o{producers}; - $o{qtype} = $t; - $o{query} = $q && coerce_for_json($t, $q); + $o{qtype} = $self->{type}; + $o{query} = $self->compact_json; state $schema ||= tuwf->compile({ type => 'hash', keys => { qtype => {}, - query => { type => 'array' }, + query => { type => 'array', required => 0 }, producers => $VNWeb::Elm::apis{ProducerResult}[0], }}); - elm_ 'AdvSearch.Main', $schema, \%o; + VNWeb::HTML::elm_ 'AdvSearch.Main', $schema, \%o; +} + + +sub query_encode { + my($self) = @_; + return if !$self->{query}; + $self->{query_encode} //= _enc_query $self->compact_json; + $self->{query_encode}; } 1; diff --git a/lib/VNWeb/Elm.pm b/lib/VNWeb/Elm.pm index 18f2ef09..4e9d435b 100644 --- a/lib/VNWeb/Elm.pm +++ b/lib/VNWeb/Elm.pm @@ -477,40 +477,11 @@ sub write_extlinks { } -sub write_advsearch { - my $data =<<~'_'; - type QType = V | R - type QVType = QVInt | QVStr | QVQuery QType - - type alias QField = - { qtype : QType - , name : String - , num : Int - , vtype : QVType - } - _ - - $data .= def fields => "List QField" => list map { - my($t, $n, $f) = @$_; - '{ '.join("\n , ", - 'qtype = '.uc($t), - 'name = '.string($n), - 'num = '.$f->{num}, - 'vtype = '.($f->{vndbid}||$f->{int} ? 'QVInt' : !ref $f->{value} ? 'QVQuery '.uc($f->{value}) : 'QVStr') - )."\n }"; - } map { my $t=$_; map [$t,$_,$VNWeb::AdvSearch::FIELDS{$t}{$_}], sort keys $VNWeb::AdvSearch::FIELDS{$t}->%* } sort keys %VNWeb::AdvSearch::FIELDS; - - write_module AdvSearch => $data; -} - - - if(tuwf->{elmgen}) { mkdir config->{root}.'/elm/Gen'; write_api; write_types; write_extlinks; - write_advsearch; open my $F, '>', config->{root}.'/elm/Gen/.generated'; print $F scalar gmtime; } diff --git a/lib/VNWeb/VN/List.pm b/lib/VNWeb/VN/List.pm index e968db55..fbcd1d99 100644 --- a/lib/VNWeb/VN/List.pm +++ b/lib/VNWeb/VN/List.pm @@ -7,8 +7,6 @@ use VNWeb::AdvSearch; sub listing_ { my($opt, $list, $count) = @_; - # TODO: query_encode() should recognize and encode the search query automatically. - $opt->{f} = JSON::XS->new->encode($opt->{f}) if $opt->{f}; my sub url { '?'.query_encode %$opt, @_ } paginate_ \&url, $opt->{p}, [$count, 50], 't'; @@ -55,9 +53,8 @@ TUWF::get qr{/experimental/v}, sub { )->data; my $where = sql_and - 'NOT v.hidden', - $opt->{q} ? map sql('v.c_search LIKE', \"%$_%"), normalize_query $opt->{q} : (), - $opt->{f} ? as_tosql(v => $opt->{f}) : (); + 'NOT v.hidden', $opt->{f}->sql_where(), + $opt->{q} ? map sql('v.c_search LIKE', \"%$_%"), normalize_query $opt->{q} : (); my $time = time; my $count = tuwf->dbVali('SELECT count(*) FROM vn v WHERE', $where); @@ -100,7 +97,7 @@ TUWF::get qr{/experimental/v}, sub { br_; form_ action => '/experimental/v', method => 'get', sub { searchbox_ v => $opt->{q}; - as_elm_ v => $opt->{f}; + $opt->{f}->elm_; }; p_ class => 'center', sprintf '%d results in %.3fs', $count, $time; }; |