68 lines
1.9 KiB
Haskell
68 lines
1.9 KiB
Haskell
module Mana where
|
|
|
|
import Data.Char
|
|
import Data.List
|
|
|
|
data Color = Colorless
|
|
| Black
|
|
| White
|
|
| Red
|
|
| Blue
|
|
| Green
|
|
deriving (Show, Eq)
|
|
|
|
class Mana a where
|
|
colors :: a -> [Color]
|
|
converted :: a -> Int
|
|
|
|
data Standard = Standard Int Color
|
|
deriving (Eq)
|
|
|
|
instance Mana Standard where
|
|
colors (Standard _ x) = [x]
|
|
converted (Standard x _) = x
|
|
|
|
instance Show Standard where
|
|
show (Standard n c)
|
|
| c == Black = replicate n 'B'
|
|
| c == White = replicate n 'W'
|
|
| c == Red = replicate n 'R'
|
|
| c == Blue = replicate n 'U'
|
|
| c == Green = replicate n 'G'
|
|
| otherwise = show n
|
|
|
|
data Hybrid = Hybrid Standard Standard
|
|
deriving (Eq)
|
|
|
|
instance Mana Hybrid where
|
|
colors (Hybrid x y) = concat [colors x, colors y]
|
|
converted (Hybrid x y) = min (converted x) (converted y)
|
|
|
|
instance Show Hybrid where
|
|
show (Hybrid x y) = map toLower $ "(" ++ (show x) ++ "/" ++ (show y) ++ ")"
|
|
|
|
data Phyrexian = Phyrexian Standard
|
|
deriving (Eq)
|
|
|
|
instance Mana Phyrexian where
|
|
colors (Phyrexian x) = colors x
|
|
converted (Phyrexian x) = converted x
|
|
|
|
instance Show Phyrexian where
|
|
show (Phyrexian x) = "(" ++ (map toLower $ show x) ++ "/p)"
|
|
|
|
data Cost = Cost [Standard] [Hybrid] [Phyrexian]
|
|
deriving (Eq)
|
|
|
|
instance Mana Cost where
|
|
colors (Cost s h p) = nub $ concat $ [(concat $ map colors s), (concat $ map colors h), (concat $ map colors p)]
|
|
converted (Cost s h p) = (sum $ map converted s) + (sum $ map converted h) + (sum $ map converted p)
|
|
|
|
instance Show Cost where
|
|
show (Cost s h p) = do
|
|
let colorless = filter (\x -> colors x == [Colorless]) s
|
|
let colored = filter (\x -> colors x /= [Colorless]) s
|
|
concat [show $ sum $ map converted colorless
|
|
, concat $ map show p
|
|
, concat $ map show h
|
|
, concat $ map show colored]
|