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)