From fc0d0eb1d65a898be5297e44eb76eb749a4b46c3 Mon Sep 17 00:00:00 2001
From: Correl Roush <croush@coredial.com>
Date: Mon, 5 Mar 2012 14:56:18 -0500
Subject: [PATCH] More card parsing, including more fields

---
 Card.hs       | 26 +++++++++++++++++++++++++
 CardParser.hs | 53 ++++++++++++++++++++++++++++++++++++++++++++++++---
 Magic.hs      | 18 +++--------------
 3 files changed, 79 insertions(+), 18 deletions(-)
 create mode 100644 Card.hs

diff --git a/Card.hs b/Card.hs
new file mode 100644
index 0000000..bb06c1a
--- /dev/null
+++ b/Card.hs
@@ -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
diff --git a/CardParser.hs b/CardParser.hs
index 568efe6..b8d35b3 100644
--- a/CardParser.hs
+++ b/CardParser.hs
@@ -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 ", ")
diff --git a/Magic.hs b/Magic.hs
index 199d0a6..22f4fa6 100644
--- a/Magic.hs
+++ b/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
+-}