#!/usr/bin/runhaskell

import Data.Maybe (fromMaybe)


average :: (Int, Int) -> (Int, Int) -> (Int, Int)
average (x, y) (x_, y_) = ((x + x_) `div` 2, (y + y_) `div` 2)



notBlocked :: [String] -> ((Int, Int), (Int, Int)) -> Bool
notBlocked maze (_, (x, y)) = ' ' == (maze !! y) !! x





substitute :: [a] -> Int -> a -> [a]
substitute orig pos el =
  let (before, after) = splitAt pos orig
  in before ++ [el] ++ tail after


draw :: [String] -> (Int, Int) -> [String]
draw maze (x, y) =
  let row = maze !! y
  in substitute maze y $ substitute row x '*'




tryMoves :: [String]
         -> (Int, Int)
         -> [((Int, Int), (Int, Int))]
         -> Maybe [String]
tryMoves _ _ [] = Nothing
tryMoves maze prevPos ((newPos, wallPos):more) =
  case solve_ maze newPos prevPos of
    Nothing -> tryMoves maze prevPos more
    Just maze_ -> Just $ foldl draw maze_ [newPos, wallPos]




solve_ :: [String] -> (Int, Int) -> (Int, Int) -> Maybe [String]
solve_ maze (2, 1) _ = Just maze
solve_ maze pos@(x, y) prevPos =
  let newPositions = [(x, y - 2), (x + 4, y), (x, y + 2), (x - 4, y)]
      notPrev pos_ = pos_ /= prevPos
      newPositions_ = filter notPrev newPositions
      wallPositions = map (average pos) newPositions_
      zipped = zip newPositions_ wallPositions
      legalMoves = filter (notBlocked maze) zipped
  in tryMoves maze pos legalMoves



solve :: [String] -> Maybe [String]
solve maze = solve_ (draw maze start) start (-1, -1)
  where
    startx = length (head maze) - 3
    starty = length maze - 2
    start = (startx, starty)


main =
  let main_ = unlines . fromMaybe ["can_t solve"] . solve . lines
  in interact main_