module Day24 where

import AoC
import Conway

import Data.List
import qualified Data.Set as S
import Optics.Core hiding (Index)
import Optics.TH

data Coord = Coord { east :: Int
                   , northeast :: Int
                   } deriving (Eq, Ord)

instance Index Coord where
    neighbours c = map (addIndex c . uncurry Coord) offsets
        where offsets = [(0, -1), (0, 1), (1, -1), (1, 0), (-1, 0), (-1, 1)]
    addIndex (Coord x1 y1) (Coord x2 y2) = Coord (x1 + x2) (y1 + y2)

parseSteps :: String -> Coord
parseSteps [] = Coord 0 0
parseSteps xs = case xs of
                  ('n':'w':xs) -> go (-1, 1) xs
                  ('w':xs)     -> go (-1, 0) xs
                  ('s':'w':xs) -> go (0, -1) xs
                  ('n':'e':xs) -> go (0, 1) xs
                  ('e':xs)     -> go (1, 0) xs
                  ('s':'e':xs) -> go (1, -1) xs
    where go (e, ne) xs = addIndex (Coord e ne) $ parseSteps xs

main = runAoC (onlySet . map parseSteps . lines) length (length . conwayN 100 . S.fromList)
    where onlySet = map head . filter (odd . length) . group . sort
          conwayN n = last . take n . tail . iterate (update (==2) (`notElem` [1, 2]))