diff --git a/hgeometry-combinatorial.cabal b/hgeometry-combinatorial.cabal
--- a/hgeometry-combinatorial.cabal
+++ b/hgeometry-combinatorial.cabal
@@ -2,7 +2,7 @@
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                hgeometry-combinatorial
-version:             0.12.0.2
+version:             0.12.0.3
 synopsis:            Data structures, and Data types.
 description:
     The Non-geometric data types and algorithms used in HGeometry.
@@ -13,7 +13,7 @@
 maintainer:          frank@fstaals.net
 -- copyright:
 
-tested-with:         GHC >= 8.4
+tested-with:         GHC >= 8.8
 
 category:            Geometry
 build-type:          Simple
@@ -49,6 +49,7 @@
 
                     -- * Graph Algorithms
                     Algorithms.Graph.DFS
+                    Algorithms.Graph.BFS
                     Algorithms.Graph.MST
                     Algorithms.FloydWarshall
 
@@ -142,14 +143,15 @@
               , quickcheck-instances    >= 0.3
               , reflection              >= 2.1
               , primitive               >= 0.6.3.0
-              , linear                  >= 1.20.8
+              , linear                  >= 1.21
               , hashable                >= 1.2
+              , witherable              >= 0.4
 
               , vector                  >= 0.11
               , data-clist              >= 0.1.2.3
               , vector-circular         >= 0.1.2
               , nonempty-vector         >= 0.2.0.0
-              , vector-builder          >= 0.3.7   && <= 0.3.8
+              , vector-builder          >= 0.3.7
               , unordered-containers
 
               , aeson                   >= 1.0
@@ -222,6 +224,7 @@
   other-modules: Algorithms.StringSearch.KMPSpec
                  Algorithms.DivideAndConquerSpec
                  Algorithms.Graph.DFSSpec
+                 Algorithms.Graph.BFSSpec
                  Data.RangeSpec
                  Data.EdgeOracleSpec
                  Data.PlanarGraphSpec
diff --git a/src/Algorithms/Graph/BFS.hs b/src/Algorithms/Graph/BFS.hs
new file mode 100644
--- /dev/null
+++ b/src/Algorithms/Graph/BFS.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  Algorithms.Graph.BFS
+-- Copyright   :  (C) Frank Staals
+-- License     :  see the LICENSE file
+-- Maintainer  :  Frank Staals
+--------------------------------------------------------------------------------
+module Algorithms.Graph.BFS
+  ( bfs
+  , bfs'
+  ) where
+
+import           Control.Monad.ST.Strict
+import qualified Data.Foldable as F
+import           Data.Sequence (Seq(..))
+import qualified Data.Sequence as Seq
+import           Data.Tree
+import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as MV
+import qualified Data.Vector.Unboxed.Mutable as UMV
+import           Witherable
+
+--------------------------------------------------------------------------------
+
+-- | Runs a BFS from the first vertex in the graph. The graph is given
+-- in adjacency list representation.
+--
+-- running time: \(O(V + E)\)
+bfs      :: Foldable f => Int -> V.Vector (v, f Int) -> Tree v
+bfs s gr = fmap (fst . (gr V.!)) . bfs' s . fmap snd $ gr
+
+-- | Runs a BFS from the first vertex in the graph. The graph is given
+-- in adjacency list representation.
+--
+-- running time: \(O(V + E)\)
+bfs'      :: Foldable f => Int -> V.Vector (f Int) -> Tree Int
+bfs' s gr = extract s $ V.create
+         $ do st  <- UMV.replicate n False
+              out <- MV.new n
+              go0 st out (s :<| mempty)
+              pure out
+  where
+    n = V.length gr
+    go0        :: forall s. UMV.MVector s Bool -> MV.MVector s [Int]
+               -> Seq Int -> ST s ()
+    go0 st out = go
+      where
+        visit i = do b <- UMV.read st i
+                     UMV.write st i True -- mark i as visited
+                     pure $ if b then Nothing else Just i
+
+        go :: Seq Int -> ST s ()
+        go = \case
+          Empty       -> pure ()
+          (u:<|queue) -> do ns <- wither visit . F.toList $ gr V.! u
+                            MV.write out u ns -- write that u's children are ns
+                            go (queue <> Seq.fromList ns)
+
+
+-- | Give na root index and a vector s.t. v[i] lists the children of
+-- node i, builds the acutal tree.
+extract     :: Int -> V.Vector [Int] -> Tree Int
+extract s v = go s
+  where
+    go i = Node i (map go $ v V.! i)
diff --git a/src/Data/LSeq.hs b/src/Data/LSeq.hs
--- a/src/Data/LSeq.hs
+++ b/src/Data/LSeq.hs
@@ -18,7 +18,7 @@
 
                 , (<|), (|>)
                 , (><)
-                , eval
+                , eval, eval'
 
                 , index
                 , adjust
@@ -133,29 +133,29 @@
 
 -- | \( O(1) \) Prove a sequence has at least @n@ elements.
 --
--- >>> eval (Proxy :: Proxy 3) (fromList [1,2,3])
+-- >>> eval @3 (fromList [1,2,3])
 -- Just (LSeq (fromList [1,2,3]))
--- >>> eval (Proxy :: Proxy 3) (fromList [1,2])
+-- >>> eval @3 (fromList [1,2])
 -- Nothing
--- >>> eval (Proxy :: Proxy 3) (fromList [1..10])
+-- >>> eval @3 (fromList [1..10])
 -- Just (LSeq (fromList [1,2,3,4,5,6,7,8,9,10]))
-eval :: forall proxy n m a. KnownNat n => proxy n -> LSeq m a -> Maybe (LSeq n a)
-eval n (LSeq xs)
+eval :: forall n m a. KnownNat n => LSeq m a -> Maybe (LSeq n a)
+eval = eval' (Proxy @n)
+
+-- | Implementatio nof eval' that takes an explicit proxy.
+eval' :: forall proxy n m a. KnownNat n => proxy n -> LSeq m a -> Maybe (LSeq n a)
+eval' n (LSeq xs)
   | toInteger (S.length xs) >= natVal n = Just $ LSeq xs
   | otherwise                           = Nothing
 
 
-
-
-
 -- | Promises that the length of this LSeq is actually n. This is not
 -- checked.
 --
 -- This function should be a noop
-promise :: forall m n a. LSeq m a -> LSeq n a
+promise :: forall n m a. LSeq m a -> LSeq n a
 promise = coerce
 
-
 -- | Forces the first n elements of the LSeq
 forceLSeq   :: KnownNat n => proxy n -> LSeq m a -> LSeq n a
 forceLSeq n = promise . go (fromInteger $ natVal n)
@@ -232,7 +232,7 @@
 
 --------------------------------------------------------------------------------
 
--- | \( O(n) \). Create an l-sequence from a sequence of elements.
+-- | \( O(1) \). Create an l-sequence from a sequence of elements.
 fromSeq :: S.Seq a -> LSeq 0 a
 fromSeq = LSeq
 
@@ -269,7 +269,7 @@
     where
       go x = \case
         S.Empty       -> (:< empty) <$> f x
-        (y S.:<| ys) -> (\x' (y' :< ys') -> x' :< promise @1 @0 (y' :<| ys'))
+        (y S.:<| ys) -> (\x' (y' :< ys') -> x' :< promise @0 (y' :<| ys'))
                         <$> f x <.> go y ys
 
 instance Eq a => Eq (ViewL n a) where
diff --git a/src/Data/Range.hs b/src/Data/Range.hs
--- a/src/Data/Range.hs
+++ b/src/Data/Range.hs
@@ -18,7 +18,7 @@
                  , prettyShow
                  , lower, upper
                  , inRange, width, clipLower, clipUpper, midPoint, clampTo
-                 , isValid, covers
+                 , isValidRange, covers
 
                  , shiftLeft, shiftRight
                  ) where
@@ -215,7 +215,7 @@
   -- The intersection is empty, if after clipping, the order of the end points is inverted
   -- or if the endpoints are the same, but both are open.
   (Range l u) `intersect` s = let i = clipLower' l . clipUpper' u $ s
-                              in if isValid i then coRec i else coRec NoIntersection
+                              in if isValidRange i then coRec i else coRec NoIntersection
 
 -- | Get the width of the interval
 --
@@ -257,12 +257,12 @@
 -- | Clip the interval from below. I.e. intersect with the interval {l,infty),
 -- where { is either open, (, orr closed, [.
 clipLower     :: Ord a => EndPoint a -> Range a -> Maybe (Range a)
-clipLower l r = let r' = clipLower' l r in if isValid r' then Just r' else Nothing
+clipLower l r = let r' = clipLower' l r in if isValidRange r' then Just r' else Nothing
 
 -- | Clip the interval from above. I.e. intersect with (-\infty, u}, where } is
 -- either open, ), or closed, ],
 clipUpper     :: Ord a => EndPoint a -> Range a -> Maybe (Range a)
-clipUpper u r = let r' = clipUpper' u r in if isValid r' then Just r' else Nothing
+clipUpper u r = let r' = clipUpper' u r in if isValidRange r' then Just r' else Nothing
 
 -- | Wether or not the first range completely covers the second one
 covers       :: forall a. Ord a => Range a -> Range a -> Bool
@@ -272,11 +272,11 @@
 -- | Check if the range is valid and nonEmpty, i.e. if the lower endpoint is
 -- indeed smaller than the right endpoint. Note that we treat empty open-ranges
 -- as invalid as well.
-isValid             :: Ord a => Range a -> Bool
-isValid (Range l u) = case _unEndPoint l `compare` _unEndPoint u of
-                          LT                            -> True
-                          EQ | isClosed l || isClosed u -> True
-                          _                             -> False
+isValidRange             :: Ord a => Range a -> Bool
+isValidRange (Range l u) = case _unEndPoint l `compare` _unEndPoint u of
+                             LT                            -> True
+                             EQ | isClosed l || isClosed u -> True
+                             _                             -> False
 
 -- operation is unsafe, as it may produce an invalid range (where l > u)
 clipLower'                  :: Ord a => EndPoint a -> Range a -> Range a
diff --git a/test/Algorithms/Graph/BFSSpec.hs b/test/Algorithms/Graph/BFSSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Algorithms/Graph/BFSSpec.hs
@@ -0,0 +1,26 @@
+module Algorithms.Graph.BFSSpec (spec) where
+
+import           Algorithms.Graph.BFS
+import           Data.Tree
+import qualified Data.Vector as V
+import           Test.Hspec
+
+--------------------------------------------------------------------------------
+
+spec :: Spec
+spec = it "BFS test" $
+         bfs' 0 testGr `shouldBe` answer
+
+testGr :: V.Vector [Int]
+testGr = V.fromList [ [1,3, 6]
+                    , [2]
+                    , [3, 5]
+                    , [2 ]
+                    , []
+                    , [4, 5]
+                    , [7]
+                    , [8,4]
+                    , [2]
+                    ]
+answer :: Tree Int
+answer = Node {rootLabel = 0, subForest = [Node {rootLabel = 1, subForest = [Node {rootLabel = 2, subForest = [Node {rootLabel = 5, subForest = []}]}]},Node {rootLabel = 3, subForest = []},Node {rootLabel = 6, subForest = [Node {rootLabel = 7, subForest = [Node {rootLabel = 8, subForest = []},Node {rootLabel = 4, subForest = []}]}]}]}