diff --git a/Text/Trifecta/CharSet.hs b/Text/Trifecta/CharSet.hs
--- a/Text/Trifecta/CharSet.hs
+++ b/Text/Trifecta/CharSet.hs
@@ -10,11 +10,10 @@
 --
 -- Fast set membership tests for 'Char' values
 --
--- Stored as a (possibly negated IntMap) and a fast set for the ASCII range.
+-- Stored as a (possibly negated) IntMap and a fast set used for the head byte.
 --
--- The ASCII range is unboxed for efficiency. For small (complemented) sets, we
--- test for membership using a binary search. For larger (complemented) sets
--- we use a lookup table. 
+-- The set of valid (possibly negated) head bytes is stored unboxed as a 32-byte
+-- bytestring-based lookup table.
 --
 -- Designed to be imported qualified:
 -- 
diff --git a/Text/Trifecta/Diagnostic/Err/Log.hs b/Text/Trifecta/Diagnostic/Err/Log.hs
new file mode 100644
--- /dev/null
+++ b/Text/Trifecta/Diagnostic/Err/Log.hs
@@ -0,0 +1,34 @@
+module Text.Trifecta.Diagnostic.Err.Log
+  ( ErrLog(..)
+  ) where
+
+import Data.Functor.Plus
+import Data.Semigroup
+import Data.Monoid
+import Text.PrettyPrint.Free
+import Text.Trifecta.Diagnostic.Prim
+import Text.Trifecta.Parser.Token.Highlight
+import Data.IntervalMap.FingerTree as IntervalMap
+import Data.Sequence (Seq)
+
+data ErrLog e = ErrLog
+  { errLog        :: !(Seq (Diagnostic e))
+  , errHighlights :: !(IntervalMap (Int, Int) TokenHighlight) 
+  }
+
+instance Functor ErrLog where
+  fmap f (ErrLog a b) = ErrLog (fmap (fmap f) a) b
+
+instance Alt ErrLog where
+  ErrLog a b <!> ErrLog a' b' = ErrLog (a <> a') (IntervalMap.union b b')
+  {-# INLINE (<!>) #-}
+
+instance Plus ErrLog where
+  zero = ErrLog mempty IntervalMap.empty
+ 
+instance Semigroup (ErrLog e) where
+  (<>) = (<!>) 
+
+instance Monoid (ErrLog e) where
+  mempty = zero
+  mappend = (<!>)
diff --git a/Text/Trifecta/Parser/ByteString.hs b/Text/Trifecta/Parser/ByteString.hs
--- a/Text/Trifecta/Parser/ByteString.hs
+++ b/Text/Trifecta/Parser/ByteString.hs
@@ -70,7 +70,7 @@
   i <- B.readFile fn
   case starve
      $ feed (rope (F.fromList [LineDirective (UTF8.fromString fn) 0, strand i]))
-     $ stepParser (fmap prettyTerm) (why prettyTerm) (release (Directed n 0 0 0 0) *> p) mempty mempty mempty of
+     $ stepParser (fmap prettyTerm) (why prettyTerm) (release (Directed n 0 0 0 0) *> p) mempty True mempty mempty of
      Success xs a -> return (xs,      Just a )
      Failure xs e -> return (xs |> e, Nothing)
   where n = UTF8.fromString fn
diff --git a/Text/Trifecta/Parser/Class.hs b/Text/Trifecta/Parser/Class.hs
--- a/Text/Trifecta/Parser/Class.hs
+++ b/Text/Trifecta/Parser/Class.hs
@@ -33,11 +33,9 @@
 import Control.Monad.Trans.RWS.Strict as Strict
 import Control.Monad.Trans.Reader
 import Control.Monad.Trans.Identity
-import Control.Monad.Trans.Codensity
+import Data.Functor.Yoneda
 import Data.Monoid
 import Data.Word
--- import Control.Monad.Trans.Maybe.Strict as Strict
--- import Control.Monad.Trans.Either.Strict as Strict
 import Data.ByteString as Strict
 import Data.ByteString.Internal (w2c)
 import Data.Semigroup
@@ -45,26 +43,53 @@
 import Text.Trifecta.Rope.Delta
 import Text.Trifecta.Rope.Prim
 import Text.Trifecta.Parser.It
+import Text.Trifecta.Parser.Token.Highlight
 import Text.Trifecta.Diagnostic.Rendering.Prim
+-- import Control.Monad.Trans.Maybe.Strict as Strict
+-- import Control.Monad.Trans.Either.Strict as Strict
+-- import Control.Monad.Codensity
 
 infix 0 <?>
 
 class ( Alternative m, MonadPlus m) => MonadParser m where
-  -- non-committal actions
-  try        :: m a -> m a
+  -- | Take a parser that may consume input, and on failure, go back to where we started and fail as if we didn't consume input.
+  try :: m a -> m a
+  -- Used to implement (<?>), runs the parser then sets the 'expected' tokens to the list supplied
   labels     :: m a -> Set String -> m a
+  -- | Lift an operation from the primitive It monad
   liftIt     :: It Rope a -> m a
+ 
+  -- | mark the current location so it can be used in constructing a span, or for later seeking
   mark       :: m Delta
+  -- | Used to emit an error on an unexpected token
   unexpected :: MonadParser m => String -> m a
+
+  -- | Retrieve the contents of the current line (from the beginning of the line)
   line       :: m ByteString
+
+  -- | A version of many that discards its input. Specialized because it can often be implemented more cheaply.
   skipMany   :: m a -> m ()
   skipMany p = () <$ many p 
 
   -- actions that definitely commit
+
+  -- | Seek back to previously marked location
   release  :: Delta -> m ()
+
+  -- | Parse a single character of the input, with UTF-8 decoding
   satisfy  :: (Char -> Bool) -> m Char
+
+  -- | Parse a single byte of the input, without UTF-8 decoding
   satisfy8 :: (Word8 -> Bool) -> m Word8
 
+  -- | @highlightToken@ is called internally in the token parsers.
+  -- It delimits ranges of the input recognized by certain parsers that 
+  -- are useful for syntax highlighting. An interested monad could
+  -- choose to listen to these events and construct an interval tree
+  -- for later pretty printing purposes.
+  highlightToken :: TokenHighlight -> m a -> m a
+  highlightToken _ m = m
+
 instance MonadParser m => MonadParser (Lazy.StateT s m) where
   try (Lazy.StateT m) = Lazy.StateT $ try . m
   labels (Lazy.StateT m) ss = Lazy.StateT $ \s -> labels (m s) ss
@@ -75,6 +100,7 @@
   unexpected = lift . unexpected
   satisfy = lift . satisfy
   satisfy8 = lift . satisfy8
+  highlightToken t (Lazy.StateT m) = Lazy.StateT $ \e -> highlightToken t (m e) 
 
 instance MonadParser m => MonadParser (Strict.StateT s m) where
   try (Strict.StateT m) = Strict.StateT $ try . m
@@ -86,6 +112,7 @@
   unexpected = lift . unexpected
   satisfy = lift . satisfy
   satisfy8 = lift . satisfy8
+  highlightToken t (Strict.StateT m) = Strict.StateT $ \e -> highlightToken t (m e) 
 
 instance MonadParser m => MonadParser (ReaderT e m) where
   try (ReaderT m) = ReaderT $ try . m
@@ -97,6 +124,7 @@
   unexpected = lift . unexpected
   satisfy = lift . satisfy
   satisfy8 = lift . satisfy8
+  highlightToken t (ReaderT m) = ReaderT $ \e -> highlightToken t (m e) 
 
 instance (MonadParser m, Monoid w) => MonadParser (Strict.WriterT w m) where
   try (Strict.WriterT m) = Strict.WriterT $ try m
@@ -108,6 +136,7 @@
   unexpected = lift . unexpected
   satisfy = lift . satisfy
   satisfy8 = lift . satisfy8
+  highlightToken t (Strict.WriterT m) = Strict.WriterT $ highlightToken t m
 
 instance (MonadParser m, Monoid w) => MonadParser (Lazy.WriterT w m) where
   try (Lazy.WriterT m) = Lazy.WriterT $ try m
@@ -119,6 +148,7 @@
   unexpected = lift . unexpected
   satisfy = lift . satisfy
   satisfy8 = lift . satisfy8
+  highlightToken t (Lazy.WriterT m) = Lazy.WriterT $ highlightToken t m
 
 instance (MonadParser m, Monoid w) => MonadParser (Lazy.RWST r w s m) where
   try (Lazy.RWST m) = Lazy.RWST $ \r s -> try (m r s)
@@ -130,6 +160,7 @@
   unexpected = lift . unexpected
   satisfy = lift . satisfy
   satisfy8 = lift . satisfy8
+  highlightToken t (Lazy.RWST m) = Lazy.RWST $ \r s -> highlightToken t (m r s)
 
 instance (MonadParser m, Monoid w) => MonadParser (Strict.RWST r w s m) where
   try (Strict.RWST m) = Strict.RWST $ \r s -> try (m r s)
@@ -141,6 +172,7 @@
   unexpected = lift . unexpected
   satisfy = lift . satisfy
   satisfy8 = lift . satisfy8
+  highlightToken t (Strict.RWST m) = Strict.RWST $ \r s -> highlightToken t (m r s)
 
 instance MonadParser m => MonadParser (IdentityT m) where
   try (IdentityT m) = IdentityT $ try m
@@ -152,15 +184,41 @@
   unexpected = lift . unexpected
   satisfy = lift . satisfy
   satisfy8 = lift . satisfy8
+  highlightToken t (IdentityT m) = IdentityT $ highlightToken t m
 
+instance MonadParser m => MonadParser (Yoneda m) where
+  try = lift . try . lowerYoneda
+  labels m ss = lift $ labels (lowerYoneda m) ss
+  line = lift line
+  liftIt = lift . liftIt
+  mark = lift mark 
+  release = lift . release
+  unexpected = lift . unexpected
+  satisfy = lift . satisfy
+  satisfy8 = lift . satisfy8
+  highlightToken t (Yoneda m) = Yoneda $ \f -> highlightToken t (m f)
+
+{-
+instance MonadParser m => MonadParser (Codensity m) where
+  try = lift . try . lowerCodensity
+  labels m ss = lift $ labels (lowerCodensity m) ss
+  line = lift line
+  liftIt = lift . liftIt
+  mark = lift mark 
+  release = lift . release
+  unexpected = lift . unexpected
+  satisfy = lift . satisfy
+  satisfy8 = lift . satisfy8
+-}
+-- instance (MonadParser m, Monoid w) => MonadParser (MaybeT m) where
+-- instance (Error e, MonadParser m, Monoid w) => MonadParser (ErrorT e m) where
+
 satisfyAscii :: MonadParser m => (Char -> Bool) -> m Char
 satisfyAscii p = w2c <$> satisfy8 (\w -> w <= 0x7f && p (w2c w))
 {-# INLINE satisfyAscii #-}
 
--- instance (MonadParser m, Monoid w) => MonadParser (MaybeT m) where
--- instance (Error e, MonadParser m, Monoid w) => MonadParser (ErrorT e m) where
 
-  -- useful when we've just recognized something out of band using access to the current line 
+-- useful when we've just recognized something out of band using access to the current line 
 skipping :: MonadParser m => Delta -> m ()
 skipping d = do
   m <- mark
@@ -194,3 +252,5 @@
 rend :: MonadParser m => m Rendering
 rend = rendering <$> mark <*> line
 {-# INLINE rend #-}
+
+
diff --git a/Text/Trifecta/Parser/Prim.hs b/Text/Trifecta/Parser/Prim.hs
--- a/Text/Trifecta/Parser/Prim.hs
+++ b/Text/Trifecta/Parser/Prim.hs
@@ -29,12 +29,14 @@
 import Data.Foldable
 import Data.Monoid
 import Data.Functor.Bind (Apply(..), Bind((>>-)))
+import Data.IntervalMap.FingerTree (Interval(..))
+import qualified Data.IntervalMap.FingerTree as IntervalMap
 import Data.Set as Set hiding (empty, toList)
 import Data.ByteString as Strict hiding (empty)
 import Data.Sequence as Seq hiding (empty)
 import Data.ByteString.UTF8 as UTF8
 import Text.PrettyPrint.Free hiding (line)
-import Text.Trifecta.Rope.Delta
+import Text.Trifecta.Rope.Delta as Delta
 import Text.Trifecta.Rope.Prim
 import Text.Trifecta.Rope.Bytes
 import Text.Trifecta.Diagnostic.Class
@@ -42,6 +44,7 @@
 import Text.Trifecta.Diagnostic.Level
 import Text.Trifecta.Diagnostic.Err
 import Text.Trifecta.Diagnostic.Err.State
+import Text.Trifecta.Diagnostic.Err.Log
 import Text.Trifecta.Diagnostic.Rendering.Prim
 import Text.Trifecta.Diagnostic.Rendering.Caret
 import Text.Trifecta.Parser.Class
@@ -50,15 +53,13 @@
 import Text.Trifecta.Parser.Result
 import System.Console.Terminfo.PrettyPrint
 
-type ErrLog e = Seq (Diagnostic e) -- use a fingertree to sort them?
-
 data Parser e a = Parser 
   { unparser :: forall r.
-    (a -> ErrState e -> ErrLog e -> Delta -> ByteString -> It Rope r) -> -- uncommitted ok
-    (     ErrState e -> ErrLog e -> Delta -> ByteString -> It Rope r) -> -- uncommitted err
-    (a -> ErrState e -> ErrLog e -> Delta -> ByteString -> It Rope r) -> -- committed ok
-    (     ErrState e -> ErrLog e -> Delta -> ByteString -> It Rope r) -> -- committed err
-                        ErrLog e -> Delta -> ByteString -> It Rope r
+    (a -> ErrState e -> ErrLog e -> Bool -> Delta -> ByteString -> It Rope r) -> -- uncommitted ok
+    (     ErrState e -> ErrLog e -> Bool -> Delta -> ByteString -> It Rope r) -> -- uncommitted err
+    (a -> ErrState e -> ErrLog e -> Bool -> Delta -> ByteString -> It Rope r) -> -- committed ok
+    (     ErrState e -> ErrLog e -> Bool -> Delta -> ByteString -> It Rope r) -> -- committed err
+                        ErrLog e -> Bool -> Delta -> ByteString -> It Rope r
   } 
 
 instance Functor (Parser e) where
@@ -129,7 +130,7 @@
   mzero = empty
   mplus = (<|>) 
 
-instance MonadWriter (Seq (Diagnostic e)) (Parser e) where
+instance MonadWriter (ErrLog e) (Parser e) where
   tell w = Parser $ \eo _ _ _ l -> eo () mempty (l <> w)
   {-# INLINE tell #-}
   listen (Parser m) = Parser $ \eo ee co ce l -> 
@@ -159,8 +160,8 @@
     ce mempty { errMessage = Err rs Fatal e ds }
   errWith ds rs e = Parser $ \_ ee _ _ -> 
     ee mempty { errMessage = Err rs Error e ds }
-  logWith v ds rs e = Parser $ \eo _ _ _ l d bs -> 
-    eo () mempty (l |> Diagnostic (Right $ addCaret d $ Prelude.foldr (<>) (rendering d bs) rs) v e ds) d bs
+  logWith v ds rs e = Parser $ \eo _ _ _ l b8 d bs -> 
+    eo () mempty l { errLog = errLog l |> Diagnostic (Right $ addCaret d $ Prelude.foldr (<>) (rendering d bs) rs) v e ds } b8 d bs
     
 instance MonadError (ErrState e) (Parser e) where
   throwError m = Parser $ \_ ee _ _ -> ee m
@@ -169,11 +170,20 @@
     m eo (\e -> unparser (k e) eo ee co ce) co ce
   {-# INLINE catchError #-}
 
+ascii :: ByteString -> Bool
+ascii = Strict.all (<=0x7f) 
+
+short :: Delta -> (Int, Int)
+short d = (bytes d, Delta.column d)
+
 instance MonadParser (Parser e) where
   -- commit (Parser m) = Parser $ \ _ _ co ce -> m co ce co ce
   try (Parser m) = Parser $ \ eo ee co ce -> m eo ee co $ 
     \e -> if fatalErr (errMessage e) then ce e else ee e
   {-# INLINE try #-}
+  highlightToken t (Parser m) = Parser $ \eo ee co ce l b8 d bs -> 
+    m eo ee (\a e l' b8' d' -> co a e l' { errHighlights = IntervalMap.insert (Interval (short d) (short d')) t (errHighlights l') } b8' d') ce l b8 d bs
+
   unexpected s = Parser $ \ _ ee _ _ -> ee mempty { errMessage = FailErr $ "unexpected " ++ s }
 
   labels (Parser p) msgs = Parser $ \ eo ee -> p
@@ -182,72 +192,89 @@
                      else e)
      (\e -> ee e { errExpected = msgs })
   {-# INLINE labels #-}
-  liftIt m = Parser $ \ eo _ _ _ l d bs -> do 
+  liftIt m = Parser $ \ eo _ _ _ l b8 d bs -> do 
      a <- m
-     eo a mempty l d bs
+     eo a mempty l b8 d bs
   {-# INLINE liftIt #-}
-  mark = Parser $ \eo _ _ _ l d -> eo d mempty l d
+  mark = Parser $ \eo _ _ _ l b8 d -> eo d mempty l b8 d
   {-# INLINE mark #-}
-  release d' = Parser $ \_ ee co _ l d bs -> do
+  release d' = Parser $ \_ ee co _ l b8 d bs -> do
     mbs <- rewindIt d'
     case mbs of
-      Just bs' -> co () mempty l d' bs'
+      Just bs' -> co () mempty l (ascii bs') d' bs'
       Nothing 
-        | bytes d' == bytes (rewind d) + Strict.length bs -> co () mempty l d' $ 
-                                                             if near d d' then bs else mempty
-        | otherwise -> ee mempty l d bs
-  {-# INLINE release #-}
-  line = Parser $ \eo _ _ _ l d bs -> eo bs mempty l d bs
+        | bytes d' == bytes (rewind d) + Strict.length bs -> if near d d' 
+            then co () mempty l (ascii bs) d' bs
+            else co () mempty l True d' mempty
+        | otherwise -> ee mempty l b8 d bs
+  line = Parser $ \eo _ _ _ l b8 d bs -> eo bs mempty l b8 d bs
   {-# INLINE line #-}
   skipMany p = () <$ manyAccum (\_ _ -> []) p
   {-# INLINE skipMany #-}
-  satisfy f = Parser $ \ _ ee co _ l d bs ->
-    case UTF8.uncons $ Strict.drop (columnByte d) bs of
-      Nothing             -> ee mempty { errMessage = FailErr "unexpected EOF" } l d bs
+  satisfy f = Parser $ \ _ ee co _ l b8 d bs ->
+    if b8 -- fast path
+    then let b = columnByte d in (
+         if b >= 0 && b < Strict.length bs 
+         then case toEnum $ fromEnum $ Strict.index bs b of
+           c | not (f c)                 -> ee mempty l b8 d bs
+             | b == Strict.length bs - 1 -> let !ddc = d <> delta c
+                                            in join $ fillIt ( if c == '\n'
+                                                               then co c mempty l True ddc mempty 
+                                                               else co c mempty l b8 ddc bs )
+                                                             (\d' bs' -> co c mempty l (ascii bs') d' bs') 
+                                                             ddc
+             | otherwise                 -> co c mempty l b8 (d <> delta c) bs
+         else ee mempty { errMessage = FailErr "unexpected EOF" } l b8 d bs)
+    else case UTF8.uncons $ Strict.drop (columnByte d) bs of
+      Nothing             -> ee mempty { errMessage = FailErr "unexpected EOF" } l b8 d bs
       Just (c, xs) 
-        | not (f c)       -> ee mempty l d bs
+        | not (f c)       -> ee mempty l b8 d bs
         | Strict.null xs  -> let !ddc = d <> delta c 
-                                 !bs' = if c == '\n' then mempty else bs
-                             in join $ fillIt (co c mempty l ddc bs') (co c mempty l) ddc
-        | otherwise       -> co c mempty l (d <> delta c) bs 
-  {-# INLINE satisfy #-}
-  satisfy8 f = Parser $ \ _ ee co _ l d bs ->
+                             in join $ fillIt ( if c == '\n'
+                                                then co c mempty l True ddc mempty 
+                                                else co c mempty l b8 ddc bs) 
+                                              (\d' bs' -> co c mempty l (ascii bs') d' bs') 
+                                              ddc
+        | otherwise       -> co c mempty l b8 (d <> delta c) bs 
+  satisfy8 f = Parser $ \ _ ee co _ l b8 d bs ->
     let b = columnByte d in
     if b >= 0 && b < Strict.length bs 
     then case toEnum $ fromEnum $ Strict.index bs b of
-      c | not (f c)                 -> ee mempty l d bs
+      c | not (f c)                 -> ee mempty l b8 d bs
         | b == Strict.length bs - 1 -> let !ddc = d <> delta c
-                                           !bs' = if c == 10 then mempty else bs
-                                       in join $ fillIt (co c mempty l ddc bs') (co c mempty l) ddc
-        | otherwise                 -> co c mempty l (d <> delta c) bs
-    else ee mempty { errMessage = FailErr "unexpected EOF" } l d bs
-  {-# INLINE satisfy8 #-}
+                                       in join $ fillIt ( if c == 10
+                                                          then co c mempty l True ddc mempty
+                                                          else co c mempty l b8 ddc bs )
+                                                        (\d' bs' -> co c mempty l (ascii bs') d' bs') 
+                                                        ddc
+        | otherwise                 -> co c mempty l b8 (d <> delta c) bs
+    else ee mempty { errMessage = FailErr "unexpected EOF" } l b8 d bs
 
-data St e a = JuSt a !(ErrState e) !(ErrLog e) !Delta !ByteString
-            | NoSt !(ErrState e) !(ErrLog e) !Delta !ByteString
+data St e a = JuSt a !(ErrState e) !(ErrLog e) !Bool !Delta !ByteString
+            | NoSt !(ErrState e) !(ErrLog e) !Bool !Delta !ByteString
 
 stepParser :: (Diagnostic e -> Diagnostic t) -> 
-              (ErrState e -> Delta -> ByteString -> Diagnostic t) ->
-              Parser e a -> ErrLog e -> Delta -> ByteString -> Step t a
-stepParser yl y (Parser p) l0 d0 bs0 = 
-  go mempty $ p ju no ju no l0 d0 bs0
+              (ErrState e -> Bool -> Delta -> ByteString -> Diagnostic t) ->
+              Parser e a -> ErrLog e -> Bool -> Delta -> ByteString -> Step t a
+stepParser yl y (Parser p) l0 b80 d0 bs0 = 
+  go mempty $ p ju no ju no l0 b80 d0 bs0
   where
-    ju a e l d bs = Pure (JuSt a e l d bs)
-    no e l d bs = Pure (NoSt e l d bs)
-    go r (Pure (JuSt a _ l _ _)) = StepDone r (yl <$> l) a
-    go r (Pure (NoSt e l d bs))   = StepFail r (yl <$> l) $ y e d bs
+    ju a e l b8 d bs = Pure (JuSt a e l b8 d bs)
+    no e l b8 d bs = Pure (NoSt e l b8 d bs)
+    go r (Pure (JuSt a _ l _ _ _)) = StepDone r (yl <$> errLog l) a
+    go r (Pure (NoSt e l b8 d bs)) = StepFail r (yl <$> errLog l) $ y e b8 d bs
     go r (It ma k) = StepCont r (case ma of
-                                   JuSt a _ l _ _  -> Success (yl <$> l) a
-                                   NoSt e l d bs   -> Failure (yl <$> l) $ y e d bs) 
+                                   JuSt a _ l _ _ _  -> Success (yl <$> errLog l) a
+                                   NoSt e l b8 d bs  -> Failure (yl <$> errLog l) $ y e b8 d bs) 
                                 (go <*> k)
 
-why :: Pretty e => (e -> Doc t) -> ErrState e -> Delta -> ByteString -> Diagnostic (Doc t)
-why pp (ErrState ss m) d bs 
+why :: Pretty e => (e -> Doc t) -> ErrState e -> Bool -> Delta -> ByteString -> Diagnostic (Doc t)
+why pp (ErrState ss m) _ d bs 
   | Set.null ss = explicateWith empty m 
   | knownErr m  = explicateWith (char ',' <+> ex) m
   | otherwise   = Diagnostic r Error ex []
   where
-    ex = text "expected" <+> fillSep (punctuate (char ',') $ text <$> toList ss) -- for once I wish I was writing this in Inform 7
+    ex = text "expected:" <+> fillSep (punctuate (char ',') $ text <$> toList ss) -- TODO: oxford comma, "or" etc...
     r = Right $ addCaret d $ rendering d bs
     explicateWith x EmptyErr        = Diagnostic r  Error ((text "unspecified error") <> x)  []
     explicateWith x (FailErr s)     = Diagnostic r  Error ((fillSep $ text <$> words s) <> x) []
@@ -258,7 +285,7 @@
 parseTest :: Show a => Parser String a -> String -> IO ()
 parseTest p s = case starve 
                    $ feed (UTF8.fromString s) 
-                   $ stepParser (fmap prettyTerm) (why prettyTerm) (release mempty *> p) mempty mempty mempty of
+                   $ stepParser (fmap prettyTerm) (why prettyTerm) (release mempty *> p) mempty True mempty mempty of
   Failure xs e -> displayLn $ prettyTerm $ toList (xs |> e)
   Success xs a -> do
     unless (Seq.null xs) $ displayLn $ prettyTerm $ toList xs
diff --git a/Text/Trifecta/Parser/Token/Class.hs b/Text/Trifecta/Parser/Token/Class.hs
--- a/Text/Trifecta/Parser/Token/Class.hs
+++ b/Text/Trifecta/Parser/Token/Class.hs
@@ -11,6 +11,7 @@
 -----------------------------------------------------------------------------
 module Text.Trifecta.Parser.Token.Class
   ( MonadTokenParser(..)
+  , TokenHighlight
   ) where
 
 import Control.Applicative
@@ -24,6 +25,7 @@
 import Control.Monad.Trans.Reader
 import Control.Monad.Trans.Identity
 import Data.Monoid
+import Text.Trifecta.Parser.Token.Highlight
 import Text.Trifecta.Parser.Class
 
 class MonadParser m => MonadTokenParser m where
diff --git a/Text/Trifecta/Parser/Token/Combinators.hs b/Text/Trifecta/Parser/Token/Combinators.hs
--- a/Text/Trifecta/Parser/Token/Combinators.hs
+++ b/Text/Trifecta/Parser/Token/Combinators.hs
@@ -40,6 +40,7 @@
 import Text.Trifecta.Parser.Combinators
 import Text.Trifecta.Parser.Token.Class
 import Text.Trifecta.Parser.Token.Prim
+import Text.Trifecta.Parser.Token.Highlight
 
 -- | This lexeme parser parses a single literal character. Returns the
 -- literal character value. This parsers deals correctly with escape
@@ -80,7 +81,7 @@
   sign = negate <$ char '-'
     <|> id <$ char '+'
     <|> pure id
-  int = lexeme sign <*> natural'
+  int = lexeme (highlightToken Operator sign) <*> natural'
 
 -- | This lexeme parser parses a floating point value. Returns the value
 -- of the number. The number is parsed according to the grammar rules
@@ -101,13 +102,13 @@
 -- trailing white space. 
 
 symbol :: MonadTokenParser m => ByteString -> m ByteString
-symbol name = lexeme (byteString name)
+symbol name = lexeme (highlightToken Symbol (byteString name))
 
 -- | Lexeme parser @symbolic s@ parses 'char' @s@ and skips
 -- trailing white space. 
 
 symbolic :: MonadTokenParser m => Char -> m Char
-symbolic name = lexeme (char name)
+symbolic name = lexeme (highlightToken Symbol (char name))
 
 -- | Lexeme parser @parens p@ parses @p@ enclosed in parenthesis,
 -- returning the value of @p@.
diff --git a/Text/Trifecta/Parser/Token/Highlight.hs b/Text/Trifecta/Parser/Token/Highlight.hs
new file mode 100644
--- /dev/null
+++ b/Text/Trifecta/Parser/Token/Highlight.hs
@@ -0,0 +1,19 @@
+module Text.Trifecta.Parser.Token.Highlight 
+  ( TokenHighlight(..)
+  ) where
+
+data TokenHighlight
+  = EscapeCode
+  | Number 
+  | Comment
+  | CharLiteral
+  | StringLiteral
+  | Constant
+  | Statement
+  | Special
+  | Symbol
+  | Identifier
+  | ReservedIdentifier
+  | Operator
+  | ReservedOperator
+  deriving (Eq,Ord,Show,Read)
diff --git a/Text/Trifecta/Parser/Token/Identifier.hs b/Text/Trifecta/Parser/Token/Identifier.hs
--- a/Text/Trifecta/Parser/Token/Identifier.hs
+++ b/Text/Trifecta/Parser/Token/Identifier.hs
@@ -27,10 +27,12 @@
 import Text.Trifecta.Parser.Token.Class
 
 data IdentifierStyle m = IdentifierStyle
-  { styleName         :: String
-  , styleStart        :: m ()
-  , styleLetter       :: m ()
-  , styleReserved     :: HashSet ByteString
+  { styleName              :: String
+  , styleStart             :: m ()
+  , styleLetter            :: m ()
+  , styleReserved          :: HashSet ByteString
+  , styleHighlight         :: TokenHighlight
+  , styleReservedHighlight :: TokenHighlight
   }
 
 -- | parse a reserved operator or identifier
@@ -40,13 +42,13 @@
 -- | parse a reserved operator or identifier specified by bytestring
 reservedByteString :: MonadTokenParser m => IdentifierStyle m -> ByteString -> m ()
 reservedByteString s name = lexeme $ try $ do
-   _ <- byteString name 
+   _ <- highlightToken (styleReservedHighlight s) $ byteString name 
    notFollowedBy (styleLetter s) <?> "end of " ++ show name
 
 -- | parse an non-reserved identifier or symbol
 ident :: MonadTokenParser m => IdentifierStyle m -> m ByteString
 ident s = lexeme $ try $ do
-  name <- sliced (styleStart s *> skipMany (styleLetter s)) <?> styleName s
+  name <- highlightToken (styleHighlight s) (sliced (styleStart s *> skipMany (styleLetter s))) <?> styleName s
   when (member name (styleReserved s)) $ unexpected $ "reserved " ++ styleName s ++ " " ++ show name
   return name
 
diff --git a/Text/Trifecta/Parser/Token/Identifier/Style.hs b/Text/Trifecta/Parser/Token/Identifier/Style.hs
--- a/Text/Trifecta/Parser/Token/Identifier/Style.hs
+++ b/Text/Trifecta/Parser/Token/Identifier/Style.hs
@@ -25,6 +25,7 @@
 import Text.Trifecta.Parser.Char
 import Text.Trifecta.Parser.Token.Class
 import Text.Trifecta.Parser.Token.Identifier
+import Text.Trifecta.Parser.Token.Highlight
 
 set :: [String] -> HashSet ByteString
 set = HashSet.fromList . fmap UTF8.fromString
@@ -35,6 +36,8 @@
   , styleStart    = styleLetter emptyOps
   , styleLetter   = () <$ oneOf ":!#$%&*+./<=>?@\\^|-~"
   , styleReserved = mempty
+  , styleHighlight = Operator
+  , styleReservedHighlight = ReservedOperator
   }
 haskell98Ops = emptyOps 
   { styleReserved = set ["::","..","=","\\","|","<-","->","@","~","=>"]
@@ -46,7 +49,9 @@
   { styleName     = "identifier"
   , styleStart    = () <$ (letter <|> char '_')
   , styleLetter   = () <$ (alphaNum <|> oneOf "_'")
-  , styleReserved = set [] }
+  , styleReserved = set []
+  , styleHighlight = Identifier
+  , styleReservedHighlight = ReservedIdentifier } 
 
 haskell98Idents = emptyIdents
   { styleReserved = set haskell98ReservedIdents }
diff --git a/Text/Trifecta/Parser/Token/Prim.hs b/Text/Trifecta/Parser/Token/Prim.hs
--- a/Text/Trifecta/Parser/Token/Prim.hs
+++ b/Text/Trifecta/Parser/Token/Prim.hs
@@ -29,6 +29,7 @@
 import Text.Trifecta.Parser.Class
 import Text.Trifecta.Parser.Char
 import Text.Trifecta.Parser.Combinators
+import Text.Trifecta.Parser.Token.Highlight
 
 -- | This parser parses a single literal character. Returns the
 -- literal character value. This parsers deals correctly with escape
@@ -38,13 +39,13 @@
 --
 -- This parser does NOT swallow trailing whitespace. 
 charLiteral' :: MonadParser m => m Char
-charLiteral' = between (char '\'') (char '\'' <?> "end of character") characterChar
+charLiteral' = highlightToken CharLiteral (between (char '\'') (char '\'' <?> "end of character") characterChar)
           <?> "character" 
 
 characterChar, charEscape, charLetter :: MonadParser m => m Char
 characterChar = charLetter <|> charEscape
             <?> "literal character"
-charEscape = char '\\' *> escapeCode
+charEscape = highlightToken EscapeCode $ char '\\' *> escapeCode
 charLetter = satisfy (\c -> (c /= '\'') && (c /= '\\') && (c > '\026'))
 
 -- | This parser parses a literal string. Returns the literal
@@ -55,7 +56,7 @@
 --
 -- This parser does NOT swallow trailing whitespace
 stringLiteral' :: MonadParser m => m String
-stringLiteral' = lit where
+stringLiteral' = highlightToken StringLiteral lit where
   lit = Prelude.foldr (maybe id (:)) "" <$> between (char '"') (char '"' <?> "end of string") (many stringChar) 
     <?> "literal string"
   stringChar = Just <$> stringLetter 
@@ -63,7 +64,7 @@
        <?> "string character"
   stringLetter    = satisfy (\c -> (c /= '"') && (c /= '\\') && (c > '\026'))
 
-  stringEscape = char '\\' *> esc where
+  stringEscape = highlightToken EscapeCode $ char '\\' *> esc where
     esc = Nothing <$ escapeGap 
       <|> Nothing <$ escapeEmpty 
       <|> Just <$> escapeCode
@@ -107,7 +108,7 @@
 --
 -- This parser does NOT swallow trailing whitespace. 
 natural' :: MonadParser m => m Integer
-natural' = nat <?> "natural"
+natural' = highlightToken Number nat <?> "natural"
 
 number :: MonadParser m => Integer -> m Char -> m Integer
 number base baseDigit = do
@@ -130,12 +131,13 @@
 integer' = int <?> "integer"
 
 sign :: MonadParser m => m (Integer -> Integer)
-sign = negate <$ char '-'
+sign = highlightToken Operator
+     $ negate <$ char '-'
    <|> id <$ char '+'
    <|> pure id
 
 int :: MonadParser m => m Integer
-int = {-lexeme-} sign <*> nat
+int = {-lexeme-} sign <*> highlightToken Number nat
 nat, zeroNumber :: MonadParser m => m Integer
 nat = zeroNumber <|> decimal
 zeroNumber = char '0' *> (hexadecimal <|> octal <|> decimal <|> return 0) <?> ""
@@ -147,7 +149,7 @@
 -- This parser does NOT swallow trailing whitespace. 
 
 double' :: MonadParser m => m Double
-double' = floating <?> "double"
+double' = highlightToken Number floating <?> "double"
 
 floating :: MonadParser m => m Double
 floating = decimal >>= fractExponent
@@ -167,7 +169,8 @@
     | e < 0     = 1.0/power(-e)
     | otherwise = fromInteger (10^e)
 
--- | This parser parses either 'natural' or a 'float'.
+
+-- | This parser parses either 'natural' or a 'double'.
 -- Returns the value of the number. This parsers deals with
 -- any overlap in the grammar rules for naturals and floats. The number
 -- is parsed according to the grammar rules defined in the Haskell report. 
@@ -175,7 +178,7 @@
 -- This parser does NOT swallow trailing whitespace. 
 
 naturalOrDouble' :: MonadParser m => m (Either Integer Double)
-naturalOrDouble' = natDouble <?> "number"
+naturalOrDouble' = highlightToken Number natDouble <?> "number"
 
 natDouble, zeroNumFloat, decimalFloat :: MonadParser m => m (Either Integer Double)
 natDouble 
@@ -200,14 +203,14 @@
 decimal = number 10 digit
 
 -- | Parses a positive whole number in the hexadecimal system. The number
--- should be prefixed with \"0x\" or \"0X\". Returns the value of the
+-- should be prefixed with \"x\" or \"X\". Returns the value of the
 -- number. 
 
 hexadecimal :: MonadParser m => m Integer
 hexadecimal = oneOf "xX" *> number 16 hexDigit
 
 -- | Parses a positive whole number in the octal system. The number
--- should be prefixed with \"0o\" or \"0O\". Returns the value of the
+-- should be prefixed with \"o\" or \"O\". Returns the value of the
 -- number. 
 
 octal :: MonadParser m => m Integer
diff --git a/Text/Trifecta/Parser/Token/Style.hs b/Text/Trifecta/Parser/Token/Style.hs
--- a/Text/Trifecta/Parser/Token/Style.hs
+++ b/Text/Trifecta/Parser/Token/Style.hs
@@ -23,6 +23,7 @@
 import Text.Trifecta.Parser.Class
 import Text.Trifecta.Parser.Char
 import Text.Trifecta.Parser.Combinators
+import Text.Trifecta.Parser.Token.Highlight
 
 data CommentStyle = CommentStyle 
   { commentStart   :: String
@@ -47,11 +48,11 @@
     noLine  = null lineStyle
     noMulti = null startStyle
     simpleSpace = skipSome (satisfy isSpace)
-    oneLineComment = do
+    oneLineComment = highlightToken Comment $ do
       _ <- try $ string lineStyle
       skipMany (satisfyAscii (/= '\n')) -- TODO: use skipping/restOfLine and fiddle with the last byte
       return ()
-    multiLineComment = do
+    multiLineComment = highlightToken Comment $ do
       _ <- try $ string startStyle
       inComment
     inComment
diff --git a/trifecta.cabal b/trifecta.cabal
--- a/trifecta.cabal
+++ b/trifecta.cabal
@@ -1,6 +1,6 @@
 name:          trifecta
 category:      Text, Parsing, Diagnostics, Pretty Printer, Logging
-version:       0.30
+version:       0.31
 license:       BSD3
 cabal-version: >= 1.6
 license-file:  LICENSE
@@ -41,6 +41,7 @@
     Text.Trifecta.Diagnostic.Combinators
     Text.Trifecta.Diagnostic.Level
     Text.Trifecta.Diagnostic.Err
+    Text.Trifecta.Diagnostic.Err.Log
     Text.Trifecta.Diagnostic.Err.State
     Text.Trifecta.Diagnostic.Rendering
     Text.Trifecta.Diagnostic.Rendering.Prim
@@ -63,6 +64,7 @@
     Text.Trifecta.Parser.Token.Combinators
     Text.Trifecta.Parser.Token.Prim
     Text.Trifecta.Parser.Token.Style
+    Text.Trifecta.Parser.Token.Highlight
     Text.Trifecta.Parser.Token.Identifier
     Text.Trifecta.Parser.Token.Identifier.Style
 
@@ -88,6 +90,7 @@
     semigroupoids        >= 1.2.4   && < 1.3,
     parallel             >= 3.1.0.1 && < 3.2,
     transformers         >= 0.2.2   && < 0.3,
+    kan-extensions       >= 2.0.1   && < 2.1,
     comonad              >= 1.1.1   && < 1.2,
     terminfo             >= 0.3.2   && < 0.4,
     keys                 >= 2.1     && < 2.2,