diff --git a/looksee.cabal b/looksee.cabal
--- a/looksee.cabal
+++ b/looksee.cabal
@@ -5,7 +5,7 @@
 -- see: https://github.com/sol/hpack
 
 name:           looksee
-version:        0.5.2
+version:        0.5.3
 synopsis:       A simple text parser with decent errors
 description:    Please see the README on GitHub at <https://github.com/ejconlon/looksee#readme>
 category:       Parsing
@@ -17,7 +17,7 @@
 license:        BSD3
 build-type:     Simple
 tested-with:
-    GHC == 9.4.5
+    GHC == 9.6.3
 extra-source-files:
     README.md
 
@@ -51,6 +51,8 @@
       LambdaCase
       KindSignatures
       MultiParamTypeClasses
+      MultiWayIf
+      PatternSynonyms
       Rank2Types
       ScopedTypeVariables
       StandaloneDeriving
@@ -97,6 +99,8 @@
       LambdaCase
       KindSignatures
       MultiParamTypeClasses
+      MultiWayIf
+      PatternSynonyms
       Rank2Types
       ScopedTypeVariables
       StandaloneDeriving
diff --git a/src/Looksee.hs b/src/Looksee.hs
--- a/src/Looksee.hs
+++ b/src/Looksee.hs
@@ -23,12 +23,15 @@
   , parse
   , parseI
   , spanP
+  , spanAroundP
   , throwP
   , altP
   , emptyP
   , endP
   , optP
   , lookP
+  , branchP
+  , commitP
   , labelP
   , textP
   , textP_
@@ -97,7 +100,7 @@
   )
 where
 
-import Control.Applicative (Alternative (..), liftA2)
+import Control.Applicative (Alternative (..))
 import Control.Exception (Exception)
 import Control.Monad (ap, void)
 import Control.Monad.Except (ExceptT, MonadError (..), runExceptT)
@@ -422,10 +425,18 @@
 -- an `n`-character document. The start offset will increase as input is consumed,
 -- and the end offset will decrease as lookahead delimits the range. To evaluate
 -- the "real" range of characters consumed by a parser, construct a span with the
--- starting offsets before and after executing a subparser.
+-- starting offsets before and after executing a subparser (or use 'spanAroundP').
 spanP :: (Monad m) => ParserT e m (Span Int)
 spanP = getsP stSpan
 
+-- | Incorporate span information into a parsed object.
+spanAroundP :: (Monad m) => (Span Int -> a -> b) -> ParserT e m a -> ParserT e m b
+spanAroundP f p = do
+  Span start _ <- spanP
+  a <- p
+  Span end _ <- spanP
+  pure (f (Span start end) a)
+
 -- | Throw a custom parse error
 throwP :: (Monad m) => e -> ParserT e m a
 throwP = errP . ReasonCustom
@@ -479,6 +490,50 @@
 lookP (ParserT g) = ParserT $ \j -> do
   st0 <- get
   g (\ea -> put st0 >> j (first (Err . ErrF (stSpan st0) . ReasonLook) ea))
+
+-- private
+subBranchP
+  :: (Monad m)
+  => (Either (Err e) a -> T e m r)
+  -> St
+  -> Seq (AltPhase, Err e)
+  -> [(ParserT e m (), ParserT e m a)]
+  -> T e m r
+subBranchP j st0 = go
+ where
+  go !errs = \case
+    [] -> mkErrT (if Seq.null errs then ReasonEmpty else ReasonAlt errs) >>= j . Left
+    (ParserT gl, ParserT gx) : rest -> gl $ \case
+      Left _ -> put st0 >> go errs rest
+      Right _ -> do
+        put st0
+        gx $ \case
+          Left e -> put st0 >> go (errs :|> (AltPhaseBranch, e)) rest
+          Right r -> do
+            es <- tryT (j (Right r))
+            case es of
+              Left e -> put st0 >> go (errs :|> (AltPhaseCont, e)) rest
+              Right s -> pure s
+
+-- | Branches guarded by lookahead. Use this for more concise errors.
+-- 'altP' will happily tell you about each of the errors it encountered in
+-- every branch, but this will quietly prune non-matching branches.
+-- Tries until first success (in order), so you can tack on a fallthrough case even if
+-- you tried a branch earlier.
+branchP :: (Monad m, Foldable f) => f (ParserT e m (), ParserT e m a) -> ParserT e m a
+branchP falts = ParserT (\j -> get >>= \st0 -> subBranchP j st0 Empty (toList falts))
+
+-- | An alternative to 'branchP' that does not backtrack after committing to a branch.
+commitP :: (Monad m, Foldable f) => f (ParserT e m (), ParserT e m a) -> ParserT e m a
+commitP = go . toList
+ where
+  go = \case
+    [] -> emptyP
+    (p, q) : rest -> do
+      mx <- optP (lookP p)
+      case mx of
+        Nothing -> go rest
+        Just _ -> q
 
 -- | Labels parse errors
 labelP :: (Monad m) => Label -> ParserT e m a -> ParserT e m a
diff --git a/src/Looksee/Examples.hs b/src/Looksee/Examples.hs
--- a/src/Looksee/Examples.hs
+++ b/src/Looksee/Examples.hs
@@ -18,7 +18,24 @@
 import Data.Sequence (Seq)
 import Data.Text (Text)
 import Data.Void (Void)
-import Looksee (Parser, altP, betweenP, decP, doubleStrP, infixRP, intP, labelP, sciP, sepByP, space1P, stripEndP, stripP, stripStartP, takeWhile1P, textP_)
+import Looksee
+  ( Parser
+  , altP
+  , betweenP
+  , decP
+  , doubleStrP
+  , infixRP
+  , intP
+  , labelP
+  , sciP
+  , sepByP
+  , space1P
+  , stripEndP
+  , stripP
+  , stripStartP
+  , takeWhile1P
+  , textP_
+  )
 
 -- | A JSON value
 data Json
diff --git a/test/Main.hs b/test/Main.hs
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -3,7 +3,7 @@
 
 module Main (main) where
 
-import Control.Applicative (Alternative (..), liftA2)
+import Control.Applicative (Alternative (..))
 import Control.Exception (throwIO)
 import Control.Monad (join)
 import Data.Foldable (for_, toList)
@@ -69,6 +69,8 @@
       , ("repeat1", testRepeat1)
       , ("or", testOr)
       , ("alt", testAlt)
+      , ("branch", testBranch)
+      , ("commit", testCommit)
       , ("opt (empty)", testOptEmpty)
       , ("opt", testOpt)
       , ("bind (1)", testBind1)
@@ -249,6 +251,58 @@
     , ParserCase "first" parser "hi" (suc "h" 1)
     , ParserCase "middle" parser "zi" (suc "y" 1)
     , ParserCase "last" parser "xi" (suc "y" 1)
+    ]
+
+testBranch :: [TestTree]
+testBranch = fmap testParserCase cases
+ where
+  parser =
+    branchP
+      [ (charP_ 'h', textP "hi")
+      , (charP_ 'y', textP "yi")
+      , (charP_ 'y', textP "ya")
+      ]
+      :: TestParser Text
+  cases =
+    [ ParserCase "empty" parser "" $
+        err (Span 0 0) ReasonEmpty
+    , ParserCase "first" parser "hi" (suc "hi" 0)
+    , ParserCase "fail first" parser "ho" $
+        errAlt
+          (Span 0 2)
+          [ (AltPhaseBranch, Span 2 2, ReasonExpect "hi" "ho")
+          ]
+    , ParserCase "middle" parser "yi" (suc "yi" 0)
+    , ParserCase "last" parser "ya" (suc "ya" 0)
+    , ParserCase "fail rest" parser "yo" $
+        errAlt
+          (Span 0 2)
+          [ (AltPhaseBranch, Span 2 2, ReasonExpect "yi" "yo")
+          , (AltPhaseBranch, Span 2 2, ReasonExpect "ya" "yo")
+          ]
+    ]
+
+testCommit :: [TestTree]
+testCommit = fmap testParserCase cases
+ where
+  parser =
+    commitP
+      [ (charP_ 'h', textP "hi")
+      , (charP_ 'y', textP "yi")
+      , (charP_ 'y', textP "ya")
+      ]
+      :: TestParser Text
+  cases =
+    [ ParserCase "empty" parser "" $
+        err (Span 0 0) ReasonEmpty
+    , ParserCase "first" parser "hi" (suc "hi" 0)
+    , ParserCase "fail first" parser "ho" $
+        err (Span 2 2) (ReasonExpect "hi" "ho")
+    , ParserCase "middle" parser "yi" (suc "yi" 0)
+    , ParserCase "fail last" parser "ya" $
+        err (Span 2 2) (ReasonExpect "yi" "ya")
+    , ParserCase "fail rest" parser "yo" $
+        err (Span 2 2) (ReasonExpect "yi" "yo")
     ]
 
 testOptEmpty :: [TestTree]
