scryfall: add more filter/reject words, better mtga parser

diff --git a/extra/scryfall/scryfall.factor b/extra/scryfall/scryfall.factor
index b877532c5363a163e2de017b0a2a57b3d1e74436..72a152e2fe4965845fb4f103c3b1b30906385d34 100644 (file)
--- a/extra/scryfall/scryfall.factor
+++ b/extra/scryfall/scryfall.factor
@@ -5,9 +5,9 @@ calendar.parser combinators combinators.short-circuit
 combinators.smart grouping http.download images.loader
 images.viewer io io.directories json json.http kernel math
 math.combinatorics math.order math.parser math.statistics
 combinators.smart grouping http.download images.loader
 images.viewer io io.directories json json.http kernel math
 math.combinatorics math.order math.parser math.statistics

-namespaces sequences sequences.deep sequences.extras sets
-sorting sorting.specification splitting strings ui.gadgets.panes
-unicode urls ;
+namespaces sequences sequences.deep sequences.extras
+sequences.generalizations sets sorting sorting.specification
+splitting splitting.extras strings ui.gadgets.panes unicode urls ;

 IN: scryfall
 
 CONSTANT: scryfall-oracle-json-path "resource:scryfall-oracle-json"
 IN: scryfall
 
 CONSTANT: scryfall-oracle-json-path "resource:scryfall-oracle-json"


@@ -253,6 +253,9 @@ MEMO: scryfall-rulings-json ( -- json )
 
 : type-line-of ( assoc -- string ) "type_line" of parse-type-line ;
 
 
 : type-line-of ( assoc -- string ) "type_line" of parse-type-line ;
 

+: types-of ( assoc -- seq ) type-line-of [ first ] map concat ;
+: subtypes-of ( assoc -- seq ) type-line-of [ second ] map concat ;
+

 ! cards can have several type lines (one for each face)
 : any-type? ( json name -- ? )
     [ type-line-of ] dip >lower '[ first [ >lower ] map _ member-of? ] any? ;
 ! cards can have several type lines (one for each face)
 : any-type? ( json name -- ? )
     [ type-line-of ] dip >lower '[ first [ >lower ] map _ member-of? ] any? ;


