diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,3 @@
+# looksee
+
+A simple text parser with decent errors
diff --git a/looksee.cabal b/looksee.cabal
new file mode 100644
--- /dev/null
+++ b/looksee.cabal
@@ -0,0 +1,121 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.35.2.
+--
+-- see: https://github.com/sol/hpack
+
+name:           looksee
+version:        0.1.0
+synopsis:       parser with looksee
+description:    Please see the README on GitHub at <https://github.com/ejconlon/looksee#readme>
+homepage:       https://github.com/ejconlon/looksee#readme
+bug-reports:    https://github.com/ejconlon/looksee/issues
+author:         Eric Conlon
+maintainer:     ejconlon@gmail.com
+copyright:      (c) 2023 Eric Conlon
+license:        BSD3
+build-type:     Simple
+tested-with:
+    GHC == 9.2.7
+extra-source-files:
+    README.md
+
+source-repository head
+  type: git
+  location: https://github.com/ejconlon/looksee
+
+library
+  exposed-modules:
+      Looksee
+      Looksee.Examples
+  other-modules:
+      Paths_looksee
+  hs-source-dirs:
+      src
+  default-extensions:
+      BangPatterns
+      ConstraintKinds
+      DataKinds
+      DeriveFunctor
+      DeriveFoldable
+      DeriveGeneric
+      DeriveTraversable
+      DerivingStrategies
+      DerivingVia
+      FlexibleContexts
+      FlexibleInstances
+      FunctionalDependencies
+      GADTs
+      GeneralizedNewtypeDeriving
+      LambdaCase
+      KindSignatures
+      MultiParamTypeClasses
+      Rank2Types
+      ScopedTypeVariables
+      StandaloneDeriving
+      TupleSections
+      TypeApplications
+      TypeOperators
+      TypeFamilies
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-unused-top-binds
+  build-depends:
+      base >=4.12 && <5
+    , bifunctors ==5.5.*
+    , containers ==0.6.*
+    , errata ==0.4.*
+    , mmorph ==1.2.*
+    , mtl ==2.2.*
+    , recursion-schemes ==5.2.*
+    , scientific ==0.3.*
+    , text >=1.2 && <2.1
+    , vector ==0.12.*
+  default-language: GHC2021
+
+test-suite looksee-test
+  type: exitcode-stdio-1.0
+  main-is: Main.hs
+  other-modules:
+      Paths_looksee
+  hs-source-dirs:
+      test
+  default-extensions:
+      BangPatterns
+      ConstraintKinds
+      DataKinds
+      DeriveFunctor
+      DeriveFoldable
+      DeriveGeneric
+      DeriveTraversable
+      DerivingStrategies
+      DerivingVia
+      FlexibleContexts
+      FlexibleInstances
+      FunctionalDependencies
+      GADTs
+      GeneralizedNewtypeDeriving
+      LambdaCase
+      KindSignatures
+      MultiParamTypeClasses
+      Rank2Types
+      ScopedTypeVariables
+      StandaloneDeriving
+      TupleSections
+      TypeApplications
+      TypeOperators
+      TypeFamilies
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-unused-top-binds -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      base >=4.12 && <5
+    , bifunctors ==5.5.*
+    , containers ==0.6.*
+    , errata ==0.4.*
+    , looksee
+    , mmorph ==1.2.*
+    , mtl ==2.2.*
+    , recursion-schemes ==5.2.*
+    , scientific ==0.3.*
+    , tasty
+    , tasty-hunit
+    , text >=1.2 && <2.1
+    , vector ==0.12.*
+  default-language: GHC2021
diff --git a/src/Looksee.hs b/src/Looksee.hs
new file mode 100644
--- /dev/null
+++ b/src/Looksee.hs
@@ -0,0 +1,1022 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+-- | A simple text parser with decent errors
+module Looksee
+  ( Label (..)
+  , Range (..)
+  , range
+  , SplitComp (..)
+  , Reason (..)
+  , ErrF (..)
+  , Err (..)
+  , errRange
+  , errReason
+  , AltPhase (..)
+  , InfixPhase (..)
+  , ParserT
+  , Parser
+  , parseT
+  , parse
+  , parseI
+  , throwP
+  , altP
+  , emptyP
+  , endP
+  , optP
+  , greedyP
+  , greedy1P
+  , lookP
+  , labelP
+  , textP
+  , textP_
+  , charP
+  , charP_
+  , breakP
+  , someBreakP
+  , splitP
+  , splitCompP
+  , split1P
+  , infixRP
+  , someInfixRP
+  , takeP
+  , dropP
+  , takeExactP
+  , dropExactP
+  , takeWhileP
+  , dropWhileP
+  , takeWhile1P
+  , dropWhile1P
+  , takeAllP
+  , dropAllP
+  , takeAll1P
+  , dropAll1P
+  , betweenP
+  , sepByP
+  , spaceP
+  , stripP
+  , stripStartP
+  , stripEndP
+  , measureP
+  , unconsP
+  , headP
+  , signedWithP
+  , signedP
+  , intP
+  , uintP
+  , decP
+  , udecP
+  , sciP
+  , usciP
+  , numP
+  , unumP
+  , repeatP
+  , repeat1P
+  , space1P
+  , strip1P
+  , stripStart1P
+  , stripEnd1P
+  , sepBy1P
+  , sepBy2P
+  , transP
+  , scopeP
+  , iterP
+  , strP
+  , doubleStrP
+  , singleStrP
+  , HasErrMessage (..)
+  , errataE
+  , renderE
+  , printE
+  )
+where
+
+import Control.Applicative (Alternative (..), liftA2)
+import Control.Exception (Exception)
+import Control.Monad (ap, void)
+import Control.Monad.Except (ExceptT, MonadError (..), runExceptT)
+import Control.Monad.IO.Class (MonadIO (..))
+import Control.Monad.Identity (Identity (..))
+import Control.Monad.Morph (MFunctor (..))
+import Control.Monad.Reader (MonadReader (..))
+import Control.Monad.State.Strict (MonadState (..), StateT (..), evalStateT, gets, state)
+import Control.Monad.Trans (MonadTrans (..))
+import Control.Monad.Writer.Strict (MonadWriter (..))
+import Data.Bifoldable (Bifoldable (..))
+import Data.Bifunctor (Bifunctor (..))
+import Data.Bifunctor.TH (deriveBifoldable, deriveBifunctor, deriveBitraversable)
+import Data.Bitraversable (Bitraversable (..))
+import Data.Char (digitToInt, isDigit, isSpace)
+import Data.Foldable (toList)
+import Data.Functor.Foldable (Base, Corecursive (..), Recursive (..))
+import Data.Maybe (fromMaybe, isJust, maybeToList)
+import Data.Ratio ((%))
+import Data.Scientific (Scientific)
+import Data.Scientific qualified as S
+import Data.Sequence (Seq (..))
+import Data.Sequence qualified as Seq
+import Data.String (IsString)
+import Data.Text (Text)
+import Data.Text qualified as T
+import Data.Text.IO qualified as TIO
+import Data.Text.Lazy qualified as TL
+import Data.Typeable (Typeable)
+import Data.Vector (Vector)
+import Data.Vector qualified as V
+import Data.Void (Void, absurd)
+import Errata qualified as E
+import Errata.Styles qualified as E
+import Errata.Types qualified as E
+import System.IO (stderr)
+
+-- private
+type OffsetVec = Vector (Int, Int)
+
+-- private
+mkOffsetVec :: Text -> OffsetVec
+mkOffsetVec t = V.unfoldrN (T.length t) go ((0, 0), T.unpack t)
+ where
+  go (p@(!line, !col), xs) =
+    case xs of
+      [] -> Nothing
+      x : xs' -> Just (p, if x == '\n' then ((line + 1, 0), xs') else ((line, col + 1), xs'))
+
+-- | A parser label (for error reporting)
+newtype Label = Label {unLabel :: Text}
+  deriving stock (Show)
+  deriving newtype (Eq, Ord, IsString)
+
+-- | Range in text character offset
+data Range = Range {rangeStart :: !Int, rangeEnd :: !Int}
+  deriving stock (Eq, Ord, Show)
+
+-- | Create a range from the given text
+range :: Text -> Range
+range t = Range 0 (T.length t)
+
+-- private
+-- Parser state
+data St = St
+  { stHay :: !Text
+  , stRange :: !Range
+  , stLabels :: !(Seq Label)
+  }
+  deriving stock (Eq, Ord, Show)
+
+-- private
+-- Returns list of possible break points with positions
+-- (startStream, breakPt) breakPt (breakPt + needLen, endStream)
+breakAllRP :: Text -> St -> [(St, Int, St)]
+breakAllRP needle (St hay (Range r0 r1) labs) = fmap go (T.breakOnAll needle hay)
+ where
+  go (hay1, hay2) =
+    let end1 = r0 + T.length hay1
+        needLen = T.length needle
+        rng1 = Range r0 end1
+        rng2 = Range (end1 + needLen) r1
+        st1 = St hay1 rng1 labs
+        st2 = St (T.drop needLen hay2) rng2 labs
+    in  (st1, end1, st2)
+
+-- private
+breakRP :: Text -> St -> Maybe (St, Int, St)
+breakRP needle (St hay (Range r0 r1) labs) =
+  let (hay1, hay2) = T.breakOn needle hay
+  in  if T.null hay2
+        then Nothing
+        else
+          let end1 = r0 + T.length hay1
+              needLen = T.length needle
+              rng1 = Range r0 end1
+              rng2 = Range (end1 + needLen) r1
+              st1 = St hay1 rng1 labs
+              st2 = St (T.drop needLen hay2) rng2 labs
+          in  Just (st1, end1, st2)
+
+-- private
+splitRP :: Text -> St -> [(St, Int)]
+splitRP needle (St hay (Range r0 _) labs) = goHead (T.splitOn needle hay)
+ where
+  needLen = T.length needle
+  mkSt start end hayN = St hayN (Range start end) labs
+  goHead = \case
+    [] -> []
+    hay0 : hays ->
+      let end0 = r0 + T.length hay0
+      in  (mkSt r0 end0 hay0, 0) : goTail end0 hays
+  goTail !endN1 = \case
+    [] -> []
+    hayN : hays ->
+      let startN = endN1 + needLen
+          endN = startN + T.length hayN
+      in  (mkSt startN endN hayN, endN1) : goTail endN hays
+
+-- | Phase of alternative parsing (for error reporting)
+data AltPhase = AltPhaseBranch | AltPhaseCont
+  deriving stock (Eq, Ord, Show, Enum, Bounded)
+
+-- | Phase of infix/split parsing (for error reporting)
+data InfixPhase = InfixPhaseLeft | InfixPhaseRight | InfixPhaseCont
+  deriving stock (Eq, Ord, Show, Enum, Bounded)
+
+data SplitComp = SplitCompEQ | SplitCompGE | SplitCompGT
+  deriving stock (Eq, Ord, Show, Enum, Bounded)
+
+-- | Reason for parse failure
+data Reason e r
+  = ReasonCustom !e
+  | ReasonSplitComp !SplitComp !Int !Text !Int
+  | ReasonExpect !Text !Text
+  | ReasonDemand !Int !Int
+  | ReasonLeftover !Int
+  | ReasonAlt !(Seq (AltPhase, r))
+  | ReasonInfix !(Seq (Int, InfixPhase, r))
+  | ReasonFail !Text
+  | ReasonLabelled !Label r
+  | ReasonLook r
+  | ReasonTakeNone
+  | ReasonEmpty
+  deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable)
+
+deriveBifunctor ''Reason
+deriveBifoldable ''Reason
+deriveBitraversable ''Reason
+
+-- | Base functor for 'Err' containing the range and reason for the error
+data ErrF e r = ErrF
+  { efRange :: !Range
+  , efReason :: !(Reason e r)
+  }
+  deriving stock (Eq, Ord, Show, Functor, Foldable, Traversable)
+
+deriveBifunctor ''ErrF
+deriveBifoldable ''ErrF
+deriveBitraversable ''ErrF
+
+-- | A parse error, which may contain multiple sub-errors
+newtype Err e = Err {unErr :: ErrF e (Err e)}
+  deriving stock (Eq, Ord, Show)
+
+instance Functor Err where
+  fmap f = go
+   where
+    go (Err (ErrF ra re)) = Err (ErrF ra (bimap f go re))
+
+instance Foldable Err where
+  foldr f = flip go
+   where
+    go (Err (ErrF _ re)) z = bifoldr f go z re
+
+instance Traversable Err where
+  traverse f = go
+   where
+    go (Err (ErrF ra re)) = fmap (Err . ErrF ra) (bitraverse f go re)
+
+instance (Typeable e, Show e) => Exception (Err e)
+
+type instance Base (Err e) = ErrF e
+
+instance Recursive (Err e) where
+  project = unErr
+
+instance Corecursive (Err e) where
+  embed = Err
+
+-- | Range of a parse error
+errRange :: Err e -> Range
+errRange = efRange . unErr
+
+-- | Reason for a parse error
+errReason :: Err e -> Reason e (Err e)
+errReason = efReason . unErr
+
+-- private
+newtype T e m a = T {unT :: ExceptT (Err e) (StateT St m) a}
+  deriving newtype (Functor, Applicative, Monad, MonadIO, MonadState St, MonadError (Err e))
+
+instance MonadTrans (T e) where
+  lift = T . lift . lift
+
+instance MFunctor (T e) where
+  hoist mn (T x) = T (hoist (hoist mn) x)
+
+deriving instance MonadReader r m => MonadReader r (T e m)
+
+deriving instance MonadWriter w m => MonadWriter w (T e m)
+
+-- private
+runT :: T e m a -> St -> m (Either (Err e) a, St)
+runT = runStateT . runExceptT . unT
+
+-- private
+mkErrT :: Monad m => Reason e (Err e) -> T e m (Err e)
+mkErrT re = gets (\st -> Err (ErrF (stRange st) re))
+
+-- private
+-- errT :: Monad m => Reason e (Err e) -> T e m a
+-- errT = mkErrT >=> throwError
+
+-- private
+tryT :: Monad m => T e m r -> T e m (Either (Err e) r)
+tryT t = get >>= \st -> lift (runT t st) >>= \(er, st') -> er <$ put st'
+
+-- | The parser monad transformer
+newtype ParserT e m a = ParserT {unParserT :: forall r. (Either (Err e) a -> T e m r) -> T e m r}
+
+instance Functor (ParserT e m) where
+  fmap f (ParserT g) = ParserT (\j -> g (j . fmap f))
+
+instance Applicative (ParserT e m) where
+  pure a = ParserT (\j -> j (Right a))
+  (<*>) = ap
+
+instance Monad (ParserT e m) where
+  return = pure
+  ParserT g >>= f = ParserT (\j -> g (\case Left e -> j (Left e); Right a -> let ParserT h = f a in h j))
+
+instance Monad m => Alternative (ParserT e m) where
+  empty = emptyP
+  p1 <|> p2 = altP [p1, p2]
+  many = fmap toList . greedyP
+  some = fmap toList . greedy1P
+
+-- | The parser monad
+type Parser e = ParserT e Identity
+
+instance MonadTrans (ParserT e) where
+  lift ma = ParserT (\j -> lift ma >>= j . Right)
+
+instance MonadIO m => MonadIO (ParserT e m) where
+  liftIO ma = ParserT (\j -> liftIO ma >>= j . Right)
+
+instance Monad m => MonadFail (ParserT e m) where
+  fail = errP . ReasonFail . T.pack
+
+instance MonadReader r m => MonadReader r (ParserT e m) where
+  ask = ParserT (\j -> ask >>= j . Right)
+  local f (ParserT g) = ParserT (local f . g)
+
+instance MonadState s m => MonadState s (ParserT e m) where
+  get = ParserT (\j -> lift get >>= j . Right)
+  put s = ParserT (\j -> lift (put s) >>= j . Right)
+  state f = ParserT (\j -> lift (state f) >>= j . Right)
+
+instance Semigroup a => Semigroup (ParserT e m a) where
+  p <> q = liftA2 (<>) p q
+
+instance Monoid a => Monoid (ParserT e m a) where
+  mempty = pure mempty
+
+-- private
+finishParserT :: Monad m => ParserT e m a -> St -> m (Either (Err e) a, St)
+finishParserT (ParserT g) st =
+  let t = g (either throwError pure)
+  in  runT t st
+
+-- private
+getP :: Monad m => ParserT e m St
+getP = ParserT (\j -> get >>= j . Right)
+
+-- private
+getsP :: Monad m => (St -> a) -> ParserT e m a
+getsP f = ParserT (\j -> gets f >>= j . Right)
+
+-- private
+putP :: Monad m => St -> ParserT e m ()
+putP st = ParserT (\j -> put st >>= j . Right)
+
+-- private
+stateP :: Monad m => (St -> (a, St)) -> ParserT e m a
+stateP f = ParserT (\j -> state f >>= j . Right)
+
+-- private
+errP :: Monad m => Reason e (Err e) -> ParserT e m a
+errP re = ParserT (\j -> mkErrT re >>= j . Left)
+
+-- private
+leftoverP :: Monad m => ParserT e m Int
+leftoverP = getsP (\st -> let Range s e = stRange st in e - s)
+
+-- | Run a parser transformer. You must consume all input or this will error!
+-- If you really don't care about the rest of the input, you can always
+-- discard it with 'dropAllP'.
+parseT :: Monad m => ParserT e m a -> Text -> m (Either (Err e) a)
+parseT p h = fmap fst (finishParserT (p <* endP) (St h (range h) Empty))
+
+-- | Run a parser (see 'parseT')
+parse :: Parser e a -> Text -> Either (Err e) a
+parse p h = runIdentity (parseT p h)
+
+-- | Run a parser and print any errors that occur
+parseI :: HasErrMessage e => Parser e a -> Text -> IO (Either (Err e) a)
+parseI p h = do
+  let ea = parse p h
+  case ea of
+    Left e -> printE "<interactive>" h e
+    Right _ -> pure ()
+  pure ea
+
+-- | Throw a custom parse error
+throwP :: Monad m => e -> ParserT e m a
+throwP = errP . ReasonCustom
+
+-- | Succeed if this is the end of input
+endP :: Monad m => ParserT e m ()
+endP = do
+  l <- leftoverP
+  if l == 0
+    then pure ()
+    else errP (ReasonLeftover l)
+
+-- | Makes parse success optional
+optP :: Monad m => ParserT e m a -> ParserT e m (Maybe a)
+optP (ParserT g) = ParserT $ \j -> do
+  st0 <- get
+  g $ \case
+    Left _ -> put st0 >> j (Right Nothing)
+    Right a -> j (Right (Just a))
+
+-- private
+subAltP
+  :: Monad m
+  => (Either (Err e) a -> T e m r)
+  -> St
+  -> Seq (AltPhase, Err e)
+  -> [ParserT e m a]
+  -> T e m r
+subAltP j st0 = go
+ where
+  go !errs = \case
+    [] -> mkErrT (if Seq.null errs then ReasonEmpty else ReasonAlt errs) >>= j . Left
+    ParserT g : rest -> g $ \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
+
+-- | Parse with many possible branches
+altP :: (Monad m, Foldable f) => f (ParserT e m a) -> ParserT e m a
+altP falts = ParserT (\j -> get >>= \st0 -> subAltP j st0 Empty (toList falts))
+
+-- | Fail with no results
+emptyP :: Monad m => ParserT e m a
+emptyP = ParserT (\j -> mkErrT ReasonEmpty >>= j . Left)
+
+-- | Parse repeatedly until the parser fails
+greedyP :: Monad m => ParserT e m a -> ParserT e m (Seq a)
+greedyP p = go Empty
+ where
+  go !acc = do
+    ma <- optP p
+    case ma of
+      Nothing -> pure acc
+      Just a -> go (acc :|> a)
+
+-- | Same as 'greedyP' but ensure at least one result
+greedy1P :: Monad m => ParserT e m a -> ParserT e m (Seq a)
+greedy1P p = liftA2 (:<|) p (greedyP p)
+
+-- | Lookahead - rewinds state if the parser succeeds, otherwise throws error
+lookP :: Monad m => ParserT e m a -> ParserT e m a
+lookP (ParserT g) = ParserT $ \j -> do
+  st0 <- get
+  g (\ea -> put st0 >> j (first (Err . ErrF (stRange st0) . ReasonLook) ea))
+
+-- | Labels parse errors
+labelP :: Monad m => Label -> ParserT e m a -> ParserT e m a
+labelP lab (ParserT g) = ParserT $ \j ->
+  g $ \case
+    Left e -> mkErrT (ReasonLabelled lab e) >>= j . Left
+    Right a -> j (Right a)
+
+-- | Expect the given text at the start of the range
+textP :: Monad m => Text -> ParserT e m Text
+textP n = do
+  o <- takeP (T.length n)
+  if n == o
+    then pure n
+    else errP (ReasonExpect n o)
+
+-- | Saves you from importing 'void'
+textP_ :: Monad m => Text -> ParserT e m ()
+textP_ = void . textP
+
+-- | Expect the given character at the start of the range
+charP :: Monad m => Char -> ParserT e m Char
+charP = fmap T.head . textP . T.singleton
+
+-- | Saves you from importing 'void'
+charP_ :: Monad m => Char -> ParserT e m ()
+charP_ = void . charP
+
+-- | Split once on the delimiter (first argument), parsing everything before it with a narrowed range.
+-- Chooses first split from START to END of range (see 'infixRP').
+breakP :: Monad m => Text -> ParserT e m a -> ParserT e m a
+breakP tx pa = fmap fst (infixRP tx pa (pure ()))
+
+-- | Split once on the delimiter (first argument), parsing everything before it with a narrowed range.
+-- Chooses splits from START to END of range (see 'someInfixRP').
+someBreakP :: Monad m => Text -> ParserT e m a -> ParserT e m a
+someBreakP tx pa = fmap fst (someInfixRP tx pa (pure ()))
+
+-- private
+subSplitP
+  :: Monad m
+  => St
+  -> ParserT e m a
+  -> (Either (Err e) (Seq a, Bool) -> T e m r)
+  -> [(St, Int)]
+  -> T e m r
+subSplitP st0 pa j = go Empty
+ where
+  go !acc = \case
+    [] -> j (Right (acc, True))
+    (st, start') : sts -> do
+      put st
+      unParserT (pa <* endP) $ \case
+        Left _ -> do
+          let rng = stRange st0
+              start = rangeStart rng
+              hay' = T.drop (start' - start) (stHay st0)
+              range' = rng {rangeStart = start'}
+              st' = st0 {stHay = hay', stRange = range'}
+          put st'
+          j (Right (acc, False))
+        Right a -> go (acc :|> a) sts
+
+-- | Split on the delimiter, parsing segments with a narrowed range, until parsing fails.
+-- Returns the sequence of successes with state at the delimiter preceding the failure (or end of input),
+-- and True if there are no more delimiters in the tail.
+splitP :: Monad m => Text -> ParserT e m a -> ParserT e m (Seq a, Bool)
+splitP tx pa = ParserT (\j -> get >>= \st0 -> subSplitP st0 pa j (splitRP tx st0))
+
+splitCompP :: Monad m => SplitComp -> Int -> Text -> ParserT e m a -> ParserT e m (Seq a, Bool)
+splitCompP comp n tx pa = do
+  p@(as, _) <- splitP tx pa
+  let len = Seq.length as
+      ok = case comp of
+        SplitCompEQ -> len == n
+        SplitCompGE -> len >= n
+        SplitCompGT -> len > n
+  if ok then pure p else errP (ReasonSplitComp comp n tx len)
+
+-- | Like 'splitP' but ensures the sequence is at least length 1
+split1P :: Monad m => Text -> ParserT e m a -> ParserT e m (Seq a, Bool)
+split1P = splitCompP SplitCompGE 1
+
+-- private
+subInfixP
+  :: Monad m
+  => St
+  -> ParserT e m a
+  -> ParserT e m b
+  -> (Either (Err e) (Maybe (a, b)) -> T e m r)
+  -> [(St, Int, St)]
+  -> T e m r
+subInfixP st0 pa pb j = go Empty
+ where
+  go !errs = \case
+    [] -> do
+      put st0
+      case errs of
+        Empty -> j (Right Nothing)
+        _ -> mkErrT (ReasonInfix errs) >>= j . Left
+    (stA, endA, stB) : sts -> do
+      put stA
+      unParserT (pa <* endP) $ \case
+        Left errA -> go (errs :|> (endA, InfixPhaseLeft, errA)) sts
+        Right a -> do
+          put stB
+          unParserT pb $ \case
+            Left errB -> go (errs :|> (endA, InfixPhaseRight, errB)) sts
+            Right b -> do
+              ec <- tryT (j (Right (Just (a, b))))
+              case ec of
+                Left errC -> go (errs :|> (endA, InfixPhaseCont, errC)) sts
+                Right c -> pure c
+
+-- private
+optInfixRP :: Monad m => Text -> ParserT e m a -> ParserT e m b -> ParserT e m (Maybe (a, b))
+optInfixRP tx pa pb = ParserT (\j -> get >>= \st0 -> subInfixP st0 pa pb j (breakAllRP tx st0))
+
+-- private
+requireInfix
+  :: Monad m
+  => (Either (Err e) (a, b) -> T e m r)
+  -> (Either (Err e) (Maybe (a, b)) -> T e m r)
+requireInfix j = \case
+  Right mxab ->
+    case mxab of
+      Nothing -> mkErrT ReasonEmpty >>= j . Left
+      Just xab -> j (Right xab)
+  Left e -> j (Left e)
+
+-- | Right-associative infix parsing. Searches for the operator from START to END of range,
+-- trying only the first break point.
+infixRP :: Monad m => Text -> ParserT e m a -> ParserT e m b -> ParserT e m (a, b)
+infixRP tx pa pb = ParserT (\j -> get >>= \st0 -> subInfixP st0 pa pb (requireInfix j) (maybeToList (breakRP tx st0)))
+
+-- | Right-associative infix parsing. Searches for the operator from START to END of range,
+-- trying subsequent break points until success.
+someInfixRP :: Monad m => Text -> ParserT e m a -> ParserT e m b -> ParserT e m (a, b)
+someInfixRP tx pa pb = ParserT (\j -> get >>= \st0 -> subInfixP st0 pa pb (requireInfix j) (breakAllRP tx st0))
+
+-- | Take the given number of characters from the start of the range, or fewer if empty
+takeP :: Monad m => Int -> ParserT e m Text
+takeP i = stateP $ \st ->
+  let h = stHay st
+      (o, h') = T.splitAt i h
+      l = T.length o
+      r = stRange st
+      r' = r {rangeStart = rangeStart r + l}
+      st' = st {stHay = h', stRange = r'}
+  in  (o, st')
+
+-- | Take exactly the given number of characters from the start of the range, or error
+takeExactP :: Monad m => Int -> ParserT e m Text
+takeExactP i = do
+  et <- stateP $ \st ->
+    let h = stHay st
+        (o, h') = T.splitAt i h
+        l = T.length o
+        r = stRange st
+        r' = r {rangeStart = rangeStart r + T.length o}
+        st' = st {stHay = h', stRange = r'}
+    in  if l == i then (Right o, st') else (Left l, st)
+  case et of
+    Left l -> errP (ReasonDemand i l)
+    Right a -> pure a
+
+-- | Drop the given number of characters from the start of the range, or fewer if empty
+dropP :: Monad m => Int -> ParserT e m Int
+dropP = fmap T.length . takeP
+
+-- | Drop exactly the given number of characters from the start of the range, or error
+dropExactP :: Monad m => Int -> ParserT e m ()
+dropExactP = void . takeExactP
+
+-- | Take characters from the start of the range satisfying the predicate
+takeWhileP :: Monad m => (Char -> Bool) -> ParserT e m Text
+takeWhileP f = stateP $ \st ->
+  let h = stHay st
+      o = T.takeWhile f h
+      l = T.length o
+      h' = T.drop l h
+      r = stRange st
+      r' = r {rangeStart = rangeStart r + l}
+      st' = st {stHay = h', stRange = r'}
+  in  (o, st')
+
+-- | Like 'takeWhileP' but ensures at least 1 character has been taken
+takeWhile1P :: Monad m => (Char -> Bool) -> ParserT e m Text
+takeWhile1P f = do
+  mt <- stateP $ \st ->
+    let h = stHay st
+        o = T.takeWhile f h
+        l = T.length o
+        h' = T.drop l h
+        r = stRange st
+        r' = r {rangeStart = rangeStart r + l}
+        st' = st {stHay = h', stRange = r'}
+    in  if l == 0 then (Nothing, st) else (Just o, st')
+  case mt of
+    Nothing -> errP ReasonTakeNone
+    Just a -> pure a
+
+-- | Drop characters from the start of the range satisfying the predicate
+dropWhileP :: Monad m => (Char -> Bool) -> ParserT e m Int
+dropWhileP = fmap T.length . takeWhileP
+
+-- | Like 'dropWhileP' but ensures at least 1 character has been dropped
+dropWhile1P :: Monad m => (Char -> Bool) -> ParserT e m Int
+dropWhile1P = fmap T.length . takeWhile1P
+
+-- | Take the remaining range, leaving it empty
+takeAllP :: Monad m => ParserT e m Text
+takeAllP = stateP $ \st ->
+  let h = stHay st
+      r = stRange st
+      r' = r {rangeStart = rangeEnd r}
+      st' = st {stHay = T.empty, stRange = r'}
+  in  (h, st')
+
+-- | Like 'takeAllP' but ensures at least 1 character has been taken
+takeAll1P :: Monad m => ParserT e m Text
+takeAll1P = do
+  mt <- stateP $ \st ->
+    let h = stHay st
+        r = stRange st
+        r' = r {rangeStart = rangeEnd r}
+        st' = st {stHay = T.empty, stRange = r'}
+    in  if T.null h then (Nothing, st) else (Just h, st')
+  case mt of
+    Nothing -> errP (ReasonDemand 1 0)
+    Just a -> pure a
+
+-- | Drop the remaining range, leaving it empty
+dropAllP :: Monad m => ParserT e m Int
+dropAllP = fmap T.length takeAllP
+
+-- | Like 'dropAllP' but ensures at least 1 character has been dropped
+dropAll1P :: Monad m => ParserT e m Int
+dropAll1P = fmap T.length takeAll1P
+
+-- | Unwrap a monad transformer layer (see 'scopeP' for use)
+transP :: (MonadTrans t, Monad m) => (forall a. t m a -> m a) -> ParserT e (t m) b -> ParserT e m b
+transP f (ParserT g) = ParserT $ \j -> do
+  st0 <- get
+  (ea, st1) <- lift (f (runT (g (hoist lift . j)) st0))
+  put st1
+  either throwError pure ea
+
+-- | Parse with some local state
+scopeP :: Monad m => s -> ParserT e (StateT s m) a -> ParserT e m a
+scopeP s0 = transP (`evalStateT` s0)
+
+-- | Repeats the parser until it returns a 'Just' value
+iterP :: ParserT e m (Maybe a) -> ParserT e m a
+iterP p = go
+ where
+  go = p >>= maybe go pure
+
+data StrState = StrState !Bool !(Seq Char)
+
+-- | Parse a string with a custom quote character. Supports backslash-escaping.
+strP :: Monad m => Char -> ParserT e m Text
+strP d = do
+  textP_ (T.singleton d)
+  scopeP (StrState False Empty) $ iterP $ do
+    c <- headP
+    state $ \ss@(StrState esc buf) ->
+      if c == d
+        then
+          if esc
+            then (Nothing, StrState False (buf :|> c))
+            else (Just (T.pack (toList buf)), ss)
+        else
+          if c == '\\'
+            then
+              if esc
+                then (Nothing, StrState False (buf :|> c))
+                else (Nothing, StrState True buf)
+            else (Nothing, StrState False (buf :|> c))
+
+-- | Parse a double-quoted string
+doubleStrP :: Monad m => ParserT e m Text
+doubleStrP = strP '"'
+
+-- | Parse a single-quoted string
+singleStrP :: Monad m => ParserT e m Text
+singleStrP = strP '\''
+
+-- | Parse between an opening delimiter (first parser) and a closing delimited (second parser)
+betweenP :: ParserT e m x -> ParserT e m y -> ParserT e m a -> ParserT e m a
+betweenP px py pa = px *> pa <* py
+
+-- | Parse a sequence of items delimited by the first parser
+sepByP :: Monad m => ParserT e m x -> ParserT e m a -> ParserT e m (Seq a)
+sepByP c p = go
+ where
+  go = do
+    ma <- optP p
+    case ma of
+      Nothing -> pure Empty
+      Just a -> goNext (Empty :|> a)
+  goNext !acc = do
+    mc <- optP c
+    case mc of
+      Nothing -> pure acc
+      Just _ -> do
+        a <- p
+        goNext (acc :|> a)
+
+-- | Consumes many spaces at the start of the range
+spaceP :: Monad m => ParserT e m ()
+spaceP = void (dropWhileP isSpace)
+
+-- | Strips spaces before and after parsing
+stripP :: Monad m => ParserT e m a -> ParserT e m a
+stripP p = spaceP *> p <* spaceP
+
+-- | Strips spaces before parsing
+stripStartP :: Monad m => ParserT e m a -> ParserT e m a
+stripStartP p = spaceP *> p
+
+-- | Strips spaces after parsing
+stripEndP :: Monad m => ParserT e m a -> ParserT e m a
+stripEndP p = p <* spaceP
+
+-- | Parses and returns the length of the consumed input along with the result
+measureP :: Monad m => ParserT e m a -> ParserT e m (a, Int)
+measureP p = do
+  start <- getsP (rangeStart . stRange)
+  a <- p
+  end <- getsP (rangeStart . stRange)
+  pure (a, end - start)
+
+-- | Takes exactly 1 character from the start of the range, returning Nothing
+-- if at end of input
+unconsP :: Monad m => ParserT e m (Maybe Char)
+unconsP = stateP $ \st ->
+  let h = stHay st
+      mxy = T.uncons h
+  in  case mxy of
+        Nothing -> (Nothing, st)
+        Just (x, y) ->
+          let r = stRange st
+              r' = r {rangeStart = rangeStart r + 1}
+              st' = st {stHay = y, stRange = r'}
+          in  (Just x, st')
+
+-- | Takes exactly 1 character from the start of the range, throwing error
+-- if at end of input
+headP :: Monad m => ParserT e m Char
+headP = unconsP >>= maybe (errP (ReasonDemand 1 0)) pure
+
+-- | Add signed-ness to any parser with a negate function
+signedWithP :: Monad m => (a -> a) -> ParserT e m a -> ParserT e m a
+signedWithP neg p = do
+  ms <- optP (charP '-')
+  case ms of
+    Nothing -> p
+    Just _ -> fmap neg p
+
+-- | Add signed-ness to any numeric parser
+signedP :: (Monad m, Num a) => ParserT e m a -> ParserT e m a
+signedP = signedWithP negate
+
+-- | Parse an signed integer
+intP :: Monad m => ParserT e m Integer
+intP = signedP uintP
+
+-- | Parse an unsigned integer
+uintP :: Monad m => ParserT e m Integer
+uintP = T.foldl' (\n d -> n * 10 + fromIntegral (digitToInt d)) 0 <$> takeWhile1P isDigit
+
+-- | Parse a signed decimal
+decP :: Monad m => ParserT e m Rational
+decP = signedP udecP
+
+-- | Parse an unsigned decimal
+udecP :: Monad m => ParserT e m Rational
+udecP = do
+  whole <- fmap fromInteger uintP
+  hasDot <- fmap isJust (optP (charP '.'))
+  if hasDot
+    then do
+      (numerator, places) <- measureP uintP
+      let denominator = 10 ^ places
+          part = numerator % denominator
+      pure (whole + part)
+    else pure whole
+
+-- | Parse a signed scientific number
+sciP :: Monad m => ParserT e m Scientific
+sciP = signedP usciP
+
+-- | Parse an unsigned scientific  number
+usciP :: Monad m => ParserT e m Scientific
+usciP = do
+  whole <- uintP
+  hasDot <- fmap isJust (optP (charP_ '.'))
+  (frac, places) <- if hasDot then measureP uintP else pure (0, 0)
+  hasEx <- fmap isJust (optP (charP_ 'e' <|> charP_ 'E'))
+  ex <- if hasEx then fmap fromIntegral intP else pure 0
+  let wholeS = S.scientific whole ex
+      partS = S.scientific frac (ex - places)
+  pure (wholeS + partS)
+
+-- | Parse a signed integer/scientific number, defaulting to integer if possible.
+numP :: Monad m => ParserT e m (Either Integer Scientific)
+numP = signedWithP (bimap negate negate) unumP
+
+-- | Parse an unsigned integer/scientific number, defaulting to integer if possible.
+unumP :: Monad m => ParserT e m (Either Integer Scientific)
+unumP = do
+  whole <- uintP
+  hasDot <- fmap isJust (optP (charP_ '.'))
+  mayFracPlaces <- if hasDot then fmap Just (measureP uintP) else pure Nothing
+  hasEx <- fmap isJust (optP (charP_ 'e' <|> charP_ 'E'))
+  mayEx <- if hasEx then fmap (Just . fromIntegral) intP else pure Nothing
+  case (mayFracPlaces, mayEx) of
+    (Nothing, Nothing) -> pure (Left whole)
+    _ -> do
+      let (frac, places) = fromMaybe (0, 0) mayFracPlaces
+          ex = fromMaybe 0 mayEx
+          wholeS = S.scientific whole ex
+          partS = S.scientific frac (ex - places)
+      pure (Right (wholeS + partS))
+
+-- | Repeat a parser until it fails, collecting the results.
+repeatP :: Monad m => ParserT e m a -> ParserT e m (Seq a)
+repeatP p = go Empty
+ where
+  go !acc = do
+    ma <- optP p
+    case ma of
+      Nothing -> pure acc
+      Just a -> go (acc :|> a)
+
+-- | Like 'repeatP' but ensures at least 1
+repeat1P :: Monad m => ParserT e m a -> ParserT e m (Seq a)
+repeat1P p = liftA2 (:<|) p (repeatP p)
+
+-- | Like 'spaceP' but ensures at least 1 space removed
+space1P :: Monad m => ParserT e m ()
+space1P = void (dropWhile1P isSpace)
+
+-- | Like 'stripP' but ensures at least 1 space removed
+strip1P :: Monad m => ParserT e m a -> ParserT e m a
+strip1P p = space1P *> p <* space1P
+
+-- | Like 'stripStartP' but ensures at least 1 space removed
+stripStart1P :: Monad m => ParserT e m a -> ParserT e m a
+stripStart1P p = space1P *> p
+
+-- | Like 'stripEndP' but ensures at least 1 space removed
+stripEnd1P :: Monad m => ParserT e m a -> ParserT e m a
+stripEnd1P p = p <* space1P
+
+-- | Like 'sepByP' but ensures at least 1 element
+sepBy1P :: Monad m => ParserT e m x -> ParserT e m a -> ParserT e m (Seq a)
+sepBy1P px pa = liftA2 (:<|) pa (fmap (fromMaybe Empty) (optP (px *> sepByP px pa)))
+
+-- | Like 'sepBy1P' but ensures at least 2 elements (i.e. there was a delimiter)
+sepBy2P :: Monad m => ParserT e m x -> ParserT e m a -> ParserT e m (Seq a)
+sepBy2P px pa = liftA2 (:<|) (pa <* px) (sepBy1P px pa)
+
+-- | Implement this to format custom errors. The list will be joined with `unlines`.
+class HasErrMessage e where
+  getErrMessage :: e -> [Text]
+
+instance HasErrMessage Void where
+  getErrMessage = absurd
+
+-- private
+indent :: Int -> [Text] -> [Text]
+indent i = let s = T.replicate (2 * i) " " in fmap (s <>)
+
+instance HasErrMessage e => HasErrMessage (Err e) where
+  getErrMessage (Err (ErrF (Range start end) re)) =
+    let pos = "Error in range: (" <> T.pack (show start) <> ", " <> T.pack (show end) <> ")"
+        body = case re of
+          ReasonCustom e ->
+            let hd = "Custom error:"
+                tl = indent 1 (getErrMessage e)
+            in  hd : tl
+          ReasonSplitComp comp n tx len ->
+            let op = case comp of SplitCompEQ -> "=="; SplitCompGE -> ">="; SplitCompGT -> ">"
+            in  ["Split on \"" <> tx <> "\" with length " <> T.pack (show len) <> " not " <> op <> " " <> T.pack (show n)]
+          ReasonExpect expected actual ->
+            ["Expected text: '" <> expected <> "' but found: '" <> actual <> "'"]
+          ReasonDemand expected actual ->
+            ["Expected count: " <> T.pack (show expected) <> " but got: " <> T.pack (show actual)]
+          ReasonLeftover count ->
+            ["Expected end but had leftover count: " <> T.pack (show count)]
+          ReasonAlt errs ->
+            let hd = "Alternatives:"
+                tl = indent 1 $ do
+                  (_, e) <- toList errs
+                  "Tried:" : indent 1 (getErrMessage e)
+            in  hd : tl
+          ReasonInfix errs ->
+            let hd = "Infix/split failed:"
+                tl = indent 1 $ do
+                  (i, _, e) <- toList errs
+                  let x = "Tried position: " <> T.pack (show i)
+                  x : indent 1 (getErrMessage e)
+            in  hd : tl
+          ReasonFail msg -> ["User reported failure: " <> msg]
+          ReasonLabelled lab e ->
+            let hd = "Labelled parser: " <> unLabel lab
+                tl = indent 1 (getErrMessage e)
+            in  hd : tl
+          ReasonLook e ->
+            let hd = "Error in lookahead:"
+                tl = indent 1 (getErrMessage e)
+            in  hd : tl
+          ReasonTakeNone -> ["Took/dropped no elements"]
+          ReasonEmpty -> ["No parse results"]
+    in  pos : body
+
+-- | Create 'Errata' formatting a parse error
+errataE :: HasErrMessage e => FilePath -> (Int -> (E.Line, E.Column)) -> Err e -> [E.Errata]
+errataE fp mkP e =
+  let (line, col) = mkP (rangeStart (errRange e))
+      msg = getErrMessage e
+      block = E.blockSimple E.basicStyle E.basicPointer fp Nothing (line, col, col + 1, Nothing) (Just (T.unlines msg))
+  in  [E.Errata Nothing [block] Nothing]
+
+-- | Render a formatted error to text
+renderE :: HasErrMessage e => FilePath -> Text -> Err e -> Text
+renderE fp h e =
+  let ov = mkOffsetVec h
+      mkP = if V.null ov then const (1, 1) else \i -> let (!l, !c) = ov V.! min i (V.length ov - 1) in (l + 1, c + 1)
+  in  TL.toStrict (E.prettyErrors h (errataE fp mkP e))
+
+-- | Print a formatted error to stderr
+printE :: HasErrMessage e => FilePath -> Text -> Err e -> IO ()
+printE fp h e = TIO.hPutStrLn stderr (renderE fp h e)
diff --git a/src/Looksee/Examples.hs b/src/Looksee/Examples.hs
new file mode 100644
--- /dev/null
+++ b/src/Looksee/Examples.hs
@@ -0,0 +1,117 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Example parsers
+module Looksee.Examples
+  ( Json (..)
+  , jsonParser
+  , Arith (..)
+  , arithParser
+  , Atom (..)
+  , Sexp (..)
+  , sexpParser
+  )
+where
+
+import Control.Applicative ((<|>))
+import Data.Char (isAlpha)
+import Data.Scientific (Scientific)
+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_)
+
+-- | A JSON value
+data Json
+  = JsonNull
+  | JsonString !Text
+  | JsonArray !(Seq Json)
+  | JsonObject !(Seq (Text, Json))
+  | JsonNum !Scientific
+  | JsonBool !Bool
+  deriving stock (Eq, Ord, Show)
+
+-- | A JSON parser (modulo some differences in numeric parsing)
+jsonParser :: Parser Void Json
+jsonParser = stripP valP
+ where
+  valP =
+    altP
+      [ labelP "null" nullP
+      , labelP "bool" boolP
+      , labelP "str" strP
+      , labelP "array" arrayP
+      , labelP "object" objectP
+      , labelP "num" numP
+      ]
+  boolP = JsonBool <$> (False <$ textP_ "false" <|> True <$ textP_ "true")
+  numP = JsonNum <$> sciP
+  nullP = JsonNull <$ textP_ "null"
+  strP = JsonString <$> doubleStrP
+  arrayP = JsonArray <$> betweenP (stripEndP (textP_ "[")) (textP_ "]") (sepByP (stripEndP (textP_ ",")) (stripEndP valP))
+  pairP = do
+    s <- doubleStrP
+    stripP (textP_ ":")
+    v <- valP
+    pure (s, v)
+  objectP = JsonObject <$> betweenP (stripEndP (textP_ "{")) (textP_ "}") (sepByP (stripEndP (textP_ ",")) (stripEndP pairP))
+
+-- | An arithmetic expression
+data Arith
+  = ArithNum !Rational
+  | ArithVar !Text
+  | ArithNeg Arith
+  | ArithMul Arith Arith
+  | ArithAdd Arith Arith
+  | ArithSub Arith Arith
+  deriving stock (Eq, Ord, Show)
+
+-- | A parser for arithmetic expressions
+arithParser :: Parser Void Arith
+arithParser = stripP rootP
+ where
+  identP = takeWhile1P isAlpha
+  binaryP op f = fmap (uncurry f) (infixRP op (stripEndP rootP) (stripStartP rootP))
+  unaryP op f = textP_ op *> fmap f rootP
+  rootP =
+    altP
+      [ labelP "add" (binaryP "+" ArithAdd)
+      , labelP "sub" (binaryP "-" ArithSub)
+      , labelP "mul" (binaryP "*" ArithMul)
+      , labelP "neg" (unaryP "-" ArithNeg)
+      , labelP "paren" (betweenP (stripEndP (textP_ "(")) (textP_ ")") (stripEndP rootP))
+      , labelP "num" (ArithNum <$> decP)
+      , labelP "var" (ArithVar <$> identP)
+      ]
+
+-- | Leaves of S-expression trees
+data Atom
+  = AtomIdent !Text
+  | AtomString !Text
+  | AtomInt !Integer
+  | AtomSci !Scientific
+  deriving stock (Eq, Ord, Show)
+
+-- | An S-expression
+data Sexp
+  = SexpAtom !Atom
+  | SexpList !(Seq Sexp)
+  deriving stock (Eq, Ord, Show)
+
+-- | A parser for S-expressions
+sexpParser :: Parser Void Sexp
+sexpParser = stripP rootP
+ where
+  identP = takeWhile1P isAlpha
+  atomP =
+    altP
+      [ labelP "ident" (AtomIdent <$> identP)
+      , labelP "string" (AtomString <$> doubleStrP)
+      , labelP "int" (AtomInt <$> intP)
+      , labelP "sci" (AtomSci <$> sciP)
+      ]
+  listP = betweenP (stripEndP (textP_ "(")) (textP_ ")") (stripEndP (sepByP space1P rootP))
+  rootP =
+    altP
+      [ labelP "atom" (SexpAtom <$> atomP)
+      , labelP "list" (SexpList <$> listP)
+      ]
diff --git a/test/Main.hs b/test/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/Main.hs
@@ -0,0 +1,616 @@
+{-# LANGUAGE NegativeLiterals #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main (main) where
+
+import Control.Applicative (Alternative (..), liftA2)
+import Data.Bifunctor (first)
+import Data.Foldable (toList)
+import Data.Sequence (Seq (..))
+import Data.Sequence qualified as Seq
+import Data.String (IsString)
+import Data.Text (Text)
+import Data.Text qualified as T
+import Looksee
+import Looksee.Examples
+import Test.Tasty (TestName, TestTree, defaultMain, testGroup)
+import Test.Tasty.HUnit (testCase, (@?=))
+
+newtype Error = Error {unError :: String} deriving (Eq, Show, IsString)
+
+type TestParser = Parser Error
+
+type TestResult = Either (Err Error)
+
+data ParserCase a = ParserCase !TestName !(TestParser a) !Text !(TestResult (a, Int))
+
+err :: Range -> Reason Error (Err Error) -> TestResult (a, Int)
+err ra re = Left (Err (ErrF ra re))
+
+errAlt :: Range -> [(AltPhase, Range, Reason Error (Err Error))] -> TestResult (a, Int)
+errAlt ra tups = Left (Err (ErrF ra (ReasonAlt (Seq.fromList (fmap f tups)))))
+ where
+  f (ap, ra', re) = (ap, Err (ErrF ra' re))
+
+errInfix :: Range -> [(Int, InfixPhase, Range, Reason Error (Err Error))] -> TestResult (a, Int)
+errInfix ra tups = Left (Err (ErrF ra (ReasonInfix (Seq.fromList (fmap f tups)))))
+ where
+  f (ix, ip, ra', re) = (ix, ip, Err (ErrF ra' re))
+
+errLook :: Range -> Range -> Reason Error (Err Error) -> TestResult (a, Int)
+errLook ra1 ra2 re = Left (Err (ErrF ra1 (ReasonLook (Err (ErrF ra2 re)))))
+
+suc :: a -> Int -> TestResult (a, Int)
+suc a i = Right (a, i)
+
+testParserCase :: (Show a, Eq a) => ParserCase a -> TestTree
+testParserCase (ParserCase name parser input expected) = testCase name $ do
+  let parser' = liftA2 (,) parser dropAllP
+      actual = parse parser' input
+  actual @?= expected
+
+testBasic :: TestTree
+testBasic =
+  testGroup "basic" $
+    fmap
+      (uncurry testGroup)
+      [ ("empty", testEmpty)
+      , ("pure", testPure)
+      , ("fail", testFail)
+      , ("head", testHead)
+      , ("take", testTake)
+      , ("drop", testDrop)
+      , ("end", testEnd)
+      , ("expectHead", testExpectHead)
+      , ("expect", testExpect)
+      , ("greedy", testGreedy)
+      , ("greedy1", testGreedy1)
+      , ("or", testOr)
+      , ("alt", testAlt)
+      , ("opt (empty)", testOptEmpty)
+      , ("opt", testOpt)
+      , ("bind (1)", testBind1)
+      , ("bind (2)", testBind2)
+      , ("throw", testThrow)
+      , ("throw (consume)", testConsumeThrow)
+      , ("throw (opt)", testOptThrow)
+      , ("throw (opt consume)", testOptConsumeThrow)
+      , ("throw (mixed)", testThrowMixed)
+      , ("throw (mixed flip)", testThrowMixedFlip)
+      , ("backtrack", testBacktrack)
+      , ("look (pure)", testLookPure)
+      , ("look (success)", testLookSuccess)
+      , ("look (failure)", testLookFailure)
+      , ("takeWhile", testTakeWhile)
+      , ("takeWhile1", testTakeWhile1)
+      , ("dropWhile", testDropWhile)
+      , ("dropWhile1", testDropWhile1)
+      , ("infixR", testInfixR)
+      , ("someInfixR", testSomeInfixR)
+      , ("break", testBreak)
+      , ("someBreak", testSomeBreak)
+      , ("split", testSplit)
+      , ("split1", testSplit1)
+      ]
+
+testEmpty :: [TestTree]
+testEmpty = fmap testParserCase cases
+ where
+  parser = emptyP :: TestParser Int
+  cases =
+    [ ParserCase "empty" parser "" (err (Range 0 0) ReasonEmpty)
+    , ParserCase "non-empty" parser "hi" (err (Range 0 2) ReasonEmpty)
+    ]
+
+testPure :: [TestTree]
+testPure = fmap testParserCase cases
+ where
+  parser = pure 'x'
+  cases =
+    [ ParserCase "empty" parser "" (suc 'x' 0)
+    , ParserCase "non-empty" parser "hi" (suc 'x' 2)
+    ]
+
+testFail :: [TestTree]
+testFail = fmap testParserCase cases
+ where
+  parser = fail "i give up" :: TestParser Int
+  cases =
+    [ ParserCase "empty" parser "" (err (Range 0 0) (ReasonFail "i give up"))
+    , ParserCase "non-empty" parser "hi" (err (Range 0 2) (ReasonFail "i give up"))
+    ]
+
+testHead :: [TestTree]
+testHead = fmap testParserCase cases
+ where
+  parser = headP
+  cases =
+    [ ParserCase "empty" parser "" (err (Range 0 0) (ReasonDemand 1 0))
+    , ParserCase "non-empty" parser "hi" (suc 'h' 1)
+    ]
+
+testTake :: [TestTree]
+testTake = fmap testParserCase cases
+ where
+  parser = takeP 2
+  cases =
+    [ ParserCase "len 0" parser "" (suc "" 0)
+    , ParserCase "len 1" parser "h" (suc "h" 0)
+    , ParserCase "len 2" parser "hi" (suc "hi" 0)
+    , ParserCase "len 3" parser "hii" (suc "hi" 1)
+    ]
+
+testDrop :: [TestTree]
+testDrop = fmap testParserCase cases
+ where
+  parser = dropP 2
+  cases =
+    [ ParserCase "len 0" parser "" (suc 0 0)
+    , ParserCase "len 1" parser "h" (suc 1 0)
+    , ParserCase "len 2" parser "hi" (suc 2 0)
+    , ParserCase "len 3" parser "hii" (suc 2 1)
+    ]
+
+testEnd :: [TestTree]
+testEnd = fmap testParserCase cases
+ where
+  parser = endP
+  cases =
+    [ ParserCase "empty" parser "" (suc () 0)
+    , ParserCase "non-empty" parser "hi" (err (Range 0 2) (ReasonLeftover 2))
+    ]
+
+testExpectHead :: [TestTree]
+testExpectHead = fmap testParserCase cases
+ where
+  parser = charP 'h'
+  cases =
+    [ ParserCase "empty" parser "" (err (Range 0 0) (ReasonExpect "h" ""))
+    , ParserCase "non-empty" parser "hi" (suc 'h' 1)
+    , ParserCase "non-match" parser "bye" (err (Range 1 3) (ReasonExpect "h" "b"))
+    ]
+
+testExpect :: [TestTree]
+testExpect = fmap testParserCase cases
+ where
+  parser = textP "hi"
+  cases =
+    [ ParserCase "empty" parser "" (err (Range 0 0) (ReasonExpect "hi" ""))
+    , ParserCase "non-empty" parser "hi" (suc "hi" 0)
+    , ParserCase "prefix" parser "hiya" (suc "hi" 2)
+    , ParserCase "partial" parser "hey" (err (Range 2 3) (ReasonExpect "hi" "he"))
+    , ParserCase "non-match" parser "bye" (err (Range 2 3) (ReasonExpect "hi" "by"))
+    , ParserCase "short" parser "h" (err (Range 1 1) (ReasonExpect "hi" "h"))
+    ]
+
+testGreedy :: [TestTree]
+testGreedy = fmap testParserCase cases
+ where
+  parser = fmap (T.pack . toList) (greedyP (charP 'h')) :: TestParser Text
+  cases =
+    [ ParserCase "empty" parser "" (suc "" 0)
+    , ParserCase "non-empty" parser "hi" (suc "h" 1)
+    , ParserCase "repeat" parser "hhi" (suc "hh" 1)
+    , ParserCase "full" parser "hhh" (suc "hhh" 0)
+    , ParserCase "non-match" parser "bye" (suc "" 3)
+    ]
+
+testGreedy1 :: [TestTree]
+testGreedy1 = fmap testParserCase cases
+ where
+  parser = fmap (T.pack . toList) (greedy1P (charP 'h')) :: TestParser Text
+  cases =
+    [ ParserCase "empty" parser "" (err (Range 0 0) (ReasonExpect "h" ""))
+    , ParserCase "non-empty" parser "hi" (suc "h" 1)
+    , ParserCase "repeat" parser "hhi" (suc "hh" 1)
+    , ParserCase "full" parser "hhh" (suc "hhh" 0)
+    , ParserCase "non-match" parser "bye" (err (Range 1 3) (ReasonExpect "h" "b"))
+    ]
+
+testOr :: [TestTree]
+testOr = fmap testParserCase cases
+ where
+  parser = textP "h" <|> textP "xi" :: TestParser Text
+  cases =
+    [ ParserCase "empty" parser "" $
+        errAlt
+          (Range 0 0)
+          [ (AltPhaseBranch, Range 0 0, ReasonExpect "h" "")
+          , (AltPhaseBranch, Range 0 0, ReasonExpect "xi" "")
+          ]
+    , ParserCase "first" parser "hi" (suc "h" 1)
+    , ParserCase "second" parser "xi" (suc "xi" 0)
+    , ParserCase "non-match" parser "bye" $
+        errAlt
+          (Range 0 3)
+          [ (AltPhaseBranch, Range 1 3, ReasonExpect "h" "b")
+          , (AltPhaseBranch, Range 2 3, ReasonExpect "xi" "by")
+          ]
+    ]
+
+testAlt :: [TestTree]
+testAlt = fmap testParserCase cases
+ where
+  parser = altP [textP "h", "y" <$ headP, textP "xi"] :: TestParser Text
+  cases =
+    [ ParserCase "empty" parser "" $
+        errAlt
+          (Range 0 0)
+          [ (AltPhaseBranch, Range 0 0, ReasonExpect "h" "")
+          , (AltPhaseBranch, Range 0 0, ReasonDemand 1 0)
+          , (AltPhaseBranch, Range 0 0, ReasonExpect "xi" "")
+          ]
+    , ParserCase "first" parser "hi" (suc "h" 1)
+    , ParserCase "middle" parser "zi" (suc "y" 1)
+    , ParserCase "last" parser "xi" (suc "y" 1)
+    ]
+
+testOptEmpty :: [TestTree]
+testOptEmpty = fmap testParserCase cases
+ where
+  parser = optP emptyP :: TestParser (Maybe ())
+  cases =
+    [ ParserCase "empty" parser "" (suc Nothing 0)
+    , ParserCase "non-empty" parser "hi" (suc Nothing 2)
+    ]
+
+testOpt :: [TestTree]
+testOpt = fmap testParserCase cases
+ where
+  parser = optP (charP 'h') :: TestParser (Maybe Char)
+  cases =
+    [ ParserCase "non-match empty" parser "" (suc Nothing 0)
+    , ParserCase "match" parser "hi" (suc (Just 'h') 1)
+    , ParserCase "non-match" parser "bye" (suc Nothing 3)
+    ]
+
+testBind1 :: [TestTree]
+testBind1 = fmap testParserCase cases
+ where
+  parser = charP 'x' >>= \c -> pure [c, c]
+  cases =
+    [ ParserCase "empty" parser "" (err (Range 0 0) (ReasonExpect "x" ""))
+    , ParserCase "first" parser "hi" (err (Range 1 2) (ReasonExpect "x" "h"))
+    , ParserCase "second" parser "xi" (suc "xx" 1)
+    ]
+
+testBind2 :: [TestTree]
+testBind2 = fmap testParserCase cases
+ where
+  parser = headP >>= \x -> if x == 'x' then pure 'y' else emptyP
+  cases =
+    [ ParserCase "empty" parser "" (err (Range 0 0) (ReasonDemand 1 0))
+    , ParserCase "first" parser "hi" (err (Range 1 2) ReasonEmpty)
+    , ParserCase "second" parser "xi" (suc 'y' 1)
+    ]
+
+testThrow :: [TestTree]
+testThrow = fmap testParserCase cases
+ where
+  cust = Error "boo"
+  parser = throwP cust :: TestParser Int
+  cases =
+    [ ParserCase "empty" parser "" (err (Range 0 0) (ReasonCustom cust))
+    , ParserCase "non-empty" parser "hi" (err (Range 0 2) (ReasonCustom cust))
+    ]
+
+testConsumeThrow :: [TestTree]
+testConsumeThrow = fmap testParserCase cases
+ where
+  cust = Error "boo"
+  parser = headP *> throwP cust :: TestParser Int
+  cases =
+    [ ParserCase "empty" parser "" (err (Range 0 0) (ReasonDemand 1 0))
+    , ParserCase "non-empty" parser "hi" (err (Range 1 2) (ReasonCustom cust))
+    ]
+
+testOptThrow :: [TestTree]
+testOptThrow = fmap testParserCase cases
+ where
+  cust = Error "boo"
+  parser = optP (throwP cust) :: TestParser (Maybe Int)
+  cases =
+    [ ParserCase "empty" parser "" (suc Nothing 0)
+    , ParserCase "non-empty" parser "hi" (suc Nothing 2)
+    ]
+
+testOptConsumeThrow :: [TestTree]
+testOptConsumeThrow = fmap testParserCase cases
+ where
+  cust = Error "boo"
+  parser = optP (headP *> throwP cust) :: TestParser (Maybe Int)
+  cases =
+    [ ParserCase "empty" parser "" (suc Nothing 0)
+    , ParserCase "non-empty" parser "hi" (suc Nothing 2)
+    ]
+
+testThrowMixed :: [TestTree]
+testThrowMixed = fmap testParserCase cases
+ where
+  cust = Error "boo"
+  parser = throwP cust <|> pure 1 :: TestParser Int
+  cases =
+    [ ParserCase "non-empty" parser "hi" (suc 1 2)
+    ]
+
+testThrowMixedFlip :: [TestTree]
+testThrowMixedFlip = fmap testParserCase cases
+ where
+  cust = Error "boo"
+  parser = pure 1 <|> throwP cust :: TestParser Int
+  cases =
+    [ ParserCase "non-empty" parser "hi" (suc 1 2)
+    ]
+
+testBacktrack :: [TestTree]
+testBacktrack = fmap testParserCase cases
+ where
+  parser = (textP "x" <|> textP "xz") <* (textP_ "z" *> endP)
+  cases =
+    [ ParserCase "non-empty" parser "xzz" (suc "xz" 0)
+    ]
+
+testLookPure :: [TestTree]
+testLookPure = fmap testParserCase cases
+ where
+  parser = lookP (pure 1) :: TestParser Int
+  cases =
+    [ ParserCase "empty" parser "" (suc 1 0)
+    , ParserCase "non-empty" parser "hi" (suc 1 2)
+    ]
+
+testLookSuccess :: [TestTree]
+testLookSuccess = fmap testParserCase cases
+ where
+  parser = lookP headP
+  cases =
+    [ ParserCase "non-match empty" parser "" (errLook (Range 0 0) (Range 0 0) (ReasonDemand 1 0))
+    , ParserCase "non-empty" parser "hi" (suc 'h' 2)
+    ]
+
+testLookFailure :: [TestTree]
+testLookFailure = fmap testParserCase cases
+ where
+  cust = Error "boo"
+  parser = lookP (headP *> throwP cust) :: TestParser Char
+  cases =
+    [ ParserCase "non-match empty" parser "" (errLook (Range 0 0) (Range 0 0) (ReasonDemand 1 0))
+    , ParserCase "non-empty" parser "hi" (errLook (Range 0 2) (Range 1 2) (ReasonCustom cust))
+    ]
+
+testTakeWhile :: [TestTree]
+testTakeWhile = fmap testParserCase cases
+ where
+  parser = takeWhileP (== 'h') :: TestParser Text
+  cases =
+    [ ParserCase "empty" parser "" (suc "" 0)
+    , ParserCase "non-match" parser "i" (suc "" 1)
+    , ParserCase "match" parser "hi" (suc "h" 1)
+    , ParserCase "match 2" parser "hhi" (suc "hh" 1)
+    , ParserCase "match end" parser "hh" (suc "hh" 0)
+    ]
+
+testTakeWhile1 :: [TestTree]
+testTakeWhile1 = fmap testParserCase cases
+ where
+  parser = takeWhile1P (== 'h') :: TestParser Text
+  cases =
+    [ ParserCase "empty" parser "" (err (Range 0 0) ReasonTakeNone)
+    , ParserCase "non-match" parser "i" (err (Range 0 1) ReasonTakeNone)
+    , ParserCase "match" parser "hi" (suc "h" 1)
+    , ParserCase "match 2" parser "hhi" (suc "hh" 1)
+    , ParserCase "match end" parser "hh" (suc "hh" 0)
+    ]
+
+testDropWhile :: [TestTree]
+testDropWhile = fmap testParserCase cases
+ where
+  parser = dropWhileP (== 'h') :: TestParser Int
+  cases =
+    [ ParserCase "empty" parser "" (suc 0 0)
+    , ParserCase "non-match" parser "i" (suc 0 1)
+    , ParserCase "match" parser "hi" (suc 1 1)
+    , ParserCase "match 2" parser "hhi" (suc 2 1)
+    , ParserCase "match end" parser "hh" (suc 2 0)
+    ]
+
+testDropWhile1 :: [TestTree]
+testDropWhile1 = fmap testParserCase cases
+ where
+  parser = dropWhile1P (== 'h') :: TestParser Int
+  cases =
+    [ ParserCase "empty" parser "" (err (Range 0 0) ReasonTakeNone)
+    , ParserCase "non-match" parser "i" (err (Range 0 1) ReasonTakeNone)
+    , ParserCase "match" parser "hi" (suc 1 1)
+    , ParserCase "match 2" parser "hhi" (suc 2 1)
+    , ParserCase "match end" parser "hh" (suc 2 0)
+    ]
+
+testInfixR :: [TestTree]
+testInfixR = fmap testParserCase cases
+ where
+  sub d = takeWhile1P (\c -> c == d || c == '+')
+  parser = infixRP "+" (sub 'x') (sub 'y') :: TestParser (Text, Text)
+  parserR = infixRP "+" (textP "x") (textP "x+x") :: TestParser (Text, Text)
+  parserL = infixRP "+" (textP "x+x") (textP "x") :: TestParser (Text, Text)
+  cases =
+    [ ParserCase "empty" parser "" (err (Range 0 0) ReasonEmpty)
+    , ParserCase "fail delim" parser "xy" (err (Range 0 2) ReasonEmpty)
+    , ParserCase "fail first" parser "+y" (errInfix (Range 0 2) [(0, InfixPhaseLeft, Range 0 0, ReasonTakeNone)])
+    , ParserCase "fail second" parser "x+" (errInfix (Range 0 2) [(1, InfixPhaseRight, Range 2 2, ReasonTakeNone)])
+    , ParserCase "match" parser "x+y" (suc ("x", "y") 0)
+    , ParserCase "match multi" parser "x++y" (suc ("x", "+y") 0)
+    , ParserCase "match rassoc" parserR "x+x+x" (suc ("x", "x+x") 0)
+    , ParserCase "fail lassoc" parserL "x+x+x" (errInfix (Range 0 5) [(1, InfixPhaseLeft, Range 1 1, ReasonExpect "x+x" "x")])
+    ]
+
+testSomeInfixR :: [TestTree]
+testSomeInfixR = fmap testParserCase cases
+ where
+  sub d = takeWhile1P (\c -> c == d || c == '+')
+  parser = someInfixRP "+" (sub 'x') (sub 'y') :: TestParser (Text, Text)
+  parserR = someInfixRP "+" (textP "x") (textP "x+x") :: TestParser (Text, Text)
+  parserL = someInfixRP "+" (textP "x+x") (textP "x") :: TestParser (Text, Text)
+  cases =
+    [ ParserCase "empty" parser "" (err (Range 0 0) ReasonEmpty)
+    , ParserCase "fail delim" parser "xy" (err (Range 0 2) ReasonEmpty)
+    , ParserCase "fail first" parser "+y" (errInfix (Range 0 2) [(0, InfixPhaseLeft, Range 0 0, ReasonTakeNone)])
+    , ParserCase "fail second" parser "x+" (errInfix (Range 0 2) [(1, InfixPhaseRight, Range 2 2, ReasonTakeNone)])
+    , ParserCase "match" parser "x+y" (suc ("x", "y") 0)
+    , ParserCase "match multi" parser "x++y" (suc ("x", "+y") 0)
+    , ParserCase "match rassoc" parserR "x+x+x" (suc ("x", "x+x") 0)
+    , ParserCase "match lassoc" parserL "x+x+x" (suc ("x+x", "x") 0)
+    ]
+
+testBreak :: [TestTree]
+testBreak = fmap testParserCase cases
+ where
+  parser = breakP "+" (takeWhile1P (== 'x'))
+  parserR = breakP "+" (textP "x")
+  parserL = breakP "+" (textP "x+x")
+  cases =
+    [ ParserCase "empty" parser "" (err (Range 0 0) ReasonEmpty)
+    , ParserCase "fail delim" parser "x" (err (Range 0 1) ReasonEmpty)
+    , ParserCase "fail first" parser "y+" (errInfix (Range 0 2) [(1, InfixPhaseLeft, Range 0 1, ReasonTakeNone)])
+    , ParserCase "match" parser "x+x+y" (suc "x" 3)
+    , ParserCase "match rassoc" parserR "x+x+x" (suc "x" 3)
+    , ParserCase "fail lassoc" parserL "x+x+x" (errInfix (Range 0 5) [(1, InfixPhaseLeft, Range 1 1, ReasonExpect "x+x" "x")])
+    ]
+
+testSomeBreak :: [TestTree]
+testSomeBreak = fmap testParserCase cases
+ where
+  parser = someBreakP "+" (takeWhile1P (== 'x'))
+  parserR = someBreakP "+" (textP "x")
+  parserL = someBreakP "+" (textP "x+x")
+  cases =
+    [ ParserCase "empty" parser "" (err (Range 0 0) ReasonEmpty)
+    , ParserCase "fail delim" parser "x" (err (Range 0 1) ReasonEmpty)
+    , ParserCase "fail first" parser "y+" (errInfix (Range 0 2) [(1, InfixPhaseLeft, Range 0 1, ReasonTakeNone)])
+    , ParserCase "match" parser "x+x+y" (suc "x" 3)
+    , ParserCase "match rassoc" parserR "x+x+x" (suc "x" 3)
+    , ParserCase "match lassoc" parserL "x+x+x" (suc "x+x" 1)
+    ]
+
+testSplit :: [TestTree]
+testSplit = fmap testParserCase cases
+ where
+  parser = fmap (first toList) (splitP "+" (takeWhileP (== 'x')))
+  cases =
+    [ ParserCase "empty" parser "" (suc ([""], True) 0)
+    , ParserCase "single" parser "x" (suc (["x"], True) 0)
+    , ParserCase "fail" parser "xy" (suc ([], False) 2)
+    , ParserCase "double" parser "x+x" (suc (["x", "x"], True) 0)
+    , ParserCase "triple" parser "x+x+x" (suc (["x", "x", "x"], True) 0)
+    , ParserCase "fail first" parser "y+x" (suc ([], False) 3)
+    , ParserCase "fail second" parser "x+y" (suc (["x"], False) 2)
+    ]
+
+testSplit1 :: [TestTree]
+testSplit1 = fmap testParserCase cases
+ where
+  parser = fmap (first toList) (split1P "+" (takeWhileP (== 'x')))
+  cases =
+    [ ParserCase "empty" parser "" (suc ([""], True) 0)
+    , ParserCase "single" parser "x" (suc (["x"], True) 0)
+    , ParserCase "fail" parser "xy" (err (Range 0 2) (ReasonSplitComp SplitCompGE 1 "+" 0))
+    , ParserCase "double" parser "x+x" (suc (["x", "x"], True) 0)
+    , ParserCase "triple" parser "x+x+x" (suc (["x", "x", "x"], True) 0)
+    , ParserCase "fail first" parser "y+x" (err (Range 0 3) (ReasonSplitComp SplitCompGE 1 "+" 0))
+    , ParserCase "fail second" parser "x+y" (suc (["x"], False) 2)
+    ]
+
+testJson :: TestTree
+testJson = testGroup "json" (fmap test cases)
+ where
+  test (name, str, expected) = testCase name $ do
+    let actual = either (const Nothing) Just (parse jsonParser str)
+    actual @?= expected
+  trueVal = JsonBool True
+  falseVal = JsonBool False
+  arrVal = JsonArray . Seq.fromList
+  objVal = JsonObject . Seq.fromList
+  cases =
+    [ ("empty", "", Nothing)
+    , ("bad", "bad", Nothing)
+    , ("null", "null", Just JsonNull)
+    , ("true", "true", Just trueVal)
+    , ("false", "false", Just falseVal)
+    , ("arr0", "[]", Just (arrVal []))
+    , ("arr1", "[null]", Just (arrVal [JsonNull]))
+    , ("arr2", "[null, false]", Just (arrVal [JsonNull, falseVal]))
+    , ("arr3", "[null, false, true]", Just (arrVal [JsonNull, falseVal, trueVal]))
+    , ("arrx", "[null,]", Nothing)
+    , ("str0", "\"\"", Just (JsonString ""))
+    , ("str1", "\"x\"", Just (JsonString "x"))
+    , ("str2", "\"xy\"", Just (JsonString "xy"))
+    , ("str3", "\"xyz\"", Just (JsonString "xyz"))
+    , ("str4", "\"xy\\\"z\"", Just (JsonString "xy\"z"))
+    , ("obj0", "{}", Just (objVal []))
+    , ("obj1", "{\"x\": true}", Just (objVal [("x", trueVal)]))
+    , ("obj2", "{\"x\": true, \"y\": false}", Just (objVal [("x", trueVal), ("y", falseVal)]))
+    , ("num0", "0", Just (JsonNum 0))
+    , ("num1", "123", Just (JsonNum 123))
+    , ("num2", "123.45", Just (JsonNum 123.45))
+    , ("num3", "1e100", Just (JsonNum (read "1e100")))
+    , ("num4", "{\"x\": 1e100, \"y\": 123.45}", Just (objVal [("x", JsonNum (read "1e100")), ("y", JsonNum 123.45)]))
+    ]
+
+testSexp :: TestTree
+testSexp = testGroup "sexp" (fmap test cases)
+ where
+  test (name, str, expected) = testCase name $ do
+    let actual = either (const Nothing) Just (parse sexpParser str)
+    actual @?= expected
+  numSexp = SexpAtom (AtomInt 1)
+  sciExpSexp = SexpAtom (AtomSci 1)
+  identSexp = SexpAtom (AtomIdent "abc")
+  stringSexp = SexpAtom (AtomString "xyz")
+  sciSexp = SexpAtom (AtomSci 3.14)
+  emptyList = SexpList Empty
+  singletonList = SexpList (Seq.singleton numSexp)
+  pairList = SexpList (Seq.fromList [numSexp, numSexp])
+  cases =
+    [ ("empty", "", Nothing)
+    , ("empty list", "()", Just emptyList)
+    , ("singleton list", "(1)", Just singletonList)
+    , ("singleton empty list", "(())", Just (SexpList (Seq.fromList [emptyList])))
+    , ("singleton nested list", "((1))", Just (SexpList (Seq.fromList [singletonList])))
+    , ("num", "1", Just numSexp)
+    , ("num neg", "-1", Just (SexpAtom (AtomInt -1)))
+    , ("ident", "abc", Just identSexp)
+    , ("string", "\"xyz\"", Just stringSexp)
+    , ("sci", "3.14", Just sciSexp)
+    , ("sci neg", "-3.14", Just (SexpAtom (AtomSci -3.14)))
+    , ("sci neg exp", "314e-2", Just sciSexp)
+    , ("sci neg exp 2", "31.4e-1", Just sciSexp)
+    , ("sci pos exp 3", "0.314e1", Just sciSexp)
+    , ("sci dec exp", "1.0", Just sciExpSexp)
+    , ("sci exp", "1e0", Just sciExpSexp)
+    , ("sci dec exp 2", "1.0e0", Just sciExpSexp)
+    , ("multi list", "(1 abc \"xyz\" 3.14)", Just (SexpList (Seq.fromList [numSexp, identSexp, stringSexp, sciSexp])))
+    , ("pair nested list", "((1 1) (1 1))", Just (SexpList (Seq.fromList [pairList, pairList])))
+    ]
+
+testArith :: TestTree
+testArith = testGroup "arith" (fmap test cases)
+ where
+  test (name, str, expected) = testCase name $ do
+    let actual = either (const Nothing) Just (parse arithParser str)
+    actual @?= expected
+  cases =
+    [ ("plus", "1 +x+ 2", Just (ArithAdd (ArithNum 1) (ArithAdd (ArithVar "x") (ArithNum 2))))
+    , ("prec1", "1 + 2 * 3", Just (ArithAdd (ArithNum 1) (ArithMul (ArithNum 2) (ArithNum 3))))
+    , ("prec2", "1 * 2 + 3", Just (ArithAdd (ArithMul (ArithNum 1) (ArithNum 2)) (ArithNum 3)))
+    ]
+
+main :: IO ()
+main =
+  defaultMain $
+    testGroup
+      "Looksee"
+      [ testBasic
+      , testJson
+      , testSexp
+      , testArith
+      ]
