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

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

-}
module Main where

import Advent (arrIx, format, stageTH)
import Advent.Coord (Coord(..), east, north, origin, south, west)
import Data.Foldable (foldl')
import Data.Array (Array, (!), listArray)

data D = DL | DR | DU | DD

stageTH

-- | >>> :main
-- 97289
-- 9A7DC
main :: IO ()
IO ()
main =
 do [[D]]
cmds <- [format|2016 2 (@D*%n)*|]
    String -> IO ()
putStrLn (Array Coord Char -> [[D]] -> String
computeCode Array Coord Char
keys1 [[D]]
cmds)
    String -> IO ()
putStrLn (Array Coord Char -> [[D]] -> String
computeCode Array Coord Char
keys2 [[D]]
cmds)

keys1 :: Array Coord Char
keys1 :: Array Coord Char
keys1 = (Coord, Coord) -> String -> Array Coord Char
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int -> Int -> Coord
C (-Int
1) (-Int
1), Int -> Int -> Coord
C Int
1 Int
1)
  String
"123\
  \456\
  \789"

keys2 :: Array Coord Char
keys2 :: Array Coord Char
keys2 = (Coord, Coord) -> String -> Array Coord Char
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int -> Int -> Coord
C (-Int
2) (-Int
2), Int -> Int -> Coord
C Int
2 Int
2)
  String
"..1..\
  \.234.\
  \56789\
  \.ABC.\
  \..D.."

computeCode :: Array Coord Char -> [[D]] -> String
computeCode :: Array Coord Char -> [[D]] -> String
computeCode Array Coord Char
ks [[D]]
cmds = (Coord -> Char) -> [Coord] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Array Coord Char
ksArray Coord Char -> Coord -> Char
forall i e. Ix i => Array i e -> i -> e
!) ([Coord] -> [Coord]
forall a. HasCallStack => [a] -> [a]
tail ((Coord -> [D] -> Coord) -> Coord -> [[D]] -> [Coord]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (Array Coord Char -> Coord -> [D] -> Coord
process Array Coord Char
ks) Coord
origin [[D]]
cmds))

process ::
  Array Coord Char {- ^ key pad           -} ->
  Coord            {- ^ starting position -} ->
  [D]              {- ^ command           -} ->
  Coord            {- ^ stopping position -}
process :: Array Coord Char -> Coord -> [D] -> Coord
process Array Coord Char
ks = (Coord -> D -> Coord) -> Coord -> [D] -> Coord
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Coord -> D -> Coord
aux
  where
    aux :: Coord -> D -> Coord
aux Coord
pos D
mov
      | Array Coord Char -> Coord -> Bool
isValid Array Coord Char
ks Coord
pos' = Coord
pos'
      | Bool
otherwise       = Coord
pos
      where
        pos' :: Coord
pos' = Coord
pos Coord -> Coord -> Coord
forall a. Num a => a -> a -> a
+ D -> Coord
translate D
mov

isValid :: Array Coord Char -> Coord -> Bool
isValid :: Array Coord Char -> Coord -> Bool
isValid Array Coord Char
ks Coord
i = Bool -> (Char -> Bool) -> Maybe Char -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') (Array Coord Char -> Coord -> Maybe Char
forall (a :: * -> * -> *) e i (f :: * -> *).
(IArray a e, Ix i, Alternative f) =>
a i e -> i -> f e
arrIx Array Coord Char
ks Coord
i)

translate :: D -> Coord
translate :: D -> Coord
translate D
DL = Coord
west
translate D
DR = Coord
east
translate D
DU = Coord
north
translate D
DD = Coord
south