scryfall: add more oracle filtering, fix double-faced cards, shorten code

diff --git a/extra/scryfall/scryfall.factor b/extra/scryfall/scryfall.factor
index 21133f612ab816b94cb157df711c4cd5034829d7..47d401eebeae365705774946b11e9f4ef20404d0 100644 (file)
--- a/extra/scryfall/scryfall.factor
+++ b/extra/scryfall/scryfall.factor
@@ -52,11 +52,11 @@ MEMO: scryfall-rulings-json ( -- json )
     >url path>> "/" ?head drop "/" "-" replace
     scryfall-images-path "" prepend-as ;
 
-: map-card-faces ( assoc quot -- seq )
-    [ "card_faces" of ] dip map ; inline
+: filter-multi-card-faces ( assoc -- seq )
+    [ "card_faces" of length 1 > ] filter ; inline
 
-: filter-card-faces ( assoc quot -- seq )
-    '[ [ "card_faces" of ] [ ] [ 1array ] ?if _ any? ] filter ; inline
+: multi-card-faces? ( assoc -- seq )
+    "card_faces" of length 1 > ; inline
 
 : card>image-uris ( assoc -- seq )
     [ "image_uris" of ]
@@ -247,32 +247,54 @@ MEMO: scryfall-rulings-json ( -- json )
     ] bi@ 2array sift ;
 
 : type-line-of ( assoc -- string ) "type_line" of parse-type-line ;
