diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,5 +1,6 @@
 Copyright 2010-2011 Edward Kmett
 Copyright 2008 Bryan O'Sullivan
+Copyright 2008 Ross Patterson
 Copyright 2007 Paolo Martini
 Copyright 1999-2000 Daan Leijen
 
diff --git a/Text/Trifecta/Diagnostic/Err/Log.hs b/Text/Trifecta/Diagnostic/Err/Log.hs
--- a/Text/Trifecta/Diagnostic/Err/Log.hs
+++ b/Text/Trifecta/Diagnostic/Err/Log.hs
@@ -4,27 +4,26 @@
 
 import Data.Functor.Plus
 import Data.Semigroup
-import Text.PrettyPrint.Free
+import Text.PrettyPrint.Free hiding (empty)
 import Text.Trifecta.Diagnostic.Prim
-import Text.Trifecta.Rope.Delta
-import Text.Trifecta.Parser.Token.Highlight
-import Data.IntervalMap.FingerTree as IntervalMap
+import Text.Trifecta.Highlight.Prim
+import Data.Semigroup.Union (union, empty)
 import Data.Sequence (Seq)
 
 data ErrLog e = ErrLog
   { errLog        :: !(Seq (Diagnostic e))
-  , errHighlights :: !(IntervalMap Delta TokenHighlight) 
+  , errHighlights :: !Highlights
   }
 
 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')
