From 2bb8a3bc177bbef2fd6ec57f560a80674dbaa6dd Mon Sep 17 00:00:00 2001 From: Correl Roush Date: Tue, 6 Mar 2012 02:30:12 -0500 Subject: [PATCH] Improved card parser --- CardParser.hs | 168 +++++++++++++++++++++++++++++++++----------------- ManaParser.hs | 15 ++--- 2 files changed, 121 insertions(+), 62 deletions(-) diff --git a/CardParser.hs b/CardParser.hs index bf5471c..f02c740 100644 --- a/CardParser.hs +++ b/CardParser.hs @@ -2,8 +2,8 @@ module CardParser where import Magic import Card -import Mana -import ManaParser +import qualified Mana as M +import qualified ManaParser as MP import Text.ParserCombinators.Parsec test_creature = unlines $ [ "AEther Adept" @@ -27,68 +27,77 @@ test_scheme = unlines $ [ "A Display of My Dark Power" , "ARC-C" ] +test_split = unlines $ [ "Assault // Battery" + , "R // 3G" + , "Sorcery // Sorcery" + , "Assault deals 2 damage to target creature or player. // Put a 3/3 green Elephant creature token onto the battlefield." + , "IN-U, TSP-S, HOP-U" + ] + card_list :: Parser [Card] -card_list = sepBy card $ string "\n\n" +card_list = do + let normal_card = do + card' <- card + return [card'] + let split_card = do + split_name; eol + manyTill (name >> eol) $ try $ lookAhead (sets >> eol) + sets; eol + return [] + let any_card = (try split_card) <|> normal_card + card_list <- sepEndBy any_card $ string "\n" + return $ concat card_list + +split_c :: Parser Char +split_c = try $ do + c <- char '/' + notFollowedBy $ char '/' + return c + <|> noneOf "\n\r" + +split_name :: Parser String +split_name = manyTill split_c $ string "//" >> many split_c -card :: Parser Card -card = do - name' <- line - mana' <- option (Cost [] [] []) mana_line - (card_type', card_subtypes') <- type_line - (power, toughness) <- option (0, 0) stats_line - abilities' <- (manyTill line (try $ lookAhead sets_line)) - sets' <- sets_line - let t = snd $ last sets' - return $ Card { card_rarity = t - , card_name = name' - , card_type = card_type' - , card_subtypes = card_subtypes' - , card_cost = mana' - , card_abilities = abilities' - , card_power = power - , card_toughness = toughness - } +eol :: Parser String +eol = try (string "\r\n") + <|> try (string "\n\r") + <|> string "\n" + <|> string "\r" + "end of line" -line :: Parser String -line = do - text <- many (noneOf "\n") - char '\n' - return text +word :: Parser String +word = many $ noneOf "\n\r " -mana_line :: Parser Cost -mana_line = do - mana' <- mana - char '\n' - return mana' +name :: Parser String +name = do + ws <- sepBy1 word $ char ' ' + return $ unwords ws -type_line :: Parser (String, [String]) -type_line = - do - let main_type = manyTill (noneOf "\n") (string " -- ") - {- Do a lookahead so we can fail over to the other pattern if it fails -} - try $ lookAhead $ main_type - main <- main_type - subtypes <- sepBy1 (many $ noneOf " \n") (many1 $ char ' ') - char '\n' - return (main, subtypes) - <|> do - main <- line - return (main, []) +card_types :: Parser [String] +card_types = + do try $ do + main <- manyTill (noneOf "\n\r") $ string " -- " + subtypes <- sepBy word $ char ' ' + return (main:subtypes) + <|> do main <- name + return [main] + "card types" +stat :: Parser Int +stat = do + let d = ['0'..'9'] ++ "\r\n /" + skipMany $ noneOf d + stat' <- sepEndBy digit (many $ noneOf d) + case stat' of + [] -> return 0 + _ -> return (read stat' :: Int) -stats_line :: Parser (Int, Int) -stats_line = do - power <- many digit - char '/' - toughness <- many digit - char '\n' - return (read power :: Int, read toughness :: Int) +power :: Parser Int +power = stat "power" -sets_line :: Parser [(String, Rarity)] -sets_line = do - sets <- sepBy1 set (string ", ") - return sets +toughness :: Parser Int +toughness = stat "toughness" set :: Parser (String, Rarity) set = do @@ -102,3 +111,52 @@ set = do 'R' -> return (set', Rare) 'M' -> return (set', Mythic) 'S' -> return (set', Special) + +sets :: Parser [(String, Rarity)] +sets = sepBy set $ string ", " + +card :: Parser Card +card = do + let cost = do + cost' <- MP.cost; eol + return cost' + let ability = do + ability' <- name; eol + return ability' + let abilities = do + manyTill ability $ try $ lookAhead (sets >> eol) + + name' <- name; eol + cost' <- option (M.Cost [] [] []) $ try cost + card_type':card_subtypes' <- card_types; eol + case card_type' of + "Creature" -> do + power' <- power; char '/'; toughness' <- toughness; eol + abilities' <- abilities + sets' <- sets; eol + let rarity' = case sets' of [] -> Special + xs -> snd $ last xs + return $ Card { card_rarity = rarity' + , card_name = name' + , card_type = card_type' + , card_subtypes = card_subtypes' + , card_cost = cost' + , card_abilities = abilities' + , card_power = power' + , card_toughness = toughness' + } + _ -> do + abilities' <- abilities + sets' <- sets; eol + let rarity' = case sets' of [] -> Special + xs -> snd $ last xs + return $ Card { card_rarity = rarity' + , card_name = name' + , card_type = card_type' + , card_subtypes = card_subtypes' + , card_cost = cost' + , card_abilities = abilities' + , card_power = 0 + , card_toughness = 0 + } + "magic card" diff --git a/ManaParser.hs b/ManaParser.hs index d4acb12..37251fc 100644 --- a/ManaParser.hs +++ b/ManaParser.hs @@ -3,13 +3,14 @@ module ManaParser where import Mana import Text.ParserCombinators.Parsec -mana :: Parser Cost -mana = do - colorless' <- many colorless - colored' <- many colored - hybrid' <- many $ try hybrid - phyrexian' <- many $ try phyrexian - return $ Cost (colorless' ++ colored') hybrid' phyrexian' +cost :: Parser Cost +cost = do + colorless' <- many colorless + hybrid' <- many $ try hybrid + phyrexian' <- many $ try phyrexian + colored' <- many colored + return $ Cost (colorless' ++ colored') hybrid' phyrexian' + "mana cost" standard :: Parser Standard standard = colorless <|> colored