magic/CardParser.hs

module CardParser where

import Magic
import Card
import qualified Mana as M
import qualified ManaParser as MP
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"
                        ]

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 = 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


eol :: Parser String
eol =   try (string "\r\n")
    <|> try (string "\n\r")
    <|> string "\n"
    <|> string "\r"
    <?> "end of line"

word :: Parser String
word = many $ noneOf "\n\r "

name :: Parser String
name = do
    ws <- sepBy1 word $ char ' '
    return $ unwords ws

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)

power :: Parser Int
power = stat <?> "power"

toughness :: Parser Int
toughness = stat <?> "toughness"

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)

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"