tutor/test/SearchParserSpec.hs

{-# LANGUAGE OverloadedStrings #-}

module SearchParserSpec (spec) where

import Data.Text
import SearchParser (parseQuery)
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 . parseQuery