+  ErrLog a b <!> ErrLog a' b' = ErrLog (a <> a') (union b b')
   {-# INLINE (<!>) #-}
 
 instance Plus ErrLog where
-  zero = ErrLog mempty IntervalMap.empty
+  zero = ErrLog mempty empty
  
 instance Semigroup (ErrLog e) where
   (<>) = (<!>) 
diff --git a/Text/Trifecta/Diagnostic/Level.hs b/Text/Trifecta/Diagnostic/Level.hs
--- a/Text/Trifecta/Diagnostic/Level.hs
+++ b/Text/Trifecta/Diagnostic/Level.hs
@@ -43,7 +43,7 @@
   pretty p = prettyTerm p *> empty
 
 instance PrettyTerm DiagnosticLevel where
-  prettyTerm (Verbose n) = blue    $ text "verbose (" <> int n <> char ')'
+  prettyTerm (Verbose n) = blue    $ text "verbose (" <> prettyTerm n <> char ')'
   prettyTerm Note        = black   $ text "note"
   prettyTerm Warning     = magenta $ text "warning"
   prettyTerm Error       = red            $ text "error"
diff --git a/Text/Trifecta/Diagnostic/Prim.hs b/Text/Trifecta/Diagnostic/Prim.hs
--- a/Text/Trifecta/Diagnostic/Prim.hs
+++ b/Text/Trifecta/Diagnostic/Prim.hs
@@ -22,12 +22,16 @@
 import Text.Trifecta.Diagnostic.Rendering.Prim
 import Text.Trifecta.Diagnostic.Level
 import Text.PrettyPrint.Free
+import Text.Trifecta.Highlight.Class
 import System.Console.Terminfo.PrettyPrint
 import Prelude hiding (log)
 import Data.Typeable
 
 data Diagnostic m = Diagnostic !(Either String Rendering) !DiagnosticLevel m [Diagnostic m]
   deriving (Show, Typeable)
+
+instance Highlightable (Diagnostic e) where
+  addHighlights h (Diagnostic rs l m xs) = Diagnostic (addHighlights h <$> rs) l m (addHighlights h <$> xs)
 
 instance (Typeable m, Show m) => Exception (Diagnostic m)
 
diff --git a/Text/Trifecta/Diagnostic/Rendering/Caret.hs b/Text/Trifecta/Diagnostic/Rendering/Caret.hs
--- a/Text/Trifecta/Diagnostic/Rendering/Caret.hs
+++ b/Text/Trifecta/Diagnostic/Rendering/Caret.hs
@@ -44,7 +44,7 @@
 caretEffects = [soft (Foreground Green), soft Bold]
 
 drawCaret :: Delta -> Delta -> Lines -> Lines
-drawCaret p = ifNear p $ draw caretEffects 1 (column p) "^"
+drawCaret p = ifNear p $ draw caretEffects 1 (fromIntegral (column p)) "^"
 
 addCaret :: Delta -> Rendering -> Rendering
 addCaret p r = drawCaret p .# r
diff --git a/Text/Trifecta/Diagnostic/Rendering/Fixit.hs b/Text/Trifecta/Diagnostic/Rendering/Fixit.hs
--- a/Text/Trifecta/Diagnostic/Rendering/Fixit.hs
+++ b/Text/Trifecta/Diagnostic/Rendering/Fixit.hs
@@ -27,7 +27,7 @@
 -- >                  ^
 -- >                  ,
 drawFixit :: Delta -> Delta -> String -> Delta -> Lines -> Lines
-drawFixit s e rpl d a = ifNear l (draw [soft (Foreground Blue)] 2 (column l) rpl) d 
+drawFixit s e rpl d a = ifNear l (draw [soft (Foreground Blue)] 2 (fromIntegral (column l)) rpl) d 
                       $ drawSpan s e d a
   where l = argmin bytes s e
 
diff --git a/Text/Trifecta/Diagnostic/Rendering/Prim.hs b/Text/Trifecta/Diagnostic/Rendering/Prim.hs
--- a/Text/Trifecta/Diagnostic/Rendering/Prim.hs
+++ b/Text/Trifecta/Diagnostic/Rendering/Prim.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
 
 -- | Diagnostics rendering
 --
@@ -40,6 +40,7 @@
 import Text.PrettyPrint.Free hiding (column)
 import Text.Trifecta.Rope.Bytes
 import Text.Trifecta.Rope.Delta
+import Text.Trifecta.Highlight.Class
 import qualified Data.ByteString.UTF8 as UTF8 
 
 outOfRangeEffects :: [ScopedEffect] -> [ScopedEffect]
@@ -50,7 +51,6 @@
 (///) :: Ix i => Array i e -> [(i, e)] -> Array i e
 a /// xs = a // P.filter (inRange (bounds a) . fst) xs
 
-
 grow :: Int -> Lines -> Lines
 grow y a 
   | inRange (t,b) y = a
@@ -78,6 +78,9 @@
   , renderingOverlays :: Delta -> Lines -> Lines
   }
 
+instance Highlightable Rendering where
+  addHighlights _h r = r -- TODO
+
 instance Show Rendering where
   showsPrec d (Rendering p ll _ _) = showParen (d > 10) $ 
     showString "Rendering " . showsPrec 11 p . showChar ' ' . showsPrec 11 ll . showString " ... ..."
@@ -145,11 +148,11 @@
 instance PrettyTerm Rendering where
   prettyTerm (Rendering d ll l f) = nesting $ \k -> columns $ \n -> go (n - k) where
     go cols = align (vsep (P.map ln [t..b])) where 
-      (lo, hi) = window (column d) ll (min (max (cols - 2) 30) 200)
+      (lo, hi) = window (fromIntegral $ column d) ll (min (max (cols - 2) 30) 200)
       a = f d $ l $ array ((0,lo),(-1,hi)) []
       ((t,_),(b,_)) = bounds a
       ln y = hcat 
-           $ P.map (\g -> P.foldr with (string (P.map snd g)) (fst (P.head g)))
+           $ P.map (\g -> P.foldr with (pretty (P.map snd g)) (fst (P.head g)))
            $ groupBy ((==) `on` fst) 
            [ a ! (y,i) | i <- [lo..hi] ] 
 
diff --git a/Text/Trifecta/Diagnostic/Rendering/Span.hs b/Text/Trifecta/Diagnostic/Rendering/Span.hs
--- a/Text/Trifecta/Diagnostic/Rendering/Span.hs
+++ b/Text/Trifecta/Diagnostic/Rendering/Span.hs
@@ -36,12 +36,12 @@
 
 drawSpan :: Delta -> Delta -> Delta -> Lines -> Lines
 drawSpan s e d a
-  | nl && nh  = go (column l) (P.replicate (max (column h - column l) 0) '~') a
-  | nl        = go (column l) (P.replicate (max (snd (snd (bounds a)) - column l + 1) 0) '~') a
-  |       nh  = go (-1)       (P.replicate (max (column h + 1) 0) '~') a
+  | nl && nh  = go (column l) (P.replicate (fromIntegral (max (column h - column l) 0)) '~') a
+  | nl        = go (column l) (P.replicate (max (snd (snd (bounds a)) - fromIntegral (column l) + 1) 0) '~') a
+  |       nh  = go (-1)       (P.replicate (fromIntegral (max (column h + 1) 0)) '~') a
   | otherwise = a
   where
-    go = draw spanEffects 1
+    go = draw spanEffects 1 . fromIntegral
     l = argmin bytes s e
     h = argmax bytes s e
     nl = near l d
diff --git a/Text/Trifecta/Highlight/Class.hs b/Text/Trifecta/Highlight/Class.hs
new file mode 100644
--- /dev/null
+++ b/Text/Trifecta/Highlight/Class.hs
@@ -0,0 +1,8 @@
+module Text.Trifecta.Highlight.Class 
+  ( Highlightable(..)
+  ) where
+
+import Text.Trifecta.Highlight.Prim
+
+class Highlightable a where
+  addHighlights :: Highlights -> a -> a
diff --git a/Text/Trifecta/Highlight/Effects.hs b/Text/Trifecta/Highlight/Effects.hs
new file mode 100644
--- /dev/null
+++ b/Text/Trifecta/Highlight/Effects.hs
@@ -0,0 +1,30 @@
+module Text.Trifecta.Highlight.Effects 
+  ( highlightEffects
+  , pushToken
+  , popToken
+  , withHighlight
+  ) where
+
+import Control.Applicative
+import System.Console.Terminfo.PrettyPrint
+import System.Console.Terminfo.Color
+import Data.Semigroup
+import Text.Trifecta.Highlight.Prim
+
+highlightEffects :: Highlight -> [ScopedEffect]
+highlightEffects Comment            = [soft $ Foreground Green]
+highlightEffects ReservedIdentifier = [soft $ Foreground Blue]
+highlightEffects Operator           = [soft $ Foreground Yellow]
+highlightEffects ReservedOperator   = [soft $ Foreground Yellow]
+highlightEffects EscapeCode         = [soft $ Foreground Magenta, soft Bold]
+highlightEffects CharLiteral        = [soft $ Foreground Cyan]
+highlightEffects StringLiteral      = [soft $ Foreground Cyan]
+-- highlightEffects Identifier      = []
+highlightEffects _             = []
+
+pushToken, popToken :: Highlight -> TermDoc
+pushToken h = foldr (\a b -> pure (Push a) <> b) mempty (highlightEffects h)
+popToken h  = foldr (\_ b -> pure Pop      <> b) mempty (highlightEffects h)
+
+withHighlight :: Highlight -> TermDoc -> TermDoc
+withHighlight h d = pushToken h <> d <> popToken h
diff --git a/Text/Trifecta/Highlight/Prim.hs b/Text/Trifecta/Highlight/Prim.hs
new file mode 100644
--- /dev/null
+++ b/Text/Trifecta/Highlight/Prim.hs
@@ -0,0 +1,28 @@
+module Text.Trifecta.Highlight.Prim
+  ( Highlight(..)
+  , Highlights
+  ) where
+
+import Data.Ix
+import Text.Trifecta.IntervalMap
+import Text.Trifecta.Rope.Delta
+
+data Highlight
+  = EscapeCode
+  | Number 
+  | Comment
+  | CharLiteral
+  | StringLiteral
+  | Constant
+  | Statement
+  | Special
+  | Symbol
+  | Identifier
+  | ReservedIdentifier
+  | Operator
+  | ReservedOperator
+  deriving (Eq,Ord,Show,Read,Enum,Ix,Bounded)
+
+type Highlights = IntervalMap Delta Highlight
+
+
diff --git a/Text/Trifecta/Highlight/Rendering/HTML.hs b/Text/Trifecta/Highlight/Rendering/HTML.hs
new file mode 100644
--- /dev/null
+++ b/Text/Trifecta/Highlight/Rendering/HTML.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Text.Trifecta.Highlight.Rendering.HTML 
+  ( Doc(..)
+  , doc
+  ) where
+
+import Data.Monoid
+import Prelude hiding (head)
+import Text.Blaze
+import Text.Blaze.Html5 hiding (b,i)
+import Text.Blaze.Html5.Attributes hiding (title)
+import Text.Trifecta.Highlight.Class
+import Text.Trifecta.Rope.Highlighted
+
+-- | Represents a source file like an HsColour rendered document
+data Doc = Doc 
+  { docTitle   :: String
+  , docCss     :: String -- href for the css file
+  , docContent :: HighlightedRope
+  }
+
+-- | 
+--
+-- > renderHtml $ toHtml $ addHighlights highlightedRope $ doc "Foo.hs"
+doc :: String -> Doc
+doc t = Doc t "trifecta.css" mempty
+
+instance ToHtml Doc where
+  toHtml (Doc t css cs) = docTypeHtml $ do
+    head $ do
+      preEscapedString "<!-- Generated by trifecta, http://github.com/ekmett/trifecta/ -->\n"
+      title $ toHtml t
+      link ! rel "stylesheet" ! type_ "text/css" ! href (toValue css)
+    body $ toHtml cs
+
+instance Highlightable Doc where 
+  addHighlights h (Doc t c r) = Doc t c (addHighlights h r) 
diff --git a/Text/Trifecta/Highlighter/Class.hs b/Text/Trifecta/Highlighter/Class.hs
deleted file mode 100644
--- a/Text/Trifecta/Highlighter/Class.hs
+++ /dev/null
@@ -1,48 +0,0 @@
-module Text.Trifecta.Highlighter.Class 
-  ( MonadHighlighter(..)
-  ) where
-
-import Data.IntervalMap.FingerTree
-import Data.Monoid
-import Text.Trifecta.Rope.Delta
-import Text.Trifecta.Parser.Token.Highlight
-import qualified Control.Monad.Trans.State.Lazy as Lazy
-import qualified Control.Monad.Trans.State.Strict as Strict
-import qualified Control.Monad.Trans.RWS.Lazy as Lazy
-import qualified Control.Monad.Trans.RWS.Strict as Strict
-import qualified Control.Monad.Trans.Writer.Lazy as Lazy
-import qualified Control.Monad.Trans.Writer.Strict as Strict
-import Control.Monad.Trans.Class
-import Control.Monad.Trans.Error
-import Control.Monad.Trans.Maybe
-import Control.Monad.Trans.Reader
-
-class Monad m => MonadHighlighter m where
-  highlights :: m (IntervalMap Delta TokenHighlight)
-
-instance MonadHighlighter m => MonadHighlighter (Lazy.StateT s m) where
-  highlights = lift highlights
-
-instance MonadHighlighter m => MonadHighlighter (Strict.StateT s m) where
-  highlights = lift highlights
-
-instance (MonadHighlighter m, Monoid w) => MonadHighlighter (Lazy.WriterT w m) where
-  highlights = lift highlights
-
-instance (MonadHighlighter m, Monoid w) => MonadHighlighter (Strict.WriterT w m) where
-  highlights = lift highlights
-
-instance MonadHighlighter m => MonadHighlighter (ReaderT e m) where
-  highlights = lift highlights
-
-instance (MonadHighlighter m, Monoid w) => MonadHighlighter (Lazy.RWST r w s m) where
-  highlights = lift highlights
-
-instance (MonadHighlighter m, Monoid w) => MonadHighlighter (Strict.RWST r w s m) where
-  highlights = lift highlights
-
-instance MonadHighlighter m => MonadHighlighter (MaybeT m) where
-  highlights = lift highlights
-
-instance (MonadHighlighter m, Error e) => MonadHighlighter (ErrorT e m) where
-  highlights = lift highlights
diff --git a/Text/Trifecta/IntervalMap.hs b/Text/Trifecta/IntervalMap.hs
new file mode 100644
--- /dev/null
+++ b/Text/Trifecta/IntervalMap.hs
@@ -0,0 +1,276 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Text.Trifecta.IntervalMap
+-- Copyright   :  (c) Edward Kmett 2011
+--                (c) Ross Paterson 2008
+-- License     :  BSD-style
+-- Maintainer  :  ekmett@gmail.com
+-- Stability   :  experimental
+-- Portability :  non-portable (MPTCs, type families, functional dependencies)
+--
+-- Interval maps implemented using the 'FingerTree' type, following
+-- section 4.8 of
+--
+--    * Ralf Hinze and Ross Paterson,
+--      \"Finger trees: a simple general-purpose data structure\",
+--      /Journal of Functional Programming/ 16:2 (2006) pp 197-217.
+--      <http://www.soi.city.ac.uk/~ross/papers/FingerTree.html>
+--
+-- An amortized running time is given for each operation, with /n/
+-- referring to the size of the priority queue.  These bounds hold even
+-- in a persistent (shared) setting.
+--
+-- /Note/: Many of these operations have the same names as similar
+-- operations on lists in the "Prelude".  The ambiguity may be resolved
+-- using either qualification or the @hiding@ clause.
+--
+-- Unlike "Data.IntervalMap.FingerTree", this version sorts things so
+-- that the largest interval from a given point comes first. This way
+-- if you have nested intervals, you get the outermost interval before 
+-- the contained intervals.
+-----------------------------------------------------------------------------
+
+module Text.Trifecta.IntervalMap 
+  (
+  -- * Intervals
+    Interval(..)
+  -- * Interval maps
+  , IntervalMap(..), singleton, insert
+  -- * Searching
+  , search, intersections, dominators
+  -- * Prepending an offset onto every interval in the map
+  , offset
+  -- * The result monoid
+  , IntInterval(..)
+  , fromList
+  ) where
+
+import Control.Applicative hiding (empty)
+import qualified Data.FingerTree as FT
+import Data.FingerTree (FingerTree, Measured(..), ViewL(..), (<|), (><))
+import Data.Functor.Plus
+
+import Data.Traversable (Traversable(traverse))
+import Data.Foldable (Foldable(foldMap))
+import Data.Bifunctor
+import Data.Semigroup
+import Data.Semigroup.Reducer
+import Data.Semigroup.Union
+import Data.Semigroup.Foldable
+import Data.Semigroup.Traversable
+import Data.Functor.Apply
+import Data.Key
+import Data.Pointed
+
+----------------------------------
+-- 4.8 Application: interval trees
+----------------------------------
+
+-- | A closed interval.  The lower bound should be less than or equal
+-- to the higher bound.
+data Interval v = Interval { low :: v, high :: v }
+  deriving Show
+
+instance Ord v => Semigroup (Interval v) where
+  Interval a b <> Interval c d = Interval (min a c) (max b d)
+
+-- assumes the monoid and ordering are compatible.
+instance (Ord v, Monoid v) => Reducer v (Interval v) where 
+  unit v = Interval v v
+  cons v (Interval a b) = Interval (v `mappend` a) (v `mappend` b)
+  snoc (Interval a b) v = Interval (a `mappend` v) (b `mappend` v)
+
+instance Eq v => Eq (Interval v) where
+  Interval a b == Interval c d = a == c && d == b
+
+instance Ord v => Ord (Interval v) where
+  compare (Interval a b) (Interval c d) = case compare a c of
+    LT -> LT
+    EQ -> compare d b -- reversed to put larger intervals first
+    GT -> GT
+
+instance Functor Interval where
+  fmap f (Interval a b) = Interval (f a) (f b)
+
+instance Foldable Interval where
+  foldMap f (Interval a b) = f a `mappend` f b
+
+instance Traversable Interval where
+  traverse f (Interval a b) = Interval <$> f a <*> f b
+
+instance Foldable1 Interval where
+  foldMap1 f (Interval a b) = f a <> f b
+
+instance Traversable1 Interval where
+  traverse1 f (Interval a b) = Interval <$> f a <.> f b
+
+instance Pointed Interval where
+  point v = Interval v v 
+
+data Node v a = Node (Interval v) a
+
+type instance Key (Node v) = Interval v
+
+instance Functor (Node v) where
+  fmap f (Node i x) = Node i (f x)
+
+instance Bifunctor Node where
+  bimap f g (Node v a) = Node (fmap f v) (g a)
+
+instance Keyed (Node v) where
+  mapWithKey f (Node i x) = Node i (f i x)
+
+instance Foldable (Node v) where
+  foldMap f (Node _ x) = f x
+
+instance FoldableWithKey (Node v) where
+  foldMapWithKey f (Node k v) = f k v
+
+instance Traversable (Node v) where
+  traverse f (Node i x) = Node i <$> f x
+
+instance TraversableWithKey (Node v) where
+  traverseWithKey f (Node i x) = Node i <$> f i x
+
+instance Foldable1 (Node v) where
+  foldMap1 f (Node _ x) = f x
+
+instance FoldableWithKey1 (Node v) where
+  foldMapWithKey1 f (Node k v) = f k v
+
+instance Traversable1 (Node v) where
+  traverse1 f (Node i x) = Node i <$> f x
+
+instance TraversableWithKey1 (Node v) where
+  traverseWithKey1 f (Node i x) = Node i <$> f i x
+
+-- rightmost interval (including largest lower bound) and largest upper bound.
+data IntInterval v = NoInterval | IntInterval (Interval v) v
+
+instance Ord v => Monoid (IntInterval v) where
+  mempty = NoInterval
+  NoInterval `mappend` i  = i
+  i `mappend` NoInterval  = i
+  IntInterval _ hi1 `mappend` IntInterval int2 hi2 =
+    IntInterval int2 (max hi1 hi2)
+
+instance Ord v => Measured (IntInterval v) (Node v a) where
+  measure (Node i _) = IntInterval i (high i)
+
+-- | Map of closed intervals, possibly with duplicates.
+-- The 'Foldable' and 'Traversable' instances process the intervals in
+-- lexicographical order.
+newtype IntervalMap v a = IntervalMap { runIntervalMap :: FingerTree (IntInterval v) (Node v a) } 
+-- ordered lexicographically by interval
+
+type instance Key (IntervalMap v) = Interval v
+
+instance Functor (IntervalMap v) where
+  fmap f (IntervalMap t) = IntervalMap (FT.unsafeFmap (fmap f) t)
+
+instance Keyed (IntervalMap v) where
+  mapWithKey f (IntervalMap t) = IntervalMap (FT.unsafeFmap (mapWithKey f) t)
+
+instance Foldable (IntervalMap v) where
+  foldMap f (IntervalMap t) = foldMap (foldMap f) t
+
+instance FoldableWithKey (IntervalMap v) where
+  foldMapWithKey f (IntervalMap t) = foldMap (foldMapWithKey f) t 
+
+instance Traversable (IntervalMap v) where
+  traverse f (IntervalMap t) =
+     IntervalMap <$> FT.unsafeTraverse (traverse f) t
+
+instance TraversableWithKey (IntervalMap v) where
+  traverseWithKey f (IntervalMap t) = 
+     IntervalMap <$> FT.unsafeTraverse (traverseWithKey f) t
+
+instance Ord v => Measured (IntInterval v) (IntervalMap v a) where
+  measure (IntervalMap m) = measure m
+
+largerError :: a
+largerError = error "Text.Trifecta.IntervalMap.larger: the impossible happened"
+
+-- | /O(m log (n/\//m))/.  Merge two interval maps.
+-- The map may contain duplicate intervals; entries with equal intervals
+-- are kept in the original order.
+instance Ord v => HasUnion (IntervalMap v a) where
+  union (IntervalMap xs) (IntervalMap ys) = IntervalMap (merge1 xs ys) where 
+    merge1 as bs = case FT.viewl as of
+      EmptyL -> bs
+      a@(Node i _) :< as' -> l >< a <| merge2 as' r
+        where 
+          (l, r) = FT.split larger bs
+          larger (IntInterval k _) = k >= i
+          larger _ = largerError
+    merge2 as bs = case FT.viewl bs of
+      EmptyL -> as
+      b@(Node i _) :< bs' -> l >< b <| merge1 r bs'
+        where 
+          (l, r) = FT.split larger as
+          larger (IntInterval k _) = k >= i
+          larger _ = largerError
+
+instance Ord v => HasUnion0 (IntervalMap v a) where
+  empty = IntervalMap FT.empty
+
+instance Ord v => Monoid (IntervalMap v a) where
+  mempty = empty
+  mappend = union
+
+instance Ord v => Alt (IntervalMap v) where
+  (<!>) = union
+
+instance Ord v => Plus (IntervalMap v) where
+  zero = empty
+
+-- | /O(n)/. Add a delta to each interval in the map
+offset :: (Ord v, Monoid v) => v -> IntervalMap v a -> IntervalMap v a 
+offset v (IntervalMap m) = IntervalMap $ FT.fmap' (first (mappend v)) m
+
+-- | /O(1)/.  Interval map with a single entry.
+singleton :: Ord v => Interval v -> a -> IntervalMap v a
+singleton i x = IntervalMap (FT.singleton (Node i x))
+
+-- | /O(log n)/.  Insert an interval into a map.
+-- The map may contain duplicate intervals; the new entry will be inserted
+-- before any existing entries for the same interval.
+insert :: Ord v => v -> v -> a -> IntervalMap v a -> IntervalMap v a
+insert lo hi _ m | lo > hi = m
+insert lo hi x (IntervalMap t) = IntervalMap (l >< Node i x <| r) where 
+  i = Interval lo hi
+  (l, r) = FT.split larger t
+  larger (IntInterval k _) = k >= i
+  larger _ = largerError
+
+-- | /O(k log (n/\//k))/.  All intervals that contain the given interval,
+-- in lexicographical order.
+dominators :: Ord v => v -> v -> IntervalMap v a -> [(Interval v, a)]
+dominators i j = intersections j i 
+
+-- | /O(k log (n/\//k))/.  All intervals that contain the given point,
+-- in lexicographical order.
+search :: Ord v => v -> IntervalMap v a -> [(Interval v, a)]
+search p = intersections p p
+
+-- | /O(k log (n/\//k))/.  All intervals that intersect with the given
+-- interval, in lexicographical order.
+intersections :: Ord v => v -> v -> IntervalMap v a -> [(Interval v, a)]
+intersections lo hi (IntervalMap t) = matches (FT.takeUntil (greater hi) t) where 
+  matches xs  =  case FT.viewl (FT.dropUntil (atleast lo) xs) of
+    EmptyL -> []
+    Node i x :< xs'  ->  (i, x) : matches xs'
+
+atleast :: Ord v => v -> IntInterval v -> Bool
+atleast k (IntInterval _ hi) = k <= hi
+atleast _ _ = False
+
+greater :: Ord v => v -> IntInterval v -> Bool
+greater k (IntInterval i _) = low i > k
+greater _ _ = False
+
+fromList :: Ord v => [(v, v, a)] -> IntervalMap v a
+fromList = foldr ins empty where 
+  ins (lo, hi, n) = insert lo hi n
+
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
@@ -42,7 +42,7 @@
 import Text.Trifecta.Rope.Delta
 import Text.Trifecta.Rope.Prim
 import Text.Trifecta.Parser.It
-import Text.Trifecta.Parser.Token.Highlight
+import Text.Trifecta.Highlight.Prim
 import Text.Trifecta.Diagnostic.Rendering.Prim
 -- import Control.Monad.Trans.Maybe.Strict as Strict
 -- import Control.Monad.Trans.Either.Strict as Strict
@@ -55,39 +55,36 @@
   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
+  -- | 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 
+  -- | 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
+  -- | @highlight@ 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.
+  highlight :: Highlight -> m a -> m a
+  highlight _ m = m
+
+
+
   -- | 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
@@ -99,7 +96,7 @@
   unexpected = lift . unexpected
   satisfy = lift . satisfy
   satisfy8 = lift . satisfy8
-  highlightToken t (Lazy.StateT m) = Lazy.StateT $ \e -> highlightToken t (m e) 
+  highlight t (Lazy.StateT m) = Lazy.StateT $ \e -> highlight t (m e) 
 
 instance MonadParser m => MonadParser (Strict.StateT s m) where
   try (Strict.StateT m) = Strict.StateT $ try . m
@@ -111,7 +108,7 @@
   unexpected = lift . unexpected
   satisfy = lift . satisfy
   satisfy8 = lift . satisfy8
-  highlightToken t (Strict.StateT m) = Strict.StateT $ \e -> highlightToken t (m e) 
+  highlight t (Strict.StateT m) = Strict.StateT $ \e -> highlight t (m e) 
 
 instance MonadParser m => MonadParser (ReaderT e m) where
   try (ReaderT m) = ReaderT $ try . m
@@ -123,7 +120,7 @@
   unexpected = lift . unexpected
   satisfy = lift . satisfy
   satisfy8 = lift . satisfy8
-  highlightToken t (ReaderT m) = ReaderT $ \e -> highlightToken t (m e) 
+  highlight t (ReaderT m) = ReaderT $ \e -> highlight t (m e) 
 
 instance (MonadParser m, Monoid w) => MonadParser (Strict.WriterT w m) where
   try (Strict.WriterT m) = Strict.WriterT $ try m
@@ -135,7 +132,7 @@
   unexpected = lift . unexpected
   satisfy = lift . satisfy
   satisfy8 = lift . satisfy8
-  highlightToken t (Strict.WriterT m) = Strict.WriterT $ highlightToken t m
+  highlight t (Strict.WriterT m) = Strict.WriterT $ highlight t m
 
 instance (MonadParser m, Monoid w) => MonadParser (Lazy.WriterT w m) where
   try (Lazy.WriterT m) = Lazy.WriterT $ try m
@@ -147,7 +144,7 @@
   unexpected = lift . unexpected
   satisfy = lift . satisfy
   satisfy8 = lift . satisfy8
-  highlightToken t (Lazy.WriterT m) = Lazy.WriterT $ highlightToken t m
+  highlight t (Lazy.WriterT m) = Lazy.WriterT $ highlight 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)
@@ -159,7 +156,7 @@
   unexpected = lift . unexpected
   satisfy = lift . satisfy
   satisfy8 = lift . satisfy8
-  highlightToken t (Lazy.RWST m) = Lazy.RWST $ \r s -> highlightToken t (m r s)
+  highlight t (Lazy.RWST m) = Lazy.RWST $ \r s -> highlight 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)
@@ -171,7 +168,7 @@
   unexpected = lift . unexpected
   satisfy = lift . satisfy
   satisfy8 = lift . satisfy8
-  highlightToken t (Strict.RWST m) = Strict.RWST $ \r s -> highlightToken t (m r s)
+  highlight t (Strict.RWST m) = Strict.RWST $ \r s -> highlight t (m r s)
 
 instance MonadParser m => MonadParser (IdentityT m) where
   try (IdentityT m) = IdentityT $ try m
@@ -183,7 +180,7 @@
   unexpected = lift . unexpected
   satisfy = lift . satisfy
   satisfy8 = lift . satisfy8
-  highlightToken t (IdentityT m) = IdentityT $ highlightToken t m
+  highlight t (IdentityT m) = IdentityT $ highlight t m
 
 instance MonadParser m => MonadParser (Yoneda m) where
   try = lift . try . lowerYoneda
@@ -195,7 +192,7 @@
   unexpected = lift . unexpected
   satisfy = lift . satisfy
   satisfy8 = lift . satisfy8
-  highlightToken t (Yoneda m) = Yoneda $ \f -> highlightToken t (m f)
+  highlight t (Yoneda m) = Yoneda $ \f -> highlight t (m f)
 
 {-
 instance MonadParser m => MonadParser (Codensity m) where
@@ -228,7 +225,7 @@
 restOfLine :: MonadParser m => m ByteString
 restOfLine = do
   m <- mark
-  Strict.drop (columnByte m) <$> line
+  Strict.drop (fromIntegral (columnByte m)) <$> line
 {-# INLINE restOfLine #-}
 
 -- | label a parser with a name
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
@@ -28,8 +28,7 @@
 import Data.Semigroup
 import Data.Foldable
 import Data.Functor.Bind (Apply(..), Bind((>>-)))
-import Data.IntervalMap.FingerTree (Interval(..))
-import qualified Data.IntervalMap.FingerTree as IntervalMap
+import qualified Text.Trifecta.IntervalMap as IntervalMap
 import Data.Set as Set hiding (empty, toList)
 import Data.ByteString as Strict hiding (empty)
 import Data.Sequence as Seq hiding (empty)
@@ -46,7 +45,8 @@
 import Text.Trifecta.Diagnostic.Err.Log
 import Text.Trifecta.Diagnostic.Rendering.Prim
 import Text.Trifecta.Diagnostic.Rendering.Caret
-import Text.Trifecta.Highlighter.Class
+import Text.Trifecta.Highlight.Class
+import Text.Trifecta.Highlight.Prim
 import Text.Trifecta.Parser.Class
 import Text.Trifecta.Parser.It
 import Text.Trifecta.Parser.Step
@@ -179,8 +179,8 @@
   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 d d') t (errHighlights l') } b8' d') ce l b8 d bs
+  highlight 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 d d' t (errHighlights l') } b8' d') ce l b8 d bs
 
   unexpected s = Parser $ \ _ ee _ _ -> ee mempty { errMessage = FailErr $ "unexpected " ++ s }
 
@@ -201,7 +201,7 @@
     case mbs of
       Just bs' -> co () mempty l (ascii bs') d' bs'
       Nothing 
-        | bytes d' == bytes (rewind d) + Strict.length bs -> if near d d' 
+        | bytes d' == bytes (rewind d) + fromIntegral (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
@@ -212,10 +212,10 @@
   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
+         if b >= 0 && b < fromIntegral (Strict.length bs)
+         then case toEnum $ fromEnum $ Strict.index bs (fromIntegral b) of
            c | not (f c)                 -> ee mempty l b8 d bs
-             | b == Strict.length bs - 1 -> let !ddc = d <> delta c
+             | b == fromIntegral (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 )
@@ -223,7 +223,7 @@
                                                              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
+    else case UTF8.uncons $ Strict.drop (fromIntegral (columnByte d)) bs of
       Nothing             -> ee mempty { errMessage = FailErr "unexpected EOF" } l b8 d bs
       Just (c, xs) 
         | not (f c)       -> ee mempty l b8 d bs
@@ -236,10 +236,10 @@
         | 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
+    if b >= 0 && b < fromIntegral (Strict.length bs)
+    then case toEnum $ fromEnum $ Strict.index bs (fromIntegral b) of
       c | not (f c)                 -> ee mempty l b8 d bs
-        | b == Strict.length bs - 1 -> let !ddc = d <> delta c
+        | b == fromIntegral (Strict.length bs - 1) -> let !ddc = d <> delta c
                                        in join $ fillIt ( if c == 10
                                                           then co c mempty l True ddc mempty
                                                           else co c mempty l b8 ddc bs )
@@ -248,40 +248,40 @@
         | otherwise                 -> co c mempty l b8 (d <> delta c) bs
     else ee mempty { errMessage = FailErr "unexpected EOF" } l b8 d bs
 
-instance MonadHighlighter (Parser e) where
-  highlights = Parser $ \eo _ _ _ l -> eo (errHighlights l) mempty l
+-- instance MonadHighlight (Parser e) where
+--  highlights = Parser $ \eo _ _ _ l -> eo (errHighlights l) mempty l
 
 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 -> Bool -> Delta -> ByteString -> Diagnostic t) ->
+              (ErrState e -> Highlights -> 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 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 (Pure (JuSt a _ l _ _ _)) = StepDone r (yl . addHighlights (errHighlights l) <$> errLog l) a
+    go r (Pure (NoSt e l b8 d bs)) = StepFail r ((yl . addHighlights (errHighlights l) <$> errLog l) |> y e (errHighlights l) b8 d bs)
     go r (It ma k) = StepCont r (case ma of
-                                   JuSt a _ l _ _ _  -> Success (yl <$> errLog l) a
-                                   NoSt e l b8 d bs  -> Failure ((yl <$> errLog l) |> y e b8 d bs)) 
+                                   JuSt a _ l _ _ _  -> Success (yl . addHighlights (errHighlights l) <$> errLog l) a
+                                   NoSt e l b8 d bs  -> Failure ((yl . addHighlights (errHighlights l) <$> errLog l) |> y e (errHighlights l) b8 d bs)) 
                                 (go <*> k)
 
-why :: Pretty e => (e -> Doc t) -> ErrState e -> Bool -> Delta -> ByteString -> Diagnostic (Doc t)
-why pp (ErrState ss m) _ d bs 
+why :: Pretty e => (e -> Doc t) -> ErrState e -> Highlights -> Bool -> Delta -> ByteString -> Diagnostic (Doc t)
+why pp (ErrState ss m) hs _ 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) -- 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) []
-    explicateWith x (PanicErr s)    = Diagnostic r  Panic ((fillSep $ text <$> words s) <> x) []
-    explicateWith x (Err rs l e es) = Diagnostic r' l (pp e <> x) (fmap (fmap pp) es)
-      where r' = Right $ addCaret d $ Prelude.foldr (<>) (rendering d bs) rs
+    r = Right $ addCaret d $ addHighlights hs $ 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) []
+    explicateWith x (PanicErr s)    = Diagnostic r Panic ((fillSep $ text <$> words s) <> x) []
+    explicateWith x (Err rs l e es) = Diagnostic r' l (pp e <> x) (fmap (addHighlights hs . fmap pp) es)
+      where r' = Right $ addCaret d $ Prelude.foldr (<>) (addHighlights hs $ rendering d bs) rs
 
 parseTest :: Show a => Parser String a -> String -> IO ()
 parseTest p s = case starve 