-: any-type? ( seq name -- ? ) [ type-line-of ] dip >lower '[ first [ >lower ] map _ member-of? ] any? ;
-: any-subtype? ( seq name -- ? ) [ type-line-of ] dip >lower '[ second [ >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? ;
+: any-subtype? ( json name -- ? )
+    [ type-line-of ] dip >lower '[ second [ >lower ] map _ member-of? ] any? ;
+
+: type-intersects? ( json types -- ? )
+    [ type-line-of ] dip [ >lower ] map '[ first [ >lower ] map _ intersects? ] any? ;
+: subtype-intersects? ( json subtypes -- ? )
+    [ type-line-of ] dip [ >lower ] map '[ second [ >lower ] map _ intersects? ] any? ;
 
 : filter-type ( seq text -- seq' ) '[ _ any-type? ] filter ;
 : filter-subtype ( seq text -- seq' ) '[ _ any-subtype? ] filter ;
+: filter-type-intersects ( seq text -- seq' ) '[ _ type-intersects? ] filter ;
+: filter-subtype-intersects ( seq text -- seq' ) '[ _ subtype-intersects? ] filter ;
 
 : filter-basic ( seq -- seq' ) [ "Basic" any-type? ] filter ;
-: filter-basic-subtype ( seq text -- seq' ) [ filter-basic ] dip '[ _ any-subtype? ] filter ;
+: filter-basic-subtype ( seq text -- seq' ) [ filter-basic ] dip filter-subtype ;
 : filter-land ( seq -- seq' ) [ "Land" any-type? ] filter ;
-: filter-land-subtype ( seq text -- seq' ) [ filter-land ] dip '[ _ any-subtype? ] filter ;
+: filter-land-subtype ( seq text -- seq' ) [ filter-land ] dip filter-subtype ;
 : filter-creature ( seq -- seq' ) [ "Creature" any-type? ] filter ;
-: filter-creature-subtype ( seq text -- seq' ) [ filter-creature ] dip '[ _ any-subtype? ] filter ;
+: filter-creature-subtype ( seq text -- seq' ) [ filter-creature ] dip filter-subtype ;
+: filter-emblem ( seq -- seq' ) [ "Emblem" any-type? ] filter ;
+: filter-emblem-subtype ( seq text -- seq' ) [ filter-emblem ] dip filter-subtype ;
 : filter-enchantment ( seq -- seq' ) [ "Enchantment" any-type? ] filter ;
-: filter-enchantment-subtype ( seq text -- seq' ) [ filter-enchantment ] dip '[ _ any-subtype? ] filter ;
+: filter-enchantment-subtype ( seq text -- seq' ) [ filter-enchantment ] dip filter-subtype ;
+: filter-saga ( seq -- seq' ) "saga" filter-enchantment-subtype ;
 : filter-instant ( seq -- seq' ) [ "Instant" any-type? ] filter ;
-: filter-instant-subtype ( seq text -- seq' ) [ filter-instant ] dip '[ _ any-subtype? ] filter ;
+: filter-instant-subtype ( seq text -- seq' ) [ filter-instant ] dip filter-subtype ;
 : filter-sorcery ( seq -- seq' ) [ "Sorcery" any-type? ] filter ;
-: filter-sorcery-subtype ( seq text -- seq' ) [ filter-sorcery ] dip '[ _ any-subtype? ] filter ;
+: filter-sorcery-subtype ( seq text -- seq' ) [ filter-sorcery ] dip filter-subtype ;
 : filter-planeswalker ( seq -- seq' ) [ "Planeswalker" any-type? ] filter ;
-: filter-planeswalker-subtype ( seq text -- seq' ) [ filter-planeswalker ] dip '[ _ any-subtype? ] filter ;
+: filter-planeswalker-subtype ( seq text -- seq' ) [ filter-planeswalker ] dip filter-subtype ;
 : filter-legendary ( seq -- seq' ) [ "Legendary" any-type? ] filter ;
-: filter-legendary-subtype ( seq text -- seq' ) [ filter-land ] dip '[ _ any-subtype? ] filter ;
+: filter-legendary-subtype ( seq text -- seq' ) [ filter-legendary ] dip filter-subtype ;
 : filter-battle ( seq -- seq' ) [ "Battle" any-type? ] filter ;
-: filter-battle-subtype ( seq text -- seq' ) [ filter-land ] dip '[ _ any-subtype? ] filter ;
+: filter-battle-subtype ( seq text -- seq' ) [ filter-battle ] dip filter-subtype ;
 : filter-artifact ( seq -- seq' ) [ "Artifact" any-type? ] filter ;
-: filter-artifact-subtype ( seq text -- seq' ) [ filter-land ] dip '[ _ any-subtype? ] filter ;
+: filter-artifact-subtype ( seq text -- seq' ) [ filter-artifact ] dip filter-subtype ;
+
+: filter-mounts ( seq -- seq' ) "mount" filter-subtype ;
+: filter-vehicles ( seq -- seq' ) "vehicle" filter-subtype ;
+: filter-adventure ( seq -- seq' ) "adventure" filter-subtype ;
+: filter-aura ( seq -- seq' ) "aura" filter-subtype ;
+: filter-aura-subtype ( seq text -- seq' ) [ filter-aura ] dip filter-subtype ;
+: filter-equipment ( seq -- seq' ) "Equipment" filter-subtype ;
+: filter-equipment-subtype ( seq text -- seq' ) [ filter-equipment ] dip filter-subtype ;
 
 : filter-common ( seq -- seq' ) '[ "rarity" of "common" = ] filter ;
 : filter-uncommon ( seq -- seq' ) '[ "rarity" of "uncommon" = ] filter ;
@@ -292,16 +314,107 @@ MEMO: scryfall-rulings-json ( -- json )
 : filter-by-text-prop ( seq string prop -- seq' )
     swap '[ _ of _ subseq-of? ] filter ;
 
-: filter-by-oracle-text ( seq string -- seq' ) "oracle_text" filter-by-text-prop ;
-: filter-by-oracle-itext ( seq string -- seq' ) "oracle_text" filter-by-itext-prop ;
+: map-card-faces ( json quot -- seq )
+    '[ [ "card_faces" of ] [ ] [ 1array ] ?if _ map ] map ; inline
+
+: all-card-types ( seq -- seq' )
+    [ "type_line" of ] map-card-faces
+    concat members sort ;
+
+: filter-card-faces ( json quot -- seq )
+    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-iprop ( seq string prop -- seq' )
+    swap >lower '[ _ of >lower _ subseq-of? ] filter-card-faces ;
+
+: filter-by-flavor-text ( seq string -- seq' )
+    "flavor_text" filter-card-faces-prop ;
+
+: filter-by-flavor-itext ( seq string -- seq' )
+    "flavor_text" filter-card-faces-iprop ;
+
+: filter-by-oracle-text ( seq string -- seq' )
+    "oracle_text" filter-card-faces-prop ;
+
+: filter-by-oracle-itext ( seq string -- seq' )
+    "oracle_text" filter-card-faces-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-flash ( seq -- seq' ) "Flash" filter-by-oracle-text ;
-: filter-cycling ( seq -- seq' ) "Cycling" filter-by-oracle-text ;
-: filter-disguise ( seq -- seq' ) "Disguise" filter-by-oracle-text ;
-: filter-madness ( seq -- seq' ) "Madness" filter-by-oracle-text ;
+: filter-create-treasure ( seq -- seq' ) "create a treasure token" filter-by-oracle-itext ;
+: filter-treasure-token ( seq -- seq' ) "treasure token" filter-by-oracle-itext ;
+: filter-create-blood-token ( seq -- seq' ) "create a blood token" filter-by-oracle-itext ;
+: filter-blood-token ( seq -- seq' ) "blood token" filter-by-oracle-itext ;
+: filter-create-map-token ( seq -- seq' ) "create a map token" filter-by-oracle-itext ;
+: filter-map-token ( seq -- seq' ) "map token" filter-by-oracle-itext ;
+
+: filter-affinity ( seq -- seq' ) "affinity" filter-by-oracle-itext ;
+: filter-backup ( seq -- seq' ) "backup" filter-by-oracle-itext ;
+: filter-blitz ( seq -- seq' ) "blitz" filter-by-oracle-itext ;
+: filter-compleated ( seq -- seq' ) "compleated" filter-by-oracle-itext ;
+: filter-corrupted ( seq -- seq' ) "corrupted" filter-by-oracle-itext ;
+: filter-counter ( seq -- seq' ) "counter" filter-by-oracle-itext ;
+: filter-crew ( seq -- seq' ) "crew" filter-by-oracle-itext ;
+: filter-cycling ( seq -- seq' ) "cycling" filter-by-oracle-itext ;
+: filter-deathtouch ( seq -- seq' ) "deathtouch" filter-by-oracle-itext ;
+: filter-defender ( seq -- seq' ) "defender" filter-by-oracle-itext ;
+: filter-descend ( seq -- seq' ) "descend" filter-by-oracle-itext ;
+: filter-destroy-target ( seq -- seq' ) "destroy target" filter-by-oracle-itext ;
+: filter-discover ( seq -- seq' ) "discover" filter-by-oracle-itext ;
+: filter-disguise ( seq -- seq' ) "disguise" filter-by-oracle-itext ;
+: filter-domain ( seq -- seq' ) "domain" filter-by-oracle-itext ;
+: filter-double-strike ( seq -- seq' ) "double strike" filter-by-oracle-itext ;
+: filter-equip ( seq -- seq' ) "equip" filter-by-oracle-itext ;
+: filter-equip-n ( seq -- seq' ) "equip {" filter-by-oracle-itext ;
+: filter-exile ( seq -- seq' ) "exile" filter-by-oracle-itext ;
+: filter-fights ( seq -- seq' ) "fights" filter-by-oracle-itext ;
+: filter-first-strike ( seq -- seq' ) "first strike" filter-by-oracle-itext ;
+: filter-flash ( seq -- seq' ) "flash" filter-by-oracle-itext ;
+: filter-flying ( seq -- seq' ) "flying" filter-by-oracle-itext ;
+: filter-for-mirrodin ( seq -- seq' ) "for mirrodin!" filter-by-oracle-itext ;
+: filter-graveyard ( seq -- seq' ) "graveyard" filter-by-oracle-itext ;
+: filter-haste ( seq -- seq' ) "haste" filter-by-oracle-itext ;
+: filter-hideaway ( seq -- seq' ) "hideaway" filter-by-oracle-itext ;
+: filter-hexproof ( seq -- seq' ) "hexproof" filter-by-oracle-itext ;
+: filter-indestructible ( seq -- seq' ) "indestructible" filter-by-oracle-itext ;
+: filter-investigate ( seq -- seq' ) "investigate" filter-by-oracle-itext ;
+: filter-lifelink ( seq -- seq' ) "lifelink" filter-by-oracle-itext ;
+: filter-madness ( seq -- seq' ) "madness" filter-by-oracle-itext ;
+: filter-menace ( seq -- seq' ) "menace" filter-by-oracle-itext ;
+: filter-mill ( seq -- seq' ) "mill" filter-by-oracle-itext ;
+: filter-ninjutsu ( seq -- seq' ) "ninjutsu" filter-by-oracle-itext ;
+: filter-proliferate ( seq -- seq' ) "proliferate" filter-by-oracle-itext ;
+: filter-protection ( seq -- seq' ) "protection" filter-by-oracle-itext ;
+: filter-prowess ( seq -- seq' ) "prowess" filter-by-oracle-itext ;
+: filter-reach ( seq -- seq' ) "reach" filter-by-oracle-itext ;
+: filter-read-ahead ( seq -- seq' ) "read ahead" filter-by-oracle-itext ;
+: filter-reconfigure ( seq -- seq' ) "reconfigure" filter-by-oracle-itext ;
+: filter-role ( seq -- seq' ) "role" filter-by-oracle-itext ;
+: filter-sacrifice ( seq -- seq' ) "sacrifice" filter-by-oracle-itext ;
+: filter-scry ( seq -- seq' ) "scry" filter-by-oracle-itext ;
+: filter-shroud ( seq -- seq' ) "shroud" filter-by-oracle-itext ;
+: filter-token ( seq -- seq' ) "token" filter-by-oracle-itext ;
+: filter-toxic ( seq -- seq' ) "toxic" filter-by-oracle-itext ;
+: filter-trample ( seq -- seq' ) "trample" filter-by-oracle-itext ;
+: filter-vehicle ( seq -- seq' ) "vehicle" filter-by-oracle-itext ;
+: filter-vigilance ( seq -- seq' ) "vigilance" filter-by-oracle-itext ;
+: filter-ward ( seq -- seq' ) "ward" filter-by-oracle-itext ;
+
+: filter-day ( seq -- seq' ) "day" filter-by-oracle-itext ;
+: filter-night ( seq -- seq' ) "night" filter-by-oracle-itext ;
+: filter-daybound ( seq -- seq' ) "daybound" filter-by-oracle-itext ;
+: filter-nightbound ( seq -- seq' ) "nightbound" filter-by-oracle-itext ;
+
+: filter-mount ( seq -- seq' ) "mount" filter-by-oracle-itext ;
+: filter-outlaw ( seq -- seq' )
+    { "Assassin" "Mercenary" "Pirate" "Rogue" "Warlock" } filter-subtype-intersects ;
+: filter-plot ( seq -- seq' ) "plot" filter-by-oracle-itext ;
+: filter-saddle ( seq -- seq' ) "saddle" filter-by-oracle-itext ;
+: filter-spree ( seq -- seq' ) "saddle" filter-by-oracle-itext ;
 
 : power>n ( string -- n/f )
     [ "*" = ] [ drop -1 ] [ string>number ] ?if ;
@@ -354,7 +467,7 @@ MEMO: scryfall-rulings-json ( -- json )
 : card-face-summary. ( json seq -- )
     {
         [ nip "name" of write bl ]
-        [ nip "mana_cost" of ?write ]
+        [ nip "mana_cost" of ?print ]
         [ nip "type_line" of ?write ]
         [ drop bl "--" write bl "rarity" of >title ?print ]
         [ nip [ "power" of ] [ "toughness" of ] bi 2dup and [ "/" glue print ] [ 2drop ] if ]
@@ -412,26 +525,26 @@ MEMO: mtg-sets-by-name ( -- assoc )
 : cards-by-set-abbrev ( -- assoc ) mtg-oracle-cards collect-cards-by-set-abbrev ;
 : cards-by-set-name ( -- assoc ) mtg-oracle-cards collect-cards-by-set-name ;
 
-: mid-cards ( -- seq ) mtg-oracle-cards [ "set" of "mid" = ] filter ;
-: vow-cards ( -- seq ) mtg-oracle-cards [ "set" of "vow" = ] filter ;
-: neo-cards ( -- seq ) mtg-oracle-cards [ "set" of "neo" = ] filter ;
-: snc-cards ( -- seq ) mtg-oracle-cards [ "set" of "snc" = ] filter ;
-
-: dmu-cards ( -- seq ) mtg-oracle-cards [ "set" of "dmu" = ] filter ;
-: bro-cards ( -- seq ) mtg-oracle-cards [ "set" of "bro" = ] filter ;
-: one-cards ( -- seq ) mtg-oracle-cards [ "set" of "one" = ] filter ;
-: mom-cards ( -- seq ) mtg-oracle-cards [ "set" of "mom" = ] filter ;
-: mat-cards ( -- seq ) mtg-oracle-cards [ "set" of "mat" = ] filter ;
-
-: woe-cards ( -- seq ) mtg-oracle-cards [ "set" of "woe" = ] filter ;
-: woe-cards-bonus ( -- seq ) mtg-oracle-cards [ "set" of "wot" = ] filter ;
-: woe-cards-all ( -- seq ) mtg-oracle-cards [ "set" of { "woe" "wot" } member? ] filter ;
-
-: lci-cards ( -- seq ) mtg-oracle-cards [ "set" of "lci" = ] filter ;
-: mkm-cards ( -- seq ) mtg-oracle-cards [ "set" of "mkm" = ] filter ;
-: otj-cards ( -- seq ) mtg-oracle-cards [ "set" of "otj" = ] filter ;
-: otj-cards-bonus ( -- seq ) mtg-oracle-cards [ "set" of "big" = ] filter ;
-: otj-cards-all ( -- seq ) mtg-oracle-cards [ "set" of { "otj" "big" } member? ] filter ;
+: filter-set ( seq abbrev -- seq ) >lower '[ "set" of _ = ] filter ;
+: filter-set-intersect ( seq abbrevs -- seq ) [ >lower ] map '[ "set" of _ member? ] filter ;
+
+: mid-cards ( -- seq ) mtg-oracle-cards "mid" filter-set ;
+: vow-cards ( -- seq ) mtg-oracle-cards "vow" filter-set ;
+: neo-cards ( -- seq ) mtg-oracle-cards "neo" filter-set ;
+: snc-cards ( -- seq ) mtg-oracle-cards "snc" filter-set ;
+: dmu-cards ( -- seq ) mtg-oracle-cards "dmu" filter-set ;
+: bro-cards ( -- seq ) mtg-oracle-cards "bro" filter-set ;
+: one-cards ( -- seq ) mtg-oracle-cards "one" filter-set ;
+: mom-cards ( -- seq ) mtg-oracle-cards "mom" filter-set ;
+: mat-cards ( -- seq ) mtg-oracle-cards "mat" filter-set ;
+: woe-cards ( -- seq ) mtg-oracle-cards "woe" filter-set ;
+: woe-cards-bonus ( -- seq ) mtg-oracle-cards [ "set" of "wot" = ] filter-set ;
+: woe-cards-all ( -- seq ) mtg-oracle-cards { "woe" "wot" } filter-set-intersect ;
+: lci-cards ( -- seq ) mtg-oracle-cards "lci" filter-set ;
+: mkm-cards ( -- seq ) mtg-oracle-cards "mkm" filter-set ;
+: otj-cards ( -- seq ) mtg-oracle-cards "otj" filter-set ;
+: otj-cards-bonus ( -- seq ) mtg-oracle-cards "big" filter-set ;
+: otj-cards-all ( -- seq ) mtg-oracle-cards { "otj" "big" } filter-set-intersect ;
 
 : sort-by-colors ( seq -- seq' )
     {
@@ -439,12 +552,11 @@ MEMO: mtg-sets-by-name ( -- assoc )
         { [ "color_identity" of sort ?first "A" or ] <=> }
         { [ "cmc" of ] <=> }
         { [ "mana_cost" of length ] <=> }
-        { [ "Creature" any-type? -1 1 ? ] <=> }
+        { [ "creature" any-type? -1 1 ? ] <=> }
         { [ "power" of -1 1 ? ] <=> }
         { [ "toughness" of -1 1 ? ] <=> }
         { [ "name" of ] <=> }
-    }
-    sort-with-spec ;
+    } sort-with-spec ;
 
 : cards-by-color. ( seq -- ) sort-by-colors normal-cards. ;
 
@@ -473,7 +585,26 @@ CONSTANT: rarity-to-number H{
         { [ "set" of ] <=> }
     } sort-with-spec ;
 
-: cards-by-name. ( seq name -- ) filter-by-name-itext sort-by-release normal-cards. ;
+: cards-by-release. ( seq -- ) sort-by-release normal-cards. ;
+
+: sort-by-set-colors ( seq -- seq' )
+    {
+        { [ "released_at" of ymd>timestamp ] <=> }
+        { [ "set" of ] <=> }
+        { [ "color_identity" of length ] <=> }
+        { [ "color_identity" of sort ?first "A" or ] <=> }
+        { [ "cmc" of ] <=> }
+        { [ "mana_cost" of length ] <=> }
+        { [ "creature" any-type? -1 1 ? ] <=> }
+        { [ "power" of -1 1 ? ] <=> }
+        { [ "toughness" of -1 1 ? ] <=> }
+        { [ "name" of ] <=> }
+    } sort-with-spec ;
+
+: cards-by-set-colors. ( seq -- ) sort-by-set-colors 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. ;
 
 : filter-mtg-cheat-sheet ( seq -- seq' )
     [