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

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

-}
module Main where

import Advent (format)
import Crypto.Hash.MD5 (hash)
import Data.ByteString qualified as B
import Data.ByteString.Builder (byteStringHex)
import Data.ByteString.Builder.Extra (toLazyByteStringWith, untrimmedStrategy)
import Data.ByteString.Char8 qualified as B8
import Data.ByteString.Lazy qualified as L
import Data.List (isInfixOf, tails)

-- | >>> :main
-- 15168
-- 20864
main :: IO ()
IO ()
main =
  do [Char]
input <- [format|2016 14 %s%n|]
     Int -> IO ()
forall a. Show a => a -> IO ()
print ([Char] -> Int -> Int
solve [Char]
input Int
1)
     Int -> IO ()
forall a. Show a => a -> IO ()
print ([Char] -> Int -> Int
solve [Char]
input Int
2017)

-- | Hash a bytestring to to ASCII encoded, lowercase hex
hashmd5 :: B.ByteString -> B.ByteString
hashmd5 :: ByteString -> ByteString
hashmd5
  = ByteString -> ByteString
L.toStrict
  (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllocationStrategy -> ByteString -> Builder -> ByteString
toLazyByteStringWith AllocationStrategy
md5strategy ByteString
L.empty
  (Builder -> ByteString)
-> (ByteString -> Builder) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
byteStringHex
  (ByteString -> Builder)
-> (ByteString -> ByteString) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
hash
  where
    md5strategy :: AllocationStrategy
md5strategy = Int -> Int -> AllocationStrategy
untrimmedStrategy Int
32 Int
32

iteratedHash :: Int -> B.ByteString -> B.ByteString
iteratedHash :: Int -> ByteString -> ByteString
iteratedHash Int
n ByteString
x
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ByteString
x
  | Bool
otherwise = Int -> ByteString -> ByteString
iteratedHash (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (ByteString -> ByteString
hashmd5 ByteString
x)

seed :: String -> Int -> B.ByteString
seed :: [Char] -> Int -> ByteString
seed [Char]
input Int
i = [Char] -> ByteString
B8.pack ([Char]
input [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i)

solve :: String -> Int -> Int
solve :: [Char] -> Int -> Int
solve [Char]
input Int
iterations =
  [[Char]] -> [Int]
search ((Int -> [Char]) -> [Int] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> [Char]
B8.unpack (ByteString -> [Char]) -> (Int -> ByteString) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
iteratedHash Int
iterations (ByteString -> ByteString)
-> (Int -> ByteString) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Int -> ByteString
seed [Char]
input) [Int
0..]) [Int] -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Int
63

search :: [String] -> [Int]
search :: [[Char]] -> [Int]
search [[Char]]
hashes =
  [ Int
i | (Int
i,[Char]
h:[[Char]]
hs) <- [Int] -> [[[Char]]] -> [(Int, [[Char]])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([[Char]] -> [[[Char]]]
forall a. [a] -> [[a]]
tails [[Char]]
hashes)
      , Char
start <- Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
1 [ Char
x | Char
x:Char
y:Char
z:[Char]
_ <- [Char] -> [[Char]]
forall a. [a] -> [[a]]
tails [Char]
h, Char
xChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
y, Char
yChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
z]
      , ([Char] -> Bool) -> [[Char]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
5 Char
start [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) (Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
take Int
1000 [[Char]]
hs)
      ]