diff --git a/Text/Trifecta/Parser/Result.hs b/Text/Trifecta/Parser/Result.hs
--- a/Text/Trifecta/Parser/Result.hs
+++ b/Text/Trifecta/Parser/Result.hs
@@ -21,14 +21,14 @@
 
 instance (Pretty e, Show a) => Pretty (Result e a) where
   pretty (Success xs a) 
-    | Seq.null xs = string (show a)
-    | otherwise   = prettyList (toList xs) `above` string (show a)
+    | Seq.null xs = pretty (show a)
+    | otherwise   = prettyList (toList xs) `above` pretty (show a)
   pretty (Failure xs) = prettyList $ toList xs
 
 instance (PrettyTerm e, Show a) => PrettyTerm (Result e a) where
   prettyTerm (Success xs a)
-    | Seq.null xs = string (show a)
-    | otherwise   = prettyTermList (toList xs) `above` string (show a)
+    | Seq.null xs = pretty (show a)
+    | otherwise   = prettyTermList (toList xs) `above` pretty (show a)
   prettyTerm (Failure xs) = prettyTermList $ toList xs
 
 instance Functor (Result e) where
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,7 +11,6 @@
 -----------------------------------------------------------------------------
 module Text.Trifecta.Parser.Token.Class
   ( MonadTokenParser(..)
-  , TokenHighlight
   ) where
 
 import Control.Applicative
