Add search parsing tests
This commit is contained in:
parent
a0d3f45a9e
commit
0957f6f150
5 changed files with 288 additions and 81 deletions
|
|
@ -84,13 +84,16 @@ color = do
|
|||
'r' -> Red
|
||||
|
||||
rarity :: Parser Rarity
|
||||
rarity = do
|
||||
c <- oneOf "curm"
|
||||
return $ case c of
|
||||
'c' -> Common
|
||||
'u' -> Uncommon
|
||||
'r' -> Rare
|
||||
'm' -> Mythic
|
||||
rarity = choice [
|
||||
rarity' Common "common",
|
||||
rarity' Uncommon "uncommon",
|
||||
rarity' Rare "rare",
|
||||
rarity' Mythic "mythic"
|
||||
]
|
||||
where
|
||||
rarity' :: Rarity -> String -> Parser Rarity
|
||||
rarity' constructor name =
|
||||
choice [try (string name), try (string [head name])] >> return constructor
|
||||
|
||||
colors :: Parser Colors
|
||||
colors =
|
||||
|
|
@ -140,11 +143,11 @@ criterion =
|
|||
choice
|
||||
[ ColorIdentityIs <$> keywords ["c", "color"] ":" colors,
|
||||
ColorIdentityLTE <$> keywords ["c", "color"] "<=" colors,
|
||||
ColorIdentityGTE <$> keywords ["c", "color"] ">" colors,
|
||||
ColorIdentityGTE <$> keywords ["c", "color"] ">=" colors,
|
||||
RarityIs <$> keywords ["r", "rarity"] ":" rarity,
|
||||
RarityLTE <$> keywords ["r", "rarity"] "<=" rarity,
|
||||
RarityGTE <$> keywords ["r", "rarity"] ">" rarity,
|
||||
ExpansionCodeIs <$> keywords ["s", "set"] ":" literal,
|
||||
RarityGTE <$> keywords ["r", "rarity"] ">=" rarity,
|
||||
ExpansionCodeIs <$> keywords ["s", "set", "e", "expansion"] ":" literal,
|
||||
CardTypeContains <$> keywords ["t", "type"] ":" literal,
|
||||
OracleTextContains <$> keywords ["o", "oracle"] ":" literal,
|
||||
NameContains <$> literal
|
||||
|
|
|
|||
71
test/AppSpec.hs
Normal file
71
test/AppSpec.hs
Normal file
|
|
@ -0,0 +1,71 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module AppSpec (spec) where
|
||||
|
||||
import Lib (app)
|
||||
import Test.Hspec
|
||||
import Test.Hspec.Wai
|
||||
import Test.Hspec.Wai.JSON
|
||||
|
||||
main :: IO ()
|
||||
main = hspec spec
|
||||
|
||||
spec :: Spec
|
||||
spec = with (return app) $ do
|
||||
describe "GET /search" $ do
|
||||
it "responds with 200" $ do
|
||||
get "/search" `shouldRespondWith` 200
|
||||
it "responds with [Card]" $ do
|
||||
let cards =
|
||||
[json|[
|
||||
{
|
||||
"scryfall_id": "f6cd7465-9dd0-473c-ac5e-dd9e2f22f5f6",
|
||||
"name": "Esika, God of the Tree // The Prismatic Bridge",
|
||||
"set_code": "KHM",
|
||||
"collector_number": "168",
|
||||
"rarity": "mythic",
|
||||
"color_identity": "WUBGR",
|
||||
"oracle_text": null,
|
||||
"prices": {
|
||||
"usd": "9.07",
|
||||
"usd_foil": "10.77",
|
||||
"eur": "7.79",
|
||||
"eur_foil": "12.27",
|
||||
"tix": "1.08"
|
||||
}
|
||||
},
|
||||
{
|
||||
"scryfall_id": "d761ff73-0717-4ee4-996b-f5547bcf9b2f",
|
||||
"name": "Go-Shintai of Life's Origin",
|
||||
"set_code": "NEC",
|
||||
"collector_number": "66",
|
||||
"rarity": "mythic",
|
||||
"color_identity": "WUBGR",
|
||||
"oracle_text": "{W}{U}{B}{R}{G}, {T}: Return target enchantment card from your graveyard to the battlefield.\nWhenever Go-Shintai of Life's Origin or another nontoken Shrine enters the battlefield under your control, create a 1/1 colorless Shrine enchantment creature token.",
|
||||
"prices": {
|
||||
"usd": "23.28",
|
||||
"usd_foil": null,
|
||||
"eur": "23.05",
|
||||
"eur_foil": null,
|
||||
"tix": null
|
||||
}
|
||||
},
|
||||
{
|
||||
"scryfall_id": "e2539ff7-2b7d-47e3-bd77-3138a6c42d2b",
|
||||
"name": "Godsire",
|
||||
"set_code": "ALA",
|
||||
"collector_number": "170",
|
||||
"rarity": "mythic",
|
||||
"color_identity": "WGR",
|
||||
"oracle_text": "Vigilance\n{T}: Create an 8/8 Beast creature token that's red, green, and white.",
|
||||
"prices": {
|
||||
"usd": "7.22",
|
||||
"usd_foil": "16.56",
|
||||
"eur": "4.00",
|
||||
"eur_foil": "13.95",
|
||||
"tix": "0.02"
|
||||
}
|
||||
}
|
||||
]|]
|
||||
get "/search" `shouldRespondWith` cards
|
||||
200
test/SearchSpec.hs
Normal file
200
test/SearchSpec.hs
Normal file
|
|
@ -0,0 +1,200 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module SearchSpec (spec) where
|
||||
|
||||
import Search (parse)
|
||||
import Data.Text
|
||||
import Test.Hspec
|
||||
|
||||
main :: IO ()
|
||||
main = hspec spec
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "Search parsing" $ do
|
||||
it "matches unquoted text as a name search" $ do
|
||||
parseSearch "foo" `shouldBe` "Right (Search [NameContains \"foo\"])"
|
||||
it "ignores leading and trailing whitespace" $ do
|
||||
parseSearch " foo " `shouldBe` "Right (Search [NameContains \"foo\"])"
|
||||
it "treats separate unquoted words as separate name filters" $ do
|
||||
parseSearch "foo bar" `shouldBe` "Right (Search [NameContains \"foo\",NameContains \"bar\"])"
|
||||
it "treats double-quoted phrases as single name filters" $ do
|
||||
parseSearch "\"foo bar\"" `shouldBe` "Right (Search [NameContains \"foo bar\"])"
|
||||
describe "Single colors" $ do
|
||||
it "handles color:white" $ do
|
||||
parseSearch "color:white" `shouldBe` "Right (Search [ColorIdentityIs {W}])"
|
||||
it "handles color:black" $ do
|
||||
parseSearch "color:black" `shouldBe` "Right (Search [ColorIdentityIs {B}])"
|
||||
it "handles color:blue" $ do
|
||||
parseSearch "color:blue" `shouldBe` "Right (Search [ColorIdentityIs {U}])"
|
||||
it "handles color:green" $ do
|
||||
parseSearch "color:green" `shouldBe` "Right (Search [ColorIdentityIs {G}])"
|
||||
it "handles color:red" $ do
|
||||
parseSearch "color:red" `shouldBe` "Right (Search [ColorIdentityIs {R}])"
|
||||
it "handles c:white" $ do
|
||||
parseSearch "c:white" `shouldBe` "Right (Search [ColorIdentityIs {W}])"
|
||||
it "handles c:black" $ do
|
||||
parseSearch "c:black" `shouldBe` "Right (Search [ColorIdentityIs {B}])"
|
||||
it "handles c:blue" $ do
|
||||
parseSearch "c:blue" `shouldBe` "Right (Search [ColorIdentityIs {U}])"
|
||||
it "handles c:green" $ do
|
||||
parseSearch "c:green" `shouldBe` "Right (Search [ColorIdentityIs {G}])"
|
||||
it "handles c:red" $ do
|
||||
parseSearch "c:red" `shouldBe` "Right (Search [ColorIdentityIs {R}])"
|
||||
describe "Ravnican guilds" $ do
|
||||
it "handles color:boros" $ do
|
||||
parseSearch "color:boros" `shouldBe` "Right (Search [ColorIdentityIs {WR}])"
|
||||
it "handles c:boros" $ do
|
||||
parseSearch "c:boros" `shouldBe` "Right (Search [ColorIdentityIs {WR}])"
|
||||
it "handles color:golgari" $ do
|
||||
parseSearch "color:golgari" `shouldBe` "Right (Search [ColorIdentityIs {BG}])"
|
||||
it "handles c:golgari" $ do
|
||||
parseSearch "c:golgari" `shouldBe` "Right (Search [ColorIdentityIs {BG}])"
|
||||
it "handles color:selesnya" $ do
|
||||
parseSearch "color:selesnya" `shouldBe` "Right (Search [ColorIdentityIs {WG}])"
|
||||
it "handles c:selesnya" $ do
|
||||
parseSearch "c:selesnya" `shouldBe` "Right (Search [ColorIdentityIs {WG}])"
|
||||
it "handles color:dimir" $ do
|
||||
parseSearch "color:dimir" `shouldBe` "Right (Search [ColorIdentityIs {BU}])"
|
||||
it "handles c:dimir" $ do
|
||||
parseSearch "c:dimir" `shouldBe` "Right (Search [ColorIdentityIs {BU}])"
|
||||
it "handles color:orzhov" $ do
|
||||
parseSearch "color:orzhov" `shouldBe` "Right (Search [ColorIdentityIs {WB}])"
|
||||
it "handles c:orzhov" $ do
|
||||
parseSearch "c:orzhov" `shouldBe` "Right (Search [ColorIdentityIs {WB}])"
|
||||
it "handles color:izzet" $ do
|
||||
parseSearch "color:izzet" `shouldBe` "Right (Search [ColorIdentityIs {UR}])"
|
||||
it "handles c:izzet" $ do
|
||||
parseSearch "c:izzet" `shouldBe` "Right (Search [ColorIdentityIs {UR}])"
|
||||
it "handles color:gruul" $ do
|
||||
parseSearch "color:gruul" `shouldBe` "Right (Search [ColorIdentityIs {GR}])"
|
||||
it "handles c:gruul" $ do
|
||||
parseSearch "c:gruul" `shouldBe` "Right (Search [ColorIdentityIs {GR}])"
|
||||
it "handles color:azorius" $ do
|
||||
parseSearch "color:azorius" `shouldBe` "Right (Search [ColorIdentityIs {WU}])"
|
||||
it "handles c:azorius" $ do
|
||||
parseSearch "c:azorius" `shouldBe` "Right (Search [ColorIdentityIs {WU}])"
|
||||
it "handles color:rakdos" $ do
|
||||
parseSearch "color:rakdos" `shouldBe` "Right (Search [ColorIdentityIs {BR}])"
|
||||
it "handles c:rakdos" $ do
|
||||
parseSearch "c:rakdos" `shouldBe` "Right (Search [ColorIdentityIs {BR}])"
|
||||
it "handles color:simic" $ do
|
||||
parseSearch "color:simic" `shouldBe` "Right (Search [ColorIdentityIs {UG}])"
|
||||
it "handles c:simic" $ do
|
||||
parseSearch "c:simic" `shouldBe` "Right (Search [ColorIdentityIs {UG}])"
|
||||
describe "Alaran shards" $ do
|
||||
it "handles color:bant" $ do
|
||||
parseSearch "color:bant" `shouldBe` "Right (Search [ColorIdentityIs {WUG}])"
|
||||
it "handles c:bant" $ do
|
||||
parseSearch "c:bant" `shouldBe` "Right (Search [ColorIdentityIs {WUG}])"
|
||||
it "handles color:esper" $ do
|
||||
parseSearch "color:esper" `shouldBe` "Right (Search [ColorIdentityIs {WBU}])"
|
||||
it "handles c:esper" $ do
|
||||
parseSearch "c:esper" `shouldBe` "Right (Search [ColorIdentityIs {WBU}])"
|
||||
it "handles color:grixis" $ do
|
||||
parseSearch "color:grixis" `shouldBe` "Right (Search [ColorIdentityIs {BUR}])"
|
||||
it "handles c:grixis" $ do
|
||||
parseSearch "c:grixis" `shouldBe` "Right (Search [ColorIdentityIs {BUR}])"
|
||||
it "handles color:jund" $ do
|
||||
parseSearch "color:jund" `shouldBe` "Right (Search [ColorIdentityIs {BGR}])"
|
||||
it "handles c:jund" $ do
|
||||
parseSearch "c:jund" `shouldBe` "Right (Search [ColorIdentityIs {BGR}])"
|
||||
it "handles color:naya" $ do
|
||||
parseSearch "color:naya" `shouldBe` "Right (Search [ColorIdentityIs {WGR}])"
|
||||
it "handles c:naya" $ do
|
||||
parseSearch "c:naya" `shouldBe` "Right (Search [ColorIdentityIs {WGR}])"
|
||||
describe "Tarkirian wedges" $ do
|
||||
it "handles color:abzan" $ do
|
||||
parseSearch "color:abzan" `shouldBe` "Right (Search [ColorIdentityIs {WBG}])"
|
||||
it "handles c:abzan" $ do
|
||||
parseSearch "c:abzan" `shouldBe` "Right (Search [ColorIdentityIs {WBG}])"
|
||||
it "handles color:jeskai" $ do
|
||||
parseSearch "color:jeskai" `shouldBe` "Right (Search [ColorIdentityIs {WUR}])"
|
||||
it "handles c:jeskai" $ do
|
||||
parseSearch "c:jeskai" `shouldBe` "Right (Search [ColorIdentityIs {WUR}])"
|
||||
it "handles color:sultai" $ do
|
||||
parseSearch "color:sultai" `shouldBe` "Right (Search [ColorIdentityIs {BUG}])"
|
||||
it "handles c:sultai" $ do
|
||||
parseSearch "c:sultai" `shouldBe` "Right (Search [ColorIdentityIs {BUG}])"
|
||||
it "handles color:mardu" $ do
|
||||
parseSearch "color:mardu" `shouldBe` "Right (Search [ColorIdentityIs {WBR}])"
|
||||
it "handles c:mardu" $ do
|
||||
parseSearch "c:mardu" `shouldBe` "Right (Search [ColorIdentityIs {WBR}])"
|
||||
it "handles color:temur" $ do
|
||||
parseSearch "color:temur" `shouldBe` "Right (Search [ColorIdentityIs {UGR}])"
|
||||
it "handles c:temur" $ do
|
||||
parseSearch "c:temur" `shouldBe` "Right (Search [ColorIdentityIs {UGR}])"
|
||||
describe "Multicolor" $ do
|
||||
it "handles color:wbugr" $ do
|
||||
parseSearch "color:wbugr" `shouldBe` "Right (Search [ColorIdentityIs {WBUGR}])"
|
||||
it "handles c:wbugr" $ do
|
||||
parseSearch "c:wbugr" `shouldBe` "Right (Search [ColorIdentityIs {WBUGR}])"
|
||||
it "handles a lack of colors" $ do
|
||||
parseSearch "c:" `shouldBe` "Right (Search [ColorIdentityIs {}])"
|
||||
describe "Color ranges" $ do
|
||||
it "handles color<=gr" $ do
|
||||
parseSearch "color<=gr" `shouldBe` "Right (Search [ColorIdentityLTE {GR}])"
|
||||
it "handles c<=gr" $ do
|
||||
parseSearch "c<=gr" `shouldBe` "Right (Search [ColorIdentityLTE {GR}])"
|
||||
it "handles color>=gr" $ do
|
||||
parseSearch "color>=gr" `shouldBe` "Right (Search [ColorIdentityGTE {GR}])"
|
||||
it "handles c>=gr" $ do
|
||||
parseSearch "c>=gr" `shouldBe` "Right (Search [ColorIdentityGTE {GR}])"
|
||||
describe "Rarities" $ do
|
||||
it "handles rarity:common" $ do
|
||||
parseSearch "rarity:common" `shouldBe` "Right (Search [RarityIs Common])"
|
||||
it "handles rarity:c" $ do
|
||||
parseSearch "rarity:c" `shouldBe` "Right (Search [RarityIs Common])"
|
||||
it "handles rarity:uncommon" $ do
|
||||
parseSearch "rarity:uncommon" `shouldBe` "Right (Search [RarityIs Uncommon])"
|
||||
it "handles rarity:u" $ do
|
||||
parseSearch "rarity:u" `shouldBe` "Right (Search [RarityIs Uncommon])"
|
||||
it "handles rarity:rare" $ do
|
||||
parseSearch "rarity:rare" `shouldBe` "Right (Search [RarityIs Rare])"
|
||||
it "handles rarity:r" $ do
|
||||
parseSearch "rarity:r" `shouldBe` "Right (Search [RarityIs Rare])"
|
||||
it "handles rarity:mythic" $ do
|
||||
parseSearch "rarity:mythic" `shouldBe` "Right (Search [RarityIs Mythic])"
|
||||
it "handles rarity:m" $ do
|
||||
parseSearch "rarity:m" `shouldBe` "Right (Search [RarityIs Mythic])"
|
||||
describe "Rarity ranges" $ do
|
||||
it "handles rarity<=rare" $ do
|
||||
parseSearch "rarity<=rare" `shouldBe` "Right (Search [RarityLTE Rare])"
|
||||
it "handles rarity<=r" $ do
|
||||
parseSearch "rarity<=r" `shouldBe` "Right (Search [RarityLTE Rare])"
|
||||
it "handles rarity>=rare" $ do
|
||||
parseSearch "rarity>=rare" `shouldBe` "Right (Search [RarityGTE Rare])"
|
||||
it "handles rarity>=r" $ do
|
||||
parseSearch "rarity>=r" `shouldBe` "Right (Search [RarityGTE Rare])"
|
||||
describe "Expansion codes with unquoted text" $ do
|
||||
it "handles set:roe" $ do
|
||||
parseSearch "set:roe" `shouldBe` "Right (Search [ExpansionCodeIs \"roe\"])"
|
||||
it "handles s:roe" $ do
|
||||
parseSearch "s:roe" `shouldBe` "Right (Search [ExpansionCodeIs \"roe\"])"
|
||||
it "handles expansion:roe" $ do
|
||||
parseSearch "expansion:roe" `shouldBe` "Right (Search [ExpansionCodeIs \"roe\"])"
|
||||
it "handles e:roe" $ do
|
||||
parseSearch "e:roe" `shouldBe` "Right (Search [ExpansionCodeIs \"roe\"])"
|
||||
describe "Card types with unquoted text" $ do
|
||||
it "handles type:legendary" $ do
|
||||
parseSearch "type:legendary" `shouldBe` "Right (Search [CardTypeContains \"legendary\"])"
|
||||
it "handles t:legendary" $ do
|
||||
parseSearch "t:legendary" `shouldBe` "Right (Search [CardTypeContains \"legendary\"])"
|
||||
describe "Card types with double-quoted text" $ do
|
||||
it "handles type:\"legendary creature\"" $ do
|
||||
parseSearch "type:\"legendary creature\"" `shouldBe` "Right (Search [CardTypeContains \"legendary creature\"])"
|
||||
it "handles t:\"legendary creature\"" $ do
|
||||
parseSearch "t:\"legendary creature\"" `shouldBe` "Right (Search [CardTypeContains \"legendary creature\"])"
|
||||
describe "Oracle text with unquoted text" $ do
|
||||
it "handles oracle:destroy" $ do
|
||||
parseSearch "oracle:destroy" `shouldBe` "Right (Search [OracleTextContains \"destroy\"])"
|
||||
it "handles o:destroy" $ do
|
||||
parseSearch "o:destroy" `shouldBe` "Right (Search [OracleTextContains \"destroy\"])"
|
||||
describe "Oracle text with double-quoted text" $ do
|
||||
it "handles oracle:\"destroy creature\"" $ do
|
||||
parseSearch "oracle:\"destroy creature\"" `shouldBe` "Right (Search [OracleTextContains \"destroy creature\"])"
|
||||
it "handles o:\"destroy creature\"" $ do
|
||||