finished refactor, compiles and runs as before now

README.md

@@ -7,9 +7,9 @@ tA's Rules Engine for the Neon Genesis Evangelion Trading Card Game.
 Currently only runs in GHCI
 
 ```haskell
-:load Connect.hs Print.hs Init.hs
-import Print
-import Init
+:load Leads/Groups.hs ComBoard/Printer.hs ComBoard/Init.hs
+import ComBoard.Printer
+import ComBoard.Init
 ```
 
 To print the representation of the initial board state
@@ -17,32 +17,37 @@ To print the representation of the initial board state
 printState initBS
 ```
 
-`conHurt` and `conAttract` are currently the only implemented mechanics
+`hurt` and `attract` are currently the only implemented main mechanics
 ```haskell
-printState $ conHurt Asuka Gendo $ conAttract Shinji Asuka initBS
+printState $ (attract Ritsuko Misato)
+           . (hurt Shinji Gendo)
+           . (attract Asuka Shinji)
+           . (hurt Rei Ritsuko)
+           $ initBS
 ```
 returns:
 
 ```plaintext
 == BOARD STATE ==
  - Groups -
-A ~ [ Shinji, Asuka ] <-> BCDE
-B ~ [ Rei ] <-> AE
-C ~ [ Misato ] <-> AD
-D ~ [ Ritsuko ] <-> ACE
-E ~ [ Gendo ] <-> ABD
+A ~ [ Ritsuko, Misato ] <-> BD
+B ~ [ Shinji, Asuka ] <-> ACD
+C ~ [ Rei ] <-> BD
+D ~ [ Gendo ] <-> ABC
  - Downed -
 ~ Gendo
+~ Ritsuko
  - GameLog -