@@ -25,7 +24,6 @@
 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,7 +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
+import Text.Trifecta.Highlight.Prim
 
 -- | This lexeme parser parses a single literal character. Returns the
 -- literal character value. This parsers deals correctly with escape
@@ -81,7 +81,7 @@
   sign = negate <$ char '-'
     <|> id <$ char '+'
     <|> pure id
-  int = lexeme (highlightToken Operator sign) <*> natural'
+  int = lexeme (highlight 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
@@ -102,13 +102,13 @@
 -- trailing white space. 
 
 symbol :: MonadTokenParser m => ByteString -> m ByteString
-symbol name = lexeme (highlightToken Symbol (byteString name))
+symbol name = lexeme (highlight Symbol (byteString name))
 
 -- | Lexeme parser @symbolic s@ parses 'char' @s@ and skips
 -- trailing white space. 
 
 symbolic :: MonadTokenParser m => Char -> m Char
-symbolic name = lexeme (highlightToken Symbol (char name))
+symbolic name = lexeme (highlight 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
deleted file mode 100644
--- a/Text/Trifecta/Parser/Token/Highlight.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-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
@@ -29,14 +29,15 @@
 import Text.Trifecta.Parser.Char
 import Text.Trifecta.Parser.Combinators
 import Text.Trifecta.Parser.Token.Class
+import Text.Trifecta.Highlight.Prim
 
 data IdentifierStyle m = IdentifierStyle
   { styleName              :: String
   , styleStart             :: m ()
   , styleLetter            :: m ()
   , styleReserved          :: HashSet ByteString
-  , styleHighlight         :: TokenHighlight
-  , styleReservedHighlight :: TokenHighlight
+  , styleHighlight         :: Highlight
+  , styleReservedHighlight :: Highlight
   }
 
 -- | parse a reserved operator or identifier using a given style
@@ -46,13 +47,13 @@
 -- | parse a reserved operator or identifier using a given style specified by bytestring
 reserveByteString :: MonadTokenParser m => IdentifierStyle m -> ByteString -> m ()
 reserveByteString s name = lexeme $ try $ do
-   _ <- highlightToken (styleReservedHighlight s) $ byteString name 
+   _ <- highlight (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 <- highlightToken (styleHighlight s) (sliced (styleStart s *> skipMany (styleLetter s))) <?> styleName s
+  name <- highlight (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,7 +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
+import Text.Trifecta.Highlight.Prim
 
 set :: [String] -> HashSet ByteString
 set = HashSet.fromList . fmap UTF8.fromString
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,7 +29,7 @@
 import Text.Trifecta.Parser.Class
 import Text.Trifecta.Parser.Char
 import Text.Trifecta.Parser.Combinators
-import Text.Trifecta.Parser.Token.Highlight
+import Text.Trifecta.Highlight.Prim
 
 -- | This parser parses a single literal character. Returns the
 -- literal character value. This parsers deals correctly with escape
@@ -39,13 +39,13 @@
 --
 -- This parser does NOT swallow trailing whitespace. 
 charLiteral' :: MonadParser m => m Char
-charLiteral' = highlightToken CharLiteral (between (char '\'') (char '\'' <?> "end of character") characterChar)
+charLiteral' = highlight CharLiteral (between (char '\'') (char '\'' <?> "end of character") characterChar)
           <?> "character" 
 
 characterChar, charEscape, charLetter :: MonadParser m => m Char
 characterChar = charLetter <|> charEscape
             <?> "literal character"
