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

<https://adventofcode.com/2021/day/13>

Given a paper with some dots and a series of fold instructions
we fold and fold and fold and find our secret code.

-}
module Main (main) where

import Advent.Coord (Coord(C), drawCoords)
import Advent (format, stageTH)
import Data.Set (Set)
import Data.Set qualified as Set

data A = Ax | Ay deriving (Int -> A -> ShowS
[A] -> ShowS
A -> String
(Int -> A -> ShowS) -> (A -> String) -> ([A] -> ShowS) -> Show A
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> A -> ShowS
showsPrec :: Int -> A -> ShowS
$cshow :: A -> String
show :: A -> String
$cshowList :: [A] -> ShowS
showList :: [A] -> ShowS
Show)

stageTH -- template haskell staging

-- | >>> :main
-- 716
-- ███··███···██··█··█·████·███··█····███·
-- █··█·█··█·█··█·█·█··█····█··█·█····█··█
-- █··█·█··█·█····██···███··███··█····█··█
-- ███··███··█····█·█··█····█··█·█····███·
-- █·█··█····█··█·█·█··█····█··█·█····█·█·
-- █··█·█·····██··█··█·█····███··████·█··█
main :: IO ()
IO ()
main =
 do ([(Int, Int)]
points, [(A, Int)]
folds) <- [format|2021 13 (%u,%u%n)*%n(fold along @A=%u%n)*|]
    let pointSet :: Set Coord
pointSet = [Coord] -> Set Coord
forall a. Ord a => [a] -> Set a
Set.fromList [Int -> Int -> Coord
C Int
y Int
x | (Int
x, Int
y) <- [(Int, Int)]
points]
        states :: [Set Coord]
states   = (Set Coord -> (A, Int) -> Set Coord)
-> Set Coord -> [(A, Int)] -> [Set Coord]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (((A, Int) -> Set Coord -> Set Coord)
-> Set Coord -> (A, Int) -> Set Coord
forall a b c. (a -> b -> c) -> b -> a -> c
flip (A, Int) -> Set Coord -> Set Coord
foldPoints) Set Coord
pointSet [(A, Int)]
folds
        p1 :: Set Coord
p1       = [Set Coord]
states [Set Coord] -> Int -> Set Coord
forall a. HasCallStack => [a] -> Int -> a
!! Int
1 -- points after first fold
        p2 :: Set Coord
p2       = [Set Coord] -> Set Coord
forall a. HasCallStack => [a] -> a
last [Set Coord]
states -- points after last fold
    Int -> IO ()
forall a. Show a => a -> IO ()
print (Set Coord -> Int
forall a. Set a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Set Coord
p1)
    String -> IO ()
putStr (Set Coord -> String
forall (t :: * -> *). Foldable t => t Coord -> String
drawCoords Set Coord
p2)

-- | 2-dimensional fold the set of points over a line.
foldPoints :: (A, Int) {- ^ fold line -} -> Set Coord -> Set Coord
foldPoints :: (A, Int) -> Set Coord -> Set Coord
foldPoints (A
Ax, Int
lx) = (Coord -> Coord) -> Set Coord -> Set Coord
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map \(C Int
y Int
x) -> Int -> Int -> Coord
C Int
y (Int -> Int -> Int
fold1 Int
lx Int
x)
foldPoints (A
Ay, Int
ly) = (Coord -> Coord) -> Set Coord -> Set Coord
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map \(C Int
y Int
x) -> Int -> Int -> Coord
C (Int -> Int -> Int
fold1 Int
ly Int
y) Int
x

-- | 1-dimensional fold updating one point
fold1 :: Int {- ^ fold -} -> Int {- ^ point -} -> Int
fold1 :: Int -> Int -> Int
fold1 Int
a Int
i = Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
forall a. Num a => a -> a
abs (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i)