Modified AStar to take a nextNode function instead of using a typeclass

AStar.hs

@@ -8,15 +8,10 @@ import qualified Data.Map as M
 import Data.List (foldl')
 import Data.Maybe (fromJust)
 
--- A node in the search
-class (Ord a, Ord b, Num b, Bounded b) => SearchNode a b where
-  -- get the next search node and the cost to reach to it from the current node
-  nextNode ::  a -> [(a, b)]
-
 -- A* algorithm: Find a path from initial node to goal node using a heuristic function.
 -- Returns Nothing if no path found. Else returns Just (path cost, path).
-astar :: SearchNode a b => a ->  a -> (a -> a -> b) -> Maybe (b, [a])
+astar :: (Ord a, Ord b, Num b) => a -> a -> (a -> [(a, b)]) -> (a -> a -> b) -> Maybe (b, [a])
-astar initNode goalNode hueristic =
+astar initNode goalNode nextNode hueristic =
   astar' (PQ.singleton (hueristic initNode goalNode) (initNode, 0))
          S.empty (M.singleton initNode 0) M.empty
   where
@@ -42,10 +37,12 @@ astar initNode goalNode hueristic =
 
         -- Find the successors (with their g and h costs) of the node
         -- which have not been seen yet
-        successors = filter (\(s, g, _) ->
+        successors =
-                                not (S.member s seen') &&
+          filter (\(s, g, _) ->
-                                  g < M.findWithDefault maxBound s gscore)
+                    not (S.member s seen') &&
-                     $ successorsAndCosts node gcost
+                      (not (s `M.member` gscore)
+                        || g < (fromJust . M.lookup s $ gscore)))
+         $ successorsAndCosts node gcost
 
         -- Insert the successors in the open set
         pq'' = foldl' (\q (s, g, h) -> PQ.insert (g + h) (s, g) q) pq' successors

KnightsTravails.hs

@@ -50,25 +50,24 @@ isValidNotation notation =
        head notation `elem` ['a'..'h'],
        last notation `elem` ['1'..'8']]
 
--- Makes Board an instance of SearchNode for astar to work
+-- Finds the next possible board configurations for one knight's move.
-instance SearchNode Board Int where
+-- Move cost is one.
-  -- Finds the next possible board configurations for one knight's move.
+nextKnightPos board@(Board {..}) =
-  -- Move cost is one.
+  zip
-  nextNode board@(Board {..}) =
+    (map (\pos -> board { knightPos = pos })
-    zip
+     . filter isValidMove
-      (map (\pos -> board { knightPos = pos })
+     . map (\(x, y) -> (fst knightPos + x, snd knightPos + y))
-       . filter isValidMove
+     $ moves)
-       . map (\(x, y) -> (fst knightPos + x, snd knightPos + y))
+    (repeat 1)
-       $ moves)
+  where
-      (repeat 1)
+    moves = [(1,2), (1,-2), (-1,2), (-1,-2), (2,1), (2,-1), (-2,1), (-2,-1)]
-    where
+    isValidMove (x, y) =
-      moves = [(1,2), (1,-2), (-1,2), (-1,-2), (2,1), (2,-1), (-2,1), (-2,-1)]
+      and [x > 0, x < 9, y > 0, y < 9, not $ (x, y) `S.member` blockedSquares]
-      isValidMove (x, y) =
-        and [x > 0, x < 9, y > 0, y < 9, not $ (x, y) `S.member` blockedSquares]
 
 knightAstar heuristic blockedSquares start target =
   fmap (second (map knightPos))
-  $ astar (Board start blockedSquares) (Board target blockedSquares) heuristic
+  $ astar (Board start blockedSquares) (Board target blockedSquares)
+          nextKnightPos heuristic
 
 -- Finds a path from a start square to an end square using BFS
 bfsSearch :: S.Set Square -> Square -> Square -> Maybe (Int, [Square])