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

<https://adventofcode.com/2015/day/5>

Search for a password that satisfies a leading zeros MD5 property.

-}
module Main where

import Advent.Format (format)
import Crypto.Hash.MD5 (hash)
import Data.ByteString qualified as BS
import Data.ByteString.Char8 qualified as B
import Data.IntMap (IntMap)
import Data.IntMap qualified as IntMap
import System.IO (hSetBuffering, stdout, BufferMode(NoBuffering))
import Text.Printf (printf)

main :: IO ()
IO ()
main =
 do ByteString
input <- [Char] -> ByteString
B.pack ([Char] -> ByteString) -> IO [Char] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [format|2016 05 %s%n|]
    Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
NoBuffering
    [Char] -> IO ()
putStrLn (ByteString -> [Char]
password1 ByteString
input)
    [Char] -> IO ()
putStrLn (ByteString -> [Char]
password2 ByteString
input)

passwordLen :: Int
passwordLen :: Int
passwordLen = Int
8

password1 :: B.ByteString -> String
password1 :: ByteString -> [Char]
password1 ByteString
input = (Char, Char) -> Char
forall a b. (a, b) -> a
fst ((Char, Char) -> Char) -> [(Char, Char)] -> [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [(Char, Char)] -> [(Char, Char)]
forall a. Int -> [a] -> [a]
take Int
passwordLen (ByteString -> [(Char, Char)]
digitStream ByteString
input)

password2 :: B.ByteString -> String
password2 :: ByteString -> [Char]
password2 ByteString
input = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
passwordLen Char
'_'
         [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> IntMap Char -> [(Int, Char)] -> [Char]
go Int
0 IntMap Char
forall a. IntMap a
IntMap.empty [(Int, Char)]
digitStream'
  where
    digitStream' :: [(Int, Char)]
digitStream' =
        [ (Int
key, Char
val) | (Char
pos,Char
val) <- ByteString -> [(Char, Char)]
digitStream ByteString
input
        , let key :: Int
key = Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'0'
        , Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
key, Int
key Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
passwordLen
        ]

    go :: Int -> IntMap Char -> [(Int, Char)] -> [Char]
go Int
_ IntMap Char
seen [(Int, Char)]
_ | IntMap Char -> Int
forall a. IntMap a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length IntMap Char
seen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
passwordLen = [Char]
""
    go Int
_ IntMap Char
_ [] = [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"password generation underflow!"
    go Int
n IntMap Char
seen ((Int
key,Char
val) : [(Int, Char)]
rest)
      | Int -> IntMap Char -> Bool
forall a. Int -> IntMap a -> Bool
IntMap.member Int
key IntMap Char
seen = Int -> IntMap Char -> [Char]
render Int
n IntMap Char
seen [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> IntMap Char -> [(Int, Char)] -> [Char]
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) IntMap Char
seen [(Int, Char)]
rest
      | Bool
otherwise              = Int -> IntMap Char -> [Char]
render Int
n IntMap Char
seen' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> IntMap Char -> [(Int, Char)] -> [Char]
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) IntMap Char
seen' [(Int, Char)]
rest
      where
        seen' :: IntMap Char
seen' = Int -> Char -> IntMap Char -> IntMap Char
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
key Char
val IntMap Char
seen

spinner :: String
spinner :: [Char]
spinner    = [Char]
"◐◓◑◒"

spinnerLen :: Int
spinnerLen :: Int
spinnerLen = [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
spinner

render :: Int -> IntMap Char -> String
render :: Int -> IntMap Char -> [Char]
render Int
n IntMap Char
seen =
  Char
'\r' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: ([Char]
spinner [Char] -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! (Int
nInt -> Int -> Int
forall a. Integral a => a -> a -> a
`rem`Int
spinnerLen)) Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
' ' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:
  [ Char -> Int -> IntMap Char -> Char
forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault Char
'_' Int
key IntMap Char
seen | Int
key <- [Int
0 .. Int
passwordLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 ] ]

hexRep :: BS.ByteString -> String
hexRep :: ByteString -> [Char]
hexRep ByteString
bs = [Char] -> Word8 -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%02x" (Word8 -> [Char]) -> [Word8] -> [Char]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> [Word8]
BS.unpack ByteString
bs

digitStream :: B.ByteString -> [(Char,Char)]
digitStream :: ByteString -> [(Char, Char)]
digitStream ByteString
input = Int -> [(Char, Char)]
forall {t}. (Show t, Num t) => t -> [(Char, Char)]
go (Int
0 :: Int)
  where
    go :: t -> [(Char, Char)]
go t
i =
      case Int -> [Char] -> ([Char], [Char])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
5 (ByteString -> [Char]
hexRep (ByteString -> ByteString
hash (ByteString
input ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [Char] -> ByteString
B.pack (t -> [Char]
forall a. Show a => a -> [Char]
show t
i)))) of
        ([Char]
"00000",Char
c1:Char
c2:[Char]
_) -> (Char
c1,Char
c2) (Char, Char) -> [(Char, Char)] -> [(Char, Char)]
forall a. a -> [a] -> [a]
: t -> [(Char, Char)]
go (t
it -> t -> t
forall a. Num a => a -> a -> a
+t
1)
        ([Char], [Char])
_ -> t -> [(Char, Char)]
go (t
it -> t -> t
forall a. Num a => a -> a -> a
+t
1)