```-- |
-- Module      : AOC.Challenge.Day12
-- Copyright   : (c) Justin Le 2018
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Day 12.  See "AOC.Solver" for the types used in this module!

module AOC.Challenge.Day12 (
day12a
, day12b
) where

import           AOC.Common     ((!!!))
import           AOC.Solver     ((:~>)(..))
import           Data.Bifunctor (bimap)
import           Data.Finite    (Finite, finites)
import           Data.Set       (Set)
import qualified Data.Map       as M
import qualified Data.Set       as S

type Ctx = Set (Finite 5)
type Pos = Int

step
:: Set Ctx
-> Set Pos
-> Set Pos
step ctxs w0 = S.fromDistinctAscList
. filter go
\$ [S.findMin w0 - 2 .. S.findMax w0 + 2]
where
go i = neighbs `S.member` ctxs
where
neighbs = S.fromDistinctAscList . flip filter finites \$ \j ->
(i - 2 + fromIntegral j) `S.member` w0

findLoop
:: Set Ctx
-> Set Pos
-> (Int, Int, Int)      -- time to loop, loop size, loop incr
findLoop ctxs w0 = go (M.singleton w0 (0, 0)) 1 w0
where
go !seen !i !w = case M.lookup w'Norm seen of
Nothing              -> go (M.insert w'Norm (mn, i) seen) (i + 1) w'
Just (seenMn, seenI) -> (seenI, i - seenI, mn - seenMn)
where
w'           = step ctxs w
(mn, w'Norm) = normalize w'
normalize w = (mn, S.map (subtract mn) w)
where
mn = S.findMin w

stepN
:: Int
-> Set Pos
-> Set Ctx
-> Set Pos
stepN n w ctx = goN extra
. S.map (+ (loopIncr * looped))
. goN ttl
\$ w
where
goN m = (!!! m) . iterate (step ctx)
(ttl, loopSize, loopIncr) = findLoop ctx w
(looped, extra) = (n - ttl) `divMod` loopSize

day12a :: (Set Pos, Set Ctx) :~> Int
day12a = MkSol
{ sParse = Just . bimap makeState makeCtxs . span (/= '\n')
, sShow  = show
, sSolve = \(w, ctx) -> Just . sum \$ iterate (step ctx) w !!! 20
}

day12b :: (Set Pos, Set Ctx) :~> Int
day12b = MkSol
{ sParse = Just . bimap makeState makeCtxs . span (/= '\n')
, sShow  = show
, sSolve = Just . sum . uncurry (stepN 50000000000)
}

makeState :: String -> Set Pos
makeState = M.keysSet
. M.filter (== '#')
. M.fromList
. zip [0..]
. filter (`elem` "#.")

makeCtxs :: String -> Set Ctx
makeCtxs = M.keysSet
. M.filter id
. M.fromList
. map ( bimap parseLine head
. splitAt 5
. map (== '#')
. filter (`elem` "#.")
)
. lines
where
parseLine = S.fromList . map fst . filter snd . zip finites
```