magic/CardParser.hs

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 :: 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 <- sepBy set (string ", ")
    return sets

set :: Parser (String, Rarity)
set = do
    set' <- many1 (noneOf "\n-")
    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)