-charEscape = highlightToken EscapeCode $ char '\\' *> escapeCode
+charEscape = highlight EscapeCode $ char '\\' *> escapeCode
 charLetter = satisfy (\c -> (c /= '\'') && (c /= '\\') && (c > '\026'))
 
 -- | This parser parses a literal string. Returns the literal
@@ -56,7 +56,7 @@
 --
 -- This parser does NOT swallow trailing whitespace
 stringLiteral' :: MonadParser m => m String
-stringLiteral' = highlightToken StringLiteral lit where
+stringLiteral' = highlight StringLiteral lit where
   lit = Prelude.foldr (maybe id (:)) "" <$> between (char '"') (char '"' <?> "end of string") (many stringChar) 
     <?> "literal string"
   stringChar = Just <$> stringLetter 
@@ -64,7 +64,7 @@
        <?> "string character"
   stringLetter    = satisfy (\c -> (c /= '"') && (c /= '\\') && (c > '\026'))
 
-  stringEscape = highlightToken EscapeCode $ char '\\' *> esc where
+  stringEscape = highlight EscapeCode $ char '\\' *> esc where
     esc = Nothing <$ escapeGap 
       <|> Nothing <$ escapeEmpty 
       <|> Just <$> escapeCode
@@ -108,7 +108,7 @@
 --
 -- This parser does NOT swallow trailing whitespace. 
 natural' :: MonadParser m => m Integer
