##### Views

This is a first attempt - *very* clumsy looking in parts, I'll improve on it and post here.

```module Main
where

import Random
import System
import System.IO
import System.IO.Unsafe
import Maybe
import List

{--
First attempt.

Algorithm is Dijkstra depth-first search

the solver is augmented by picking neighbour which is closest to the goal
rather than a random one

*Main> doSol 10 10 Nothing
+---+---+---+---+---+---+---+---+---+---+
| x   x | x   x   x |       |           |
+---+   +   +---+   +   +---+   +   +   +
| x   x | x |   | x |           |   |   |
+   +---+   +   +   +---+---+---+   +---+
| x   x   x |   | x   x |       |       |
+---+---+---+   +---+   +   +   +---+   +
|               | x   x |   |       |   |
+   +   +---+   +   +---+   +---+   +   +
|   |   |       | x |       |   |   |   |
+---+   +   +---+   +---+   +   +   +   +
|       |   | x   x |       |   |   |   |
+   +---+---+   +---+   +---+   +   +   +
|   |       | x   x |       |   |   |   |
+   +   +   +---+   +---+   +   +   +   +
|       |   | x   x |       |           |
+---+---+   +   +---+   +---+---+---+---+
|           | x   x |                   |
+   +---+---+---+   +---+---+---+---+   +
|                 x   x   x   x   x   x |
+---+---+---+---+---+---+---+---+---+---+

--}

data Direction = N | E | S | W
deriving (Show, Eq, Enum)
data Cell = GenCell [Direction] [Direction] -- Cell borders walls
deriving Show
type Maze = [Cell]
type Neighbour = (Maybe Cell, Int, Direction) --(cell, position, direction in which it lies)
data CLIFlag = Help | Version | Mode | Input String | Output String | Start Int | End Int
deriving Show
type Solution = (Maze, [Int], [Int]) --(m, path, backtracks)

borders, walls :: Cell -> [Direction]
borders (GenCell bs ws) = bs
walls (GenCell bs ws) = ws
smaze :: Solution -> Maze
smaze (m, s, b) = m
spath :: Solution -> [Int]
spath (m, s, b) = s
sback :: Solution -> [Int]
sback (m, s, b) = b
ncell :: Neighbour -> Maybe Cell
ncell (c, p, d) = c
npos :: Neighbour -> Int
npos (c, p, d) = p
ndir :: Neighbour -> Direction
ndir (c, p, d) = d

--get a maze with all walls intact
genBlockedMaze :: Int -> Int -> Maze
genBlockedMaze w h = topRow ++ (genMaze' (h-2) []) ++ bottomRow
where genMaze' 0 m = m
genMaze' (h+1) m   = midRow ++ genMaze' h m
genCells 0 bs ws   = []
genCells x bs ws   = (GenCell bs ws) : (genCells (x-1) bs ws)
topRow      = (GenCell [W,N] [E,S]) : (genCells (w-2) [N] [E .. W]) ++ [(GenCell [N, E] [S,W])]
bottomRow   = (GenCell [W,S] [N, E]) : (genCells (w-2) [S] [N, E, W]) ++ [(GenCell [S, E] [N, W])]
midRow      = (GenCell [W] [N .. S]) : (genCells (w-2) [] [N .. W]) ++ [(GenCell [E] [N, S, W])]

getRandNum :: Int -> Int
getRandNum n = unsafePerformIO \$ getStdRandom \$ randomR (0,n)

getDir :: Int -> Direction
getDir n = if n < 4
then [N .. W]!!n
else error ("can't give a direction for " ++ (show n))

randElem :: [a] -> a
randElem xs = xs!!(getRandNum ((length xs)-1))

--get the dimensions of a maze
dims :: Maze -> (Int, Int)
dims m = (w, (h+1))
where w = findW m 1
h = findH m 1
findW [] x     = -1
findW (c:cs) x = if elem E (borders c) then x else findW cs (x+1)
findH [] x     = -1
findH (c:cs) x = if elem S (borders c) then (x `div` w) else findH cs (x+1)

--get the neighbours of a position in the maze
neighbs :: Maze -> Int -> [Neighbour]
neighbs m i = filter (isJust . ncell) (neighb (-1) 0 W : neighb 1 0 E : neighb 0 (-1) N : neighb 0 1 S : [])
where len = length m
w   = fst (dims m)
h   = snd (dims m)
neighb x y d | newPos > (len)-1 || newPos < 0 = (Nothing, -1, d) --past beginning or end
| newX > (w-1) || newX < 0       = (Nothing, -1, d) --last row
| newY > (h-1) || newY < 0       = (Nothing, -1, d) --last col
| otherwise                      = (Just (m!!newPos), newPos, d)
where newPos = i+x + (y*w)
newX   = x + (i `mod` h)
newY   = floor ((fromIntegral i)/ (fromIntegral w)) + y

--generate a perfect maze given the dimensions
genMaze :: Int -> Int -> Maze
genMaze w h = genMaze' m [0] 0 1
where m = genBlockedMaze w h
t = length m
genMaze' m' stk cur vis | vis == t = m'
| null newNeighbs = genMaze' m' (tail stk) (head \$ tail stk) vis
| otherwise = genMaze' m'' (neighbPos:stk) neighbPos (vis+1)
where newNeighbs = filter (\x -> (not (elem (npos x) stk)) && allwalls (fromJust \$ ncell x)) (neighbs m' cur)
neighb = randElem newNeighbs
neighbWall = opp curWall
neighbPos = npos neighb
neighbCell = fromJust \$ ncell neighb
curWall = ndir neighb
m'' = splice (splice m' (newNeighb, neighbPos)) (newCur, cur)
newCur = GenCell (borders curcell) (delete curWall (walls curcell))
newNeighb = GenCell (borders (neighbCell)) (delete neighbWall \$ walls neighbCell)
curcell = m'!!cur

opp :: Direction -> Direction
opp d = case d of N -> S
E -> W
S -> N
W -> E

allwalls :: Cell -> Bool
allwalls c = foldr (\(b, w) t -> (b || w) && t) True
\$ zip [elem d (walls c) | d <- ds] [elem d (borders c) | d <- ds]
where ds = [N .. W]

splice :: Maze -> (Cell, Int) -> Maze
splice [] _ = []
splice m (c, 0) = c : (tail m)
splice m (c, i) = if i >= length m then error "cannot splice " else take i m ++ [c] ++ drop (i+1) m

topBorder :: Int -> String
topBorder i = (topBorder' i "") ++ "+\n"
where topBorder' 0 acc = acc
topBorder' (n+1) acc = topBorder' n ("+---" ++ acc)

asciiMaze :: Solution -> String
asciiMaze (m, s, b) = (topBorder w) ++ asciiRows m 0
where w = fst (dims m)
h = snd (dims m)
asciiRows [] c = "\n"
asciiRows m c = (asciiRow (take w m) [] 0 c s b) ++ (asciiRows (drop w m) (c+w))

asciiRow :: [Cell] -> [Cell] -> Int -> Int -> [Int] -> [Int] -> String
asciiRow [] acc i pos sol bk = ""
asciiRow [c] acc i pos sol bk | i == 0 = (showCell c i pos sol bk) ++ "|\n" ++ asciiRow (reverse (c:acc)) [] 1 (pos-(length (c:acc))) sol bk
| otherwise = (showCell c i pos sol bk) ++ "+\n"
asciiRow (c:cs) acc i pos sol bk | i == 0 = (showCell c i pos sol bk) ++ (asciiRow cs (c:acc) 0 (pos+1) sol bk)
| otherwise = (showCell c i pos sol bk) ++ (asciiRow cs (c:acc) 1 (pos+1) sol bk)

showCell :: Cell -> Int -> Int -> [Int] -> [Int] -> String
showCell c b pos sol bk | b == 0 && (elem pos sol) = showCellMS c
| b == 0 && (elem pos bk)  = showCellMB c
| b == 0                   = showCellM c
| otherwise                = showCellB c

showCellB, showCellM, showCellMS, showCellMB :: Cell -> String
showCellB c = if (elem S \$ borders c) || (elem S \$ walls c) then "+---" else "+   "
showCellM c = if (elem W \$ borders c) || (elem W \$ walls c) then "|   " else "    "
showCellMS c = if (elem W \$ borders c) || (elem W \$walls c) then "| x " else "  x "
showCellMB c = if (elem W \$ borders c) || (elem W \$walls c) then "| - " else "  - "

printMaze :: Maze -> IO ()
printMaze m = putStr \$ asciiMaze (m ,[], [])

solveMaze :: Maze -> Int -> Int -> Solution
solveMaze m start end = solveMaze' [start] [] start
where solveMaze' sol bk cur | cur == end = (m, sol, bk)
| null newNeighbs = solveMaze' (tail sol) ((head sol):bk) \$ head \$ tail sol
| otherwise = solveMaze' (neighbPos:sol) bk neighbPos
where newNeighbs = (filter (\x -> (not (elem (npos x) sol)) && (not (elem (npos x) bk)) && nowalls curcell x)) \$ neighbs m cur
curcell    = m!!cur
--neighb  = randElem newNeighbs
neighb = mhat newNeighbs end \$ dims m
neighbPos  = npos neighb

coords :: Int -> (Int, Int) -> (Int, Int)
coords i (w, h) = ((i `mod` w), floor \$ (fromIntegral i)/(fromIntegral h))

xpos, ypos :: (Int, Int) -> Int
xpos = fst
ypos = snd

--get neighbour which is closest to the goal
mhat :: [Neighbour] -> Int -> (Int, Int) -> Neighbour
mhat ns g (w, h) = head (qsort ns)
where mhatdist n = abs (xpos (coords (npos n) (w, h)) - xposg) + abs (ypos (coords (npos n) (w, h)) - yposg)
xposg = xpos (coords g (w, h))
yposg = ypos (coords g (w, h))
qsort [] = []
qsort (n:ns) = qsort (filter closer ns) ++ [n] ++ qsort (filter further ns)
where closer n' = mhatdist n' <= mhatdist n
further   = not . closer

nowalls :: Cell -> Neighbour -> Bool
nowalls c n | isNothing \$ ncell n                = False
| not (elem dir \$ walls c)
&& not (elem dir \$ borders c)
&& not (elem (opp dir) \$ borders c')
&& not (elem (opp dir) \$ walls c') = True
| otherwise                          = False
where c'  = fromJust \$ ncell n
dir = ndir n

printSolution :: Solution -> IO ()
printSolution = putStr . asciiMaze

proc :: [String] -> IO ()
proc args | length args /= 3 && length args /= 4 = usage
| o == "--gen"                         = doGen w h f
| o == "--sol"                         = doSol w h f
| otherwise                            = usage
where w = read \$ args!!0
o = args!!2
f = if length args == 4 then Just \$ args!!3 else Nothing

doGen :: Int -> Int -> Maybe String -> IO ()
doGen w h Nothing  = printMaze \$ genMaze w h
doGen w h (Just s) = writeFile s \$ asciiMaze ((genMaze w h), [], [])

doSol :: Int -> Int -> Maybe String -> IO ()
doSol w h Nothing  = printSolution \$ solveMaze (genMaze w h) 0 ((w*h)-1)
doSol w h (Just s) = writeFile s \$ asciiMaze m
where m = solveMaze (genMaze w h) 0 ((w*h)-1)

usage :: IO ()
usage = do putStrLn "USAGE:"
putStrLn "maze w h [--gen|--sol] [OUTFILE] [--start=START] [--end=END]"

main :: IO ()
main = do x <- getArgs
proc x```