{-# OPTIONS_HADDOCK ignore-exports #-}
module Day10 (day10a, day10b, deriveKey, hashString, knotRanges, reverseRange, xorEach) where
import Data.Array.IArray (IArray, (!), bounds, elems, ixmap, listArray)
import Data.Array.Unboxed (UArray)
import Data.Bits (Bits, xor)
import Data.Bool (bool)
import Data.Char (ord)
import Data.Ix (Ix, inRange, index, rangeSize)
import Data.List (foldl', foldl1', replicate, scanl')
import Data.List.Split (chunksOf)
import Data.Word (Word8)
import Text.Printf (printf)
reverseRange :: (IArray a e, Ix i, Num i) => a i e -> (i, i) -> a i e
reverseRange arr r@(start, end) = ixmap b reverseIx arr where
b@(low, high) = bounds arr
ix = index b
reverseIx i
| start <= end, inRange r i = start + end - i
| start > end, inRange (start, high) i || inRange (low, end) i
= low + fromIntegral ((ix start + ix end - ix i) `mod` rangeSize b)
| otherwise = i
knotRanges :: (Ix i, Num i) => (i, i) -> [Int] -> [Maybe (i, i)]
knotRanges b@(low, high) counts =
[ if len <= 0 then Nothing else Just
(low + fromIntegral start, low + fromIntegral (addMod start $ len - 1))
| (len, start) <- zip counts $ scanl' addMod 0 $ zipWith (+) [0..] counts
] where addMod x y = (x + y) `mod` rangeSize b
hash :: (IArray a e, Ix i, Num i) => a i e -> [Int] -> a i e
hash arr counts =
foldl' (maybe <*> reverseRange) arr $ knotRanges (bounds arr) counts
deriveKey :: String -> [Int]
deriveKey = concat . replicate 64 . (++ [17, 31, 73, 47, 23]) . map ord
xorEach :: (IArray a e, Ix i, Bits e) => Int -> a i e -> [e]
xorEach n = fmap (foldl1' xor) . chunksOf n . elems
hashString :: String -> [Word8]
hashString = xorEach 16 . hash arr . deriveKey where
arr = listArray (0, 255) [0..] :: UArray Int Word8
day10a :: Int -> String -> Int
day10a len input = hashed ! 0 * hashed ! 1 where
arr = listArray (0, len - 1) [0..] :: UArray Int Int
hashed = hash arr . read $ '[' : input ++ "]"
day10b :: String -> String
day10b = concatMap (printf "%02x") . hashString