import Control.Monad
import Data.Bits (xor)
import Data.Char
import Data.List
import Numeric


strip :: String -> String
strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse

splitOn :: Eq a => a -> [a] -> [[a]]
splitOn _ [] = []
splitOn ch str = case break (== ch) str of
    (pre, ch' : post) | ch' == ch -> pre : splitOn ch post
    (pre, _) -> [pre]

rotate :: Int -> [a] -> [a]
rotate num l = take (length l) (drop num (cycle l))

blocks :: Int -> [a] -> [[a]]
blocks _ [] = []
blocks n l = let (pre, post) = splitAt n l in pre : blocks n post

pad :: Int -> a -> [a] -> [a]
pad len x list = replicate (len - length list) x ++ list

tie' :: [a] -> [Int] -> Int -> [a]
tie' chain [] _ = chain
tie' chain (len : lens) skip =
    let (sub, rest) = splitAt len chain
    in tie' (rotate skip (rest ++ reverse sub)) lens (skip + 1)

tie :: [a] -> [Int] -> [a]
tie chain lens =
    let chainlen = length chain
        numlens = length lens
        backnum = chainlen - (sum lens + numlens * (numlens - 1) `div` 2) `mod` chainlen
    in rotate backnum (tie' chain lens 0)

part1 :: IO ()
part1 = do
    let chainlen = 256
    lenlist <- liftM (map read . splitOn ',') (readFile "10.in")

    let result = tie [0..chainlen-1] lenlist

    print (let (a:b:_) = result in a * b)

part2 :: IO ()
part2 = do
    let chainlen = 256
    lenlist <- liftM ((++ [17, 31, 73, 47, 23]) . map ord . strip) (readFile "10.in")

    let sparse = tie [0..chainlen-1] (take (64 * length lenlist) (cycle lenlist))
    let dense = map (foldl1 xor) (blocks 16 sparse) :: [Int]
    putStrLn $ concat $ map (pad 2 '0' . flip showHex "") dense

main :: IO ()
main = part1 >> part2