shortest path using bfs

bfs.hs

{-# LANGUAGE ViewPatterns, TupleSections #-}

import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Sequence as Seq
import Control.Monad.Except

type User = String
type From = User
type To = User
type Network = M.Map User (S.Set User)
type Path = [User]
type Queue = Seq.Seq (User, [User])
type Seen = S.Set User

data Error
  = NoPath From To
  | UserNotInNetwork User Network
  deriving Show

data Result
  = Done Path
  | Partial Seen Queue
  deriving Show

shortestPath :: From -> To -> Network -> Either Error Path
shortestPath from to network =
  case bfs from to network mempty mempty mempty of
    Left NoPath{} -> Left $ NoPath from to
    x -> x

bfs :: From -> To -> Network -> Path -> Seen -> Queue -> Either Error Path
bfs from to network path seen queue =
  case bfsStep from to network path seen queue of
    Right (Done path) -> pure path
    Right (Partial _ Seq.Empty) -> Left $ NoPath from to
    Right (Partial seen ((next, path) Seq.:<| queue)) ->
      bfs next to network path seen queue
    Left err -> Left err
    

bfsStep :: From -> To -> Network -> Path -> Seen -> Queue -> Either Error Result
bfsStep from to network ((:) from -> path) (S.insert from -> seen) queue
  | from == to = pure $ Done $ reverse path
  | otherwise =
    case M.lookup from network of
      Nothing ->
        throwError (UserNotInNetwork from network)
      -- we will be
      Just friends ->
        let
          queue' = Seq.filter ((`S.notMember` seen) . fst) $
            queue <> Seq.fromList (map (,path) $ S.toList friends)
        in
          pure $ Partial seen queue'