-natural' = highlightToken Number nat <?> "natural"
+natural' = highlight Number nat <?> "natural"
 
 number :: MonadParser m => Integer -> m Char -> m Integer
 number base baseDigit = do
@@ -131,13 +131,13 @@
 integer' = int <?> "integer"
 
 sign :: MonadParser m => m (Integer -> Integer)
-sign = highlightToken Operator
+sign = highlight Operator
      $ negate <$ char '-'
    <|> id <$ char '+'
    <|> pure id
 
 int :: MonadParser m => m Integer
-int = {-lexeme-} sign <*> highlightToken Number nat
+int = {-lexeme-} sign <*> highlight Number nat
 nat, zeroNumber :: MonadParser m => m Integer
 nat = zeroNumber <|> decimal
 zeroNumber = char '0' *> (hexadecimal <|> octal <|> decimal <|> return 0) <?> ""
@@ -149,7 +149,7 @@
 -- This parser does NOT swallow trailing whitespace. 
 
 double' :: MonadParser m => m Double
-double' = highlightToken Number floating <?> "double"
+double' = highlight Number floating <?> "double"
 
 floating :: MonadParser m => m Double
 floating = decimal >>= fractExponent
@@ -178,7 +178,7 @@
 -- This parser does NOT swallow trailing whitespace. 
 
 naturalOrDouble' :: MonadParser m => m (Either Integer Double)
