magic/CardParser.hs

104 lines
3.1 KiB
Haskell

module CardParser where
import Magic
import Card
import Mana
import ManaParser
import Text.ParserCombinators.Parsec
test_creature = unlines $ [ "AEther Adept"
, "1UU"
, "Creature -- Human Wizard"
, "2/2"
, "When AEther Adept enters the battlefield, return target creature to its owner's hand."
, "M11-C, M12-U"
]
test_enchantment = unlines $ [ "AEther Barrier"
, "2U"
, "Enchantment"
, "Whenever a player casts a creature spell, that player sacrifices a permanent unless he or she pays {1}."
, "NE-R"
]
test_scheme = unlines $ [ "A Display of My Dark Power"
, "Scheme"
, "When you set this scheme in motion, until your next turn, whenever a player taps a land for mana, that player adds one mana to his or her mana pool of any type that land produced."
, "ARC-C"
]
card_list :: Parser [Card]
card_list = sepBy card $ string "\n\n"
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
}
line :: Parser String
line = do
text <- many (noneOf "\n")
char '\n'
return text
mana_line :: Parser Cost
mana_line = do
mana' <- mana
char '\n'
return mana'
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, [])
stats_line :: Parser (Int, Int)
stats_line = do
power <- many digit
char '/'
toughness <- many digit
char '\n'
return (read power :: Int, read toughness :: Int)
sets_line :: Parser [(String, Rarity)]
sets_line = do
sets <- sepBy1 set (string ", ")
return sets
set :: Parser (String, Rarity)
set = do
set' <- many1 $ oneOf $ ['A'..'Z'] ++ ['0'..'9']
char '-'
rarity' <- oneOf "LCURMS"
case rarity' of
'L' -> return (set', Land)
'C' -> return (set', Common)
'U' -> return (set', Uncommon)
'R' -> return (set', Rare)
'M' -> return (set', Mythic)
'S' -> return (set', Special)