made everything nicer, wont compile

Cards.hs

@@ -0,0 +1,100 @@
+module Cards where
+
+import Types
+
+getCardInfo :: CardSym -> CardLib -> CardInfo
+getCardInfo c cl = snd $ head $ filter (\(s, _) -> s == c) cl
+
+gCardLib :: CardLib
+gCardLib =
+   [ (S01_Shinji, ciS01_Shinji)
+   , (S02_Asuka, ciS02_Asuka)
+   , (S03_Rei, ciS03_Rei)
+   , (S04_Misato, ciS04_Misato)
+   , (S05_Ritsuko, ciS05_Ritsuko)
+   , (S06_Gendo, ciS06_Gendo)
+   ]
+
+ciS01_Shinji = CardInfo
+   { ciName = "3rd Child - Shinji Ikari"
+   , ciFaction = Blue
+   , ciType = Character
+   , ciText = "Can speak one blue card every turn."
+   , ciTraits = [Male]
+   , ciLineMarks = Just [(Circle, Blue)]
+   , ciLine = Just "I feel like I belong here!"
+   , ciDP = Just 0
+   , ciStrength = Nothing
+   , ciLevel = Nothing
+   , ciNextInst = Nothing
+   }
+
+ciS02_Asuka = CardInfo
+   { ciName = "2nd Child - Asuka Langley-Soryu"
+   , ciFaction = Red
+   , ciType = Character
+   , ciText = "Can speak one red card every turn."
+   , ciTraits = [Female]
+   , ciLineMarks = Just [(Triangle, Blue), (Triangle, Green), (Triangle, Yellow)]
+   , ciLine = Just "What're you, stupid?!"
+   , ciDP = Just 1
+   , ciStrength = Nothing
+   , ciLevel = Nothing
+   , ciNextInst = Nothing
+   }
+
+ciS03_Rei = CardInfo
+   { ciName = "1st Child - Rei Ayanami"
+   , ciFaction = White
+   , ciType = Character
+   , ciText = "Can speak one white card every turn. All white lines are zero DP. If down at the start of the Opening Draw phase, Rei recovers automatically."
+   , ciTraits = [Female]
+   , ciLineMarks = Just [(Circle, White)]
+   , ciLine = Just "I feel connected."
+   , ciDP = Just (-1)
+   , ciStrength = Nothing
+   , ciLevel = Nothing
+   , ciNextInst = Nothing
+   }
+
+ciS04_Misato = CardInfo
+   { ciName = "Misato Katsuragi"
+   , ciFaction = Green
+   , ciType = Character
+   , ciText = "Can speak one green card every turn."
+   , ciTraits = [Female]
+   , ciLineMarks = Just [(Circle, Green)]
+   , ciLine = Just "We can't wait for a miracle, let's give it our best shot."
+   , ciDP = Just 0
+   , ciStrength = Nothing
+   , ciLevel = Nothing
+   , ciNextInst = Nothing
+   }
+
+ciS05_Ritsuko = CardInfo
+   { ciName = "Ritsuko Akagi"
+   , ciFaction = Yellow
+   , ciType = Character
+   , ciText = "Can speak one yellow card every turn."
+   , ciTraits = [Female]
+   , ciLineMarks = Just [(Circle, Yellow)]
+   , ciLine = Just "The one Unit Zero was after was me."
+   , ciDP = Just 0
+   , ciStrength = Nothing
+   , ciLevel = Nothing
+   , ciNextInst = Nothing
+   }
+
+ciS06_Gendo = CardInfo
+   { ciName = "Gendo Ikari"
+   , ciFaction = Black
+   , ciType = Character
+   , ciText = "Can speak one black card every turn."
+   , ciTraits = [Male]
+   , ciLineMarks = Just [(Circle, Black)]
+   , ciLine = Just "There is no problem."
+   , ciDP = Just (-1)
+   , ciStrength = Nothing
+   , ciLevel = Nothing
+   , ciNextInst = Nothing
+   }

