Day19.hs

module Day19 where 

import Data.Maybe (maybe)
import Data.List (find, findIndex, unfoldr)
import Data.Char (isLetter)

day19text :: IO [[Char]] -- We could use a better data structure, but the code only gets run once
day19text = lines <$> readFile "C:\\Users\\me\\advent\\day19.txt"

isWire :: Char -> Bool
isWire = (/= ' ')

data Point = Point { x :: Int, y :: Int }

safeIndex :: Int -> [a] -> Maybe a
safeIndex _ [] = Nothing
safeIndex y _ | y < 0 = Nothing
safeIndex 0 (x:_) = Just x
safeIndex i (_:xs) = safeIndex (i-1) xs

val :: [[Char]] -> Point -> Maybe Char
val maze Point { x = x, y = y } = safeIndex x =<< safeIndex y maze

data Direction = No | So | Ea | We

move :: Direction -> Point -> Point
move d Point { x = x, y = y } = Point {x = fx d, y = fy d}
    where fx Ea = x + 1
          fx We = x - 1
          fx _ = x
          fy No = y - 1
          fy So = y + 1
          fy _ = y

nextDirection :: [[Char]] -> Direction -> Point -> Maybe Direction
nextDirection maze d p = find v (d:others d)
    where others No = [Ea, We]
          others So = [Ea, We]
          others _ = [No, So]
          v dir = maybe False isWire (val maze $ move dir p)
        
data State19 = State19 { position :: Point, direction :: Direction}

createState :: Point -> Direction -> State19
createState p d = State19 { position  = p, direction  = d}

startState :: [Char] -> Maybe State19
startState chars = (toState . toPoint) <$> findIndex isWire chars
    where toPoint x = Point { x = x, y = 0 }
          toState p = createState p So

nextState :: [[Char]] -> State19 -> Maybe (Char, State19)
nextState maze State19 { position = p, direction = d } = (,) <$> v2 <*> s2
    where d2 = nextDirection maze d p
          p2 = flip move p <$> d2
          s2 = createState <$> p2 <*> d2
          v2 = val maze =<< p2

path :: [[Char]] -> Maybe [Char]
path maze = unfoldr (nextState maze) <$> startState (head maze)

(<$$>) = fmap . fmap
day19a = filter isLetter <$$> path <$> day19text
day19b = ((1+) . length) <$$> path <$> day19text