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

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

-}
module Main where

import Advent (format)
import Advent.Coord (east, north, origin, south, west, Coord(..))
import Advent.Search (bfs)
import Crypto.Hash.MD5 (hash)
import Data.Bits ((.&.), shiftR)
import Data.ByteString qualified as BS
import Data.ByteString (ByteString)
import Data.ByteString.Char8 qualified as B8

-- | >>> :main
-- DUDRLRRDDR
-- 788
main :: IO ()
IO ()
main =
 do ByteString
input <- String -> ByteString
B8.pack (String -> ByteString) -> IO String -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [format|2016 17 %s%n|]
    let paths :: [String]
paths = [String
path | (C Int
3 Int
3, String
path) <- ((Coord, String) -> [(Coord, String)])
-> (Coord, String) -> [(Coord, String)]
forall a. Ord a => (a -> [a]) -> a -> [a]
bfs (ByteString -> (Coord, String) -> [(Coord, String)]
nextStates ByteString
input) (Coord, String)
initialState ]
        shortestPath :: String
shortestPath = [String] -> String
forall a. HasCallStack => [a] -> a
head [String]
paths
        longestPath :: String
longestPath  = [String] -> String
forall a. HasCallStack => [a] -> a
last [String]
paths
    String -> IO ()
putStrLn String
shortestPath
    Int -> IO ()
forall a. Show a => a -> IO ()
print (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
longestPath)

initialState :: (Coord, String)
initialState :: (Coord, String)
initialState = (Coord
origin, String
"")

isValidLocation :: Coord -> Bool
isValidLocation :: Coord -> Bool
isValidLocation (C Int
y Int
x) = Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
x Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 Bool -> Bool -> Bool
&& Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
y Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4

nextStates :: ByteString -> (Coord, String) -> [(Coord, String)]
nextStates :: ByteString -> (Coord, String) -> [(Coord, String)]
nextStates ByteString
_ (C Int
3 Int
3,String
path) = []
nextStates ByteString
input (Coord
c, String
path) =
  [ (Coord
c', String
pathString -> String -> String
forall a. [a] -> [a] -> [a]
++[Char
step])
  | (Char
step, Coord
delta) <- ByteString -> String -> [(Char, Coord)]
directions ByteString
input String
path
  , let c' :: Coord
c' = Coord
c Coord -> Coord -> Coord
forall a. Num a => a -> a -> a
+ Coord
delta
  , Coord -> Bool
isValidLocation Coord
c'
  ]

directions :: ByteString -> String -> [(Char, Coord)]
directions :: ByteString -> String -> [(Char, Coord)]
directions ByteString
input String
path = [(Char, Coord)]
ways
  where
    h :: ByteString
h = ByteString -> ByteString
hash (ByteString
input ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
B8.pack String
path)

    isOpen :: a -> Bool
isOpen a
x = a
0xb a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0xf

    ways :: [(Char, Coord)]
ways = [ (Char
'U', Coord
north) | Word8 -> Bool
forall {a}. (Ord a, Num a) => a -> Bool
isOpen (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
h Int
0 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4) ] [(Char, Coord)] -> [(Char, Coord)] -> [(Char, Coord)]
forall a. [a] -> [a] -> [a]
++
           [ (Char
'D', Coord
south) | Word8 -> Bool
forall {a}. (Ord a, Num a) => a -> Bool
isOpen (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
h Int
0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xf)    ] [(Char, Coord)] -> [(Char, Coord)] -> [(Char, Coord)]
forall a. [a] -> [a] -> [a]
++
           [ (Char
'L', Coord
west)  | Word8 -> Bool
forall {a}. (Ord a, Num a) => a -> Bool
isOpen (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
h Int
1 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4) ] [(Char, Coord)] -> [(Char, Coord)] -> [(Char, Coord)]
forall a. [a] -> [a] -> [a]
++
           [ (Char
'R', Coord
east)  | Word8 -> Bool
forall {a}. (Ord a, Num a) => a -> Bool
isOpen (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
h Int
1 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xf)    ]