diff --git a/src/Search.hs b/src/Search.hs index 2f4517b..2374fd9 100644 --- a/src/Search.hs +++ b/src/Search.hs @@ -4,7 +4,7 @@ import qualified Data.Char as C import qualified Data.Set as Set import qualified Data.Text as T -newtype Search = Search [Criteria] deriving (Show) +newtype Search = Search [Criteria] deriving (Eq, Show) data Criteria = NameContains T.Text @@ -17,7 +17,7 @@ data Criteria | RarityIs Rarity | RarityGTE Rarity | RarityLTE Rarity - deriving (Show) + deriving (Eq, Show) data Color = Colorless @@ -37,6 +37,7 @@ instance Show Color where newtype Colors = Colors (Set.Set Color) + deriving (Eq) instance Show Colors where show (Colors xs) = @@ -48,6 +49,9 @@ instance Show Colors where "}" ] +toColors :: [Color] -> Colors +toColors = Colors . Set.fromList + data Rarity = Common | Uncommon diff --git a/test/SearchParserSpec.hs b/test/SearchParserSpec.hs index 7d8b72c..02bbc15 100644 --- a/test/SearchParserSpec.hs +++ b/test/SearchParserSpec.hs @@ -3,9 +3,10 @@ module SearchParserSpec (spec) where import Data.Text +import Search import SearchParser (parseQuery) import Test.Hspec - +import qualified Text.Parsec.Error main :: IO () main = hspec spec @@ -13,188 +14,188 @@ spec :: Spec spec = do describe "Search parsing" $ do it "matches unquoted text as a name search" $ do - parseSearch "foo" `shouldBe` "Right (Search [NameContains \"foo\"])" + parseSearch "foo" `shouldBe` Right (Search [NameContains "foo"]) it "ignores leading and trailing whitespace" $ do - parseSearch " foo " `shouldBe` "Right (Search [NameContains \"foo\"])" + 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\"])" + 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\"])" + 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}])" + parseSearch "color:white" `shouldBe` Right (Search [ColorIdentityIs (toColors [White])]) it "handles color:black" $ do - parseSearch "color:black" `shouldBe` "Right (Search [ColorIdentityIs {B}])" + parseSearch "color:black" `shouldBe` Right (Search [ColorIdentityIs (toColors [Black])]) it "handles color:blue" $ do - parseSearch "color:blue" `shouldBe` "Right (Search [ColorIdentityIs {U}])" + parseSearch "color:blue" `shouldBe` Right (Search [ColorIdentityIs (toColors [Blue])]) it "handles color:green" $ do - parseSearch "color:green" `shouldBe` "Right (Search [ColorIdentityIs {G}])" + parseSearch "color:green" `shouldBe` Right (Search [ColorIdentityIs (toColors [Green])]) it "handles color:red" $ do - parseSearch "color:red" `shouldBe` "Right (Search [ColorIdentityIs {R}])" + parseSearch "color:red" `shouldBe` Right (Search [ColorIdentityIs (toColors [Red])]) it "handles c:white" $ do - parseSearch "c:white" `shouldBe` "Right (Search [ColorIdentityIs {W}])" + parseSearch "c:white" `shouldBe` Right (Search [ColorIdentityIs (toColors [White])]) it "handles c:black" $ do - parseSearch "c:black" `shouldBe` "Right (Search [ColorIdentityIs {B}])" + parseSearch "c:black" `shouldBe` Right (Search [ColorIdentityIs (toColors [Black])]) it "handles c:blue" $ do - parseSearch "c:blue" `shouldBe` "Right (Search [ColorIdentityIs {U}])" + parseSearch "c:blue" `shouldBe` Right (Search [ColorIdentityIs (toColors [Blue])]) it "handles c:green" $ do - parseSearch "c:green" `shouldBe` "Right (Search [ColorIdentityIs {G}])" + parseSearch "c:green" `shouldBe` Right (Search [ColorIdentityIs (toColors [Green])]) it "handles c:red" $ do - parseSearch "c:red" `shouldBe` "Right (Search [ColorIdentityIs {R}])" + parseSearch "c:red" `shouldBe` Right (Search [ColorIdentityIs (toColors [Red])]) describe "Ravnican guilds" $ do it "handles color:boros" $ do - parseSearch "color:boros" `shouldBe` "Right (Search [ColorIdentityIs {WR}])" + parseSearch "color:boros" `shouldBe` Right (Search [ColorIdentityIs (toColors [White, Red])]) it "handles c:boros" $ do - parseSearch "c:boros" `shouldBe` "Right (Search [ColorIdentityIs {WR}])" + parseSearch "c:boros" `shouldBe` Right (Search [ColorIdentityIs (toColors [White, Red])]) it "handles color:golgari" $ do - parseSearch "color:golgari" `shouldBe` "Right (Search [ColorIdentityIs {BG}])" + parseSearch "color:golgari" `shouldBe` Right (Search [ColorIdentityIs (toColors [Black, Green])]) it "handles c:golgari" $ do - parseSearch "c:golgari" `shouldBe` "Right (Search [ColorIdentityIs {BG}])" + parseSearch "c:golgari" `shouldBe` Right (Search [ColorIdentityIs (toColors [Black, Green])]) it "handles color:selesnya" $ do - parseSearch "color:selesnya" `shouldBe` "Right (Search [ColorIdentityIs {WG}])" + parseSearch "color:selesnya" `shouldBe` Right (Search [ColorIdentityIs (toColors [White, Green])]) it "handles c:selesnya" $ do - parseSearch "c:selesnya" `shouldBe` "Right (Search [ColorIdentityIs {WG}])" + parseSearch "c:selesnya" `shouldBe` Right (Search [ColorIdentityIs (toColors [White, Green])]) it "handles color:dimir" $ do - parseSearch "color:dimir" `shouldBe` "Right (Search [ColorIdentityIs {BU}])" + parseSearch "color:dimir" `shouldBe` Right (Search [ColorIdentityIs (toColors [Black, Blue])]) it "handles c:dimir" $ do - parseSearch "c:dimir" `shouldBe` "Right (Search [ColorIdentityIs {BU}])" + parseSearch "c:dimir" `shouldBe` Right (Search [ColorIdentityIs (toColors [Black, Blue])]) it "handles color:orzhov" $ do - parseSearch "color:orzhov" `shouldBe` "Right (Search [ColorIdentityIs {WB}])" + parseSearch "color:orzhov" `shouldBe` Right (Search [ColorIdentityIs (toColors [White, Black])]) it "handles c:orzhov" $ do - parseSearch "c:orzhov" `shouldBe` "Right (Search [ColorIdentityIs {WB}])" + parseSearch "c:orzhov" `shouldBe` Right (Search [ColorIdentityIs (toColors [White, Black])]) it "handles color:izzet" $ do - parseSearch "color:izzet" `shouldBe` "Right (Search [ColorIdentityIs {UR}])" + parseSearch "color:izzet" `shouldBe` Right (Search [ColorIdentityIs (toColors [Blue, Red])]) it "handles c:izzet" $ do - parseSearch "c:izzet" `shouldBe` "Right (Search [ColorIdentityIs {UR}])" + parseSearch "c:izzet" `shouldBe` Right (Search [ColorIdentityIs (toColors [Blue, Red])]) it "handles color:gruul" $ do - parseSearch "color:gruul" `shouldBe` "Right (Search [ColorIdentityIs {GR}])" + parseSearch "color:gruul" `shouldBe` Right (Search [ColorIdentityIs (toColors [Green, Red])]) it "handles c:gruul" $ do - parseSearch "c:gruul" `shouldBe` "Right (Search [ColorIdentityIs {GR}])" + parseSearch "c:gruul" `shouldBe` Right (Search [ColorIdentityIs (toColors [Green, Red])]) it "handles color:azorius" $ do - parseSearch "color:azorius" `shouldBe` "Right (Search [ColorIdentityIs {WU}])" + parseSearch "color:azorius" `shouldBe` Right (Search [ColorIdentityIs (toColors [White, Blue])]) it "handles c:azorius" $ do - parseSearch "c:azorius" `shouldBe` "Right (Search [ColorIdentityIs {WU}])" + parseSearch "c:azorius" `shouldBe` Right (Search [ColorIdentityIs (toColors [White, Blue])]) it "handles color:rakdos" $ do - parseSearch "color:rakdos" `shouldBe` "Right (Search [ColorIdentityIs {BR}])" + parseSearch "color:rakdos" `shouldBe` Right (Search [ColorIdentityIs (toColors [Black, Red])]) it "handles c:rakdos" $ do - parseSearch "c:rakdos" `shouldBe` "Right (Search [ColorIdentityIs {BR}])" + parseSearch "c:rakdos" `shouldBe` Right (Search [ColorIdentityIs (toColors [Black, Red])]) it "handles color:simic" $ do - parseSearch "color:simic" `shouldBe` "Right (Search [ColorIdentityIs {UG}])" + parseSearch "color:simic" `shouldBe` Right (Search [ColorIdentityIs (toColors [Blue, Green])]) it "handles c:simic" $ do - parseSearch "c:simic" `shouldBe` "Right (Search [ColorIdentityIs {UG}])" + parseSearch "c:simic" `shouldBe` Right (Search [ColorIdentityIs (toColors [Blue, Green])]) describe "Alaran shards" $ do it "handles color:bant" $ do - parseSearch "color:bant" `shouldBe` "Right (Search [ColorIdentityIs {WUG}])" + parseSearch "color:bant" `shouldBe` Right (Search [ColorIdentityIs (toColors [White, Blue, Green])]) it "handles c:bant" $ do - parseSearch "c:bant" `shouldBe` "Right (Search [ColorIdentityIs {WUG}])" + parseSearch "c:bant" `shouldBe` Right (Search [ColorIdentityIs (toColors [White, Blue, Green])]) it "handles color:esper" $ do - parseSearch "color:esper" `shouldBe` "Right (Search [ColorIdentityIs {WBU}])" + parseSearch "color:esper" `shouldBe` Right (Search [ColorIdentityIs (toColors [White, Black, Blue])]) it "handles c:esper" $ do - parseSearch "c:esper" `shouldBe` "Right (Search [ColorIdentityIs {WBU}])" + parseSearch "c:esper" `shouldBe` Right (Search [ColorIdentityIs (toColors [White, Black, Blue])]) it "handles color:grixis" $ do - parseSearch "color:grixis" `shouldBe` "Right (Search [ColorIdentityIs {BUR}])" + parseSearch "color:grixis" `shouldBe` Right (Search [ColorIdentityIs (toColors [Black, Blue, Red])]) it "handles c:grixis" $ do - parseSearch "c:grixis" `shouldBe` "Right (Search [ColorIdentityIs {BUR}])" + parseSearch "c:grixis" `shouldBe` Right (Search [ColorIdentityIs (toColors [Black, Blue, Red])]) it "handles color:jund" $ do - parseSearch "color:jund" `shouldBe` "Right (Search [ColorIdentityIs {BGR}])" + parseSearch "color:jund" `shouldBe` Right (Search [ColorIdentityIs (toColors [Black, Green, Red])]) it "handles c:jund" $ do - parseSearch "c:jund" `shouldBe` "Right (Search [ColorIdentityIs {BGR}])" + parseSearch "c:jund" `shouldBe` Right (Search [ColorIdentityIs (toColors [Black, Green, Red])]) it "handles color:naya" $ do - parseSearch "color:naya" `shouldBe` "Right (Search [ColorIdentityIs {WGR}])" + parseSearch "color:naya" `shouldBe` Right (Search [ColorIdentityIs (toColors [White, Green, Red])]) it "handles c:naya" $ do - parseSearch "c:naya" `shouldBe` "Right (Search [ColorIdentityIs {WGR}])" + parseSearch "c:naya" `shouldBe` Right (Search [ColorIdentityIs (toColors [White, Green, Red])]) describe "Tarkirian wedges" $ do it "handles color:abzan" $ do - parseSearch "color:abzan" `shouldBe` "Right (Search [ColorIdentityIs {WBG}])" + parseSearch "color:abzan" `shouldBe` Right (Search [ColorIdentityIs (toColors [White, Black, Green])]) it "handles c:abzan" $ do - parseSearch "c:abzan" `shouldBe` "Right (Search [ColorIdentityIs {WBG}])" + parseSearch "c:abzan" `shouldBe` Right (Search [ColorIdentityIs (toColors [White, Black, Green])]) it "handles color:jeskai" $ do - parseSearch "color:jeskai" `shouldBe` "Right (Search [ColorIdentityIs {WUR}])" + parseSearch "color:jeskai" `shouldBe` Right (Search [ColorIdentityIs (toColors [White, Blue, Red])]) it "handles c:jeskai" $ do - parseSearch "c:jeskai" `shouldBe` "Right (Search [ColorIdentityIs {WUR}])" + parseSearch "c:jeskai" `shouldBe` Right (Search [ColorIdentityIs (toColors [White, Blue, Red])]) it "handles color:sultai" $ do - parseSearch "color:sultai" `shouldBe` "Right (Search [ColorIdentityIs {BUG}])" + parseSearch "color:sultai" `shouldBe` Right (Search [ColorIdentityIs (toColors [Black, Blue, Green])]) it "handles c:sultai" $ do - parseSearch "c:sultai" `shouldBe` "Right (Search [ColorIdentityIs {BUG}])" + parseSearch "c:sultai" `shouldBe` Right (Search [ColorIdentityIs (toColors [Black, Blue, Green])]) it "handles color:mardu" $ do - parseSearch "color:mardu" `shouldBe` "Right (Search [ColorIdentityIs {WBR}])" + parseSearch "color:mardu" `shouldBe` Right (Search [ColorIdentityIs (toColors [White, Black, Red])]) it "handles c:mardu" $ do - parseSearch "c:mardu" `shouldBe` "Right (Search [ColorIdentityIs {WBR}])" + parseSearch "c:mardu" `shouldBe` Right (Search [ColorIdentityIs (toColors [White, Black, Red])]) it "handles color:temur" $ do - parseSearch "color:temur" `shouldBe` "Right (Search [ColorIdentityIs {UGR}])" + parseSearch "color:temur" `shouldBe` Right (Search [ColorIdentityIs (toColors [Blue, Green, Red])]) it "handles c:temur" $ do - parseSearch "c:temur" `shouldBe` "Right (Search [ColorIdentityIs {UGR}])" + parseSearch "c:temur" `shouldBe` Right (Search [ColorIdentityIs (toColors [Blue, Green, Red])]) describe "Multicolor" $ do it "handles color:wbugr" $ do - parseSearch "color:wbugr" `shouldBe` "Right (Search [ColorIdentityIs {WBUGR}])" + parseSearch "color:wbugr" `shouldBe` Right (Search [ColorIdentityIs (toColors [White, Blue, Black, Green, Red])]) it "handles c:wbugr" $ do - parseSearch "c:wbugr" `shouldBe` "Right (Search [ColorIdentityIs {WBUGR}])" + parseSearch "c:wbugr" `shouldBe` Right (Search [ColorIdentityIs (toColors [White, Blue, Black, Green, Red])]) it "handles a lack of colors" $ do - parseSearch "c:" `shouldBe` "Right (Search [ColorIdentityIs {}])" + parseSearch "c:" `shouldBe` Right (Search [ColorIdentityIs (toColors [])]) describe "Color ranges" $ do it "handles color<=gr" $ do - parseSearch "color<=gr" `shouldBe` "Right (Search [ColorIdentityLTE {GR}])" + parseSearch "color<=gr" `shouldBe` Right (Search [ColorIdentityLTE (toColors [Green, Red])]) it "handles c<=gr" $ do - parseSearch "c<=gr" `shouldBe` "Right (Search [ColorIdentityLTE {GR}])" + parseSearch "c<=gr" `shouldBe` Right (Search [ColorIdentityLTE (toColors [Green, Red])]) it "handles color>=gr" $ do - parseSearch "color>=gr" `shouldBe` "Right (Search [ColorIdentityGTE {GR}])" + parseSearch "color>=gr" `shouldBe` Right (Search [ColorIdentityGTE (toColors [Green, Red])]) 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\"])" + parseSearch "c>=gr" `shouldBe` Right (Search [ColorIdentityGTE (toColors [Green, Red])]) + -- 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 + parseSearch :: Text -> Either Text.Parsec.Error.ParseError Search + parseSearch = parseQuery