{-# Language ImportQualifiedPost #-}
{-|
Module      : Main
Description : Day 10 solution
Copyright   : (c) Eric Mertens, 2017
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2017/day/10>

Day 10 poses a convoluted knot-tying algorithm to implement.

-}
module Main where

import Advent           (getInputLines)
import Control.Monad    ((<=<), zipWithM_)
import Control.Monad.ST (ST, runST)
import Data.Bits        (xor)
import Data.Char        (ord, chr)
import Data.Foldable    (for_)
import Data.List        (foldl1')
import Data.List.Split  (chunksOf, splitOn)
import Text.Printf      (printf)
import Data.Vector.Unboxed qualified as V
import Data.Vector.Unboxed.Mutable qualified as M
import KnotHash (knotHash, tieKnots)

-- | Print the solution to both parts of Day 10. Input file is configurable
-- via the command-line.
--
-- >>> :main
-- 23874
-- e1a65bfb5a5ce396025fab5528c25a87
main :: IO ()
IO ()
main =
  do [String
inputLine] <- Int -> Int -> IO [String]
getInputLines Int
2017 Int
10
     String -> IO ()
putStrLn (String -> String
part1 String
inputLine)
     String -> IO ()
putStrLn (String -> String
part2 String
inputLine)

-- | Compute the product of the first two elements after performing
-- the knot-tying ritual using the lengths given as inputs.
--
-- >>> part1 5 "3,4,1,5"
-- "12"
part1 ::
  String {- ^ input string -} ->
  String {- ^ output hash  -}
part1 :: String -> String
part1 = Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> (String -> Integer) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ([Integer] -> Integer)
-> (String -> [Integer]) -> String -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Integer) -> [Word8] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger ([Word8] -> [Integer])
-> (String -> [Word8]) -> String -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
2 ([Word8] -> [Word8]) -> (String -> [Word8]) -> String -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Word8]
tieKnots ([Int] -> [Word8]) -> (String -> [Int]) -> String -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Int]
part1Input

-- | Given a rope size and an input string, compute the resulting hash.
--
-- >>> part2 256 ""
-- "a2582a3a0e66e6e86e3812dcb672a272"
-- >>> part2 256 "AoC 2017"
-- "33efeb34ea91902bb2f59c9920caa6cd"
-- >>> part2 256 "1,2,3"
-- "3efbe78a8d82f29979031a4aa0b16a9d"
-- >>> part2 256 "1,2,4"
-- "63960835bcdc130f0b66d7ff4f6a5a8e"
part2 ::
  String {- ^ input string -} ->
  String {- ^ output hash  -}
part2 :: String -> String
part2 = String -> Integer -> String
forall r. PrintfType r => String -> r
printf String
"%032x" (Integer -> String) -> (String -> Integer) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Integer
knotHash

-- | Transform the input string according to the part 1 rule to
-- produce the list of knot lengths required.
--
-- >>> part1Input "1,2,3"
-- [1,2,3]
part1Input ::
  String {- ^ input string -} ->
  [Int]  {- ^ rope lengths -}
part1Input :: String -> [Int]
part1Input = (String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall a. Read a => String -> a
read ([String] -> [Int]) -> (String -> [String]) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
","

-- | Transform the input string according to the part 2 rule to
-- produce the list of knot lengths required.
--
-- >>> part2Input "1,2,3"
-- [49,44,50,44,51,17,31,73,47,23]
part2Input ::
  String {- ^ input string -} ->
  [Int]  {- ^ rope lengths -}
part2Input :: String -> [Int]
part2Input String
str = (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
ord String
str [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
17, Int
31, Int
73, Int
47, Int
23]