{-# Language QuasiQuotes, TupleSections #-}
{-|
Module      : Main
Description : Day 8 solution
Copyright   : (c) Eric Mertens, 2021
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2016/day/8>

Run a series of pixel rotation commands to find the
solution image.

-}
module Main (main) where

import Advent (format, countBy)
import Advent.Coord (Coord(..), drawCoords)
import Control.Monad (when)
import Data.Array.IO
import Data.Foldable (for_, traverse_)

rows, cols :: Int
rows :: Int
rows = Int
6
cols :: Int
cols = Int
50

data Command
  = Rect      !Int !Int
  | RotateCol !Int !Int
  | RotateRow !Int !Int
  deriving Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
(Int -> Command -> ShowS)
-> (Command -> String) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Command -> ShowS
showsPrec :: Int -> Command -> ShowS
$cshow :: Command -> String
show :: Command -> String
$cshowList :: [Command] -> ShowS
showList :: [Command] -> ShowS
Show

toCommand :: Either (Either (Int, Int) (Int, Int)) (Int, Int) -> Command
toCommand :: Either (Either (Int, Int) (Int, Int)) (Int, Int) -> Command
toCommand (Left (Left (Int
x,Int
y))) = Int -> Int -> Command
Rect Int
x Int
y
toCommand (Left (Right (Int
y,Int
n))) = Int -> Int -> Command
RotateRow Int
y Int
n
toCommand (Right (Int
x,Int
n)) = Int -> Int -> Command
RotateCol Int
x Int
n

-- | >>> :main
-- 128
-- ████··██···██··███···██··███··█··█·█···█·██···██·
-- █····█··█·█··█·█··█·█··█·█··█·█··█·█···██··█·█··█
-- ███··█··█·█··█·█··█·█····█··█·████··█·█·█··█·█··█
-- █····█··█·████·███··█·██·███··█··█···█··████·█··█
-- █····█··█·█··█·█·█··█··█·█····█··█···█··█··█·█··█
-- ████··██··█··█·█··█··███·█····█··█···█··█··█··██·
main :: IO ()
IO ()
main =
 do input <- [format|2016 8 ((rect %ux%u|rotate row y=%u by %u|rotate column x=%u by %u)%n)*|]
    let cmds = (Either (Either (Int, Int) (Int, Int)) (Int, Int) -> Command)
-> [Either (Either (Int, Int) (Int, Int)) (Int, Int)] -> [Command]
forall a b. (a -> b) -> [a] -> [b]
map Either (Either (Int, Int) (Int, Int)) (Int, Int) -> Command
toCommand [Either (Either (Int, Int) (Int, Int)) (Int, Int)]
input
    a <- newArray (C 0 0,C (rows-1) (cols-1)) False
          :: IO (IOUArray Coord Bool)
    traverse_ (interpCommand a) cmds
    print =<< countPixels a
    drawScreen a

drawScreen :: IOUArray Coord Bool -> IO ()
drawScreen :: IOUArray Coord Bool -> IO ()
drawScreen IOUArray Coord Bool
a =
 do xs <- IOUArray Coord Bool -> IO [(Coord, Bool)]
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m [(i, e)]
getAssocs IOUArray Coord Bool
a
    putStr (drawCoords [c | (c, True) <- xs])

countPixels :: IOUArray Coord Bool -> IO Int
countPixels :: IOUArray Coord Bool -> IO Int
countPixels IOUArray Coord Bool
a =
  do xs <- IOUArray Coord Bool -> IO [Bool]
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> m [e]
getElems IOUArray Coord Bool
a
     return $! countBy id xs

interpCommand :: IOUArray Coord Bool -> Command -> IO ()
interpCommand :: IOUArray Coord Bool -> Command -> IO ()
interpCommand IOUArray Coord Bool
a (Rect Int
xn Int
yn) =
  [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0 .. Int
xnInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
x ->
  [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0 .. Int
ynInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
y ->
  IOUArray Coord Bool -> Coord -> Bool -> IO ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOUArray Coord Bool
a (Int -> Int -> Coord
C Int
y Int
x) Bool
True
interpCommand IOUArray Coord Bool
a (RotateCol Int
x Int
n) = IOUArray Coord Bool -> (Int -> Coord) -> Int -> Int -> IO ()
forall i (a :: * -> * -> *) e (m :: * -> *).
(Ix i, MArray a e m) =>
a i e -> (Int -> i) -> Int -> Int -> m ()
rotate IOUArray Coord Bool
a (Int -> Int -> Coord
`C` Int
x) Int
rows Int
n
interpCommand IOUArray Coord Bool
a (RotateRow Int
y Int
n) = IOUArray Coord Bool -> (Int -> Coord) -> Int -> Int -> IO ()
forall i (a :: * -> * -> *) e (m :: * -> *).
(Ix i, MArray a e m) =>
a i e -> (Int -> i) -> Int -> Int -> m ()
rotate IOUArray Coord Bool
a (Int -> Int -> Coord
C Int
y) Int
cols Int
n

rotate :: (Ix i, MArray a e m) => a i e -> (Int -> i) -> Int -> Int -> m ()
rotate :: forall i (a :: * -> * -> *) e (m :: * -> *).
(Ix i, MArray a e m) =>
a i e -> (Int -> i) -> Int -> Int -> m ()
rotate a i e
a Int -> i
f Int
len Int
n =
  do a i e -> (Int -> i) -> Int -> Int -> m ()
forall i (a :: * -> * -> *) e (m :: * -> *).
(Ix i, MArray a e m) =>
a i e -> (Int -> i) -> Int -> Int -> m ()
reverseRange a i e
a Int -> i
f Int
0 (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n)
     a i e -> (Int -> i) -> Int -> Int -> m ()
forall i (a :: * -> * -> *) e (m :: * -> *).
(Ix i, MArray a e m) =>
a i e -> (Int -> i) -> Int -> Int -> m ()
reverseRange a i e
a Int -> i
f (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
     a i e -> (Int -> i) -> Int -> Int -> m ()
forall i (a :: * -> * -> *) e (m :: * -> *).
(Ix i, MArray a e m) =>
a i e -> (Int -> i) -> Int -> Int -> m ()
reverseRange a i e
a Int -> i
f Int
0 (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

reverseRange :: (Ix i, MArray a e m) => a i e -> (Int -> i) -> Int -> Int -> m ()
reverseRange :: forall i (a :: * -> * -> *) e (m :: * -> *).
(Ix i, MArray a e m) =>
a i e -> (Int -> i) -> Int -> Int -> m ()
reverseRange a i e
a Int -> i
f Int
lo Int
hi =
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
lo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
hi) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    do a i e -> i -> i -> m ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> i -> m ()
swap a i e
a (Int -> i
f Int
lo) (Int -> i
f Int
hi)
       a i e -> (Int -> i) -> Int -> Int -> m ()
forall i (a :: * -> * -> *) e (m :: * -> *).
(Ix i, MArray a e m) =>
a i e -> (Int -> i) -> Int -> Int -> m ()
reverseRange a i e
a Int -> i
f (Int
loInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
hiInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

swap :: (MArray a e m, Ix i) => a i e -> i -> i -> m ()
swap :: forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> i -> m ()
swap a i e
a i
i i
j =
  do t <- a i e -> i -> m e
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray a i e
a i
i
     writeArray a i =<< readArray a j
     writeArray a j t