module Day3Maze where
    import System.IO
    import Data.Set (empty, fromList, union, notMember)

    -- This is a "type" alias, because they're just naming pre-existing types with specific patterns
    -- Note: Nested lists with indexes will be inefficient compared to Vectors, but I'm working with what I know!
    type Maze = [[Node]]
    type Coords = (Int, Int)
    type Node = (Coords, [Direction])
    data Direction = North | South | East | West deriving (Show, Eq)

    -- Input map based on https://github.com/icefox/asciimaze/blob/master/sample-mazes/input1.txt

    -- Usage:
    --
    -- my_maze <- parseMap "day3-simple.maze"
    -- let exits = findExits my_maze
    -- solveMaze my_maze exits

     -- Currently takes too long on bay3.maze because a) the paths are double-width and b) we don't discard routes that get to the same position by a different route

    parseMap :: String -> IO Maze
    parseMap map_path = do 
        file_contents <- (readFile map_path)
        let file_lines = lines file_contents
        return (parseMap' file_lines)
    
    findExits :: Maze -> Maybe (Node, Node)
    findExits maze = let exits = findExits' maze
        in if (length exits) == 2 then Just (exits !! 0, exits !! 1) else Nothing
    
    solveMaze :: Maze -> Maybe (Node, Node) -> [Coords]
    solveMaze maze (Just (start, end)) = findRoute maze (fst end) [[fst start]]
    solveMaze maze _ = []

    findRoute :: Maze -> Coords -> [[Coords]] -> [Coords]
    findRoute maze exit routes
        | routes == [] = [] -- No solution
        | successful_routes /= [] = head successful_routes
        | otherwise = findRoute maze exit (step maze routes)
        where successful_routes = filter ((exit ==) . head) routes

    getNode' :: [[a]] -> Int -> Int -> a
    getNode' two_d_array x y = (two_d_array !! y) !! x

    getNode :: [[a]] -> Coords -> a
    getNode two_d_array (x, y) = getNode' two_d_array x y

    getRelativeNode :: Maze -> Coords -> Direction -> Node
    getRelativeNode maze (x, y) direction = 
        case direction of
            North -> getNode' maze x (y - 1)
            South -> getNode' maze x (y + 1)
            East -> getNode' maze (x + 1) y
            West -> getNode' maze (x - 1) y
    
    parseMap' :: [String] -> Maze
    parseMap' map_string = zipWith (makeRow map_string) [0..] map_string

    makeRow :: [String] -> Int -> String -> [Node]
    makeRow map_string row_num cols = zipWith (makeNode map_string row_num) [0..] cols

    makeNode :: [String] -> Int -> Int -> Char -> Node
    makeNode map_string row_num col_num node = if node /= ' ' then ((col_num, row_num), [])
        else ((col_num, row_num), makeExitsList map_string row_num col_num)

    makeExitsList :: [String] -> Int -> Int -> [Direction]
    -- FIXME: This can probably be done with a "map (isExit…) directions", with a modified isExit
    makeExitsList map_string row_num col_num = map fst (filter snd (zip directions isExitDirections))
        where {
            directions = [North, South, East, West] ;
            isExitDirections = [isExit map_string col_num (row_num - 1), isExit map_string col_num (row_num + 1), isExit map_string (col_num + 1) row_num, isExit map_string (col_num - 1) row_num]
        }

    isExit :: [String] -> Int -> Int -> Bool
    isExit map_string x y
        | y < 0 || x < 0 = False
        | y >= length map_string || x >= length (map_string !! y) = False
        | otherwise = (getNode' map_string x y) == ' '

    findExits' :: Maze -> [Node]
    -- Examine the outside by taking the first and last item from each row, and the first and last row)
    -- This doubles up the corners, but we'll make an assumption that the corner is always filled in!
    findExits' maze = let candidates = (map last maze) ++ (map head maze) ++ (head maze) ++ (last maze)
        in filter (\node -> (snd node) /= []) candidates

    step :: Maze -> [[Coords]] -> [[Coords]]
    -- Map out all of the next steps, but remove ones that go back on themselves (head is in its own tail) or that we've been to before
    -- (head is in previous points, meaning we've found a shorter route)
    step maze routes = filter (\(hd:lst) -> (hd `notElem` lst) && (hd `notMember` all_previous_points)) (concatMap (\route -> map (: route) (nextSteps maze route)) routes)
            where all_previous_points = foldl union empty (map fromList routes)

    nextSteps :: Maze -> [Coords] -> [Coords]
    nextSteps maze route = map (fst . getRelativeNode maze pos) exits
        where {
            pos:prior_steps = route ;
            exits = snd (getNode maze pos)
        }