Improved card parser

CardParser.hs

@@ -2,8 +2,8 @@ module CardParser where
 
 import Magic
 import Card
-import Mana
+import qualified Mana as M
-import ManaParser
+import qualified ManaParser as MP
 import Text.ParserCombinators.Parsec
 
 test_creature = unlines $ [ "AEther Adept"
@@ -27,68 +27,77 @@ test_scheme = unlines $ [ "A Display of My Dark Power"
                         , "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 = sepBy card $ string "\n\n"
+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
 
 
-card :: Parser Card
+eol :: Parser String
-card = do
+eol =   try (string "\r\n")
-    name' <- line
+    <|> try (string "\n\r")
-    mana' <- option (Cost [] [] []) mana_line
+    <|> string "\n"
-    (card_type', card_subtypes') <- type_line
+    <|> string "\r"
-    (power, toughness) <- option (0, 0) stats_line
+    <?> "end of line"
-    abilities' <- (manyTill line (try $ lookAhead sets_line))
-    sets' <- sets_line
-    let t = snd $ last sets'
-    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
+word :: Parser String
-line = do
+word = many $ noneOf "\n\r "
-    text <- many (noneOf "\n")
-    char '\n'
-    return text
 
-mana_line :: Parser Cost
+name :: Parser String
-mana_line = do
+name = do
-    mana' <- mana
+    ws <- sepBy1 word $ char ' '
-    char '\n'
+    return $ unwords ws
-    return mana'
 
-type_line :: Parser (String, [String])
+card_types :: Parser [String]
-type_line =
+card_types =
-        do
+        do  try $ do
-        let main_type = manyTill (noneOf "\n") (string " -- ")
+            main <- manyTill (noneOf "\n\r") $ string " -- "
-        {- Do a lookahead so we can fail over to the other pattern if it fails -}
+            subtypes <- sepBy word $ char ' '
-        try $ lookAhead $ main_type
+            return (main:subtypes)
-        main <- main_type
+    <|> do  main <- name
-        subtypes <- sepBy1 (many $ noneOf " \n") (many1 $ char ' ')
+            return [main]
-        char '\n'
+    <?> "card types"
-        return (main, subtypes)
-    <|> do
-        main <- line
-        return (main, [])
 
+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)
 
-stats_line :: Parser (Int, Int)
+power :: Parser Int
-stats_line = do
+power = stat <?> "power"
-    power <- many digit
-    char '/'
-    toughness <- many digit
-    char '\n'
-    return (read power :: Int, read toughness :: Int)
 
-sets_line :: Parser [(String, Rarity)]
+toughness :: Parser Int
-sets_line = do
+toughness = stat <?> "toughness"
-    sets <- sepBy1 set (string ", ")
-    return sets
 
 set :: Parser (String, Rarity)
 set = do
@@ -102,3 +111,52 @@ set = do
         '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"

ManaParser.hs

@@ -3,13 +3,14 @@ module ManaParser where
 import Mana
 import Text.ParserCombinators.Parsec
 
-mana :: Parser Cost
+cost :: Parser Cost
-mana = do
+cost = do
-    colorless' <- many colorless
+        colorless' <- many colorless
-    colored' <- many colored
+        hybrid' <- many $ try hybrid
-    hybrid' <- many $ try hybrid
+        phyrexian' <- many $ try phyrexian
-    phyrexian' <- many $ try phyrexian
+        colored' <- many colored
-    return $ Cost (colorless' ++ colored') hybrid' phyrexian'
+        return $ Cost (colorless' ++ colored') hybrid' phyrexian'
+    <?> "mana cost"
 
 standard :: Parser Standard
 standard = colorless <|> colored