Esper Maze Mugs

maze.hs

-- Esper http://tech.esper.com/2015/03/08/maze-navigation-challenge/
-- Gilles Pirio
-- run with runghc maze.hs

import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.List as L

import Control.Monad
import System.Environment

-- Direction
data Dir = C | U | D | L | R deriving(Show, Read, Eq)

back U = D
back D = U
back L = R
back R = L

data Action = Back | Done | Move Dir
-- Coord
type Coord = (Int,Int)
mv C = (0,0)
mv U = (0,1)
mv D = (0,-1)
mv R = (1,0)
mv L = (-1,0)

add d (a',b') = case mv d of (a,b) -> (a+a',b+b')
-- 
data Found = Wall | Ch Char | Space deriving(Show, Read, Eq)

find ' ' = Space
find '#' = Wall
find c | c >= 'A' && c<='Z' = Ch c


-- Interact with API
explore :: IO [(Dir, Found)]
explore = do
  line <- getLine
  return $ filter (\(_, f) -> f/=Wall) $ zip [C, U, D, L, R] (map find line)

walk :: Dir -> IO ()
walk d = print d

data State = State String (S.Set Coord)

-- 
wander :: Coord     
       -> Dir        -- Dir taken to get here
       -> Bool       -- Do we need to go back?
       -> State
       -> IO State
wander coord dir bck (State r set) = do
  ((_,c):udlr) <- explore
  let r' = case c of Ch c -> c:r
                     _ -> r
  let set' = S.insert coord set
  let st' = State r' set'
  let udlr' = L.filter (\(d,_) -> notBeenThere (add d coord) st') udlr
  doit udlr' st'
  where
    notBeenThere c (State _ set) = S.notMember c set
    doit [] st = done st
    doit [(d,_)] st = do
      st' <- if notBeenThere (add d coord) st 
             then move d bck st 
             else return st
      done st'
    doit ((d,_):dtl) st = do
      st' <- if notBeenThere (add d coord) st 
             then move d True st 
             else return st
      doit dtl st'
    done st = do
      when bck $ do
        walk (back dir)
        getLine
        return ()
      return st
    move d back st = do
      walk d
      st <- wander (add d coord) d back st
      return st

main = do
  args <- getArgs
  if length args == 0 then do
    (State r _) <- wander (0,0) U False (State [] S.empty)
    putStrLn $ 'K':(L.sort r)
  else 
    test m0 (1,1)




-- Test

m1 = "######"
   : "#A C #"
   : "##   #"
   : "####D#"
   : "######"
   : []

m0 = "#############"
   : "#   A   #   #"
   : "# ## ## # # #"
   : "# Q# #   B  #"
   : "#  #A# # ####"
   : "#############"
   : []

get m (x,y) = (m !! y) !! x  

test m coord = do
  putStrLn $ map (\d -> get m (add d coord)) order
  c <- getLine
  if head c == 'K'
  then putStrLn c
  else test m $ add (read [head c]) coord
  where order = [C, U, D, L, R]