Group.hs

@@ -0,0 +1,66 @@
+module Groups where
+
+import State
+import Util
+import Cards
+import Types
+import Data.Either
+
+-- Each characters default adjacents
+defFrens :: MainCharacter -> [MainCharacter]
+defFrens Asuka = [Rei, Shinji, Misato]
+defFrens Shinji = [Rei, Gendo, Ritsuko, Misato, Asuka]
+defFrens Rei = [Gendo, Shinji, Asuka]
+defFrens Misato = [Asuka, Shinji, Ritsuko]
+defFrens Ritsuko = [Misato, Shinji, Gendo]
+defFrens Gendo = [Rei, Shinji, Ritsuko]
+
+-- The group that character x belongs to
+charsGroup :: MainCharacter -> NeoTokyo -> Group
+charsGroup x nt = head $ filter (\g -> x `elem` g) nt
+
+-- The characters currently grouped with x
+curFrens :: MainCharacter -> NeoTokyo -> [MainCharacter]
+curFrens x nt = filter (/= x) $ charsGroup x nt
+
+-- The groups a character is adaject to
+adjGroups :: MainCharacter -> NeoTokyo -> [Group]
+adjGroups x nt = filter (\g -> any (\x -> x `elem` adjFrens) g) (otherGroups x nt)
+   where
+      adjFrens = uniq $ foldr (++) [] (map defFrens $ charsGroup x nt)
+
+-- The groups a character isnt in
+otherGroups :: MainCharacter -> NeoTokyo -> [Group]
+otherGroups x nt = filter (\g -> not $ x `elem` g) nt
+
+-- All characters a X is adjacent to
+getAdj :: MainCharacter -> NeoTokyo -> [MainCharacter]
+getAdj x nt = curFrens x nt ++ (foldr (++) [] (adjGroups x nt))
+
+-- X hurts Y (only if adjacent)
+hurt :: MainCharacter -> MainCharacter -> BoardState -> BoardState
+hurt x y (nt,d)
+      | not $ y `elem` (getAdj x nt) = (nt,d)
+      | otherwise = hurt' x y (nt,d)
+
+-- X hurts Y (no restrictions)
+hurt' :: MainCharacter -> MainCharacter -> BoardState -> BoardState
+hurt' x y (nt,d)
+      | y `elem` d = if (curFrens y nt == [])
+                       then (nt, d)
+                       else ([y] : (groupMinusChar y) : (otherGroups y nt), d)
+      | otherwise = (nt, y:d)
+   where
+      groupMinusChar y = (filter (/= y) $ charsGroup y nt)
+
+-- Attract X and Y (only if adjacent)
+attract :: MainCharacter -> MainCharacter -> BoardState -> BoardState
+attract x y (nt,d)
+         | not $ y `elem` (getAdj x nt) = (nt,d)
+         | otherwise = attract' x y (nt,d)
+
+-- Attract X and Y (no restrictions)
+attract' :: MainCharacter -> MainCharacter -> BoardState -> BoardState
+attract' x y (nt,d) 
+         | x `elem` d = (nt, (filter (/= x) d))
+         | otherwise = ((uniq (charsGroup x nt ++ charsGroup y nt)) : (otherGroups y (otherGroups x nt)), d)

Init.hs

@@ -0,0 +1,29 @@
+module Init where
+
+import Types
+import Cards
+
+p1 :: Player
+p1 = ("Shaun", [S01_Shinji, S02_Asuka, S02_Asuka, S04_Misato, S05_Ritsuko, S06_Gendo], [])
+
+p2 :: Player
+p2 = ("James", [S01_Shinji, S03_Rei, S03_Rei, S04_Misato], [])
+
+bs1 :: BoardState
+bs1 = BoardState
+   { bsNeoTokyo =
+      ( [[Shinji], [Asuka], [Rei], [Misato], [Ritsuko], [Gendo]]
+      , [UnitZero, UnitOne, UnitTwo]
+      , []
+      , []
+      , []
+      )
+   , bsPlayerLib =
+      [ (1, p1)
+      , (2, p2)
+      ]
+   , bsActivePlayers = [1, 2]
+   , bsPriorityPlayer = 1
+   , bsCardStack = []
+   , bsCardLib = gCardLib
+   }

