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"