diff --git a/src/Search.hs b/src/Search.hs index 4d542b3..e410b7a 100644 --- a/src/Search.hs +++ b/src/Search.hs @@ -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 diff --git a/test/AppSpec.hs b/test/AppSpec.hs new file mode 100644 index 0000000..3443e44 --- /dev/null +++ b/test/AppSpec.hs @@ -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 diff --git a/test/SearchSpec.hs b/test/SearchSpec.hs new file mode 100644 index 0000000..f360da0 --- /dev/null +++ b/test/SearchSpec.hs @@ -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 + parseSearch "o:\"destroy creature\"" `shouldBe` "Right (Search [OracleTextContains \"destroy creature\"])" + where + parseSearch :: Text -> Text + parseSearch = pack . show . parse diff --git a/test/Spec.hs b/test/Spec.hs index b48519d..a824f8c 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,71 +1 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} - -module Main (main) 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 +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/tutor.cabal b/tutor.cabal index 5b45dbc..5f6fbda 100644 --- a/tutor.cabal +++ b/tutor.cabal @@ -24,6 +24,7 @@ source-repository head library exposed-modules: Lib + Search other-modules: Paths_tutor hs-source-dirs: @@ -74,6 +75,8 @@ test-suite tutor-test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: + AppSpec + SearchSpec Paths_tutor hs-source-dirs: test