State.hs

@@ -1,49 +1,5 @@
 module State where
 
-import Data.Either
-
-type CardLib = [(CardSym, CardInfo)]
-type BoardState = (CardLib, Players, Downed, PutCards)
-
-type Downed = [MainCharacter]
-type PutCards = [(Either MainCharacter MainEva, CardSym)]
-type CardStack = [(PlayerId, CardSym)]
-type NeoTokyo = ([Group], Evas)
-type Evas = [MainEvas]
-type Group = [MainCharacter]
-type Angels = [Angel]
-
-type PlayerLib = [PlayerId, PlayerState]
-type ActivePlayers = [PlayerId]
-type PriorityPlayer = PlayerId
-type PlayerId = Integer
-type PlayerState = (PlayerName, Hand, Deck, Discard)
-type PlayerName = String
-type Hand = [CardSym]
-type Deck = [CardSym]
-type Discard = [CardSym]
-
-type GameLog = [GameMessage]
-type GameMessage = Either GameLine GameError
-type GameLine = String
-type GameError = String
-
-data Faction = Blue | Red | White | Green | Yellow | Black deriving (Show)
-data TypeSym = Character | Eva | Angel | Drama | Put | Intstrumentality deriving (Show, Eq)
-data Trait = Other | Reaction | Male | Female | Weapon deriving (Show)
-data MainCharacter = Shinji | Asuka | Rei | Misato | Ritsuko | Gendo deriving (Show, Eq)
-data MainEva = UnitZero | UnitOne | UnitTwo deriving (Show, Eq)
-data Angel = Sachiel | Shamshel | Ramiel | Gaghiel | Israfel | Sandalphon | Matariel | Sahaquiel | Ireul | Leliel | Bardiel | Zeruel | Arael | Armisael | Kaworu | Man | Lilith | Adam
-data CardSym = S01_Shinji | S02_Asuka | S03_Rei | S04_Misato | S05_Ritsuko | S06_Gendo deriving (Show, Eq)
-data Mark = Circle | Triangle deriving (Show)
-
-type Traits = [Trait]
-type LineMark = (Mark, Faction)
-type LineMarks = [LineMark]
-
-getCardInfo :: CardSym -> CardLib -> CardInfo
-getCardInfo c cl = snd $ head $ filter (\(s, _) -> s == c) cl
-
 defCharsFaction :: Faction -> MainCharacter
 defCharsFaction Blue = Shinji
 defCharsFaction Red = Asuka
@@ -55,12 +11,6 @@ defCharsFaction Black = Gendo
 numPut :: Either MainCharacter MainEva -> PutCards -> Integer
 numPut c p = toInteger $ length $ filter (\x -> (fst x) == c) p
 
-rmFirstMatch :: [a] -> (a -> Bool) -> [a]
-rmFirstMatch [] _ = []
-rmFirstMatch (l:ls) f
-   | f l = ls
-   | otherwise = (l : rmFirstMatch ls f)
-
 removeHand :: CardSym -> Player -> Either Player GameError
 removeHand c p@(n, h, d)
    | not $ c `elem` h = Right "Card not in hand"
@@ -81,193 +31,4 @@ playChar p@(on, oh, od) c ob@(cl, ps, d, pc)
          np = removeHand c p
          npc = (Left targetChar, c):pc
 
-unwrapLeft :: Either a b -> a
-unwrapLeft (Left x) = x
-unwrapLeft (Right _) = error "Not a Left value"
 
