Improved card parser
This commit is contained in:
parent
8596c81c62
commit
2bb8a3bc17
2 changed files with 121 additions and 62 deletions
168
CardParser.hs
168
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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue