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

verifyPath
  :: (Eq vertex, Ord vertex, Eq edge)
  => GetEdges vertex edge
  -> vertex
  -> vertex
  -> [edge]
  -> Either (VerifyPathError vertex edge) Bool
verifyPath getEdges goal start path =
  case path of
    [] -> Right $ start == goal
    (thisEdge:nextEdges) ->
      case map fst $ filter (\(next, realEdge) -> realEdge == thisEdge) $ getEdges start of
        [] -> Left $ NoSuchEdge start thisEdge
        (next:_) -> verifyPath getEdges goal next nextEdges