-unwrapRight :: Either a b -> b
-unwrapRight (Right x) = x
-unwrapRight (Left _) = error "Not a Right value"
-
-p1 :: Player
-p1 = ("Shaun", [S01_Shinji, S02_Asuka, S03_Rei, S04_Misato, S05_Ritsuko, S06_Gendo], [])
-
-gCardLib :: CardLib
-gCardLib =
-   [ (S01_Shinji, ciS01_Shinji)
-   , (S02_Asuka, ciS02_Asuka)
-   , (S03_Rei, ciS03_Rei)
-   , (S04_Misato, ciS04_Misato)
-   , (S05_Ritsuko, ciS05_Ritsuko)
-   , (S06_Gendo, ciS06_Gendo)
-   ]
-
-data CardInfo = CardInfo
-   { ciName :: String
-   , ciFaction :: Faction
-   , ciType :: TypeSym
-   , ciText :: String
-   , ciTraits :: Traits
-   , ciLineMarks :: Maybe LineMarks
-   , ciLine :: Maybe String
-   , ciDP :: Maybe Integer
-   , ciStrength :: Maybe Integer
-   , ciLevel :: Maybe Integer
-   , ciNextInst :: Maybe CardSym
-   } deriving (Show)
-
-ciS01_Shinji = CardInfo
-   { ciName = "3rd Child - Shinji Ikari"
-   , ciFaction = Blue
-   , ciType = Character
-   , ciText = "Can speak one blue card every turn."
-   , ciTraits = [Male]
-   , ciLineMarks = Just [(Circle, Blue)]
-   , ciLine = Just "I feel like I belong here!"
-   , ciDP = Just 0
-   , ciStrength = Nothing
-   , ciLevel = Nothing
-   , ciNextInst = Nothing
-   }
-
-ciS02_Asuka = CardInfo
-   { ciName = "2nd Child - Asuka Langley-Soryu"
-   , ciFaction = Red
-   , ciType = Character
-   , ciText = "Can speak one red card every turn."
-   , ciTraits = [Female]
-   , ciLineMarks = Just [(Triangle, Blue), (Triangle, Green), (Triangle, Yellow)]
-   , ciLine = Just "What're you, stupid?!"
-   , ciDP = Just 1
-   , ciStrength = Nothing
-   , ciLevel = Nothing
-   , ciNextInst = Nothing
-   }
-
-ciS03_Rei = CardInfo
-   { ciName = "1st Child - Rei Ayanami"
-   , ciFaction = White
-   , ciType = Character
-   , ciText = "Can speak one white card every turn. All white lines are zero DP. If down at the start of the Opening Draw phase, Rei recovers automatically."
-   , ciTraits = [Female]
-   , ciLineMarks = Just [(Circle, White)]
-   , ciLine = Just "I feel connected."
-   , ciDP = Just (-1)
-   , ciStrength = Nothing
-   , ciLevel = Nothing
-   , ciNextInst = Nothing
-   }
-
-ciS04_Misato = CardInfo
-   { ciName = "Misato Katsuragi"
-   , ciFaction = Green
-   , ciType = Character
-   , ciText = "Can speak one green card every turn."
-   , ciTraits = [Female]
-   , ciLineMarks = Just [(Circle, Green)]
-   , ciLine = Just "We can't wait for a miracle, let's give it our best shot."
-   , ciDP = Just 0
-   , ciStrength = Nothing
-   , ciLevel = Nothing
-   , ciNextInst = Nothing
-   }
-
-ciS05_Ritsuko = CardInfo
-   { ciName = "Ritsuko Akagi"
-   , ciFaction = Yellow
-   , ciType = Character
-   , ciText = "Can speak one yellow card every turn."
-   , ciTraits = [Female]
-   , ciLineMarks = Just [(Circle, Yellow)]
-   , ciLine = Just "The one Unit Zero was after was me."
-   , ciDP = Just 0
-   , ciStrength = Nothing
-   , ciLevel = Nothing
-   , ciNextInst = Nothing
-   }
-
-ciS06_Gendo = CardInfo
-   { ciName = "Gendo Ikari"
-   , ciFaction = Black
-   , ciType = Character
-   , ciText = "Can speak one black card every turn."
-   , ciTraits = [Male]
-   , ciLineMarks = Just [(Circle, Black)]
-   , ciLine = Just "There is no problem."
-   , ciDP = Just (-1)
-   , ciStrength = Nothing
-   , ciLevel = Nothing
-   , ciNextInst = Nothing
-   }
-
-{--
-module Groups where
-
-import State
-
--- Each characters default adjacents
-defFrens :: MainCharacter -> [MainCharacter]
-defFrens Asuka = [Rei, Shinji, Misato]
-defFrens Shinji = [Rei, Gendo, Ritsuko, Misato, Asuka]
-defFrens Rei = [Gendo, Shinji, Asuka]
-defFrens Misato = [Asuka, Shinji, Ritsuko]
-defFrens Ritsuko = [Misato, Shinji, Gendo]
-defFrens Gendo = [Rei, Shinji, Ritsuko]
-
--- The group that character x belongs to
-charsGroup :: MainCharacter -> NeoTokyo -> Group
-charsGroup x nt = head $ filter (\g -> x `elem` g) nt
-
--- The characters currently grouped with x
-curFrens :: MainCharacter -> NeoTokyo -> [MainCharacter]
-curFrens x nt = filter (/= x) $ charsGroup x nt
-
--- Remove duplicates, stabily
-uniq :: (Eq a) => [a] -> [a]
-uniq x = reverse $ go x []
-   where
-      go [] al = al
-      go (c:cs) al = if (c `elem` al) then (go cs al) else (go cs (c:al))
-
--- The groups a character is adaject to
-adjGroups :: MainCharacter -> NeoTokyo -> [Group]
-adjGroups x nt = filter (\g -> any (\x -> x `elem` adjFrens) g) (otherGroups x nt)
-   where
-      adjFrens = uniq $ foldr (++) [] (map defFrens $ charsGroup x nt)
-
--- The groups a character isnt in
-otherGroups :: MainCharacter -> NeoTokyo -> [Group]
-otherGroups x nt = filter (\g -> not $ x `elem` g) nt
-
--- All characters a X is adjacent to
-getAdj :: MainCharacter -> NeoTokyo -> [MainCharacter]
-getAdj x nt = curFrens x nt ++ (foldr (++) [] (adjGroups x nt))
-
--- X hurts Y (only if adjacent)
-hurt :: MainCharacter -> MainCharacter -> BoardState -> BoardState
-hurt x y (nt,d)
-      | not $ y `elem` (getAdj x nt) = (nt,d)
-      | otherwise = hurt' x y (nt,d)
-
--- X hurts Y (no restrictions)
-hurt' :: MainCharacter -> MainCharacter -> BoardState -> BoardState
-hurt' x y (nt,d)
-      | y `elem` d = if (curFrens y nt == [])
-                       then (nt, d)
-                       else ([y] : (groupMinusChar y) : (otherGroups y nt), d)
-      | otherwise = (nt, y:d)
-   where
-      groupMinusChar y = (filter (/= y) $ charsGroup y nt)
-
--- Attract X and Y (only if adjacent)
-attract :: MainCharacter -> MainCharacter -> BoardState -> BoardState
-attract x y (nt,d)
-         | not $ y `elem` (getAdj x nt) = (nt,d)
-         | otherwise = attract' x y (nt,d)
-
--- Attract X and Y (no restrictions)
-attract' :: MainCharacter -> MainCharacter -> BoardState -> BoardState
-attract' x y (nt,d) 
-         | x `elem` d = (nt, (filter (/= x) d))
-         | otherwise = ((uniq (charsGroup x nt ++ charsGroup y nt)) : (otherGroups y (otherGroups x nt)), d)
---}

