From 7a9598f4d89cf9e23acce68d21040dc9cfbdfe02 Mon Sep 17 00:00:00 2001
From: JasterV <49537445+JasterV@users.noreply.github.com>
Date: Thu, 20 Mar 2025 22:29:52 +0100
Subject: [PATCH] WIP: BfsSearch

---
 src/Graph.hs | 39 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 39 insertions(+)

diff --git a/src/Graph.hs b/src/Graph.hs
index 553507e..2367908 100644
--- a/src/Graph.hs
+++ b/src/Graph.hs
@@ -1,3 +1,7 @@
+{-# LANGUAGE TupleSections #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Use map once" #-}
 module Graph
   ( DiGraph,
     hasNode,
@@ -15,6 +19,8 @@ module Graph
 where
 
 import qualified Data.AssocMap as M
+import Data.Bifunctor (second)
+import Data.Function ((&))
 import qualified Data.List as L
 
 type DiGraph a = M.AssocMap a [a]
@@ -57,3 +63,36 @@ deleteEdge (node, child) = M.alter aux node
 
 deleteEdges :: (Eq a) => [(a, a)] -> DiGraph a -> DiGraph a
 deleteEdges edges graph = foldr deleteEdge graph edges
+
+addMultiplePredecessors :: (Eq a) => [(a, [a])] -> DiGraph a -> DiGraph a
+addMultiplePredecessors [] graph = graph
+addMultiplePredecessors ((node, childs) : xs) graph =
+  let edges = L.map (,node) childs
+   in addMultiplePredecessors xs (addEdges edges graph)
+
+type SearchState a = ([a], DiGraph a, DiGraph a)
+
+data SearchResult a = Unsuccessful | Success (DiGraph a)
+
+bfsSearch :: (Eq a) => DiGraph a -> a -> a -> Maybe [a]
+bfsSearch graph start end
+  | start == end = Just [start]
+  | otherwise = case bfsSearch' ([start], graph, empty) of
+      Unsuccessful -> Nothing
+      Success preds -> Just (findSolution preds)
+
+bfsSearch' :: (Eq a) => SearchState a -> SearchResult a
+bfsSearch' (frontier, graph, preds) =
+  let -- Create a new graph with the frontier nodes removed
+      newGraph = deleteNodes frontier graph
+      neighboursMap =
+        -- Associate each node to its neighbours
+        L.map (\node -> (node, children node graph)) frontier
+          -- Filter the neighbours that are not present on the new graph (does not contain frontier)
+          & L.map (second $ L.filter (`M.member` newGraph))
+
+      predecessors = addPredecessors preds neighboursMap
+   in Unsuccessful
+
+findSolution :: DiGraph a -> [a]
+findSolution _graph = []