-Shinji attracted Asuka, Asuka's group joined Shinji's group
-Asuka hurt Gendo, Gendo is downed
+Rei hurts Ritsuko, Ritsuko is downed!
+Shinji attracts Asuka, both groups are joined
+Shinji hurts Gendo, Gendo is downed!
+Ritsuko attracts Misato, both groups are joined
 =================
 ```
 
-
 ### Dependencies
 
-`Data.List` and `Data.Either`
+`Data.List` and `Maybe (Data.Either)`
 
 ## Authors
 

src/Cogs/Groups.hs

@@ -33,22 +33,22 @@ isDowned c bs = c `elem` d
 
 -- Return true if character is not grouped
 isAlone :: MainCharacter -> BoardState -> Bool
-isAlone c bs = curFrens c g == []
+isAlone c bs = curFrens c bs == []
    where g = (ntGroups . bsNeoTokyo) bs
 
 -- Return true if X is adjacent to Y
 isAdjacent :: MainCharacter -> MainCharacter -> BoardState -> Bool
-isAdjacent x y bs = y `elem` (getAdj x g)
+isAdjacent x y bs = y `elem` (getAdj x bs)
    where g = (ntGroups . bsNeoTokyo) bs
 
 -- All characters a X is adjacent to
 getAdj :: MainCharacter -> BoardState -> [MainCharacter]
-getAdj x bs = curFrens x g ++ (foldr (++) [] (adjGroups x g))
+getAdj x bs = curFrens x bs ++ (foldr (++) [] (adjGroups x bs))
    where g = (ntGroups . bsNeoTokyo) bs
 
 -- The characters currently grouped with x
 curFrens :: MainCharacter -> BoardState -> [MainCharacter]
-curFrens x bs = filter (/= x) $ charsGroup x g
+curFrens x bs = filter (/= x) $ charsGroup x bs
    where g = (ntGroups . bsNeoTokyo) bs
 
 -- The group that character x belongs to
@@ -63,13 +63,12 @@ otherGroups x bs = filter (\y -> not $ x `elem` y) g
 
 -- The groups a character is adaject to
 adjGroups :: MainCharacter -> BoardState -> Groups
-adjGroups x bs = filter (\y -> any (\z -> z `elem` adjFrens) y) (otherGroups x g)
+adjGroups x bs = filter (\y -> any (\z -> z `elem` adjFrens) y) (otherGroups x bs)
    where
-      adjFrens = uniq $ foldr (++) [] (map defFrens $ charsGroup x g)
+      adjFrens = uniq $ foldr (++) [] (map defFrens $ charsGroup x bs)
       g = (ntGroups . bsNeoTokyo) bs
 
 -- The groups a group is adjacent to
 neighborGroups :: Group -> BoardState -> Groups
-neighborGroups g bs = uniq . concat $ map (\x -> adjGroups x gs) g
-   where g = (ntGroups . bsNeoTokyo) bs
+neighborGroups g bs = uniq . concat $ map (\x -> adjGroups x bs) g
  

src/Cogs/Players.hs

@@ -6,7 +6,7 @@ module Cogs.Players where
 -- ====
 
 import ComBoard.Types
-import Util
+import Toolbox.Utils
 
 -- Returns whether CardSym is in PlayerId's hand
 isInHand :: CardSym -> PlayerId -> BoardState -> Bool

src/ComBoard/Printer.hs

@@ -4,8 +4,8 @@ module ComBoard.Printer where
 -- Prints the state of the ComBoard
 -- ====
 
-import Types
-import Groups
+import ComBoard.Types
+import Cogs.Groups
 import Data.List
 
 printState :: BoardState -> IO ()
@@ -16,7 +16,7 @@ printState bs = do
       map
          (\(gid, x) -> [gid] ++ " ~ [ " ++ concatGroup x ++ " ] <-> "
          ++
-         (map fst $ filter (\(_,y) -> y `elem` (neighborGroups x groups)) zipGroups)
+         (map fst $ filter (\(_,y) -> y `elem` (neighborGroups x bs)) zipGroups)
       ) zipGroups
    putStrLn " - Downed -"
    mapM_ putStrLn $ map 

src/Leads/ComBoard.hs

@@ -11,7 +11,7 @@ import Cogs.Players
 -- Sets the groups in NeoTokyo
 setGroups :: Groups -> BoardState -> BoardState
 setGroups gs bs = bs
-   { bsNeoTokyo = (bsNeoTokyo bs) { nsGroups = gs } }
+   { bsNeoTokyo = (bsNeoTokyo bs) { ntGroups = gs } }
 
 -- Sets the downed in NeoTokyo
 setDowned :: Downed -> BoardState -> BoardState
@@ -24,8 +24,17 @@ setPlayerLib pl bs = bs { bsPlayerLib = pl }
 
 -- Sets a players state
 setPlayer :: PlayerId -> PlayerState -> BoardState -> BoardState
-setPlayer pi ps bs = setPlayerLib $ map
-   (\(pid,state) -> if (pid == pi) then ps else state) pl
+setPlayer pi ps bs = setPlayerLib (map
+   (\(pid,state) -> if (pid == pi) then (pid,ps) else (pid,state)) pl) bs
    where
       pl = (bsPlayerLib bs)
 
+-- Adds a message to the game log
+addGameMessage :: String -> BoardState -> BoardState
+addGameMessage m bs = bs
+   { bsGameLog = (bsGameLog bs) ++ [ Left m ] }
+
+-- Adds an error to the game log
+addGameError :: String -> BoardState -> BoardState
+addGameError e bs = bs
+   { bsGameLog = (bsGameLog bs) ++ [ Right e ] }

src/Leads/Connect.hs

@@ -1,57 +0,0 @@
-module Leads.Groups where
-
--- == Leads - Groups ==
--- Functions of type :: Arg1... -> BoardState -> BoardState
--- Changes state of groups
-
-import ComBoard.Types
-import Cogs.Groups
-
--- X hurts Y
-conHurt :: MainCharacter -> MainCharacter -> BoardState -> BoardState
-conHurt charX charY oldBoardState
-   | not $ isAdjacent charX charY oldGroups = oldBoardState
-      { bsGameLog = (bsGameLog oldBoardState)
-         ++ [ Right (show charX ++ " is not adjacent to " ++ show charY ++ ", could not hurt") ]
-      }
-   | isAlone charY oldGroups = oldBoardState
-      { bsGameLog = (bsGameLog oldBoardState)
-         ++ [ Left (show charX ++ " hurt " ++ show charY ++ ", " ++ show charY ++ " is downed") ]
-      , bsNeoTokyo = (bsNeoTokyo oldBoardState)
-         { ntPutCards = filter (\x -> ((fst x) /= Left charX)) oldPut
-         , ntDowned = downChar charY oldDowned
-         }
-      }
-   | otherwise = oldBoardState
-      { bsGameLog = (bsGameLog oldBoardState)
-         ++ [ Left (show charX ++ " hurt " ++ show charY ++ ", " ++ show charY ++ " left their group") ]
-      , bsNeoTokyo = (bsNeoTokyo oldBoardState)
-         { ntGroups = removeFromGroup charY oldGroups }
-      }  
-   where
-      oldDowned = (ntDowned . bsNeoTokyo) oldBoardState
-      oldGroups = (ntGroups . bsNeoTokyo) oldBoardState
-      oldPut = (ntPutCards . bsNeoTokyo) oldBoardState
-
--- X attracts Y
-conAttract :: MainCharacter -> MainCharacter -> BoardState -> BoardState
-conAttract charX charY oldBoardState
-   | not $ isAdjacent charX charY oldGroups = oldBoardState
-      { bsGameLog = (bsGameLog oldBoardState)
-         ++ [ Right (show charX ++ " is not adjacent to " ++ show charY ++ ", could not attract") ]
-      }
-   | isDowned charX oldDowned = oldBoardState
-      { bsGameLog = (bsGameLog oldBoardState)
-         ++ [ Left (show charX ++ " attracted " ++ show charY ++ ", " ++ show charY ++ " is ready") ]
-      , bsNeoTokyo = (bsNeoTokyo oldBoardState)
-         { ntDowned = readyChar charY oldDowned }
-      }
-   | otherwise = oldBoardState
-      { bsGameLog = (bsGameLog oldBoardState)
-         ++ [ Left (show charX ++ " attracted " ++ show charY ++ ", " ++ show charY ++ "'s group joined " ++ show charX ++ "'s group") ]
-      , bsNeoTokyo = (bsNeoTokyo oldBoardState)
-         { ntGroups = joinGroups charX charY oldGroups }
-      }  
-   where
-      oldDowned = (ntDowned . bsNeoTokyo) oldBoardState
-      oldGroups = (ntGroups . bsNeoTokyo) oldBoardState

src/Leads/Groups.hs

@@ -5,26 +5,28 @@ module Leads.Groups where
 -- Changes state of groups
 -- ====
 
+import Cogs.Groups
 import Leads.ComBoard
 import ComBoard.Types
 import Toolbox.Utils
 
 -- Return the groups with C removed from its current group
 removeFromGroup :: MainCharacter -> BoardState -> BoardState
-removeFromGroup c bs = setGroups ( [c] : (groupMinusChar c) : (otherGroups c g) ) bs
+removeFromGroup c bs = setGroups ( [c] : (groupMinusChar c) : (otherGroups c bs) ) bs
    where
-      groupMinusChar x = curFrens x g
+      groupMinusChar x = curFrens x bs
       g = (ntGroups . bsNeoTokyo) bs
 
 -- Return the groups with X grouped with Y
 joinGroups :: MainCharacter -> MainCharacter -> BoardState -> BoardState
 joinGroups x y bs
-   | x `elem` curFrens y g = bs
-   | otherwise = setGroups ((groupX ++ groupY) : (otherGroups x . otherGroups y) g) bs
+   | x `elem` curFrens y bs = bs
+   | otherwise = setGroups ((groupX ++ groupY) : ogs) bs
    where
       g = (ntGroups . bsNeoTokyo) bs
-      groupX = charsGroup x g
-      groupY = charsGroup y g
+      groupX = charsGroup x bs
+      groupY = charsGroup y bs
+      ogs = otherGroups y (setGroups (otherGroups x bs) bs)
 
 -- Return the Downed with the new character
 downChar :: MainCharacter -> BoardState -> BoardState
@@ -39,3 +41,25 @@ readyChar :: MainCharacter -> BoardState -> BoardState
 readyChar c bs = setDowned (filter (/= c) d) bs
    where
       d = (ntDowned . bsNeoTokyo) bs
+
+-- Have character X attract Y
+attract :: MainCharacter -> MainCharacter -> BoardState -> BoardState
+attract charX charY bs
+   | charY `elem` d = (addGameMessage
+      (show charX ++ " attracts " ++ show charY ++ ", " ++ show charY ++ " is readied!"))
+      . (readyChar charY) $ bs
+   | otherwise = (addGameMessage
+      (show charX ++ " attracts " ++ show charY ++ ", both groups are joined"))
+      . (joinGroups charX charY) $ bs
+   where
+      d = (ntDowned . bsNeoTokyo) bs
+
+-- Have character X hurt Y
+hurt :: MainCharacter -> MainCharacter -> BoardState -> BoardState
+hurt charX charY bs
+   | isAlone charY bs = (addGameMessage
+      (show charX ++ " hurts " ++ show charY ++ ", " ++ show charY ++ " is downed!"))
+      . (downChar charY) {- . (removePut charY) -} $ bs
+   | otherwise = (addGameMessage
+      (show charX ++ " hurts " ++ show charY ++ ", " ++ show charY ++ " is seperated"))
+      . (removeFromGroup charY) $ bs

src/Leads/Lines.hs

@@ -0,0 +1,11 @@
+module Leads.Lines where
+
+-- == Leads - Lines ==
+-- Functions of type :: Arg1... -> BoardState -> BoardState
+-- used to change state of line cards
+-- ====
+
+import ComBoard.Types
+import Toolbox.Utils
+
+