+ go (g, c, i) = (rollCycle g cGrid, M.insert g i c, (i + 1))
+
+rollNorth, rollCycle :: Grid -> Grid -> Grid
+rollNorth rGrid cGrid = roll [(V2 0 0, V2 0 1, V2 1 0)] cGrid rGrid
+
+rollCycle rGrid cGrid = roll [ (V2 0 0, V2 0 1, V2 1 0)
+ , (V2 0 0, V2 1 0, V2 0 1)
+ , (V2 r 0, V2 0 1, V2 -1 0)
+ , (V2 0 c, V2 1 0, V2 0 -1)
+ ]
+ cGrid rGrid
+ where (_, V2 r c) = U.bounds rGrid
+
+roll :: [(Position, Position, Position)] -> Grid -> Grid -> Grid
+roll moveSpecs cGrid rGrid =
+ A.runSTUArray $
+ do grid <- A.thaw rGrid
+ holes <- newSTRef Q.Empty
+ forM_ moveSpecs $ \(start, majorStep, minorStep) ->
+ forM_ (takeWhile (inBounds rGrid) $ iterate (^+^ majorStep) start) $ \maj ->
+ do writeSTRef holes Q.Empty
+ forM_ (takeWhile (inBounds rGrid) $ iterate (^+^ minorStep) maj) $ \here ->
+ rollPosition grid cGrid holes here
+ return grid
+
+rollPosition :: (MGrid s) -> Grid -> (Gaps s) -> Position -> ST s ()
+rollPosition grid cGrid holes here
+ | cGrid U.! here = writeSTRef holes Q.Empty
+ | otherwise = do roundHere <- A.readArray grid here
+ holesVal <- readSTRef holes
+ if roundHere then
+ case holesVal of
+ Q.Empty -> return ()
+ (h :<| hs) -> do A.writeArray grid h True
+ A.writeArray grid here False
+ writeSTRef holes (hs :|> here)
+ else modifySTRef holes (:|> here)
+
+inBounds :: Grid -> Position -> Bool
+inBounds g h = inRange (U.bounds g) h
+
+getLoad :: Grid -> Int
+getLoad grid = sum [getColLoad c | c <- [0..cMax]]
+ where (_, V2 rMax cMax) = U.bounds grid
+ getColLoad c = sum [(rMax - r + 1) | r <- [0..rMax], grid U.! (V2 r c)]
+
+readGrids :: String -> (Grid, Grid)
+readGrids text = (rGrid, cGrid)
+ where rows = lines text
+ r = length rows - 1
+ c = (length $ head rows) - 1
+ rGrid = U.listArray ((V2 0 0), (V2 r c)) $ fmap (== 'O') $ concat rows
+ cGrid = U.listArray ((V2 0 0), (V2 r c)) $ fmap (== '#') $ concat rows
+
+showGrids :: Grid -> Grid -> String
+showGrids rGrid cGrid = unlines rows
+ where (_, V2 rMax cMax) = U.bounds rGrid
+ rows = [showRow r | r <- [0..rMax]]
+ showRow r = [showElem r c | c <- [0..cMax]]
+ showElem r c = let isR = rGrid U.! (V2 r c)
+ isC = cGrid U.! (V2 r c)
+ in if | isR && isC -> 'X'
+ | isR -> 'O'
+ | isC -> '#'
+ | otherwise -> '.'