Haskell Quiz/Knight's Travails/Solution Nroets

import System.Environment (getArgs)
import System.Exit (exitFailure)


-- The first argument is a list of "squares" that can be reached. The "squares" are ordered
--   with the ones that can be reached in the smallest number of moves first.
-- What is a "square" ? It is a sequence of moves in reverse order (list of strings). So the
--   head is also the square that have been reached.
-- Note that the "squares" are built at the same time, so if the compiler is doing it's job,
--   the "squares" should be sharing their tails and a maximum of one linked list element
--   should be allocated for each square.

shortest [] end forbid = Nothing
shortest (s1:start) end forbid =
  if head s1 == end then Just (tail $ reverse s1)
  else shortest (start ++ (signs1 2 1) ++ (signs1 1 2)) end (head s1 : forbid)
-- We add 'head s1' to 'forbid' to prevent making an exponential number of calls.

  where
    col = fromEnum $ head $ head s1
    row = fromEnum $ last $ head s1
    signs1 c r = newLoc (-c) (-r) ++ newLoc (-c) r ++ newLoc c (-r) ++ newLoc c r
    newLoc c r = if col + c < fromEnum 'a' || col + c > fromEnum 'h' ||
                    row + r < fromEnum '1' || row + r > fromEnum '8' ||
                    head s1 `elem` forbid then []
      else [ ( [ toEnum (col + c) :: Char, toEnum (row + r) :: Char ] : s1) ]

test = shortest [ [ "a8" ] ] "b7" [ "b6" ]
test2 = shortest [ [ "a8" ] ] "g6" [ "b6", "c7" ]
test3 = shortest [ [ "a8" ] ] "h2" [ "b6", "a6", "b5", "d5", "e6", "d6", "f6", "f5", "g3",
 "h3", "g2", "d3", "f3", "e3" ]
test4 = shortest [ [ "h8" ] ] "a8" [ "c7", "a4", "c4", "d5", "d7", "d6", "e7", "c6", "d4",
  "c7", "c3", "c2"  ]
-- If the algorithm does not prune properly, then test4 can take close to 8^11 = 8 billion
-- iterations.

usage = "Usage: knight_travails startpos endpos [forbidden positions]"

main = do
  args <- getArgs
  if length args < 2
     then do putStrLn ("Insufficient arguments.\n\n" ++ usage)
             exitFailure
     else let result = shortest [ [ args !! 0 ]] (args !! 1) (drop 2 args)
          in case result of
             Nothing -> do { putStrLn "No solutions" }
             Just ps -> do { print ps }