From 192f4a935cb9a035caa273b65e365afa0acd5dfd Mon Sep 17 00:00:00 2001 From: Correl Date: Fri, 25 Mar 2022 17:29:10 -0400 Subject: [PATCH] Add search parsing --- Search.hs | 118 +++++++++++++++++++++++++++++++++++++++++++----- package.yaml | 2 + stack.yaml | 1 + stack.yaml.lock | 7 +++ tutor.cabal | 6 +++ 5 files changed, 123 insertions(+), 11 deletions(-) diff --git a/Search.hs b/Search.hs index 51777e0..4d542b3 100644 --- a/Search.hs +++ b/Search.hs @@ -1,12 +1,13 @@ module Search - ( colors, - colorless, - parse + ( Search.parse, ) where +import qualified Data.Char as C import qualified Data.Set as Set import qualified Data.Text as T +import Text.Parsec +import Text.Parsec.Text (Parser) data Search = Search [Criteria] deriving (Show) @@ -59,13 +60,108 @@ data Rarity | Mythic deriving (Eq, Ord, Show) -colors :: [Color] -> Colors -colors = Colors . Set.fromList +literal :: Parser T.Text +literal = bareLiteral <|> quotedLiteral + where + bareLiteral :: Parser T.Text + bareLiteral = do + chars <- many1 $ noneOf " \"" + return $ T.pack chars -colorless :: Colors -> Bool -colorless (Colors xs) - | Set.null xs = True - | otherwise = False + quotedLiteral :: Parser T.Text + quotedLiteral = do + chars <- between (char '"') (char '"') (many $ noneOf "\"") + return $ T.pack chars -parse :: T.Text -> Search -parse _ = Search [] +color :: Parser Color +color = do + c <- oneOf "wubgr" + return $ case c of + 'w' -> White + 'u' -> Blue + 'b' -> Black + 'g' -> Green + 'r' -> Red + +rarity :: Parser Rarity +rarity = do + c <- oneOf "curm" + return $ case c of + 'c' -> Common + 'u' -> Uncommon + 'r' -> Rare + 'm' -> Mythic + +colors :: Parser Colors +colors = + choice + [ -- Single colors + colorGroup "white" [White], + colorGroup "black" [Black], + colorGroup "blue" [Blue], + colorGroup "green" [Green], + colorGroup "red" [Red], + -- Ravnican Guilds + colorGroup "boros" [Red, White], + colorGroup "golgari" [Green, Black], + colorGroup "selesnya" [Green, White], + colorGroup "dimir" [Blue, Black], + colorGroup "orzhov" [White, Black], + colorGroup "izzet" [Red, Blue], + colorGroup "gruul" [Red, Green], + colorGroup "azorius" [Blue, White], + colorGroup "rakdos" [Black, Red], + colorGroup "simic" [Green, Blue], + -- Alaran Shards + colorGroup "bant" [White, Green, Blue], + colorGroup "esper" [Blue, White, Black], + colorGroup "grixis" [Black, Blue, Red], + colorGroup "jund" [Red, Black, Green], + colorGroup "naya" [Green, Red, White], + -- Tarkirian Wedges + colorGroup "abzan" [White, Black, Green], + colorGroup "jeskai" [White, Blue, Red], + colorGroup "sultai" [Blue, Black, Green], + colorGroup "mardu" [White, Black, Red], + colorGroup "temur" [Blue, Red, Green], + -- Multicolor + multiColor + ] + where + colorGroup :: String -> [Color] -> Parser Colors + colorGroup name xs = try (string name) >> return (Colors $ Set.fromList xs) + multiColor :: Parser Colors + multiColor = do + xs <- many color + return $ Colors $ Set.fromList xs + +criterion :: Parser Criteria +criterion = + choice + [ ColorIdentityIs <$> keywords ["c", "color"] ":" colors, + ColorIdentityLTE <$> 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, + CardTypeContains <$> keywords ["t", "type"] ":" literal, + OracleTextContains <$> keywords ["o", "oracle"] ":" literal, + NameContains <$> literal + ] + where + -- Attempt a keyword and operator pair without consuming input. + keyword :: String -> String -> Parser String + keyword operator name = try $ string (name <> operator) + + -- Attempt to match a set of keywords with an operator, using parser on success. + keywords :: [String] -> String -> Parser a -> Parser a + keywords names operator parser = (choice $ map (keyword operator) names) >> parser + +search :: Parser Search +search = do + criteria <- spaces >> sepEndBy criterion spaces + return $ Search criteria + +parse :: T.Text -> Either ParseError Search +parse query = Text.Parsec.parse search "search" query diff --git a/package.yaml b/package.yaml index 020d163..5c2a806 100644 --- a/package.yaml +++ b/package.yaml @@ -24,6 +24,8 @@ dependencies: - containers - lens - openapi3 +- parsec +- parsec-extra - servant-openapi3 - servant-server - text diff --git a/stack.yaml b/stack.yaml index a2e35b0..1692b79 100644 --- a/stack.yaml +++ b/stack.yaml @@ -42,6 +42,7 @@ packages: extra-deps: - hspec-wai-0.11.0@sha256:79f8aab21161cd551e0bb740f5416fb622fe94f710bedc97dabd39fe901b5291,2314 - hspec-wai-json-0.11.0@sha256:1fdd66a61c84a9ba6f2e1673ed49b2da1f57f025cd3fb9a46d62620ff9259d63,1629 + - parsec-extra-0.2.0.0@sha256:47f16e5d00cb62db52d126903787dcccc94d500cfbcb54316f5db00f31da4fa2,735 # Override default flag values for local packages and extra-deps # flags: {} diff --git a/stack.yaml.lock b/stack.yaml.lock index efc134c..4535273 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -18,6 +18,13 @@ packages: sha256: c25b93d8e0140a9ea24605199de5065967cd5fceeacac2b7f7d0747ab2142778 original: hackage: hspec-wai-json-0.11.0@sha256:1fdd66a61c84a9ba6f2e1673ed49b2da1f57f025cd3fb9a46d62620ff9259d63,1629 +- completed: + hackage: parsec-extra-0.2.0.0@sha256:47f16e5d00cb62db52d126903787dcccc94d500cfbcb54316f5db00f31da4fa2,735 + pantry-tree: + size: 225 + sha256: 8d8d15ac5aca977855d1fe89f3f23ecbbddc604e3cb887af5c27b540dba49ffc + original: + hackage: parsec-extra-0.2.0.0@sha256:47f16e5d00cb62db52d126903787dcccc94d500cfbcb54316f5db00f31da4fa2,735 snapshots: - completed: size: 616897 diff --git a/tutor.cabal b/tutor.cabal index b323783..5b45dbc 100644 --- a/tutor.cabal +++ b/tutor.cabal @@ -34,6 +34,8 @@ library , containers , lens , openapi3 + , parsec + , parsec-extra , servant-openapi3 , servant-server , text @@ -56,6 +58,8 @@ executable tutor-exe , containers , lens , openapi3 + , parsec + , parsec-extra , servant-openapi3 , servant-server , text @@ -83,6 +87,8 @@ test-suite tutor-test , hspec-wai-json , lens , openapi3 + , parsec + , parsec-extra , servant-openapi3 , servant-server , text