module Logic.Graph where

import Data.Set (Set, insert)

type GetEdges vertex edge = vertex -> [(vertex, edge)]
type GetEdgesCosts vertex edge cost = vertex -> [((vertex, edge), cost)]

bfs
  :: (Eq vertex, Ord vertex)
  => GetEdges vertex edge
  -> vertex
  -> vertex
  -> Maybe [edge]
bfs getEdges goal start = reverse <$> aux [(start, [])] mempty
  where
    aux [] _ = Nothing
    aux ((vertex, path):queue) visited
      | vertex == goal = Just path
      | otherwise =
        let new = getUnvisitedAdjacent vertex visited
        in
          case filter (\(v, _) -> v == goal) new of
            [] ->
              let queue' = queue ++ map (\(next, edge) -> (next, edge:path)) new
              in aux queue' $ insert vertex visited
            ((_, edge):_) -> Just (edge:path)

    getUnvisitedAdjacent vertex visited =
      filter (\(next, edge) -> not $ next `elem` visited) $
      getEdges vertex

{-
ghci> bfs 10 0 (\x -> [("pred", x-1), ("succ", x+1)])
Just ["succ","succ","succ","succ","succ","succ","succ","succ","succ","succ"]
ghci> bfs 13 0 (\x -> [("double", x+x), ("add", x+1)])
Just ["add","double","add","double","double","add"]
-}

data VerifyPathError vertex edge
  = NoSuchEdge vertex edge
  | GoalNotReached [vertex]
  deriving Show

verifyPath
  :: (Eq vertex, Ord vertex, Eq edge)
  => GetEdges vertex edge
  -> vertex
  -> vertex
  -> [edge]
  -> Either (VerifyPathError vertex edge) [vertex]
verifyPath getEdges goal start path =
  case aux start path of
    Right (vertices, True) -> Right vertices
    Right (vertices, False) -> Left $ GoalNotReached vertices
    Left x -> Left x
  where
    aux vertex path' = cons vertex <$>
      case path' of
        [] -> Right $
          if vertex == goal
          then ([], True)
          else ([], False)
        (thisEdge:nextEdges) ->
          case map fst $ filter (\(next, realEdge) -> realEdge == thisEdge) $ getEdges vertex of
            [] -> Left $ NoSuchEdge vertex thisEdge
            (next:_) -> aux next nextEdges

    cons vertex (vertices, bool) = (vertex:vertices, bool)