Types.hs

@@ -0,0 +1,63 @@
+module Types where
+
+import Cards
+
+data MainCharacter = Shinji | Asuka | Rei | Misato | Ritsuko | Gendo deriving (Show, Eq)
+data MainEva = UnitZero | UnitOne | UnitTwo deriving (Show, Eq)
+data Angel = Sachiel | Shamshel | Ramiel | Gaghiel | Israfel | Sandalphon | Matariel | Sahaquiel | Ireul | Leliel | Bardiel | Zeruel | Arael | Armisael | Kaworu | Man | Lilith | Adam
+data CardSym = S01_Shinji | S02_Asuka | S03_Rei | S04_Misato | S05_Ritsuko | S06_Gendo deriving (Show, Eq)
+
+type CardLib = [(CardSym, CardInfo)]
+type Downed = [MainCharacter]
+type PutCards = [(Either MainCharacter MainEva, CardSym)]
+type CardStack = [(PlayerId, CardSym)]
+type NeoTokyo = ([Group], Evas, Angels, PutCards, Downed)
+type Evas = [MainEvas]
+type Group = [MainCharacter]
+type Angels = [Angel]
+type BoardState =
+   { bsNeoTokyo :: NeoTokyo
+   , bsPlayerLib :: PlayerLib
+   , bsActivePlayers :: ActivePlayers
+   , bsPriorityPlayer :: PriorityPlayer
+   , bsCardStack :: CardStack
+   , bsCardLib :: CardLib
+   }
+
+type PlayerLib = [(PlayerId, PlayerState)]
+type ActivePlayers = [PlayerId]
+type PriorityPlayer = PlayerId
+type PlayerId = Integer
+type PlayerState = (PlayerName, Hand, Deck, Discard)
+type PlayerName = String
+type Hand = [CardSym]
+type Deck = [CardSym]
+type Discard = [CardSym]
+
+type GameLog = [GameMessage]
+type GameMessage = Either GameLine GameError
+type GameLine = String
+type GameError = String
+
+data Faction = Blue | Red | White | Green | Yellow | Black deriving (Show)
+data TypeSym = Character | Eva | Angel | Drama | Put | Intstrumentality deriving (Show, Eq)
+data Trait = Other | Reaction | Male | Female | Weapon deriving (Show)
+type Traits = [Trait]
+data Mark = Circle | Triangle deriving (Show)
+type LineMark = (Mark, Faction)
+type LineMarks = [LineMark]
+
+data CardInfo = CardInfo
+   { ciName :: String
+   , ciFaction :: Faction
+   , ciType :: TypeSym
+   , ciText :: String
+   , ciTraits :: Traits
+   , ciLineMarks :: Maybe LineMarks
+   , ciLine :: Maybe String
+   , ciDP :: Maybe Integer
+   , ciStrength :: Maybe Integer
+   , ciLevel :: Maybe Integer
+   , ciNextInst :: Maybe CardSym
+   } deriving (Show)
+

Util.hs

@@ -0,0 +1,23 @@
+module Util where
+
+rmFirstMatch :: [a] -> (a -> Bool) -> [a]
+rmFirstMatch [] _ = []
+rmFirstMatch (l:ls) f
+   | f l = ls
+   | otherwise = (l : rmFirstMatch ls f)
+
+unwrapLeft :: Either a b -> a
+unwrapLeft (Left x) = x
+unwrapLeft (Right _) = error "Not a Left value"
+
+unwrapRight :: Either a b -> b
+unwrapRight (Right x) = x
+unwrapRight (Left _) = error "Not a Right value"
+
+-- Remove duplicates, stabily
+uniq :: (Eq a) => [a] -> [a]
+uniq x = reverse $ go x []
+   where
+      go [] al = al
+      go (c:cs) al = if (c `elem` al) then (go cs al) else (go cs (c:al))
+