@@ -293,6 +296,18 @@ MEMO: scryfall-rulings-json ( -- json )
 : filter-artifact ( seq -- seq' ) [ "Artifact" any-type? ] filter ;
 : filter-artifact-subtype ( seq text -- seq' ) [ filter-artifact ] dip filter-subtype ;
 
 : filter-artifact ( seq -- seq' ) [ "Artifact" any-type? ] filter ;
 : filter-artifact-subtype ( seq text -- seq' ) [ filter-artifact ] dip filter-subtype ;
 

+: reject-basic ( seq -- seq' ) [ "Basic" any-type? ] reject ;
+: reject-land ( seq -- seq' ) [ "Land" any-type? ] reject ;
+: reject-creature ( seq -- seq' ) [ "Creature" any-type? ] reject ;
+: reject-emblem ( seq -- seq' ) [ "Emblem" any-type? ] reject ;
+: reject-enchantment ( seq -- seq' ) [ "Enchantment" any-type? ] reject ;
+: reject-instant ( seq -- seq' ) [ "Instant" any-type? ] reject ;
+: reject-sorcery ( seq -- seq' ) [ "Sorcery" any-type? ] reject ;
+: reject-planeswalker ( seq -- seq' ) [ "Planeswalker" any-type? ] reject ;
+: reject-legendary ( seq -- seq' ) [ "Legendary" any-type? ] reject ;
+: reject-battle ( seq -- seq' ) [ "Battle" any-type? ] reject ;
+: reject-artifact ( seq -- seq' ) [ "Artifact" any-type? ] reject ;
+

 : filter-mounts ( seq -- seq' ) "mount" filter-subtype ;
 : filter-vehicles ( seq -- seq' ) "vehicle" filter-subtype ;
 : filter-adventure ( seq -- seq' ) "adventure" filter-subtype ;
 : filter-mounts ( seq -- seq' ) "mount" filter-subtype ;
 : filter-vehicles ( seq -- seq' ) "vehicle" filter-subtype ;
 : filter-adventure ( seq -- seq' ) "adventure" filter-subtype ;


@@ -326,26 +341,38 @@ MEMO: scryfall-rulings-json ( -- json )
     [ "type_line" of ] map-card-faces
     concat members sort ;
 
     [ "type_line" of ] map-card-faces
     concat members sort ;
 

-: filter-card-faces ( json quot -- seq )
+: card>faces ( assoc -- seq )
+    [ "card_faces" of ] [ ] [ 1array ] ?if ;
+
+: filter-card-faces-sub-card ( seq quot -- seq )
+    [ [ card>faces ] map concat ] dip filter ; inline
+
+: filter-card-faces-sub-card-prop ( seq string prop -- seq' )
+    swap '[ _ of _ subseq-of? ] filter-card-faces-sub-card ;
+
+: filter-card-faces-sub-card-iprop ( seq string prop -- seq' )
+    swap >lower '[ _ of >lower _ subseq-of? ] filter-card-faces-sub-card ;
+
+: filter-card-faces-main-card ( seq quot -- seq )

     dup '[ [ "card_faces" of ] [ _ any? ] _ ?if ] filter ; inline
 
     dup '[ [ "card_faces" of ] [ _ any? ] _ ?if ] filter ; inline
 

-: filter-card-faces-prop ( seq string prop -- seq' )
-    swap '[ _ of _ subseq-of? ] filter-card-faces ;
+: filter-card-faces-main-card-prop ( seq string prop -- seq' )
+    swap '[ _ of _ subseq-of? ] filter-card-faces-main-card ;

 
 

-: filter-card-faces-iprop ( seq string prop -- seq' )
-    swap >lower '[ _ of >lower _ subseq-of? ] filter-card-faces ;
+: filter-card-faces-main-card-iprop ( seq string prop -- seq' )
+    swap >lower '[ _ of >lower _ subseq-of? ] filter-card-faces-main-card ;

 
 : filter-by-flavor-text ( seq string -- seq' )
 
 : filter-by-flavor-text ( seq string -- seq' )

-    "flavor_text" filter-card-faces-prop ;
+    "flavor_text" filter-card-faces-main-card-prop ;

 
 : filter-by-flavor-itext ( seq string -- seq' )
 
 : filter-by-flavor-itext ( seq string -- seq' )

-    "flavor_text" filter-card-faces-iprop ;
+    "flavor_text" filter-card-faces-main-card-iprop ;

 
 : filter-by-oracle-text ( seq string -- seq' )
 
 : filter-by-oracle-text ( seq string -- seq' )

-    "oracle_text" filter-card-faces-prop ;
+    "oracle_text" filter-card-faces-main-card-prop ;

 
 : filter-by-oracle-itext ( seq string -- seq' )
 
 : filter-by-oracle-itext ( seq string -- seq' )

-    "oracle_text" filter-card-faces-iprop ;
+    "oracle_text" filter-card-faces-main-card-iprop ;

 
 : filter-by-name-text ( seq string -- seq' ) "name" filter-by-text-prop ;
 : filter-by-name-itext ( seq string -- seq' ) "name" filter-by-itext-prop ;
 
 : filter-by-name-text ( seq string -- seq' ) "name" filter-by-text-prop ;
 : filter-by-name-itext ( seq string -- seq' ) "name" filter-by-itext-prop ;


@@ -414,6 +441,9 @@ MEMO: scryfall-rulings-json ( -- json )
 : filter-daybound ( seq -- seq' ) "daybound" filter-by-oracle-itext ;
 : filter-nightbound ( seq -- seq' ) "nightbound" filter-by-oracle-itext ;
 
 : filter-daybound ( seq -- seq' ) "daybound" filter-by-oracle-itext ;
 : filter-nightbound ( seq -- seq' ) "nightbound" filter-by-oracle-itext ;
 

+: filter-cave ( seq -- seq' ) "cave" filter-land-subtype ;
+: filter-sphere ( seq -- seq' ) "sphere" filter-land-subtype ;
+

 : filter-mount ( seq -- seq' ) "mount" filter-by-oracle-itext ;
 : filter-outlaw ( seq -- seq' )
     { "Assassin" "Mercenary" "Pirate" "Rogue" "Warlock" } filter-subtype-intersects ;
 : filter-mount ( seq -- seq' ) "mount" filter-by-oracle-itext ;
 : filter-outlaw ( seq -- seq' )
     { "Assassin" "Mercenary" "Pirate" "Rogue" "Warlock" } filter-subtype-intersects ;


@@ -430,20 +460,20 @@ MEMO: scryfall-rulings-json ( -- json )
 : mtg>= ( string/n/f n -- seq' ) [ power>n ] dip { [ and ] [ >= ] } 2&& ;
 : mtg=  ( string/n/f n -- seq' ) [ power>n ] dip { [ and ] [ = ] } 2&& ;
 
 : mtg>= ( string/n/f n -- seq' ) [ power>n ] dip { [ and ] [ >= ] } 2&& ;
 : mtg=  ( string/n/f n -- seq' ) [ power>n ] dip { [ and ] [ = ] } 2&& ;
 

-: filter-power=* ( seq -- seq' ) [ "power" of "*" = ] filter-card-faces ;
-: filter-toughness=* ( seq -- seq' ) [ "toughness" of "*" = ] filter-card-faces ;
+: filter-power=* ( seq -- seq' ) [ "power" of "*" = ] filter-card-faces-main-card ;
+: filter-toughness=* ( seq -- seq' ) [ "toughness" of "*" = ] filter-card-faces-main-card ;

 
 

-: filter-power= ( seq n -- seq' ) '[ "power" of _ mtg= ] filter-card-faces ;
-: filter-power< ( seq n -- seq' ) '[ "power" of _ mtg< ] filter-card-faces ;
-: filter-power> ( seq n -- seq' ) '[ "power" of _ mtg> ] filter-card-faces ;
-: filter-power<= ( seq n -- seq' ) '[ "power" of _ mtg<= ] filter-card-faces ;
-: filter-power>= ( seq n -- seq' ) '[ "power" of _ mtg>= ] filter-card-faces ;
+: filter-power= ( seq n -- seq' ) '[ "power" of _ mtg= ] filter-card-faces-main-card ;
+: filter-power< ( seq n -- seq' ) '[ "power" of _ mtg< ] filter-card-faces-main-card ;
+: filter-power> ( seq n -- seq' ) '[ "power" of _ mtg> ] filter-card-faces-main-card ;
+: filter-power<= ( seq n -- seq' ) '[ "power" of _ mtg<= ] filter-card-faces-main-card ;
+: filter-power>= ( seq n -- seq' ) '[ "power" of _ mtg>= ] filter-card-faces-main-card ;

 
 

-: filter-toughness= ( seq n -- seq' ) '[ "toughness" of _ mtg= ] filter-card-faces ;
-: filter-toughness< ( seq n -- seq' ) '[ "toughness" of _ mtg< ] filter-card-faces ;
-: filter-toughness> ( seq n -- seq' ) '[ "toughness" of _ mtg> ] filter-card-faces ;
-: filter-toughness<= ( seq n -- seq' ) '[ "toughness" of _ mtg<= ] filter-card-faces ;
-: filter-toughness>= ( seq n -- seq' ) '[ "toughness" of _ mtg>= ] filter-card-faces ;
+: filter-toughness= ( seq n -- seq' ) '[ "toughness" of _ mtg= ] filter-card-faces-main-card ;
+: filter-toughness< ( seq n -- seq' ) '[ "toughness" of _ mtg< ] filter-card-faces-main-card ;
+: filter-toughness> ( seq n -- seq' ) '[ "toughness" of _ mtg> ] filter-card-faces-main-card ;
+: filter-toughness<= ( seq n -- seq' ) '[ "toughness" of _ mtg<= ] filter-card-faces-main-card ;
+: filter-toughness>= ( seq n -- seq' ) '[ "toughness" of _ mtg>= ] filter-card-faces-main-card ;

 
 : map-props ( seq props -- seq' ) '[ _ intersect-keys ] map ;
 
 
 : map-props ( seq props -- seq' ) '[ _ intersect-keys ] map ;
 


@@ -611,27 +641,59 @@ CONSTANT: rarity-to-number H{
 : cards-by-name ( seq name -- seq' ) filter-by-name-itext sort-by-release ;
 : cards-by-name. ( seq name -- ) cards-by-name [ "name" of ] sort-by normal-cards. ;
 
 : cards-by-name ( seq name -- seq' ) filter-by-name-itext sort-by-release ;
 : cards-by-name. ( seq name -- ) cards-by-name [ "name" of ] sort-by normal-cards. ;
 

-: parse-cards ( strings -- seq )
-    [
-        [ blank? ] trim
-        " " split1
-        [ string>number ]
-        [ standard-cards swap cards-by-name first ] bi* <array>
-    ] map concat ;
+: paren-set? ( string -- ? )
+    { [ "(" head? ] [ ")" tail? ] [ length 5 = ] } 1&& ;

 
 

-: parse-mtga-deck ( string -- deck sideboard )
+: remove-set-and-num ( string -- string' )
+    " " split
+    dup 2 ?lastn
+    [ paren-set? ] [ string>number ] bi* and [
+        2 head*
+    ] when " " join ;
+
+: parse-mtga-card-line ( string -- array )

     [ blank? ] trim
     [ blank? ] trim

-    "Deck" ?head drop
-    string-lines
-    "Sideboard" split1
-    [ parse-cards ] bi@ ;
+    " " split1
+    [ string>number ]
+    [
+        remove-set-and-num
+        standard-cards swap cards-by-name first
+    ] bi* <array> ;
+
+: parse-standard-cards ( strings -- seq )
+    [ parse-mtga-card-line ] map concat ;
+
+TUPLE: mtga-deck about deck sideboard section ;
+
+: <mtga-deck> ( -- mtga-deck )
+    mtga-deck new "Deck" >>section ;
+
+ERROR: unknown-mtga-deck-section section ;
+: parse-mtga-standard-deck ( string -- mtga-deck )
+    string-lines [ [ blank? ] trim ] map harvest
+    { "About" "Deck" "Sideboard" } split*
+    [ <mtga-deck> ] dip
+    [
+        dup { "About" "Deck" "Sideboard" } intersects? [
+            first >>section
+        ] [
+            over section>> {
+                { "About" [ >>about ] }
+                { "Deck" [ parse-standard-cards >>deck ] }
+                { "Sideboard" [ parse-standard-cards >>sideboard ] }
+                [ unknown-mtga-deck-section ]
+            } case
+        ] if
+    ] each ;

 
 : sort-by-deck-order ( seq -- seq' )
     [ "Land" any-type? not ] partition
     [ sort-by-set-colors ] bi@ append ;
 
 
 : sort-by-deck-order ( seq -- seq' )
     [ "Land" any-type? not ] partition
     [ sort-by-set-colors ] bi@ append ;
 

-: deck. ( seq -- )
-    sort-by-deck-order normal-cards. ;
+: mtga-deck. ( mtga-deck -- )
+    [ about>> print ]
+    [ deck>> "Deck" print sort-by-deck-order normal-cards. ]
+    [ sideboard>> "Sideboard" print sort-by-deck-order normal-cards. ] tri ;

 
 : filter-mtg-cheat-sheet ( seq -- seq' )
     [
 
 : filter-mtg-cheat-sheet ( seq -- seq' )
     [