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
|
module CardParser where
|
||||||
|
|
||||||
import Magic
|
import Magic
|
||||||
|
import Card
|
||||||
import Mana
|
import Mana
|
||||||
import ManaParser
|
import ManaParser
|
||||||
import Text.ParserCombinators.Parsec
|
import Text.ParserCombinators.Parsec
|
||||||
|
|
||||||
test_card = unlines $ [ "AEther Adept"
|
test_creature = unlines $ [ "AEther Adept"
|
||||||
, "1UU"
|
, "1UU"
|
||||||
, "Creature -- Human Wizard"
|
, "Creature -- Human Wizard"
|
||||||
, "2/2"
|
, "2/2"
|
||||||
|
@ -13,14 +14,37 @@ test_card = unlines $ [ "AEther Adept"
|
||||||
, "M11-C, M12-U"
|
, "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 :: Parser Card
|
||||||
card = do
|
card = do
|
||||||
name' <- line
|
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))
|
abilities' <- (manyTill line (try $ lookAhead sets_line))
|
||||||
sets' <- sets_line
|
sets' <- sets_line
|
||||||
let t = snd $ last sets'
|
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 :: Parser String
|
||||||
line = do
|
line = do
|
||||||
|
@ -34,6 +58,29 @@ mana_line = do
|
||||||
char '\n'
|
char '\n'
|
||||||
return mana'
|
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 :: Parser [(String, Rarity)]
|
||||||
sets_line = do
|
sets_line = do
|
||||||
sets <- sepBy set (string ", ")
|
sets <- sepBy set (string ", ")
|
||||||
|
|
18
Magic.hs
18
Magic.hs
|
@ -1,28 +1,15 @@
|
||||||
module Magic where
|
module Magic where
|
||||||
|
|
||||||
import Mana
|
import Mana
|
||||||
|
import Card
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- Cards
|
-- 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]
|
data Deck = Deck [Card]
|
||||||
|
{-
|
||||||
curve :: Deck -> [(Int, Int)]
|
curve :: Deck -> [(Int, Int)]
|
||||||
curve (Deck cards) = do
|
curve (Deck cards) = do
|
||||||
let largest = maximum (map converted cards)
|
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] [] []) [])
|
, replicate 4 (Card Mythic "Jace Beleren" (Cost [Standard 1 Colorless, Standard 2 Blue] [] []) [])
|
||||||
]
|
]
|
||||||
deck = Deck cards
|
deck = Deck cards
|
||||||
|
-}
|
||||||
|
|
Loading…
Reference in a new issue