{-# LANGUAGE TemplateHaskell, NoMonomorphismRestriction #-}
module Lecture09b where

import Control.Lens
import Data.Semigroup
import qualified Data.Set as S
import Control.Monad.State

type Vertex = Char
type Edge = (Vertex, Vertex)

data BfsState = BfsState { _visited :: S.Set Vertex
                         , _queue   :: [Vertex]
                         , _stamp   :: Int
                         , _result  :: [(Int, Vertex)]
                         } deriving Show

makeLenses ''BfsState


bfs :: Vertex -> [Edge] -> [(Int, Vertex)]
bfs start es = evalState go (BfsState (S.singleton start) [start] 0 [])
 where go :: State BfsState [(Int, Vertex)]
       go = do
              v <- preuse $ queue . _head
              case v of
                Nothing ->  gets $ reverse . _result
                Just v -> do
                  queue %= tail
                  idx <- stamp <<+= 1
                  result %= ((idx, v) :)

                  let succs = es ^.. traverse . filtered ((==v) . fst) . _2
                  succStamps <- forM succs $ \s -> do
                      seen <- use $ visited . to (S.member s)
                      unless seen $ do
                        visited <>= S.singleton s
                        queue <>= [s]
                  go

g :: [Edge]
g = [ ('a','b')
    , ('a','c')
    , ('a','d')
    , ('b','c')  --     ,----( a )←---.
    , ('b','e')  --     ↓      ↓      ↓
    , ('c','b')  --   ( b )←→( c )-→( d )
    , ('c','d')  --     ↕     |_↑
    , ('c','c')  --   ( e )
    , ('d','a')
    , ('e','b')
    ]