{-
Copyright (C) 2017 Yuchen Pei.

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as
published by the Free Software Foundation, either version 3 of the
License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU Affero General Public
License along with this program.  If not, see
<https://www.gnu.org/licenses/>.
-}
import Puzzle10 (knotHash)
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Maybe (catMaybes)
-- import Data.Char (digit2Int)

hex2Bin '0' = "0000"
hex2Bin '1' = "0001"
hex2Bin '2' = "0010"
hex2Bin '3' = "0011"
hex2Bin '4' = "0100"
hex2Bin '5' = "0101"
hex2Bin '6' = "0110"
hex2Bin '7' = "0111"
hex2Bin '8' = "1000"
hex2Bin '9' = "1001"
hex2Bin 'a' = "1010"
hex2Bin 'b' = "1011"
hex2Bin 'c' = "1100"
hex2Bin 'd' = "1101"
hex2Bin 'e' = "1110"
hex2Bin 'f' = "1111"

matrix :: [Char] -> [[Char]]
matrix xs = (mconcat . (fmap hex2Bin) . knotHash . (\x -> xs ++ "-" ++ (show x))) <$> [0 .. 127]

solve1 :: [Char] -> Int
solve1 = length . (filter (=='1')) . mconcat . matrix

i2B :: Char -> Bool
i2B '0' = False
i2B '1' = True


truthMat :: [Char] -> [[Bool]]
truthMat = fmap (fmap i2B) . matrix

mat2Map :: [[a]] -> Map (Int, Int) a
mat2Map xs = Map.fromList $ mconcat $ fmap f $ zipWith (,) [0 .. length xs - 1] xs
  where f (x, ys) = zipWith (,) ((\y -> (x,y)) <$> [0 .. length ys]) ys

step :: (Int, [(Int, Int)], Map (Int, Int) Bool) -> Int
step (n, queue, mat)
  | null mat = n
  | null queue = let (z, b) = head $ Map.toList mat in
                   if b then step (n + 1, [z], Map.delete z mat) 
                        else step (n, [], Map.delete z mat)
  | otherwise = step (n, catMaybes (zipWith f nbhd $ flip Map.lookup mat <$> nbhd) ++ zs, Map.delete (x, y) mat)
                   where (x, y):zs = queue
                         nbhd = [(x + 1, y), (x - 1, y), (x, y + 1), (x, y - 1)]

f :: (Int, Int) -> Maybe Bool -> Maybe (Int, Int)
f x (Just True) = Just x
f x _ = Nothing

solve2 :: [Char] -> Int
solve2 xs = step (0, [], mat2Map $ truthMat xs)