-naturalOrDouble' = highlightToken Number natDouble <?> "number"
+naturalOrDouble' = highlight Number natDouble <?> "number"
 
 natDouble, zeroNumFloat, decimalFloat :: MonadParser m => m (Either Integer Double)
 natDouble 
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,7 +23,7 @@
 import Text.Trifecta.Parser.Class
 import Text.Trifecta.Parser.Char
 import Text.Trifecta.Parser.Combinators
-import Text.Trifecta.Parser.Token.Highlight
+import Text.Trifecta.Highlight.Prim
 
 data CommentStyle = CommentStyle 
   { commentStart   :: String
@@ -48,11 +48,11 @@
     noLine  = null lineStyle
     noMulti = null startStyle
     simpleSpace = skipSome (satisfy isSpace)
-    oneLineComment = highlightToken Comment $ do
+    oneLineComment = highlight Comment $ do
       _ <- try $ string lineStyle
       skipMany (satisfyAscii (/= '\n')) -- TODO: use skipping/restOfLine and fiddle with the last byte
       return ()
-    multiLineComment = highlightToken Comment $ do
+    multiLineComment = highlight Comment $ do
       _ <- try $ string startStyle
       inComment
     inComment
diff --git a/Text/Trifecta/Rope/Bytes.hs b/Text/Trifecta/Rope/Bytes.hs
--- a/Text/Trifecta/Rope/Bytes.hs
+++ b/Text/Trifecta/Rope/Bytes.hs
@@ -4,12 +4,13 @@
 
 import Data.ByteString as Strict
 import Data.FingerTree
+import Data.Int (Int64)
 
 class HasBytes t where
-  bytes :: t -> Int
+  bytes :: t -> Int64
 
 instance HasBytes ByteString where
-  bytes = Strict.length
+  bytes = fromIntegral . Strict.length
 
 instance (Measured v a, HasBytes v) => HasBytes (FingerTree v a) where
   bytes = bytes . measure
diff --git a/Text/Trifecta/Rope/Delta.hs b/Text/Trifecta/Rope/Delta.hs
--- a/Text/Trifecta/Rope/Delta.hs
+++ b/Text/Trifecta/Rope/Delta.hs
@@ -11,6 +11,7 @@
 import Control.Applicative
 import Data.Semigroup
 import Data.Hashable
+import Data.Int
 import Data.Word
 import Data.Foldable
 import Data.Function (on)
@@ -22,20 +23,20 @@
 import System.Console.Terminfo.PrettyPrint
 
 data Delta
-  = Columns   {-# UNPACK #-} !Int  -- the number of characters
-              {-# UNPACK #-} !Int  -- the number of bytes
-  | Tab       {-# UNPACK #-} !Int  -- the number of characters before the tab
-              {-# UNPACK #-} !Int  -- the number of characters after the tab
-              {-# UNPACK #-} !Int  -- the number of bytes
-  | Lines     {-# UNPACK #-} !Int  -- the number of newlines contained
-              {-# UNPACK #-} !Int  -- the number of characters since the last newline
-              {-# UNPACK #-} !Int  -- number of bytes
-              {-# UNPACK #-} !Int  -- the number of bytes since the last newline
-  | Directed  !ByteString          -- current file name
-              {-# UNPACK #-} !Int  -- the number of lines since the last line directive
-              {-# UNPACK #-} !Int  -- the number of characters since the last newline
-              {-# UNPACK #-} !Int  -- number of bytes
-              {-# UNPACK #-} !Int  -- the number of bytes since the last newline
+  = Columns   {-# UNPACK #-} !Int64 -- the number of characters
+              {-# UNPACK #-} !Int64 -- the number of bytes
+  | Tab       {-# UNPACK #-} !Int64 -- the number of characters before the tab
+              {-# UNPACK #-} !Int64 -- the number of characters after the tab
+              {-# UNPACK #-} !Int64 -- the number of bytes
+  | Lines     {-# UNPACK #-} !Int64 -- the number of newlines contained
+              {-# UNPACK #-} !Int64 -- the number of characters since the last newline
+              {-# UNPACK #-} !Int64 -- number of bytes
+              {-# UNPACK #-} !Int64 -- the number of bytes since the last newline
+  | Directed  !ByteString           -- current file name
+              {-# UNPACK #-} !Int64 -- the number of lines since the last line directive
+              {-# UNPACK #-} !Int64 -- the number of characters since the last newline
+              {-# UNPACK #-} !Int64 -- number of bytes
+              {-# UNPACK #-} !Int64 -- the number of bytes since the last newline
   deriving Show
 
 instance Eq Delta where
@@ -57,10 +58,13 @@
     Lines l c _ _ -> k f l c
     Directed fn l c _ _ -> k (UTF8.toString fn) l c
     where 
-      k fn ln cn = bold (string fn) <> char ':' <> bold (int (ln+1)) <> char ':' <> bold (int (cn+1))
+      k fn ln cn = bold (pretty fn) <> char ':' <> bold (int64 (ln+1)) <> char ':' <> bold (int64 (cn+1))
       f = "(interactive)"
 
-column :: HasDelta t => t -> Int
+int64 :: Int64 -> Doc e
+int64 = pretty . show
+
+column :: HasDelta t => t -> Int64
 column t = case delta t of 
   Columns c _ -> c
   Tab b a _ -> nextTab b + a
@@ -68,7 +72,7 @@
   Directed _ _ c _ _ -> c
 {-# INLINE column #-}
 
-columnByte :: Delta -> Int
+columnByte :: Delta -> Int64
 columnByte (Columns _ b) = b
 columnByte (Tab _ _ b) = b
 columnByte (Lines _ _ _ b) = b
@@ -109,7 +113,7 @@
   Directed p l _ t _ <> Lines m d t' b      = Directed p (l + m) d                         (t + t') b
   Directed _ _ _ t _ <> Directed p l c t' b = Directed p l       c                         (t + t') b
   
-nextTab :: Int -> Int
+nextTab :: Int64 -> Int64
 nextTab x = x + (8 - mod x 8)
 {-# INLINE nextTab #-}
 
diff --git a/Text/Trifecta/Rope/Highlighted.hs b/Text/Trifecta/Rope/Highlighted.hs
new file mode 100644
--- /dev/null
+++ b/Text/Trifecta/Rope/Highlighted.hs
@@ -0,0 +1,87 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Text.Trifecta.Rope.Highlighted
+  ( HighlightedRope(..)
+  ) where
+
+import qualified Data.ByteString.Lazy.Char8 as L
+import qualified Data.ByteString.Lazy.UTF8 as LazyUTF8
+import Data.Foldable as F
+import Data.Int (Int64)
+import Text.Trifecta.IntervalMap as IM
+import Data.Key hiding ((!))
+import Data.List (sort)
+import Data.Semigroup
+import Data.Semigroup.Union
+import Prelude hiding (head)
+import System.Console.Terminfo.PrettyPrint
+import Text.Blaze
+import Text.Blaze.Internal
+import Text.Blaze.Html5 hiding (b,i)
+import Text.Blaze.Html5.Attributes hiding (title)
+import Text.Trifecta.Rope.Delta
+import Text.Trifecta.Rope.Bytes
+import Text.Trifecta.Rope.Prim
+import Text.Trifecta.Highlight.Class
+import Text.Trifecta.Highlight.Effects
+import Text.Trifecta.Highlight.Prim
+import Text.PrettyPrint.Free
+
+data HighlightedRope = HighlightedRope 
+  { ropeHighlights :: !Highlights
+  , ropeContent    :: {-# UNPACK #-} !Rope 
+  }
+
+instance HasDelta HighlightedRope where
+  delta = delta . ropeContent
+
+instance HasBytes HighlightedRope where
+  bytes = bytes . ropeContent
+
+instance Semigroup HighlightedRope where
+  HighlightedRope h bs <> HighlightedRope h' bs' = HighlightedRope (h `union` IM.offset (delta bs) h') (bs <> bs')
+
+instance Monoid HighlightedRope where
+  mappend = (<>) 
+  mempty = HighlightedRope mempty mempty
+
+instance Highlightable HighlightedRope where
+  addHighlights h (HighlightedRope h' r) = HighlightedRope (h `union` h') r
+
+data Located a = a :@ {-# UNPACK #-} !Int64
+infix 5 :@
+instance Eq (Located a) where
+  _ :@ m == _ :@ n = m == n
+instance Ord (Located a) where
+  compare (_ :@ m) (_ :@ n) = compare m n
+
+instance ToHtml HighlightedRope where
+  toHtml (HighlightedRope intervals r) = pre $ go 0 lbs effects where 
+    lbs = L.fromChunks [bs | Strand bs _ <- F.toList (strands r)]
+    ln no = a ! name (toValue $ "line-" ++ show no) $ Empty
+    effects = sort $ [ i | (Interval lo hi, tok) <- intersections mempty (delta r) intervals
+                     , i <- [ (Leaf "span" "<span" ">" ! class_ (toValue $ show tok)) :@ bytes lo
+                            , preEscapedString "</span>" :@ bytes hi
+                            ]
+                     ] ++ mapWithKey (\k i -> ln k :@ i) (L.elemIndices '\n' lbs)
+    go _ cs [] = unsafeLazyByteString cs
+    go b cs ((eff :@ eb) : es) 
+      | eb <= b = eff >> go b cs es 
+      | otherwise = unsafeLazyByteString om >> go eb nom es
+         where (om,nom) = L.splitAt (fromIntegral (eb - b)) cs
+
+instance Pretty HighlightedRope where
+  pretty (HighlightedRope _ r) = hsep $ [ pretty bs | Strand bs _ <- F.toList (strands r)]
+
+instance PrettyTerm HighlightedRope where
+  prettyTerm (HighlightedRope intervals r) = go 0 lbs effects where
+    lbs = L.fromChunks [bs | Strand bs _ <- F.toList (strands r)]
+    effects = sort $ [ i | (Interval lo hi, tok) <- intersections mempty (delta r) intervals
+                     , i <- [ pushToken tok :@ bytes lo
+                            , popToken tok  :@ bytes hi
+                            ]
+                     ]
+    go _ cs [] = prettyTerm (LazyUTF8.toString cs)
+    go b cs ((eff :@ eb) : es) 
+      | eb <= b = eff <> go b cs es 
+      | otherwise = prettyTerm (LazyUTF8.toString om) <> go eb nom es
+         where (om,nom) = L.splitAt (fromIntegral (eb - b)) cs
diff --git a/Text/Trifecta/Rope/Prim.hs b/Text/Trifecta/Rope/Prim.hs
--- a/Text/Trifecta/Rope/Prim.hs
+++ b/Text/Trifecta/Rope/Prim.hs
@@ -18,13 +18,14 @@
 import Data.FingerTree as FingerTree
 import Data.Foldable (toList)
 import Data.Hashable
+import Data.Int (Int64)
 import Text.Trifecta.Util as Util
 import Text.Trifecta.Rope.Bytes
 import Text.Trifecta.Rope.Delta
 
 data Strand
   = Strand        {-# UNPACK #-} !ByteString !Delta
-  | LineDirective {-# UNPACK #-} !ByteString {-# UNPACK #-} !Int
+  | LineDirective {-# UNPACK #-} !ByteString {-# UNPACK #-} !Int64
   deriving Show
 
 strand :: ByteString -> Strand
@@ -36,7 +37,7 @@
 
 instance Hashable Strand where
   hash (Strand h _) = hashWithSalt 0 h
-  hash (LineDirective p l)   = l `hashWithSalt` p
+  hash (LineDirective p l) = hash l `hashWithSalt` p
 
 instance HasDelta Strand where
   delta = measure
@@ -57,7 +58,7 @@
 grabRest :: Delta -> Rope -> r -> (Delta -> Lazy.ByteString -> r) -> r
 grabRest i t kf ks = trim (delta l) (bytes i - bytes l) (toList r) where
   trim j 0 (Strand h _ : xs) = go j h xs
-  trim _ k (Strand h _ : xs) = go i (Strict.drop k h) xs
+  trim _ k (Strand h _ : xs) = go i (Strict.drop (fromIntegral k) h) xs
   trim j k (p          : xs) = trim (j <> delta p) k xs 
   trim _ _ []                = kf
   go j h s = ks j $ Lazy.fromChunks $ h : [ a | Strand a _ <- s ]
@@ -100,5 +101,3 @@
   unit = unit . strand . UTF8.fromString
   cons = cons . strand . UTF8.fromString
   snoc r = snoc r . strand . UTF8.fromString
-
-
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.35
+version:       0.36
 license:       BSD3
 cabal-version: >= 1.6
 license-file:  LICENSE
@@ -35,10 +35,12 @@
     Text.Trifecta.CharSet.Unicode
     Text.Trifecta.CharSet.Unicode.Block
     Text.Trifecta.CharSet.Unicode.Category
+    Text.Trifecta.IntervalMap
     Text.Trifecta.Rope
     Text.Trifecta.Rope.Bytes
     Text.Trifecta.Rope.Delta
     Text.Trifecta.Rope.Prim
+    Text.Trifecta.Rope.Highlighted
     Text.Trifecta.Diagnostic
     Text.Trifecta.Diagnostic.Prim
     Text.Trifecta.Diagnostic.Class
@@ -52,7 +54,10 @@
     Text.Trifecta.Diagnostic.Rendering.Caret
     Text.Trifecta.Diagnostic.Rendering.Fixit
     Text.Trifecta.Diagnostic.Rendering.Span
-    Text.Trifecta.Highlighter.Class
+    Text.Trifecta.Highlight.Class
+    Text.Trifecta.Highlight.Prim
+    Text.Trifecta.Highlight.Effects
+    Text.Trifecta.Highlight.Rendering.HTML
     Text.Trifecta.Parser
     Text.Trifecta.Parser.ByteString
     Text.Trifecta.Parser.Char
@@ -70,7 +75,6 @@
     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
 
@@ -84,6 +88,8 @@
     array                >= 0.3.0.2 && < 0.4, 
     containers           >= 0.3     && < 0.5,
     unordered-containers >= 0.1.4   && < 0.2,
+    blaze-builder        >= 0.3.0.1 && < 0.4,
+    blaze-html           >= 0.4.1.6 && < 0.5,
     bifunctors           >= 0.1.1.3 && < 0.2,
     hashable             >= 1.1.2.1 && < 1.2,
     bytestring           >= 0.9.1   && < 0.10,
@@ -95,10 +101,11 @@
     utf8-string          >= 0.3.6   && < 0.4,
     semigroupoids        >= 1.2.4   && < 1.3,
     parallel             >= 3.1.0.1 && < 3.2,
+    pointed              >= 2       && < 2.1,
     transformers         >= 0.2.2   && < 0.3,
     kan-extensions       >= 2.0.1   && < 2.1,
     comonad              >= 1.1.1.1 && < 1.2,
     terminfo             >= 0.3.2   && < 0.4,
     keys                 >= 2.1     && < 2.2,
-    wl-pprint-extras     >= 1.5     && < 1.6,
+    wl-pprint-extras     >= 1.6     && < 1.7,
     wl-pprint-terminfo   >= 0.7     && < 0.8