More card parsing, including more fields
This commit is contained in:
parent
17bb3989fb
commit
fc0d0eb1d6
3 changed files with 79 additions and 18 deletions
26
Card.hs
Normal file
26
Card.hs
Normal file
|
@ -0,0 +1,26 @@
|
|||
module Card where
|
||||
|
||||
import Mana
|
||||
|
||||
data Rarity = Land
|
||||
| Common
|
||||
| Uncommon
|
||||
| Rare
|
||||
| Mythic
|
||||
| Special
|
||||
deriving (Show, Eq)
|
||||
|
||||
data Card = Card { card_name :: String
|
||||
, card_cost :: Cost
|
||||
, card_type :: String
|
||||
, card_subtypes :: [String]
|
||||
, card_rarity :: Rarity
|
||||
, card_abilities :: [String]
|
||||
, card_power :: Int
|
||||
, card_toughness :: Int
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance Mana Card where
|
||||
colors c = colors $ card_cost c
|
||||
converted c = converted $ card_cost c
|
|
@ -1,11 +1,12 @@
|
|||
module CardParser where
|
||||
|
||||
import Magic
|
||||
import Card
|
||||
import Mana
|
||||
import ManaParser
|
||||
import Text.ParserCombinators.Parsec
|
||||
|
||||
test_card = unlines $ [ "AEther Adept"
|
||||
test_creature = unlines $ [ "AEther Adept"
|
||||
, "1UU"
|
||||
, "Creature -- Human Wizard"
|
||||
, "2/2"
|
||||
|
@ -13,14 +14,37 @@ test_card = unlines $ [ "AEther Adept"
|
|||
, "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))
|
||||
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 t name' mana' abilities'
|
||||
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
|
||||
|
@ -34,6 +58,29 @@ mana_line = do
|
|||
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 ", ")
|
||||
|
|
18
Magic.hs
18
Magic.hs
|
@ -1,28 +1,15 @@
|
|||
module Magic where
|
||||
|
||||
import Mana
|
||||
import Card
|
||||
|
||||
-------------------------------------------------------------------------------
|
||||
-- Cards
|
||||
-------------------------------------------------------------------------------
|
||||
|
||||
data Rarity = Land
|
||||
| Common
|
||||
| Uncommon
|
||||
| Rare
|
||||
| Mythic
|
||||
| Special
|
||||
deriving (Show, Eq)
|
||||
|
||||
data Card = Card Rarity String Cost [String]
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance Mana Card where
|
||||
colors (Card _ _ cost _) = colors cost
|
||||
converted (Card _ _ cost _) = converted cost
|
||||
|
||||
data Deck = Deck [Card]
|
||||
|
||||
{-
|
||||
curve :: Deck -> [(Int, Int)]
|
||||
curve (Deck cards) = do
|
||||
let largest = maximum (map converted cards)
|
||||
|
@ -33,3 +20,4 @@ cards = concat $ [ replicate 13 (Card Land "Swamp" (Cost [] [] []) [])
|
|||
, replicate 4 (Card Mythic "Jace Beleren" (Cost [Standard 1 Colorless, Standard 2 Blue] [] []) [])
|
||||
]
|
||||
deck = Deck cards
|
||||
-}
|
||||
|
|
Loading…
Reference in a new issue