diff --git a/README b/README
--- a/README
+++ b/README
@@ -3,6 +3,4 @@
 
 TODO:
 
-- Some files are not in UTF8.  Use ByteString with a lenient decoder?
-
 - \ continuation in strings is not parsed correctly.
diff --git a/changelog.md b/changelog.md
--- a/changelog.md
+++ b/changelog.md
@@ -1,3 +1,26 @@
+1.0:
+
+* Merged a whole bunch of patches from Sergey Vinokurov.  Copy paste from
+<https://github.com/elaforge/fast-tags/pull/6>:
+
+* recognize more syntactic constructs (consider tests as specification of
+what's handled)
+
+* add more tests
+
+* use tasty to organize tests
+
+* ability to produce emacs tags
+
+* handling of literate files
+
+* new mode to recursively traverse directory tree and search for haskell files
+
+* optionally ignore encoding errors during reading and skip offending files
+
+* ability to read \n-separated or \0-separated list of files from stdin
+and blazing-fast speed of tag generation is presevred
+
 0.0.6:
 
 * fix bug where class context in a class's methods would be confused for the
diff --git a/fast-tags.cabal b/fast-tags.cabal
--- a/fast-tags.cabal
+++ b/fast-tags.cabal
@@ -1,12 +1,12 @@
 name: fast-tags
-version: 0.0.6
+version: 1.0
 cabal-version: >= 1.8
 build-type: Simple
-synopsis: Fast incremental vi tags.
+synopsis: Fast incremental vi and emacs tags.
 description:
     Yet another tags program.  Like hasktags, it uses its own parser rather
     than haskell-src or haskell-src-exts, so it's fast.  It understands
-    hsc files, though not literate haskell.
+    hsc and literate haskell.
     .
     In addition, it will load an existing tags file and merge generated tags.
     .
@@ -16,15 +16,9 @@
     .
     Limitations:
     .
-    - No emacs tags, but they would be easy to add.
-    .
-    - Not using a real haskell parser means there are more likely to be dark
+    - Not using a real haskell parser means there is likely to be dark
     corners that don't parse right.
     .
-    - Only top-level functions with type declarations are tagged.  Top-level
-    functions without type declarations are skipped, as are ones inside 'let'
-    or 'where'.
-    .
     - Code has to be indented \"properly\", so brace and semicolon style with
     strange dedents will probably confuse it.
 
@@ -45,21 +39,46 @@
     type: git
     location: git://github.com/elaforge/fast-tags.git
 
-executable fast-tags
-    main-is: Main.hs
+flag fast
+    description:
+        Spend more time optimizing a program (may yield up to 25% speedup)
+    default:     False
+
+library
+    build-depends:
+        base >= 3 && < 5, containers, cpphs >1.18, filepath, directory,
+        -- text 0.11.1.12 has a bug.
+        text (> 0.11.1.12 || < 0.11.1.12), deepseq
+    exposed-modules: FastTags
     hs-source-dirs: src
-    build-depends: base >= 3 && < 5, containers,
+    ghc-options: -Wall -fno-warn-name-shadowing
+    ghc-prof-options: -Wall -fno-warn-name-shadowing -auto-all
+    if flag(fast)
+        ghc-options:
+            -funfolding-creation-threshold=10000 -funfolding-use-threshold=2500
+
+executable fast-tags
+    main-is: src/Main.hs
+    build-depends:
+        base >= 3 && < 5, containers, filepath, directory,
         -- text 0.11.1.12 has a bug.
-        text (> 0.11.1.12 || < 0.11.1.12)
+        text (> 0.11.1.12 || < 0.11.1.12),
+        fast-tags
     ghc-options: -Wall -fno-warn-name-shadowing
+    ghc-prof-options: -Wall -fno-warn-name-shadowing -auto-all
+    if flag(fast)
+        ghc-options:
+            -funfolding-creation-threshold=10000 -funfolding-use-threshold=2500
 
-test-suite tests
+test-suite test-fast-tags
     type: exitcode-stdio-1.0
-    hs-source-dirs: src
-    main-is: Main_test.hs
-    build-depends: ghc,
-        base >= 3 && < 5, containers,
+    main-is: MainTest.hs
+    hs-source-dirs: tests
+    ghc-options: -main-is MainTest
+    ghc-prof-options: -main-is MainTest
+    build-depends:
+        base >= 3 && < 5, containers, filepath, directory,
         -- text 0.11.1.12 has a bug.
-        text (> 0.11.1.12 || < 0.11.1.12)
-    -- Needed for the srcloc hack.
-    ghc-options: -fno-ignore-asserts
+        text (> 0.11.1.12 || < 0.11.1.12),
+        tasty, tasty-hunit,
+        fast-tags
diff --git a/src/FastTags.hs b/src/FastTags.hs
--- a/src/FastTags.hs
+++ b/src/FastTags.hs
@@ -1,69 +1,115 @@
-{-# LANGUAGE OverloadedStrings, PatternGuards, ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns               #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE PatternGuards              #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE ViewPatterns               #-}
+
 {-# OPTIONS_GHC -funbox-strict-fields #-}
-module FastTags where
-import qualified Control.Exception as Exception
+
+module FastTags
+    ( isHsFile
+    , isLiterateFile
+    , merge
+    , TokenVal(..)
+    , TagVal(..)
+    , Type(..)
+    , Tag(..)
+    , Pos(..)
+    , SrcPos(..)
+    , UnstrippedTokens(..)
+    , breakString
+    , stripComments
+    , processFile
+    , processAll
+    , process
+    , tokenize
+    , stripCpp
+    , annotate
+    , stripNewlines
+    , breakBlocks
+    , unstrippedTokensOf
+    , split
+    )
+where
+
+import Control.Arrow ((***), (&&&))
 import Control.Monad
-import qualified Data.Char as Char
-import qualified Data.List as List
-import qualified Data.Monoid as Monoid
-import Data.Monoid ((<>))
-import qualified Data.Set as Set
-import qualified Data.Text as T
+import Control.DeepSeq (NFData, rnf)
+import Data.Function (on)
+import Data.Functor ((<$>))
+import Data.Monoid (Monoid, (<>), mconcat)
 import Data.Text (Text)
-import qualified Data.Text.IO as Text.IO
+import qualified System.Exit as Exit
 
-import qualified Debug.Trace as Trace
+import qualified Language.Preprocessor.Unlit as Unlit
+import Text.Printf (printf)
+
+import qualified Control.Exception as Exception
+import qualified Data.Char as Char
+import qualified Data.IntSet as IntSet
+import qualified Data.List as L
+import qualified Data.Map as M
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
 import qualified System.IO as IO
-import qualified System.IO.Error as IO.Error
 
 
-mergeTags :: [FilePath] -> [Text] -> [Pos TagVal] -> [Text]
-mergeTags inputs old new =
-    -- 'new' was already been sorted by 'process', but then I just concat
-    -- the tags from each file, so they need sorting again.
-    merge (map showTag new) (filter (not . isNewTag textFns) old)
-    where textFns = Set.fromList $ map T.pack inputs
+-- * types
 
--- | Documented in vim :h tags-file-format.
--- This tells vim that the file is sorted (but not case folded) so that
--- it can do a bsearch and never needs to fall back to linear search.
-vimMagicLine :: Text
-vimMagicLine = "!_TAG_FILE_SORTED\t1\t~"
+data TagVal = TagVal
+    !Text -- ^ prefix
+    !Text -- ^ name
+    !Type -- ^ tag type
+    deriving (Show)
 
-isNewTag :: Set.Set Text -> Text -> Bool
-isNewTag textFns line = Set.member fn textFns
-    where fn = T.takeWhile (/='\t') $ T.drop 1 $ T.dropWhile (/='\t') line
+instance NFData TagVal where
+    rnf (TagVal x y z) = rnf x `seq` rnf y `seq` rnf z
 
--- | Convert a Tag to text, e.g.: AbsoluteMark\tCmd/TimeStep.hs 67 ;" f
-showTag :: Pos TagVal -> Text
-showTag (Pos (SrcPos fn lineno) (Tag text typ)) =
-    T.concat [text, "\t", T.pack fn, "\t", T.pack (show lineno), " ;\" ",
-        T.singleton (showType typ)]
+instance Eq TagVal where
+    TagVal _ name t == TagVal _ name' t' = name == name' && t == t'
 
--- | Vim takes this to be the \"kind:\" annotation.  It's just an arbitrary
--- string and these letters conform to no standard.  Presumably there are some
--- vim extensions that can make use of it.
-showType :: Type -> Char
-showType typ = case typ of
-    Module -> 'm'
-    Function -> 'f'
-    Class -> 'c'
-    Type -> 't'
-    Constructor -> 'C'
+instance Ord TagVal where
+    compare (TagVal _ name t) (TagVal _ name' t') =
+        name `compare` name' <> t `compare` t'
 
--- * types
+-- don't swap constructors since we rely that Type < Constructor == True holds
+data Type =
+    Function
+    | Type
+    | Constructor
+    | Class
+    | Module
+    | Operator
+    | Pattern
+    deriving (Eq, Ord, Show)
 
-data TagVal = Tag !Text !Type
-    deriving (Eq, Show)
+instance NFData Type where
+    rnf t = t `seq` ()
 
-data Type = Module | Function | Class | Type | Constructor
-    deriving (Eq, Show)
+data TokenVal =
+    Token !Text !Text
+    | Newline !Int -- ^ indentation
+    deriving (Show)
 
-data TokenVal = Token !Text | Newline !Int
-    deriving (Eq, Show)
+tokenName :: TokenVal -> Text
+tokenName (Token _ name) = name
+tokenName _              = error "cannot extract name from non-Token TokenVal"
 
-type Tag = Either String (Pos TagVal)
+data Tag =
+    Tag !(Pos TagVal)
+    | RepeatableTag !(Pos TagVal)
+    | Warning !String
+    deriving (Show, Eq, Ord)
+
+partitionTags :: [Tag] -> ([Pos TagVal], [Pos TagVal], [String])
+partitionTags ts = go ts [] [] []
+    where
+    go []                     xs ys zs = (xs, ys, reverse zs)
+    go (Tag t : ts)           xs ys zs = go ts (t:xs) ys     zs
+    go (RepeatableTag t : ts) xs ys zs = go ts xs     (t:ys) zs
+    go (Warning warn : ts)    xs ys zs = go ts xs     ys     (warn:zs)
+
 type Token = Pos TokenVal
 
 -- | Newlines have to remain in the tokens because 'breakBlocks' relies on
@@ -71,7 +117,7 @@
 -- newlines might be anywhere.  A newtype makes sure that the tokens only get
 -- stripped once and that I don't do any pattern matching on unstripped tokens.
 newtype UnstrippedTokens = UnstrippedTokens [Token]
-    deriving (Show, Monoid.Monoid)
+    deriving (Show, Monoid)
 
 mapTokens :: ([Token] -> [Token]) -> UnstrippedTokens -> UnstrippedTokens
 mapTokens f (UnstrippedTokens tokens) = UnstrippedTokens (f tokens)
@@ -79,18 +125,34 @@
 unstrippedTokensOf :: UnstrippedTokens -> [Token]
 unstrippedTokensOf (UnstrippedTokens tokens) = tokens
 
+-- | Drop @n@ non-newline tokens.
+dropTokens :: Int -> UnstrippedTokens -> UnstrippedTokens
+dropTokens n = mapTokens (f n)
+    where
+    f :: Int -> [Token] -> [Token]
+    f 0 xs                       = xs
+    f _ []                       = []
+    f n (Pos _ (Newline _) : xs) = f n xs
+    f n (Pos _ (Token _ _) : xs) = f (n - 1) xs
+
 type Line = Pos Text
 
 data Pos a = Pos {
     posOf :: !SrcPos
     , valOf :: !a
-    }
+    } deriving (Eq, Ord)
 
+instance (NFData a) => NFData (Pos a) where
+    rnf (Pos x y) = rnf x `seq` rnf y
+
 data SrcPos = SrcPos {
-    posFile :: !FilePath
-    , posLine :: !Int
-    } deriving (Eq)
+    _posFile :: !FilePath
+    , posLine  :: !Int
+    } deriving (Eq, Ord)
 
+instance NFData SrcPos where
+    rnf (SrcPos x y) = rnf x `seq` rnf y
+
 instance Show a => Show (Pos a) where
     show (Pos pos val) = show pos ++ ":" ++ show val
 instance Show SrcPos where
@@ -99,44 +161,100 @@
 -- * process
 
 -- | Global processing for when all tags are together.
-processAll :: [Pos TagVal] -> [Pos TagVal]
-processAll = sortDups . dropDups (\t -> (posOf t, tagText t))
-    . sortOn tagText
+processAll :: [[Pos TagVal]] -> [Pos TagVal]
+processAll =
+    sortDups . dropDups isDuplicatePair
+        . combineBalanced (mergeOn tagSortingKey)
+        . map (dropDups isDuplicatePair)
+    where
+    isDuplicatePair :: Pos TagVal -> Pos TagVal -> Bool
+    isDuplicatePair t t' =
+        posOf t == posOf t'
+        && tagText t == tagText t'
+        && tagType t == tagType t'
 
+combineBalanced :: forall a. (a -> a -> a) -> [a] -> a
+combineBalanced f xs = go xs
+    where
+    go :: [a] -> a
+    go [] = error "cannot combine empty list"
+    go xs@(_:_) = case combine xs of
+        []  -> error "unexpected empty list when combining nonempty lists"
+        [x] -> x
+        xs' -> go xs'
+    combine :: [a] -> [a]
+    combine []        = []
+    combine [x]       = [x]
+    combine (x:x':xs) = f x x' : combine xs
+
 -- | Given multiple matches, vim will jump to the first one.  So sort adjacent
 -- tags with the same text by their type.
 --
 -- Mostly this is so that given a type with the same name as its module,
 -- the type will come first.
 sortDups :: [Pos TagVal] -> [Pos TagVal]
-sortDups = concat . sort . List.groupBy (\a b -> tagText a == tagText b)
-    where
-    sort = map (sortOn key)
-    key :: Pos TagVal -> Int
-    key (Pos _ (Tag _ typ)) = case typ of
-        Function -> 0
-        Type -> 1
-        Constructor -> 2
-        Class -> 3
-        Module -> 4
+sortDups = concatMap (sortOn tagType) .  M.elems . M.fromAscListWith (++)
+    . map (fst . tagSortingKey &&& (:[]))
 
 tagText :: Pos TagVal -> Text
-tagText (Pos _ (Tag text _)) = text
+tagText (Pos _ (TagVal _ text _)) = text
 
+tagType :: Pos TagVal -> Type
+tagType (Pos _ (TagVal _ _ t)) = t
+
+tagLine :: Pos TagVal -> Int
+tagLine (Pos (SrcPos _ line) _) = line
+
 -- | Read tags from one file.
-processFile :: FilePath -> IO [Tag]
-processFile fn = fmap (process fn) (Text.IO.readFile fn)
+processFile :: Bool -> FilePath -> Bool -> IO ([Pos TagVal], [String])
+processFile ignoreEncodingErrors fn trackPrefixes =
+    fmap (process fn trackPrefixes) (T.readFile fn)
     `Exception.catch` \(exc :: Exception.SomeException) -> do
         -- readFile will crash on files that are not UTF8.  Unfortunately not
         -- all haskell source file are.
-        IO.hPutStrLn IO.stderr $ "exception reading " ++ show fn ++ ": "
-            ++ show exc
-        return []
+        IO.hPutStrLn IO.stderr $
+            "exception reading " ++ show fn ++ ": " ++ show exc
+        unless ignoreEncodingErrors $
+            void $ Exit.exitFailure
+        return ([], [])
 
+tagSortingKey :: Pos TagVal -> (Text, Type)
+tagSortingKey (Pos _ (TagVal _ name t)) = (name, t)
+
 -- | Process one file's worth of tags.
-process :: FilePath -> Text -> [Tag]
-process fn = concatMap blockTags . breakBlocks . stripComments
-    . Monoid.mconcat . map tokenize . stripCpp . annotate fn
+process :: FilePath -> Bool -> Text -> ([Pos TagVal], [String])
+process fn trackPrefixes =
+    splitAndRemoveRepeats . concatMap blockTags . breakBlocks . stripComments
+        . mconcat . map (tokenize trackPrefixes) . stripCpp . annotate fn
+        . unlit'
+    where
+    splitAndRemoveRepeats :: [Tag] -> ([Pos TagVal], [String])
+    splitAndRemoveRepeats tags =
+        (mergeOn tagSortingKey (sortOn tagSortingKey newTags) earliestRepeats,
+            warnings)
+        where
+        (newTags, repeatableTags, warnings) = partitionTags tags
+        earliestRepeats :: [Pos TagVal]
+        earliestRepeats = M.elems $ M.fromListWith minLine $
+            map (tagSortingKey &&& id) repeatableTags
+        minLine x y
+            | tagLine x < tagLine y = x
+            | otherwise             = y
+    unlit' :: Text -> Text
+    unlit' s
+        | isLiterateFile fn = T.pack $ Unlit.unlit fn $ T.unpack s'
+        | otherwise = s
+        where
+        s' :: Text
+        s'  | "\\begin{code}" `T.isInfixOf` s && "\\end{code}" `T.isInfixOf` s =
+                T.unlines $ filter (not . birdLiterateLine) $ T.lines s
+            | otherwise = s
+        birdLiterateLine :: Text -> Bool
+        birdLiterateLine xs
+            | T.null xs = False
+            | otherwise = case headt $ T.dropWhile Char.isSpace xs of
+                Just '>' -> True
+                _ -> False
 
 -- * tokenize
 
@@ -148,294 +266,673 @@
 stripCpp :: [Line] -> [Line]
 stripCpp = filter $ not . ("#" `T.isPrefixOf`) . valOf
 
-tokenize :: Line -> UnstrippedTokens
-tokenize (Pos pos line) = UnstrippedTokens $ map (Pos pos) (tokenizeLine line)
+tokenize :: Bool -> Line -> UnstrippedTokens
+tokenize trackPrefixes (Pos pos line) =
+  UnstrippedTokens $ map (Pos pos) (tokenizeLine trackPrefixes line)
 
-tokenizeLine :: Text -> [TokenVal]
-tokenizeLine text = Newline nspaces : go line
+spanToken :: Text -> (Text, Text)
+spanToken text
+    | T.null text = ("", "")
+    -- Special case to prevent "--" from consuming too much input so that
+    -- closing "-}" becomes unavailable.
+    | Just rest <- T.stripPrefix "--}" text = ("-}", rest)
+    | Just (sym, rest) <- consume comments text = (sym, rest)
+    -- Find symbol that isn't followed by haskellOpChar.
+    | Just (sym, rest) <- consume symbols text
+            , maybe True (not . haskellOpChar) (headt rest)
+        = (sym, rest)
+    | c == '\'' = let (token, rest) = breakChar cs in (T.cons c token, rest)
+    | c == '"' =
+        let (token, rest) = breakString cs in (T.cons c token, rest)
+    | state@(token, _) <- spanSymbol (haskellOpChar c) text,
+        not (T.null token) = state
+    -- This will tokenize differently than haskell should, e.g., 9x will
+    -- be "9x" not "9" "x".  But I just need a wordlike chunk, not an
+    -- actual token.  Otherwise I'd have to tokenize numbers.
+    | otherwise = case T.span (identChar $ Char.isUpper c) text of
+        ("", _)       -> (T.singleton c, cs)
+        (token, rest) -> (token, rest)
     where
-    nspaces = T.count " " spaces + T.count "\t" spaces * 8
+    -- Safe because of null check above.
+    Just (c, cs) = T.uncons text
+    comments = ["{-", "-}"]
+    symbols = ["--", "=>", "->", "::"]
+
+tokenizeLine :: Bool -> Text -> [TokenVal]
+tokenizeLine trackPrefixes text = Newline nspaces : go spaces line
+    where
+    nspaces = fromIntegral $ T.count " " spaces + T.count "\t" spaces * 8
     (spaces, line) = T.break (not . Char.isSpace) text
-    symbols = ["--", "{-", "-}", "=>", "->", "::"]
-    go unstripped
-        | T.null text = []
-        | Just sym <- List.find (`T.isPrefixOf` text) symbols =
-            Token sym : go (T.drop (T.length sym) text)
-        | c == '\'' = let (token, rest) = breakChar text
-            in Token (T.cons c token) : go rest
-        | c == '"' = go (skipString cs)
-        | (token, rest) <- spanSymbol text, not (T.null token) =
-            Token token : go rest
-        -- This will tokenize differently than haskell should, e.g.
-        -- 9x will be "9x" not "9" "x".  But I just need a wordlike chunk, not
-        -- an actual token.  Otherwise I'd have to tokenize numbers.
-        | otherwise = case T.span identChar text of
-            ("", _) -> Token (T.singleton c) : go cs
-            (token, rest) -> Token token : go rest
-        where
-        text = T.dropWhile Char.isSpace unstripped
-        c = T.head text
-        cs = T.tail text
+    go :: Text -> Text -> [TokenVal]
+    go oldPrefix unstripped
+        | T.null stripped = []
+        | otherwise       =
+            let (token, rest) = spanToken stripped
+                newPrefix     = if trackPrefixes
+                                then oldPrefix <> spaces <> token
+                                else T.empty
+            in Token newPrefix token : go newPrefix rest
+        where (spaces, stripped) = T.break (not . Char.isSpace) unstripped
 
 startIdentChar :: Char -> Bool
 startIdentChar c = Char.isAlpha c || c == '_'
 
-identChar :: Char -> Bool
-identChar c = Char.isAlphaNum c || c == '.' || c == '\'' || c == '_'
+identChar :: Bool -> Char -> Bool
+identChar considerDot c = Char.isAlphaNum c || c == '\'' || c == '_' || c == '#'
+    || considerDot && c == '.'
 
+-- unicode operators are not supported yet
+haskellOpChar :: Char -> Bool
+haskellOpChar c = IntSet.member (Char.ord c) opChars
+    where
+    opChars :: IntSet.IntSet
+    opChars = IntSet.fromList $ map Char.ord "-!#$%&*+./<=>?@^|~:\\"
+
+isTypeVarStart :: Text -> Bool
+isTypeVarStart x = case headt x of
+    Just c -> Char.isLower c || c == '_'
+    _ -> False
+
 -- | Span a symbol, making sure to not eat comments.
-spanSymbol :: Text -> (Text, Text)
-spanSymbol text
-    | any (`T.isPrefixOf` post) [",", "--", "-}", "{-"] = (pre, post)
+spanSymbol :: Bool -> Text -> (Text, Text)
+spanSymbol considerColon text
+    | Just res <- haskellOp text [] = res
+    | any (`T.isPrefixOf` post) [",", "--", "-}", "{-"] = split
     | Just (c, cs) <- T.uncons post, c == '-' || c == '{' =
-        let (pre2, post2) = spanSymbol cs
+        let (pre2, post2) = spanSymbol considerColon cs
         in (pre <> T.cons c pre2, post2)
-    | otherwise = (pre, post)
+    | otherwise = split
     where
-    (pre, post) = T.break (\c -> T.any (==c) "-{," || not (symbolChar c)) text
+    split@(pre, post) = T.break
+        (\c -> T.any (==c) "-{," || not (symbolChar considerColon c)) text
 
-symbolChar :: Char -> Bool
-symbolChar c = Char.isSymbol c || Char.isPunctuation c
+    haskellOp :: Text -> [Char] -> Maybe (Text, Text)
+    haskellOp txt op
+      | Just (c, cs) <- T.uncons txt
+      , haskellOpChar c
+      , not $ "-}" `T.isPrefixOf` txt =
+          haskellOp cs $ c : op
+      | null op   = Nothing
+      | otherwise = Just (T.pack $ reverse op, txt)
 
+symbolChar :: Bool -> Char -> Bool
+symbolChar considerColon c =
+    (Char.isSymbol c || Char.isPunctuation c)
+    && (not (c `elem` "(),;[]`{}_:\"'") || considerColon && c == ':')
+
 breakChar :: Text -> (Text, Text)
-breakChar text
-    | T.null text = ("", "")
-    | T.head text == '\\' = T.splitAt 3 text
-    | otherwise = T.splitAt 2 text
+breakChar text = case headt text of
+    Nothing -> ("", "")
+    Just '\\' -> T.splitAt 3 text
+    _ -> T.splitAt 2 text
 
--- | Skip until the ending double-quote of a string.  Tags never happen in
--- strings so I don't need to keep it.
---
 -- TODO \ continuation isn't supported.  I'd have to tokenize at the file
 -- level instead of the line level.
-skipString :: Text -> Text
-skipString text = case T.uncons (T.dropWhile (not . end) text) of
-    Nothing -> ""
-    Just (c, cs)
-        | c == '"' -> cs
-        | otherwise -> skipString (T.drop 1 cs)
-    where end c = c == '\\' || c == '"'
+breakString :: Text -> (Text, Text)
+breakString = (T.pack . reverse *** T.pack) . go [] . T.unpack
+    where
+    go :: String -> String -> (String, String)
+    go s []             = (s, [])
+    go s ('"':xs)       = ('"': s, xs)
+    go s ('\\':[])      = (s, "\\")
+    -- handle string continuation
+    go s ('\\':'\n':xs) = go s $ dropBackslash $
+        dropWhile (\c -> c /= '\\' && c /= '"') xs
+    go s ('\\':x:xs)    = go (x : '\\': s) xs
+    go s (x:xs)         = go (x : s) xs
 
+    dropBackslash :: String -> String
+    dropBackslash ('\\':xs) = xs
+    dropBackslash xs        = xs
+
 stripComments :: UnstrippedTokens -> UnstrippedTokens
 stripComments = mapTokens (go 0)
     where
     go :: Int -> [Token] -> [Token]
     go _ [] = []
     go nest (pos@(Pos _ token) : rest)
-        | token == Token "--" = go nest (dropLine rest)
-        | token == Token "{-" = go (nest+1) rest
-        | token == Token "-}" = go (nest-1) rest
-        | nest > 0 = go nest rest
-        | otherwise = pos : go nest rest
+        | token `nameStartsWith` "{-"                     = go (nest + 1) rest
+        | token `nameEndsWith` "-}"                       = go (nest - 1) rest
+        | nest == 0 && tokenNameSatisfies token isComment =
+            go nest (dropLine rest)
+        | nest > 0                                        = go nest rest
+        | otherwise                                       = pos : go nest rest
+    dropLine :: [Token] -> [Token]
+    dropLine = dropWhile (not . isNewline)
+    isComment :: Text -> Bool
+    isComment name =
+        "--" `T.isPrefixOf` name
+        && T.all (\c -> not (haskellOpChar c) || c == '-') (T.drop 2 name)
 
 -- | Break the input up into blocks based on indentation.
 breakBlocks :: UnstrippedTokens -> [UnstrippedTokens]
-breakBlocks = map UnstrippedTokens . filter (not . null) . go . filterBlank
-    . unstrippedTokensOf
+breakBlocks =
+    map UnstrippedTokens . filter (not . null)
+        . go . filterBlank . unstrippedTokensOf
     where
-    go [] = []
+    go :: [Token] -> [[Token]]
+    go []     = []
     go tokens = pre : go post
         where (pre, post) = breakBlock tokens
     -- Blank lines mess up the indentation.
+    filterBlank :: [Token] -> [Token]
     filterBlank [] = []
     filterBlank (Pos _ (Newline _) : xs@(Pos _ (Newline _) : _)) =
         filterBlank xs
     filterBlank (x:xs) = x : filterBlank xs
 
 -- | Take until a newline, then take lines until the indent established after
--- that newline decreases.
+-- that newline decreases. Or, alternatively, if "{" is encountered then count
+-- it as a block until closing "}" is found taking nesting into account.
 breakBlock :: [Token] -> ([Token], [Token])
-breakBlock (t@(Pos _ tok):ts) = case tok of
+breakBlock (t@(Pos _ tok) : ts) = case tok of
     Newline indent -> collectIndented indent ts
-    _ -> let (pre, post) = breakBlock ts in (t:pre, post)
+    Token _ "{"    -> collectBracedBlock breakBlock ts 1
+    _              -> remember t $ breakBlock ts
     where
-    collectIndented indent (t@(Pos _ tok) : ts) = case tok of
-        Newline n | n <= indent -> ([], t:ts)
-        _ -> let (pre, post) = collectIndented indent ts in (t:pre, post)
+    collectIndented :: Int -> [Token] -> ([Token], [Token])
+    collectIndented indent tsFull@(t@(Pos _ tok) : ts) = case tok of
+        Newline n | n <= indent -> ([], tsFull)
+        Token _ "{" ->
+            remember t $ collectBracedBlock (collectIndented indent) ts 1
+        _           -> remember t $ collectIndented indent ts
     collectIndented _ [] = ([], [])
-breakBlock [] = ([], [])
 
+    collectBracedBlock :: ([Token] -> ([Token], [Token])) -> [Token] -> Int
+        -> ([Token], [Token])
+    collectBracedBlock _    []                           _ = ([], [])
+    collectBracedBlock cont ts                           0 = cont ts
+    collectBracedBlock cont (t@(Pos _ (Token _ "{")) : ts) n =
+      remember t $ collectBracedBlock cont ts $! n + 1
+    collectBracedBlock cont (t@(Pos _ (Token _ "}")) : ts) n =
+      remember t $ collectBracedBlock cont ts $! n - 1
+    collectBracedBlock cont (t:ts)                       n =
+      remember t $ collectBracedBlock cont ts n
 
+    remember :: Token -> ([Token], [Token]) -> ([Token], [Token])
+    remember t (xs, ys) = (t : xs, ys)
+breakBlock [] = ([], [])
+
 -- * extract tags
 
 -- | Get all the tags in one indented block.
+-- TODO clean this up to require less nesting, and dropDataContext duplication
 blockTags :: UnstrippedTokens -> [Tag]
-blockTags tokens = case stripNewlines tokens of
+blockTags unstripped = case stripNewlines unstripped of
     [] -> []
-    Pos _ (Token "module") : Pos pos (Token name) : _ ->
-        [mktag pos (snd (T.breakOnEnd "." name)) Module]
+    Pos _ (Token _ "module") : Pos pos (Token prefix name) : _ ->
+        [mkTag pos prefix (snd (T.breakOnEnd "." name)) Module]
+    Pos _ (Token _ "pattern") : Pos pos (Token prefix name) : _
+        | maybe False Char.isUpper (headt name) ->
+            [mkTag pos prefix name Pattern]
+    Pos _ (Token _ "foreign") : decl -> foreignTags decl
+    -- newtype instance * = ...
+    Pos _ (Token _ "newtype") : Pos _ (Token _ "instance")
+            : (dropDataContext -> Pos pos _: rest) ->
+        newtypeTags pos rest
     -- newtype X * = X *
-    Pos _ (Token "newtype") : Pos pos (Token name) : rest ->
-        mktag pos name Type : newtypeTags pos rest
+    Pos _ (Token _ "newtype")
+            : (dropDataContext -> whole@(tok@(Pos pos (Token _ name)) : rest))
+        | isTypeName name -> tokToTag tok Type : newtypeTags pos rest
+        | otherwise -> tok' : newtypeTags pos' rest'
+        where (pos', tok', rest') = recordInfixName Type whole
     -- type family X ...
-    Pos _ (Token "type") : Pos _ (Token "family") : Pos pos (Token name) : _ ->
-        [mktag pos name Type]
+    Pos _ (Token _ "type") : Pos _ (Token _ "family")
+            : (dropDataContext -> whole@(tok@(Pos _ (Token _ name)) : _))
+        | isTypeFamilyName name -> [tokToTag tok Type]
+        | otherwise -> [tok']
+        where (_, tok', _) = recordInfixName Type whole
     -- type X * = ...
-    Pos _ (Token "type") : Pos pos (Token name) : _ -> [mktag pos name Type]
+    Pos _ (Token _ "type")
+            : (dropDataContext -> whole@(tok@(Pos _ (Token _ name)) : _))
+        | isTypeName name -> [tokToTag tok Type]
+        | otherwise -> [tok']
+        where (_, tok', _) = recordInfixName Type whole
     -- data family X ...
-    Pos _ (Token "data") : Pos _ (Token "family") : Pos pos (Token name) : _ ->
-        [mktag pos name Type]
+    Pos _ (Token _ "data") : Pos _ (Token _ "family")
+            : (dropDataContext -> tok@(Pos _ (Token _ name)) : rest)
+        | isTypeFamilyName name -> [tokToTag tok Type]
+        | otherwise -> [tok']
+        where (_, tok', _) = recordInfixName Type rest
+    -- data instance * = ...
+    -- data instance * where ...
+    Pos _ (Token _ "data") : Pos _ (Token _ "instance")
+            : (dropDataContext -> Pos pos _: _) ->
+        dataConstructorTags pos (dropTokens 2 unstripped)
     -- data X * = X { X :: *, X :: * }
     -- data X * where ...
-    Pos _ (Token "data") : Pos pos (Token name) : _ ->
-        mktag pos name Type : dataTags pos (mapTokens (drop 2) tokens)
+    Pos _ (Token _ "data")
+            : (dropDataContext -> tok@(Pos pos (Token _ name)) : rest)
+        | isTypeName name -> tokToTag tok Type
+            : dataConstructorTags pos (dropTokens 2 unstripped)
+      -- if token after data is not a type name then it isn't
+      -- infix type as well since it may be only '(' or some
+      -- lowercase name, either of which is not type constructor
+        | otherwise -> let (pos', tok, _) = recordInfixName Type rest
+           in tok : dataConstructorTags pos' (dropTokens 1 unstripped)
     -- class * => X where X :: * ...
-    Pos pos (Token "class") : _ -> classTags pos (mapTokens (drop 1) tokens)
+    Pos pos (Token _ "class") : _ -> classTags pos (dropTokens 1 unstripped)
+
+    Pos _ (Token _ "infix") : _ -> []
+    Pos _ (Token _ "infixl") : _ -> []
+    Pos _ (Token _ "infixr") : _ -> []
+    -- instance * where data * = X :: * ...
+    Pos pos (Token _ "instance") : _ ->
+        instanceTags pos (dropTokens 1 unstripped)
     -- x, y, z :: *
-    stripped -> fst $ functionTags False stripped
+    stripped -> toplevelFunctionTags stripped
 
+isTypeFamilyName :: Text -> Bool
+isTypeFamilyName = maybe False (\c -> Char.isUpper c || haskellOpChar c) . headt
+
+isTypeName  :: Text -> Bool
+isTypeName x = case headt x of
+    Just c -> Char.isUpper c || c == ':'
+    _ -> False
+
+dropDataContext :: [Token] -> [Token]
+dropDataContext = stripParensKindsTypeVars . stripOptContext
+
+recordInfixName :: Type -> [Token] -> (SrcPos, Tag, [Token])
+recordInfixName tokenType tokens = (pos, tokToTag tok tokenType, rest)
+    where (tok@(Pos pos _) : rest) = dropInfixTypeStart tokens
+
+-- same as dropWhile with counting
+dropInfixTypeStart :: [Token] -> [Token]
+dropInfixTypeStart tokens = dropWhile f tokens
+    where
+    f (Pos _ (Token _ name)) = isInfixTypePrefix name || name == "`"
+    f _                      = False
+
+    isInfixTypePrefix :: Text -> Bool
+    isInfixTypePrefix =
+        maybe False ((\c -> Char.isLower c || c == '(')) . headt
+
 -- | It's easier to scan for tokens without pesky newlines popping up
 -- everywhere.  But I need to keep the newlines in in case I hit a @where@
 -- and need to call 'breakBlocks' again.
 stripNewlines :: UnstrippedTokens -> [Token]
 stripNewlines = filter (not . isNewline) . (\(UnstrippedTokens t) -> t)
 
+-- | Tags from foreign import.
+--
+-- e.g. @foreign import ccall safe \"name\" c_name :: ...@ will produce a tag
+-- for @c_name@.
+foreignTags :: [Token] -> [Tag]
+foreignTags decl = case decl of
+    Pos _ (Token _ "import") : decl'
+        | name : _ <- dropBefore ((=="::") . tokenName . valOf) decl' ->
+            [tokToTag name Pattern]
+    _ -> []
+
+toplevelFunctionTags :: [Token] -> [Tag]
+toplevelFunctionTags toks = case tags of
+    -- Tags of toplevel functions are all repeatable, even the ones that come
+    -- from the type signature because there will definitely be tags from the
+    -- body and they should be sorted out if type signature is present.
+    [] -> functionTagsNoSig toks
+    _  -> map toRepeatableTag $ tags
+    where
+    -- first try to detect tags from type signature, if it fails then
+    -- do the actual work of detecting from body
+    (tags, _) = functionTags False toks
+    toRepeatableTag :: Tag -> Tag
+    toRepeatableTag (Tag t) = RepeatableTag t
+    toRepeatableTag t       = t
+
+functionTagsNoSig :: [Token] -> [Tag]
+functionTagsNoSig toks = go toks
+    where
+    go :: [Token] -> [Tag]
+    go []                           = []
+    go toks@(Pos _ (Token _ "(") : _) = go $ stripBalancedParens toks
+    go (Pos pos (Token prefix name) : ts)
+        -- this function does not analyze type signatures
+        | name == "::" = []
+        | name == "!" || name == "~" || name == "@" = go ts
+        | name == "=" || name == "|" = case stripParens toks of
+            Pos pos (Token prefix name) : _
+                | functionName False name  ->
+                    [mkRepeatableTag pos prefix name Function]
+                | T.all haskellOpChar name ->
+                    [mkRepeatableTag pos prefix name Operator]
+            _ -> []
+        | name == "`" = case ts of
+            Pos pos' (Token prefix' name') : _
+                | functionName False name' ->
+                    [mkRepeatableTag pos' prefix' name' Function]
+            _ -> go ts
+      | T.all haskellOpChar name   = [mkRepeatableTag pos prefix name Operator]
+      | otherwise                  = go ts
+    stripParens :: [Token] -> [Token]
+    stripParens = dropWhile ((`hasName` "(") . valOf)
+
 -- | Get tags from a function type declaration: token , token , token ::
 -- Return the tokens left over.
 functionTags :: Bool -- ^ expect constructors, not functions
     -> [Token] -> ([Tag], [Token])
 functionTags constructors = go []
     where
-    go tags (Pos pos (Token name) : Pos _ (Token "::") : rest)
-        | Just name <- functionName constructors name =
-            (reverse $ mktag pos name Function : tags, rest)
-    go tags (Pos pos (Token name) : Pos _ (Token ",") : rest)
-            | Just name <- functionName constructors name =
-        go (mktag pos name Function : tags) rest
+    opTag   = if constructors then Constructor else Operator
+    funcTag = if constructors then Constructor else Function
+    go :: [Tag] -> [Token] -> ([Tag], [Token])
+    go tags (Pos _ (Token _ "(") : Pos pos (Token _ name)
+            : Pos _ (Token prefix ")") : Pos _ (Token _ "::") : rest) =
+        (reverse $ mkTag pos prefix name opTag : tags, rest)
+    go tags (Pos pos (Token prefix name) : Pos _ (Token _ "::") : rest)
+        | functionName constructors name =
+            (reverse $ mkTag pos prefix name funcTag : tags, rest)
+    go tags (Pos _ (Token _ "(") : Pos pos (Token _ name)
+            : Pos _ (Token prefix ")") : Pos _ (Token _ ",") : rest) =
+        go (mkTag pos prefix name opTag : tags) rest
+    go tags (Pos pos (Token prefix name) : Pos _ (Token _ ",") : rest)
+        | functionName constructors name =
+            go (mkTag pos prefix name funcTag : tags) rest
     go tags tokens = (tags, tokens)
 
-functionName :: Bool -> Text -> Maybe Text
-functionName constructors text
-    | isFunction text = Just text
-    | isOperator text && not (T.null stripped) = Just stripped
-    | otherwise = Nothing
+functionName :: Bool -> Text -> Bool
+functionName constructors text = isFunction text
     where
     isFunction text = case T.uncons text of
-        Just (c, cs) -> firstChar c && startIdentChar c && T.all identChar cs
-        Nothing -> False
-    firstChar = if constructors then Char.isUpper else not . Char.isUpper
-    -- Technically I could insist on colons if constructors is True, but
-    -- let's let ghc decide about the syntax.
-    isOperator text = "(" `T.isPrefixOf` text && ")" `T.isSuffixOf` text
-        && T.all symbolChar stripped
-    stripped = T.drop 1 $ T.take (T.length text - 1) text
+        Just (c, cs) ->
+            firstChar c && startIdentChar c && T.all (identChar True) cs
+        Nothing      -> False
+    firstChar = if constructors
+                then Char.isUpper
+                else \c -> Char.isLower c || c == '_'
 
 -- | * = X *
 newtypeTags :: SrcPos -> [Token] -> [Tag]
 newtypeTags prevPos tokens = case dropUntil "=" tokens of
-    Pos pos (Token name) : _ -> [mktag pos name Constructor]
+    Pos pos (Token prefix name) : rest ->
+        let constructor = mkTag pos prefix name Constructor
+        in  case rest of
+            Pos _ (Token _ "{") : Pos funcPos (Token funcPrefix funcName) : _ ->
+                [constructor, mkTag funcPos funcPrefix funcName Function]
+            _ ->
+                [constructor]
     rest -> unexpected prevPos (UnstrippedTokens tokens) rest "newtype * ="
 
 -- | [] (empty data declaration)
 -- * = X { X :: *, X :: * }
 -- * where X :: * X :: *
 -- * = X | X
-dataTags :: SrcPos -> UnstrippedTokens -> [Tag]
-dataTags prevPos unstripped
-    | any ((== Token "where") . valOf) (unstrippedTokensOf unstripped) =
+dataConstructorTags :: SrcPos -> UnstrippedTokens -> [Tag]
+dataConstructorTags prevPos unstripped
+    -- GADT
+    | any ((`hasName` "where") . valOf) (unstrippedTokensOf unstripped) =
         concatMap gadtTags (whereBlock unstripped)
-    | otherwise = case dropUntil "=" (stripNewlines unstripped) of
+    -- plain ADT
+    | otherwise = case strip unstripped of
         [] -> [] -- empty data declaration
-        Pos pos (Token name) : rest ->
-            mktag pos name Constructor : collectRest rest
+        rest | Just (Pos pos (Token prefix name), rest') <-
+                extractInfixConstructor rest ->
+            mkTag pos prefix name Constructor : collectRest rest'
+        Pos pos (Token prefix name) : rest ->
+            mkTag pos prefix name Constructor : collectRest rest
         rest -> unexpected prevPos unstripped rest "data * ="
     where
+    strip = stripOptBang . stripOptContext . stripOptForall . dropUntil "="
+         . stripNewlines
+    collectRest :: [Token] -> [Tag]
     collectRest tokens
         | (tags@(_:_), rest) <- functionTags False tokens =
-            tags ++ collectRest rest
-    collectRest (Pos _ (Token "|") : Pos pos (Token name) : rest) =
-        mktag pos name Constructor : collectRest rest
+            tags ++ collectRest (dropUntilNextField rest)
+    collectRest (Pos pipePos (Token _ "|") : rest)
+        | Just (Pos pos (Token prefix name), rest'') <-
+                extractInfixConstructor rest' =
+            mkTag pos prefix name Constructor : collectRest rest''
+        | Pos pos (Token prefix name) : rest'' <- rest' =
+            mkTag pos prefix name Constructor
+                : collectRest (dropUntilNextCaseOrRecordStart rest'')
+        | otherwise = error $
+            printf "syntax error@%d: | not followed by tokens\n"
+                (posLine pipePos)
+        where
+        rest' = stripOptBang $ stripOptContext $ stripOptForall rest
     collectRest (_ : rest) = collectRest rest
     collectRest [] = []
 
+    stripOptBang :: [Token] -> [Token]
+    stripOptBang ((Pos _ (Token _ "!")) : rest) = rest
+    stripOptBang ts = ts
+
+    extractInfixConstructor :: [Token] -> Maybe (Token, [Token])
+    extractInfixConstructor = extract . stripTypeParam
+        where
+        extract :: [Token] -> Maybe (Token, [Token])
+        extract (tok@(Pos _ (Token _ name)) : rest)
+            | ":" `T.isPrefixOf` name = Just (tok, stripTypeParam rest)
+        extract (Pos _ (Token _ "`") : tok@(Pos _ _) : Pos _ (Token _ "`")
+                : rest) =
+            Just (tok, stripTypeParam rest)
+        extract _ = Nothing
+        stripTypeParam :: [Token] -> [Token]
+        stripTypeParam input@((Pos _ (Token _ "(")) : _) =
+            stripBalancedParens input
+        stripTypeParam input@((Pos _ (Token _ "[")) : _) =
+            stripBalancedBrackets input
+        stripTypeParam ts = drop 1 ts
+
+    dropUntilNextCaseOrRecordStart :: [Token] -> [Token]
+    dropUntilNextCaseOrRecordStart =
+        dropWithStrippingBalanced (\x -> not $ x == "|" || x == "{")
+
+    dropUntilNextField :: [Token] -> [Token]
+    dropUntilNextField =
+        dropWithStrippingBalanced (\x -> not $ x == "," || x == "}" || x == "|")
+
+stripOptForall :: [Token] -> [Token]
+stripOptForall (Pos _ (Token _ "forall") : rest) = dropUntil "." rest
+stripOptForall xs                               = xs
+
+stripParensKindsTypeVars :: [Token] -> [Token]
+stripParensKindsTypeVars (Pos _ (Token _ "(") : xs)  =
+    stripParensKindsTypeVars xs
+stripParensKindsTypeVars (Pos _ (Token _ "::") : xs) =
+    stripParensKindsTypeVars $ tail $ dropWithStrippingBalanced (/= ")") xs
+stripParensKindsTypeVars (Pos _ (Token _ name) : xs)
+    | isTypeVarStart name = stripParensKindsTypeVars xs
+stripParensKindsTypeVars xs = xs
+
+stripOptContext :: [Token] -> [Token]
+stripOptContext (stripBalancedParens -> (Pos _ (Token _ "=>") : xs)) = xs
+stripOptContext (stripSingleClassContext -> Pos _ (Token _ "=>") : xs) = xs
+stripOptContext xs = xs
+
+stripSingleClassContext :: [Token] -> [Token]
+stripSingleClassContext (Pos _ (Token _ name) : xs)
+    | maybe False Char.isUpper (headt name) =
+        dropWithStrippingBalanced isTypeVarStart xs
+stripSingleClassContext xs = xs
+
+-- | Drop all tokens for which @pred@ returns True, also drop
+-- any parenthesized expressions.
+dropWithStrippingBalanced :: (Text -> Bool) -> [Token] -> [Token]
+dropWithStrippingBalanced pred input@(Pos _ (Token _ name) : xs)
+    | name == "(" = dropWithStrippingBalanced pred $ stripBalancedParens input
+    | name == "[" = dropWithStrippingBalanced pred $ stripBalancedBrackets input
+    | pred name   = dropWithStrippingBalanced pred xs
+dropWithStrippingBalanced _ xs = xs
+
+stripBalancedParens :: [Token] -> [Token]
+stripBalancedParens = stripBalanced "(" ")"
+
+stripBalancedBrackets :: [Token] -> [Token]
+stripBalancedBrackets = stripBalanced "[" "]"
+
+stripBalanced :: Text -> Text -> [Token] -> [Token]
+stripBalanced open close (Pos _ (Token _ name) : xs)
+    | name == open = go 1 xs
+    where
+    go :: Int -> [Token] -> [Token]
+    go 0 xs = xs
+    go !n (Pos _ (Token _ name) : xs)
+        | name == open  = go (n + 1) xs
+        | name == close = go (n - 1) xs
+        | otherwise     = go n       xs
+    go n (_: xs)                     = go n xs
+    go _ []                          = []
+stripBalanced _ _ xs = xs
+
 gadtTags :: UnstrippedTokens -> [Tag]
 gadtTags = fst . functionTags True . stripNewlines
 
 -- | * => X where X :: * ...
 classTags :: SrcPos -> UnstrippedTokens -> [Tag]
-classTags prevPos unstripped = case dropContext (stripNewlines unstripped) of
-    Pos pos (Token name) : _ ->
-        -- Drop the where and start expecting functions.
-        mktag pos name Class : concatMap classBodyTags (whereBlock unstripped)
-    rest -> unexpected prevPos unstripped rest "class * =>"
-    where
-    dropContext tokens
-        | any ((== Token "=>") . valOf) (takeUntil "where" tokens) =
-            dropUntil "=>" tokens
-        | otherwise = tokens
+classTags prevPos unstripped =
+    case dropDataContext $ stripNewlines unstripped of
+        whole@(tok@(Pos _ (Token _ name)) : _)
+          -- Drop the where and start expecting functions.
+            | isTypeName name -> tokToTag tok Class : cont
+            | otherwise ->
+                let (_, tok, _) = recordInfixName Class whole
+                in tok : concatMap classBodyTags (whereBlock unstripped)
+            where cont = concatMap classBodyTags (whereBlock unstripped)
+        rest -> unexpected prevPos unstripped rest "class * =>"
 
 classBodyTags :: UnstrippedTokens -> [Tag]
 classBodyTags unstripped = case stripNewlines unstripped of
-    Pos _ (Token typedata) : Pos pos (Token name) : _
-        | typedata `elem` ["type", "data"] -> [mktag pos name Type]
+    Pos _ (Token _ typedata) : Pos pos (Token prefix name) : _
+        | typedata `elem` ["type", "data"] -> [mkTag pos prefix name Type]
     tokens -> fst $ functionTags False tokens
 
 -- | Skip to the where and split the indented block below it.
 whereBlock :: UnstrippedTokens -> [UnstrippedTokens]
 whereBlock = breakBlocks . mapTokens (dropUntil "where")
 
+instanceTags :: SrcPos -> UnstrippedTokens -> [Tag]
+instanceTags prevPos unstripped =
+    -- instances can offer nothing but some fresh data constructors since
+    -- the actual datatype is really declared in the class declaration
+    concatMap (newtypeTags prevPos . unstrippedTokensOf)
+        (filter isNewtypeDecl block)
+    ++ concatMap (dataConstructorTags prevPos)
+        (filter isDataDecl block)
+    where
+    block = whereBlock unstripped
 
+    isNewtypeDecl :: UnstrippedTokens -> Bool
+    isNewtypeDecl (UnstrippedTokens (Pos _ (Token _ "newtype") : _)) = True
+    isNewtypeDecl _ = False
+
+    isDataDecl :: UnstrippedTokens -> Bool
+    isDataDecl (UnstrippedTokens (Pos _ (Token _ "data") : _)) = True
+    isDataDecl _ = False
+
 -- * util
 
-mktag :: SrcPos -> Text -> Type -> Tag
-mktag pos name typ = Right $ Pos pos (Tag name typ)
+mkTag :: SrcPos -> Text -> Text -> Type -> Tag
+mkTag pos prefix name typ = Tag $ Pos pos (TagVal prefix name typ)
 
+mkRepeatableTag :: SrcPos -> Text -> Text -> Type -> Tag
+mkRepeatableTag pos prefix name typ =
+    RepeatableTag $ Pos pos (TagVal prefix name typ)
+
+tokToTag :: Token -> Type -> Tag
+tokToTag (Pos pos (Token prefix name)) t = mkTag pos prefix name t
+
 warning :: SrcPos -> String -> Tag
-warning pos warn = Left $ show pos ++ ": " ++ warn
+warning pos warn = Warning $ show pos ++ ": " ++ warn
 
 unexpected :: SrcPos -> UnstrippedTokens -> [Token] -> String -> [Tag]
 unexpected prevPos (UnstrippedTokens tokensBefore) tokensHere declaration =
     [warning pos ("unexpected " ++ thing ++ " after " ++ declaration)]
     where
-    thing = if null tokensHere then "end of block"
-        else show (valOf (head tokensHere))
+    thing = maybe "end of block" (show . valOf) (mhead tokensHere)
     pos
-        | not (null tokensHere) = posOf (head tokensHere)
-        | not (null tokensBefore) = posOf (last tokensBefore)
+        | Just t <- mhead tokensHere = posOf t
+        | Just t <- mlast tokensBefore = posOf t
         | otherwise = prevPos
 
-dropLine :: [Token] -> [Token]
-dropLine = drop 1 . dropWhile (not . isNewline)
-
 isNewline :: Token -> Bool
 isNewline (Pos _ (Newline _)) = True
-isNewline _ = False
+isNewline _                   = False
 
--- | Drop until a token, then drop that token.
-dropUntil :: Text -> [Token] -> [Token]
-dropUntil token = drop 1 . dropWhile ((/= Token token) . valOf)
+hasName :: TokenVal -> Text -> Bool
+hasName tok text = tokenNameSatisfies tok (== text)
 
--- | Take until, but not including, a token.
-takeUntil :: Text -> [Token] -> [Token]
-takeUntil token = takeWhile ((/= Token token) . valOf)
+nameStartsWith :: TokenVal -> Text -> Bool
+nameStartsWith tok text = tokenNameSatisfies tok (text `T.isPrefixOf`)
 
+nameEndsWith :: TokenVal -> Text -> Bool
+nameEndsWith tok text = tokenNameSatisfies tok (text `T.isSuffixOf`)
 
--- * misc
+tokenNameSatisfies :: TokenVal -> (Text -> Bool) -> Bool
+tokenNameSatisfies (Token _ name) pred = pred name
+tokenNameSatisfies _              _    = False
 
-tracem :: Show a => String -> a -> a
-tracem msg x = Trace.trace (msg ++ ": " ++ show x) x
+-- * generic utils
 
--- | If @op@ raised ENOENT, return Nothing.
-catchENOENT :: IO a -> IO (Maybe a)
-catchENOENT op = Exception.handleJust (guard . IO.Error.isDoesNotExistError)
-    (const (return Nothing)) (fmap Just op)
+-- | Try to match one of the given prefixes.
+consume :: [Text] -> Text -> Maybe (Text, Text) -- ^ (prefix, remainder)
+consume prefixes t =
+    msum [(,) prefix <$> T.stripPrefix prefix t | prefix <- prefixes]
 
-dropDups :: Eq k => (a -> k) -> [a] -> [a]
-dropDups key (x:xs) = go x xs
+-- | Drop until the element before the matching one.  Return [] if the function
+-- never matches.
+dropBefore :: (a -> Bool) -> [a] -> [a]
+dropBefore f = go
     where
+    go [] = []
+    go [_] = []
+    go xs@(_ : rest@(y:_))
+        | f y = xs
+        | otherwise = go rest
+
+dropDups :: (a -> a -> Bool) -> [a] -> [a]
+dropDups cmp (x:xs) = go x xs
+    where
     go a [] = [a]
     go a (b:bs)
-        | key a == key b = go a bs
+        | cmp a b   = go a bs
         | otherwise = a : go b bs
 dropDups _ [] = []
 
-sortOn :: Ord k => (a -> k) -> [a] -> [a]
-sortOn key = List.sortBy (\a b -> compare (key a) (key b))
+dropUntil :: Text -> [Token] -> [Token]
+dropUntil token = drop 1 . dropWhile (not . (`hasName` token) . valOf)
 
--- | Merge sorted lists.
+sortOn :: (Ord k) => (a -> k) -> [a] -> [a]
+sortOn key = L.sortBy (compare `on` key)
+
+-- | Split list into chunks delimited by specified element.
+split :: (Eq a) => a -> [a] -> [[a]]
+split _ [] = []
+split x xs = xs': split x (drop 1 xs'')
+    where (xs', xs'') = break (==x) xs
+
+-- | Crude predicate for Haskell files
+isHsFile :: FilePath -> Bool
+isHsFile fn =
+  ".hs" `L.isSuffixOf` fn  || ".hsc" `L.isSuffixOf` fn || isLiterateFile fn
+
+isLiterateFile :: FilePath -> Bool
+isLiterateFile fn = ".lhs" `L.isSuffixOf` fn
+
 merge :: Ord a => [a] -> [a] -> [a]
-merge [] ys = ys
-merge xs [] = xs
-merge (x:xs) (y:ys)
-    | x <= y = x : merge xs (y:ys)
-    | otherwise = y : merge (x:xs) ys
+merge = mergeBy compare
+
+mergeOn :: (Ord b) => (a -> b) -> [a] -> [a] -> [a]
+mergeOn f = mergeBy (compare `on` f)
+
+mergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
+mergeBy f xs ys = go xs ys
+    where
+    go []     ys     = ys
+    go xs     []     = xs
+    go (x:xs) (y:ys) = case f x y of
+        EQ -> x: y: go xs ys
+        LT -> x: go xs (y:ys)
+        GT -> y: go (x:xs) ys
+
+headt :: Text -> Maybe Char
+headt = fmap fst . T.uncons
+
+mhead :: [a] -> Maybe a
+mhead [] = Nothing
+mhead (x:_) = Just x
+
+mlast :: [a] -> Maybe a
+mlast xs
+    | null xs = Nothing
+    | otherwise = Just (last xs)
diff --git a/src/Main.hs b/src/Main.hs
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {- | Tagify haskell source.
 
@@ -6,16 +7,26 @@
     hsc. That way I can hook it to the editor's save action and always keep
     the tags up to date.
 -}
-module Main where
+module Main (main) where
+import Control.Applicative
 import Control.Monad
-import qualified Data.Either as Either
+import Data.Map (Map)
+import Data.Monoid
+import Data.Set (Set)
+import Data.Text (Text)
+import System.Console.GetOpt
+import System.Directory
+    (doesFileExist, doesDirectoryExist, getDirectoryContents)
+import System.FilePath ((</>))
+import qualified System.Exit as Exit
 import qualified Data.List as List
+import qualified Data.Map as Map
+import qualified Data.Set as Set
 import qualified Data.Text as Text
 import qualified Data.Text.IO as Text.IO
 
 import qualified System.Console.GetOpt as GetOpt
 import qualified System.Environment as Environment
-import qualified System.Exit
 import qualified System.IO as IO
 
 import FastTags
@@ -24,52 +35,202 @@
 main :: IO ()
 main = do
     args <- Environment.getArgs
-    (flags, inputs) <- case GetOpt.getOpt GetOpt.Permute options args of
+
+    (flags, inputs) <- case getOpt Permute options args of
         (flags, inputs, []) -> return (flags, inputs)
-        (_, _, errs) -> usage $ "flag errors:\n" ++ List.intercalate ", " errs
+        (_, _, errs) ->
+            let errMsg = "flag errors:\n" ++ List.intercalate ", " errs
+            in usage $ errMsg ++ "\n" ++ help
+
+    when (Help `elem` flags) $ usage help
+
+    let verbose       = Verbose `elem` flags
+        emacs         = ETags `elem` flags
+        vim           = not emacs
+        trackPrefixes = emacs
+        recurse       = Recurse `elem` flags
+        output        = last $ defaultOutput : [fn | Output fn <- flags]
+        noMerge       = NoMerge `elem` flags
+        useZeroSep    = ZeroSep `elem` flags
+        ignoreEncErrs = IgnoreEncodingErrors `elem` flags
+        sep           = if useZeroSep then '\0' else '\n'
+        defaultOutput = if vim then "tags" else "TAGS"
+        inputsM       = if null inputs
+                        then split sep <$> getContents
+                        else fmap concat $ forM inputs $ \input -> do
+                            -- if an input is a directory then we find the
+                            -- haskell files inside it, optionally recursing
+                            -- further if the -R switch is specified
+                            isDirectory <- doesDirectoryExist input
+                            if isDirectory
+                                then filter isHsFile <$> contents recurse input
+                                else return [input]
+
+    oldTags <- if vim && not noMerge
+        then do
+            exists <- doesFileExist output
+            if exists
+                then Text.lines <$> Text.IO.readFile output
+                else return [vimMagicLine]
+        else return [] -- we do not support tags merging for emacs for now
+
+    inputs <- inputsM
     when (null inputs) $
-        usage "no input files\n"
-    let output = last $ "tags" : [fn | Output fn <- flags]
-        verbose = Verbose `elem` flags
-    oldTags <- fmap (maybe [vimMagicLine] Text.lines) $
-        catchENOENT $ Text.IO.readFile output
+        usage "no input files on either command line or stdin\n"
     -- This will merge and sort the new tags.  But I don't run it on the
     -- the result of merging the old and new tags, so tags from another
     -- file won't be sorted properly.  To do that I'd have to parse all the
     -- old tags and run processAll on all of them, which is a hassle.
     -- TODO try it and see if it really hurts performance that much.
-    newTags <- fmap (processAll . concat) $
+    newTags <- fmap processAll $
         forM (zip [0..] inputs) $ \(i :: Int, fn) -> do
-            tags <- processFile fn
-            -- This has the side-effect of forcing the the tags, which is
-            -- essential if I'm tagging a lot of files at once.
-            let (warnings, newTags) = Either.partitionEithers tags
-            forM_ warnings $ \warn -> do
-                IO.hPutStrLn IO.stderr warn
+            (newTags, warnings) <- processFile ignoreEncErrs fn trackPrefixes
+            forM_ warnings printErr
             when verbose $ do
-                let line = show i ++ " of " ++ show (length inputs - 1)
-                        ++ ": " ++ fn
+                let line = take 78 $ show i ++ ": " ++ fn
                 putStr $ '\r' : line ++ replicate (78 - length line) ' '
                 IO.hFlush IO.stdout
             return newTags
+
     when verbose $ putChar '\n'
 
-    let write = if output == "-" then Text.IO.hPutStr IO.stdout
+    let write = if output == "-"
+            then Text.IO.hPutStr IO.stdout
             else Text.IO.writeFile output
-    write $ Text.unlines (mergeTags inputs oldTags newTags)
+
+    write $ if vim
+        then Text.unlines $ mergeTags inputs oldTags newTags
+        else Text.concat $ prepareEmacsTags newTags
+
     where
-    usage msg = do
-        putStr $ GetOpt.usageInfo
-            (msg ++ "\nusage: fast-tags file1 file2 ...") options
-        System.Exit.exitFailure
+    usage msg = putStr (GetOpt.usageInfo msg options) >> Exit.exitFailure
 
-data Flag = Output FilePath | Verbose
+    printErr :: String -> IO ()
+    printErr = IO.hPutStrLn IO.stderr
+
+    contents recurse =
+        if recurse then getRecursiveDirContents else getProperDirContents
+
+-- | Get all absolute filepaths contained in the supplied topdir,
+-- except "." and ".."
+getProperDirContents :: FilePath -> IO [FilePath]
+getProperDirContents topdir = do
+    names <- getDirectoryContents topdir
+    let properNames = filter (`notElem` [".", ".."]) names
+    return $ map ((</>) topdir) properNames
+
+-- | Recurse directories collecting all files
+getRecursiveDirContents :: FilePath -> IO [FilePath]
+getRecursiveDirContents topdir = do
+    paths <- getProperDirContents topdir
+    paths' <- forM paths $ \path -> do
+        isDirectory <- doesDirectoryExist path
+        if isDirectory
+            then getRecursiveDirContents path
+            else return [path]
+    return (concat paths')
+
+
+type TagsTable = Map FilePath [Pos TagVal]
+
+prepareEmacsTags :: [Pos TagVal] -> [Text]
+prepareEmacsTags = printTagsTable . classifyTagsByFile
+
+printTagsTable :: TagsTable -> [Text]
+printTagsTable = map (uncurry printSection) . Map.assocs
+
+printSection :: FilePath -> [Pos TagVal] -> Text
+printSection file tags = Text.concat
+    ["\x0c\x0a", Text.pack file, ","
+    , Text.pack $ show tagsLength, "\x0a", tagsText
+    ]
+    where
+    tagsText = Text.unlines $ map printEmacsTag tags
+    tagsLength = Text.length tagsText
+
+printEmacsTag :: Pos TagVal -> Text
+printEmacsTag (Pos (SrcPos _file line) (TagVal prefix _text _type)) =
+  Text.concat [prefix, "\x7f", Text.pack (show line)]
+
+classifyTagsByFile :: [Pos TagVal] -> TagsTable
+classifyTagsByFile = foldr insertTag Map.empty
+
+insertTag :: Pos TagVal -> TagsTable -> TagsTable
+insertTag tag@(Pos (SrcPos file _) _) table =
+    Map.insertWith (<>) file [tag] table
+
+mergeTags :: [FilePath] -> [Text] -> [Pos TagVal] -> [Text]
+mergeTags inputs old new =
+    -- 'new' was already been sorted by 'process', but then I just concat
+    -- the tags from each file, so they need sorting again.
+    merge (map showTag new) (filter (not . isNewTag textFns) old)
+    where
+    textFns = Set.fromList $ map Text.pack inputs
+
+data Flag = Output FilePath
+    | Help
+    | Verbose
+    | ETags
+    | Recurse
+    | NoMerge
+    | ZeroSep
+    | IgnoreEncodingErrors
     deriving (Eq, Show)
 
-options :: [GetOpt.OptDescr Flag]
+help :: String
+help = "usage: fast-tags [options] [filenames]\n" ++
+       "In case no filenames provided on commandline, fast-tags expects " ++
+       "list of files separated by newlines in stdin."
+
+options :: [OptDescr Flag]
 options =
-    [ GetOpt.Option ['o'] [] (GetOpt.ReqArg Output "filename")
+    [ Option ['h'] ["help"] (NoArg Help)
+        "print help message"
+    , Option ['o'] [] (ReqArg Output "file")
         "output file, defaults to 'tags'"
-    , GetOpt.Option ['v'] [] (GetOpt.NoArg Verbose)
+    , Option ['e'] [] (NoArg ETags)
+        "print tags in Emacs format"
+    , Option ['v'] [] (NoArg Verbose)
         "print files as they are tagged, useful to track down slow files"
+    , Option ['R'] [] (NoArg Recurse)
+        "read all files under any specified directories recursively"
+    , Option ['0'] [] (NoArg ZeroSep)
+        "expect list of file names in stdin to be 0-separated."
+    , Option [] ["nomerge"] (NoArg NoMerge)
+        "do not merge tag files"
+    , Option [] ["ignore-encoding-errors"] (NoArg IgnoreEncodingErrors)
+        "do exit on utf8 encoding error and continue processing other files"
     ]
+
+-- | Documented in vim :h tags-file-format.
+-- This tells vim that the file is sorted (but not case folded) so that
+-- it can do a bsearch and never needs to fall back to linear search.
+vimMagicLine :: Text
+vimMagicLine = "!_TAG_FILE_SORTED\t1\t~"
+
+isNewTag :: Set Text -> Text -> Bool
+isNewTag textFns line = Set.member fn textFns
+    where
+    fn = Text.takeWhile (/='\t') $ Text.drop 1 $ Text.dropWhile (/='\t') line
+
+-- | Convert a Tag to text, e.g.: AbsoluteMark\tCmd/TimeStep.hs 67 ;" f
+showTag :: Pos TagVal -> Text
+showTag (Pos (SrcPos fn lineno) (TagVal _ text typ)) = Text.concat
+    [ text, "\t"
+    , Text.pack fn, "\t"
+    , Text.pack (show lineno), " ;\" "
+    , Text.singleton (showType typ)
+    ]
+
+-- | Vim takes this to be the \"kind:\" annotation.  It's just an arbitrary
+-- string and these letters conform to no standard.  Presumably there are some
+-- vim extensions that can make use of it.
+showType :: Type -> Char
+showType typ = case typ of
+    Module      -> 'm'
+    Function    -> 'f'
+    Class       -> 'c'
+    Type        -> 't'
+    Constructor -> 'C'
+    Operator    -> 'o'
+    Pattern     -> 'p'
diff --git a/tests/MainTest.hs b/tests/MainTest.hs
new file mode 100644
--- /dev/null
+++ b/tests/MainTest.hs
@@ -0,0 +1,655 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module MainTest where
+
+import qualified Control.Exception as Exception
+import Control.Monad
+import qualified Data.Either as Either
+import qualified Data.Monoid as Monoid
+import Data.Text (Text)
+import qualified Data.Text as T
+
+import Control.Exception (assert)
+import qualified System.IO.Unsafe as Unsafe
+
+import qualified FastTags
+import FastTags (UnstrippedTokens(..), TokenVal(..), TagVal(..), Type(..), Tag, Pos(..))
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+main :: IO ()
+main = defaultMain tests
+
+
+tests :: TestTree
+tests = testGroup "tests"
+  [ testTokenize
+  , testSkipString
+  , testStripComments
+  , testBreakBlocks
+  , testProcessAll
+  , testProcess
+  ]
+
+test :: (Show a, Eq b, Show b) => (a -> b) -> a -> b -> TestTree
+test f x expected = testCase (take 70 $ show x) $ f x @?= expected
+
+testTokenize :: TestTree
+testTokenize = testGroup "tokenize"
+  [ "a::b->c"           ==> ["a", "::", "b", "->", "c"]
+  , "x{-\n  bc#-}\n"    ==> ["x", "{-", "nl 2", "bc#", "-}"]
+  , "X.Y"               ==> ["X.Y"]
+  , "x9"                ==> ["x9"]
+  -- , "9x" ==> ["nl 0", "9", "x"]
+  , "x :+: y"           ==> ["x", ":+:", "y"]
+  , "(#$)"              ==> ["(", "#$", ")"]
+  , "Data.Map.map"      ==> ["Data.Map.map"]
+  , "Map.map"           ==> ["Map.map"]
+  , "forall a. f a"     ==> ["forall", "a", ".", "f", "a"]
+  , "forall a . Foo"    ==> ["forall", "a", ".", "Foo"]
+  , "forall a. Foo"     ==> ["forall", "a", ".", "Foo"]
+  , "forall a .Foo"     ==> ["forall", "a", ".", "Foo"]
+  , "forall a.Foo"      ==> ["forall", "a", ".", "Foo"]
+  , "$#-- hi"           ==> ["$#--", "hi"]
+  , "(*), (-)"          ==> ["(", "*", ")", ",", "(", "-", ")"]
+  , "(.::)"             ==> ["(", ".::", ")"]
+  -- we rely on this behavior
+  , "data (:+) a b"     ==> ["data", "(", ":+", ")", "a", "b"]
+  , "data (.::+::) a b" ==> ["data", "(", ".::+::", ")", "a", "b"]
+  ]
+  where
+    (==>) = test f
+    f = tail . extractTokens . tokenize
+
+testSkipString :: TestTree
+testSkipString = testGroup "skipString"
+  [ "hi \" there"             ==> " there"
+  , "hi \\a \" there"         ==> " there"
+  , "hi \\\" there\""         ==> ""
+  , "hi"                      ==> ""
+  -- String continuation
+  , test f' "hi \\\n    \\bar\" baz" ("hi bar\"", " baz")
+  ]
+  where
+    (==>) = test f
+    f = snd . FastTags.breakString
+    f' = FastTags.breakString
+
+testStripComments :: TestTree
+testStripComments = testGroup "stripComments"
+  [ "hello -- there"                                           ==> ["nl 0", "hello"]
+  , "hello --there"                                            ==> ["nl 0", "hello"]
+  , "hello {- there -} fred"                                   ==> ["nl 0", "hello", "fred"]
+  , "hello -- {- there -}\nfred"                               ==> ["nl 0", "hello", "nl 0", "fred"]
+  , "{-# LANG #-} hello {- there {- nested -} comment -} fred" ==> ["nl 0", "hello", "fred"]
+  , "hello {-\nthere\n------}\n fred"                          ==> ["nl 0", "hello",  "nl 1", "fred"]
+  , "hello {-  \nthere\n  ------}  \n fred"                    ==> ["nl 0", "hello",  "nl 1", "fred"]
+  , "hello {-\nthere\n-----}\n fred"                           ==> ["nl 0", "hello", "nl 1", "fred"]
+  , "hello {-  \nthere\n  -----}  \n fred"                     ==> ["nl 0", "hello",  "nl 1", "fred"]
+  , "hello {-\n-- there -}"                                    ==> ["nl 0", "hello"]
+  , "foo --- my comment\n--- my other comment\nbar"            ==> ["nl 0", "foo", "nl 0", "nl 0", "bar"]
+  ]
+  where
+    (==>) = test f
+    f = extractTokens . FastTags.stripComments . tokenize
+
+testBreakBlocks :: TestTree
+testBreakBlocks = testGroup "breakBlocks"
+  [ "1\n2\n"           ==> [["1"], ["2"]]
+  , "1\n 1\n2\n"       ==> [["1", "1"], ["2"]]
+  , "1\n 1\n 1\n2\n"   ==> [["1", "1", "1"], ["2"]]
+  -- intervening blank lines are ignored
+  , "1\n 1\n\n 1\n2\n" ==> [["1", "1", "1"], ["2"]]
+  , "1\n\n\n 1\n2\n"   ==> [["1", "1"], ["2"]]
+
+  , "1\n 11\n 11\n"    ==> [["1", "11", "11"]]
+  , " 11\n 11\n"       ==> [["11"], ["11"]]
+  ]
+  where
+    (==>) = test f
+    f = map (extractTokens . UnstrippedTokens . FastTags.stripNewlines)
+        . FastTags.breakBlocks . tokenize
+
+testProcessAll :: TestTree
+testProcessAll = testGroup "processAll"
+  [ ["data X", "module X"]     ==> ["fn0:1 X Type", "fn1:1 X Module"]
+  -- Type goes ahead of Module.
+  , ["module X\n\
+     \data X"]       ==> ["fn0:2 X Type", "fn0:1 X Module"]
+  -- Extra X was filtered.
+  , ["module X\n\
+     \data X = X\n"] ==> ["fn0:2 X Type", "fn0:2 X Constructor", "fn0:1 X Module"]
+  , ["module X\n\
+     \data X a =\n\
+     \  X a\n"] ==> ["fn0:2 X Type", "fn0:3 X Constructor", "fn0:1 X Module"]
+  , ["newtype A f a b = A\n\
+     \  { unA :: f (a -> b) }"]
+    ==> ["fn0:1 A Type", "fn0:1 A Constructor", "fn0:2 unA Function"]
+  ]
+  where
+    (==>) = test f
+    f = map showTag
+        . FastTags.processAll
+        . map (\(i, t) -> fst $ FastTags.process ("fn" ++ show i) False t)
+        . zip [0..]
+    showTag (Pos p (TagVal _ text typ)) =
+      unwords [show p, T.unpack text, show typ]
+
+testProcess :: TestTree
+testProcess = testGroup "process"
+  [ testMisc
+  , testData
+  , testGADT
+  , testFamilies
+  , testFunctions
+  , testClass
+  , testInstance
+  , testLiterate
+  , testPatterns
+  , testFFI
+  ]
+
+testMisc :: TestTree
+testMisc = testGroup "misc"
+  [ "module Bar.Foo where\n"
+    ==>
+    [TagVal "module Bar.Foo" "Foo" Module]
+  , "newtype Foo a b =\n\
+    \\tBar x y z\n"
+    ==>
+    [ TagVal "\tBar" "Bar" Constructor
+    ,  TagVal "newtype Foo" "Foo" Type
+    ]
+  , "f :: A -> B\n\
+    \g :: C -> D\n\
+    \data D = C {\n\
+    \\tf :: A\n\
+    \\t}\n"
+    ==>
+    [ TagVal "data D = C" "C" Constructor
+    , TagVal "data D" "D" Type
+    , TagVal "\tf" "f" Function
+    , TagVal "f" "f" Function
+    , TagVal "g" "g" Function
+    ]
+  ]
+  where
+    (==>) = test f
+    f = map valOf . fst . FastTags.process "fn.hs" False
+
+testData :: TestTree
+testData = testGroup "data"
+  [ "data X\n"                            ==> ["X"]
+  , "data X = X Int\n"                    ==> ["X", "X"]
+  , "data Foo = Bar | Baz"                ==> ["Bar", "Baz", "Foo"]
+  , "data Foo =\n\tBar\n\t| Baz"          ==> ["Bar", "Baz", "Foo"]
+  -- Records.
+  , "data Foo a = Bar { field :: Field }" ==> ["Bar", "Foo", "field"]
+  , "data R = R { a::X, b::Y }"           ==> ["R", "R", "a", "b"]
+  , "data R = R {\n\ta::X\n\t, b::Y\n\t}" ==> ["R", "R", "a", "b"]
+  , "data R = R {\n\ta,b::X\n\t}"         ==> ["R", "R", "a", "b"]
+
+  , "data R = R {\n\
+    \    a :: !RealTime\n\
+    \  , b :: !RealTime\n\
+    \}"
+    ==>
+    ["R", "R", "a", "b"]
+  , "data Rec = Rec {\n\
+    \  a :: Int\n\
+    \, b :: !Double\n\
+    \, c :: Maybe Rec\
+    \\n\
+    \}"
+    ==>
+    ["Rec", "Rec", "a", "b", "c"]
+
+  , "data X = X !Int"                 ==> ["X", "X"]
+  , "data X = Y !Int !X | Z"          ==> ["X", "Y", "Z"]
+  , "data X = Y :+: !Z | !X `Mult` X" ==> [":+:", "Mult", "X"]
+  , "data X = !Y `Add` !Z"            ==> ["Add", "X"]
+
+  , "data X = forall a. Y a"                   ==> ["X", "Y"]
+  , "data X = forall a . Y a"                  ==> ["X", "Y"]
+  , "data X = forall a .Y a"                   ==> ["X", "Y"]
+  , "data X = forall a.Y a"                    ==> ["X", "Y"]
+  , "data X = forall a. Eq a => Y a"           ==> ["X", "Y"]
+  , "data X = forall a. (Eq a) => Y a"         ==> ["X", "Y"]
+  , "data X = forall a. (Eq a, Ord a) => Y a"  ==> ["X", "Y"]
+  -- "data X = forall a. Ref :<: a => Y a"     ==> ["X", "Y"]
+  -- "data X = forall a. (:<:) Ref a => Y a"   ==> ["X", "Y"]
+  , "data X = forall a. ((:<:) Ref a) => Y a"  ==> ["X", "Y"]
+  , "data X = forall a. Y !a"                  ==> ["X", "Y"]
+  , "data X = forall a. (Eq a, Ord a) => Y !a" ==> ["X", "Y"]
+
+  , "data Foo a = \n\
+    \    Plain Int\n\
+    \  | forall a. Bar a Int\n\
+    \  | forall a b. Baz b a\n\
+    \  | forall a . Quux a \
+    \  | forall a .Quuz a"
+    ==>
+    ["Bar", "Baz", "Foo", "Plain", "Quux", "Quuz"]
+
+  , "data X a = Add a "                     ==> ["Add", "X"]
+  , "data Eq a => X a = Add a"              ==> ["Add", "X"]
+  , "data (Eq a) => X a = Add a"            ==> ["Add", "X"]
+  , "data (Eq a, Ord a) => X a = Add a"     ==> ["Add", "X"]
+  , "data (Eq (a), Ord (a)) => X a = Add a" ==> ["Add", "X"]
+
+  -- These are hard-to-deal-with uses of contexts, which are probably not that
+  -- common and therefoce can be ignored.
+  -- "data Ref :<: f => X f = RRef f" ==> ["X", "RRef"]
+  -- "data a :<: b => X a b = Add a" ==> ["X", "Add"]
+  , "data (a :<: b) => X a b = Add a" ==> ["Add", "X"]
+
+  , "newtype Eq a => X a = Add a"          ==> ["Add", "X"]
+  , "newtype (Eq a) => X a = Add a"        ==> ["Add", "X"]
+  , "newtype (Eq a, Ord a) => X a = Add a" ==> ["Add", "X"]
+
+  , "newtype (u :*: v) z = X"      ==> [":*:", "X"]
+  , "data (u :*: v) z = X"         ==> [":*:", "X"]
+  , "type (u :*: v) z = (u, v, z)" ==> [":*:"]
+
+  , "newtype ((u :: (* -> *) -> *) :*: v) z = X"      ==> [":*:", "X"]
+  , "data ((u :: (* -> *) -> *) :*: v) z = X"         ==> [":*:", "X"]
+  , "type ((u :: (* -> *) -> *) :*: v) z = (u, v, z)" ==> [":*:"]
+
+  , "newtype (Eq (v z)) => ((u :: (* -> *) -> *) :*: v) z = X"      ==> [":*:", "X"]
+  , "data (Eq (v z)) => ((u :: (* -> *) -> *) :*: v) z = X"         ==> [":*:", "X"]
+  , "type (Eq (v z)) => ((u :: (* -> *) -> *) :*: v) z = (u, v, z)" ==> [":*:"]
+
+  , "newtype Eq (v z) => ((u :: (* -> *) -> *) :*: v) z = X"      ==> [":*:", "X"]
+  , "data Eq (v z) => ((u :: (* -> *) -> *) :*: v) z = X"         ==> [":*:", "X"]
+  , "type Eq (v z) => ((u :: (* -> *) -> *) :*: v) z = (u, v, z)" ==> [":*:"]
+
+  , "newtype (Eq (v z)) => ((u :: (* -> *) -> *) `Foo` v) z = X"      ==> ["Foo", "X"]
+  , "data (Eq (v z)) => ((u :: (* -> *) -> *) `Foo` v) z = X"         ==> ["Foo", "X"]
+  , "type (Eq (v z)) => ((u :: (* -> *) -> *) `Foo` v) z = (u, v, z)" ==> ["Foo"]
+
+  , "newtype Eq (v z) => ((u :: (* -> *) -> *) `Foo` v) z = X"      ==> ["Foo", "X"]
+  , "data Eq (v z) => ((u :: (* -> *) -> *) `Foo` v) z = X"         ==> ["Foo", "X"]
+  , "type Eq (v z) => ((u :: (* -> *) -> *) `Foo` v) z = (u, v, z)" ==> ["Foo"]
+
+  , "data (:*:) u v z = X"                        ==> [":*:", "X"]
+  , "data (Eq (u v), Ord (z)) => (:*:) u v z = X" ==> [":*:", "X"]
+  , "data (u `W` v) z = X"                        ==> ["W", "X"]
+  , "data (Eq (u v), Ord (z)) => (u `W` v) z = X" ==> ["W", "X"]
+
+  , "newtype X a = Z {\n\
+    \ -- TODO blah\n\
+    \ foo :: [a] }"
+    ==>
+    ["X", "Z", "foo"]
+  , "newtype (u :*: v) z = X {\n\
+    \ -- my insightful comment\n\
+    \ extract :: (u (v z)) }"
+    ==>
+    [":*:", "X", "extract"]
+
+  , "data Hadron a b = Science { f :: a, g :: a, h :: b }"
+    ==>
+    ["Hadron", "Science", "f", "g", "h"]
+  , "data Hadron a b = Science { f :: a, g :: (a, b), h :: b }"
+    ==>
+    ["Hadron", "Science", "f", "g", "h"]
+  , "data Hadron a b = forall x. Science { f :: x, h :: b }"
+    ==>
+    ["Hadron", "Science", "f", "h"]
+  , "data Hadron a b = forall x. Science { f :: [x], h :: b }"
+    ==>
+    ["Hadron", "Science", "f", "h"]
+  , "data Hadron a b = forall x y. Science { f :: (x, y), h :: b }"
+    ==>
+    ["Hadron", "Science", "f", "h"]
+  , "data Hadron a b = forall x y. Science { f :: [(x, y)], h :: b }"
+    ==>
+    ["Hadron", "Science", "f", "h"]
+  , "data Hadron a b = forall x y. Science { f :: [(Box x, Map x y)], h :: b }"
+    ==>
+    ["Hadron", "Science", "f", "h"]
+  , "data Hadron a b = forall x y z. Science\n\
+    \  { f :: x\n\
+    \  , g :: [(Box x, Map x y, z)] \
+    \  }"
+    ==>
+    ["Hadron", "Science", "f", "g"]
+  , "data Hadron a b = forall x y z. Science\n\
+    \  { f :: x\n\
+    \  , g :: [(Box x, Map x y, z)] \
+    \  , h :: b\n\
+    \  }"
+    ==>
+    ["Hadron", "Science", "f", "g", "h"]
+  , "data Hadron a b = Science { h :: b }"
+    ==>
+    ["Hadron", "Science", "h"]
+  , "data Test a b =\n\
+    \    Foo a\n\
+    \  | Bar [(Maybe a, Map a b, b)]"
+    ==>
+    ["Bar", "Foo", "Test"]
+  , "data Test a b =\n\
+    \    Foo a\n\
+    \  | [(Maybe b, Map b a, a)] `Bar` [(Maybe a, Map a b, b)]"
+    ==>
+    ["Bar", "Foo", "Test"]
+  ]
+  where
+    (==>) = test process
+
+testGADT :: TestTree
+testGADT = testGroup "gadt"
+  [ "data X where A :: X\n"              ==> ["A", "X"]
+  , "data X where\n\tA :: X\n"           ==> ["A", "X"]
+  , "data X where\n\tA :: X\n\tB :: X\n" ==> ["A", "B", "X"]
+  , "data X where\n\tA, B :: X\n"        ==> ["A", "B", "X"]
+  , "data X :: * -> * -> * where\n\
+    \  A, B :: Int -> Int -> X\n"
+    ==>
+    ["A", "B", "X"]
+  , "data Vec ix where\n\
+    \  Nil   :: Int -> Foo Int\n\
+    \  (:::) :: Int -> Vec Int -> Vec Int\n\
+    \  (.+.) :: Int -> Int -> Vec Int -> Vec Int\n"
+    ==>
+    [".+.", ":::", "Nil", "Vec"]
+  , "data Vec ix where\n\
+    \  Nil   :: Int -> Foo Int\n\
+    \  -- foo\n\
+    \  (:::) :: Int -> Vec Int -> Vec Int\n\
+    \-- bar\n\
+    \  (.+.) :: Int     -> \n\
+    \           -- ^ baz\n\
+    \           Int     -> \n\
+    \           Vec Int -> \n\
+    \Vec Int\n"
+    ==>
+    [".+.", ":::", "Nil", "Vec"]
+  , "data NatSing (n :: Nat) where\n    ZeroSing :: 'Zero\n    SuccSing :: NatSing n -> NatSing ('Succ n)\n"
+    ==>
+    ["NatSing", "SuccSing", "ZeroSing"]
+  ]
+  where
+    (==>) = test process
+
+testFamilies :: TestTree
+testFamilies = testGroup "families"
+  [ "type family X :: *\n"      ==> ["X"]
+  , "data family X :: * -> *\n" ==> ["X"]
+  , "data family a ** b"        ==> ["**"]
+
+  , "type family a :<: b\n"                               ==> [":<:"]
+  , "type family (a :: Nat) :<: (b :: Nat) :: Nat\n"      ==> [":<:"]
+  , "type family (a :: Nat) `Family` (b :: Nat) :: Nat\n" ==> ["Family"]
+  , "type family (m :: Nat) <=? (n :: Nat) :: Bool"       ==> ["<=?"]
+
+  , "data instance X a b = Y a | Z { unZ :: b }"                  ==> ["Y", "Z", "unZ"]
+  , "data instance (Eq a, Eq b) => X a b = Y a | Z { unZ :: b }"  ==> ["Y", "Z", "unZ"]
+  , "data instance XList Char = XCons !Char !(XList Char) | XNil" ==> ["XCons", "XNil"]
+  , "newtype instance Cxt x => T [x] = A (B x) deriving (Z,W)"    ==> ["A"]
+  , "data instance G [a] b where\n\
+    \   G1 :: c -> G [Int] b\n\
+    \   G2 :: G [a] Bool"
+    ==>
+    ["G1", "G2"]
+  , "class C where\n\ttype X y :: *\n" ==> ["C", "X"]
+  , "class C where\n\tdata X y :: *\n" ==> ["C", "X"]
+  ]
+  where
+    (==>) = test process
+
+testFunctions :: TestTree
+testFunctions = testGroup "functions"
+  [
+  -- Multiple declarations.
+    "a,b::X"      ==> ["a", "b"]
+  -- With an operator.
+  , "(+), a :: X" ==> ["+", "a"]
+  -- Don't get fooled by literals.
+  , "1 :: Int"    ==> []
+
+  -- plain functions and operators
+  , "(.::) :: X -> Y" ==> [".::"]
+  , "(:::) :: X -> Y" ==> [":::"]
+  , "(->:) :: X -> Y" ==> ["->:"]
+  , "(--+) :: X -> Y" ==> ["--+"]
+  , "(=>>) :: X -> Y" ==> ["=>>"]
+
+  , "_g :: X -> Y" ==> ["_g"]
+  , toplevelFunctionsWithoutSignatures
+  ]
+  where
+    (==>) = test process
+    toplevelFunctionsWithoutSignatures =
+      testGroup "toplevel functions without signatures"
+        [ "infix 5 |+|"  ==> []
+        , "infixl 5 |+|" ==> []
+        , "infixr 5 |+|" ==> []
+        , "f = g"        ==> ["f"]
+        , "f :: a -> b -> a\n\
+          \f x y = x"
+          ==>
+          ["f"]
+        , "f x y = x"   ==> ["f"]
+        , "f (x :+: y) z = x" ==> ["f"]
+        , "(x :+: y) `f` z = x" ==> ["f"]
+        , "(x :+: y) :*: z = x" ==> [":*:"]
+        , "((:+:) x y) :*: z = x" ==> [":*:"]
+        , "(:*:) (x :+: y) z = x" ==> [":*:"]
+        , "(:*:) ((:+:) x y) z = x" ==> [":*:"]
+        , strictMatchTests
+        , lazyMatchTests
+        , atPatternsTests
+        , "f x Nothing = x\n\
+          \f x (Just y) = y"
+          ==>
+          ["f"]
+        , "f x y = g x\n\
+          \  where\n\
+          \    g _ = y"
+          ==>
+          ["f"]
+        , "x `f` y = x"   ==> ["f"]
+        , "(|+|) x y = x" ==> ["|+|"]
+        , "x |+| y = x"   ==> ["|+|"]
+        , "(!) x y = x" ==> ["!"]
+        , "--- my comment" ==> []
+        ]
+    strictMatchTests = testGroup "strict match (!)"
+      [ "f !x y = x"  ==> ["f"]
+      , "f x !y = x"  ==> ["f"]
+      , "f !x !y = x" ==> ["f"]
+      , "f ! x y = x" ==> ["f"]
+      -- this one is a bit controversial but it seems to be the way ghc parses it
+      , "f ! x = x"   ==> ["f"]
+      , "(:*:) !(x :+: y) z = x" ==> [":*:"]
+      , "(:*:) !(!x :+: !y) !z = x" ==> [":*:"]
+      , "(:*:) !((:+:) x y) z = x" ==> [":*:"]
+      , "(:*:) !((:+:) !x !y) !z = x" ==> [":*:"]
+      , "(!) :: a -> b -> a\n\
+        \(!) x y = x"
+        ==>
+        ["!"]
+      -- this is a degenerate case since even ghc treats ! here as
+      -- a BangPatterns instead of operator
+      , "x ! y = x" ==> ["x"]
+      ]
+    lazyMatchTests = testGroup "lazy match (~)"
+      [ "f ~x y = x"  ==> ["f"]
+      , "f x ~y = x"  ==> ["f"]
+      , "f ~x ~y = x" ==> ["f"]
+      , "f ~ x y = x" ==> ["f"]
+      -- this one is a bit controversial but it seems to be the way ghc parses it
+      , "f ~ x = x"   ==> ["f"]
+      , "(:*:) ~(x :+: y) z = x" ==> [":*:"]
+      , "(:*:) ~(~x :+: ~y) ~z = x" ==> [":*:"]
+      , "(:*:) ~((:+:) x y) z = x" ==> [":*:"]
+      , "(:*:) ~((:+:) ~x ~y) ~z = x" ==> [":*:"]
+      , "(~) :: a -> b -> a\n\
+        \(~) x y = x"
+        ==>
+        ["~"]
+      -- this is a degenerate case since even ghc treats ~ here as
+      -- a BangPatterns instead of operator
+      , "x ~ y = x" ==> ["x"]
+      ]
+    atPatternsTests = testGroup "at patterns (@)"
+      [ "f z@x y    = z"              ==> ["f"]
+      , "f x   z'@y = z'"             ==> ["f"]
+      , "f z@x z'@y = z"              ==> ["f"]
+      , "f z@(Foo _) z'@y = z"        ==> ["f"]
+      , "f z@(Foo _) z'@(Bar _) = z"  ==> ["f"]
+      , "f z @ x y  = z"              ==> ["f"]
+      , "f z @ (x : xs) = z: [x: xs]" ==> ["f"]
+      , "f z @ (x : zs @ xs) = z: [x: zs]"      ==> ["f"]
+      , "f z @ (zz @x : zs @ xs) = z: [zz: zs]" ==> ["f"]
+
+      , "(:*:) zzz@(x :+: y) z = x"            ==> [":*:"]
+      , "(:*:) zzz@(zx@x :+: zy@y) zz@z = x"   ==> [":*:"]
+      , "(:*:) zzz@((:+:) x y) z = x"          ==> [":*:"]
+      , "(:*:) zzz@((:+:) zs@x zs@y) zz@z = x" ==> [":*:"]
+
+      , "f z@(!x) ~y = x"              ==> ["f"]
+      ]
+
+testClass :: TestTree
+testClass = testGroup "class"
+  [ "class (X x) => C a b where\n\tm :: a->b\n\tn :: c\n" ==> ["C", "m", "n"]
+  , "class A a where f :: X\n"                            ==> ["A", "f"]
+    -- indented inside where
+  , "class X where\n\ta, (+) :: X\n"            ==> ["+", "X", "a"]
+  , "class X where\n\ta :: X\n\tb, c :: Y"      ==> ["X", "a", "b", "c"]
+  , "class X\n\twhere\n\ta :: X\n\tb, c :: Y"   ==> ["X", "a", "b", "c"]
+  , "class X\n\twhere\n\ta ::\n\t\tX\n\tb :: Y" ==> ["X", "a", "b"]
+
+  , "class a :<: b where\n    f :: a -> b"         ==> [":<:", "f"]
+  , "class (:<:) a b where\n    f :: a -> b"       ==> [":<:", "f"]
+  , "class Eq a => a :<: b where\n    f :: a -> b" ==> [":<:", "f"]
+  -- , "class a :<<<: b => a :<: b where\n    f :: a -> b"
+  --   ==>
+  --   [":<:", "f"]
+  , "class (a :<<<: b) => a :<: b where\n    f :: a -> b"   ==> [":<:", "f"]
+  , "class (Eq a, Ord b) => a :<: b where\n    f :: a -> b" ==> [":<:", "f"]
+  , "class (Eq a, Ord b) => (a :: (* -> *) -> *) :<: b where\n    f :: a -> b"
+    ==>
+    [":<:", "f"]
+    -- this is bizzarre
+  , "class (Eq (a), Ord (f a [a])) => f `Z` a" ==> ["Z"]
+
+  , "class A f where\n  data F f :: *\n  g :: a -> f a\n  h :: f a -> a"
+    ==>
+    ["A", "F", "g", "h"]
+  , "class A f where\n  data F f :: *\n  mkF :: f -> F f\n  getF :: F f -> f"
+    ==>
+    ["A", "F", "getF", "mkF"]
+  , "class A f where\n\
+    \  data F f :: * -- foo\n\
+    \                -- bar\n\
+    \                -- baz\n\
+    \  mkF  :: f -> F f\n\
+    \  getF :: F f -> f"
+    ==>
+    ["A", "F", "getF", "mkF"]
+  -- Not confused by a class context on a method.
+  , "class X a where\n\tfoo :: Eq a => a -> a\n" ==> ["X", "foo"]
+  ]
+  where
+    (==>) = test process
+
+testInstance :: TestTree
+testInstance = testGroup "instance"
+  [ "instance Foo Quux where\n\
+    \  data Bar Quux a = QBar { frob :: a }\n\
+    \                  | QBaz { fizz :: String }\n\
+    \                  deriving (Show)"
+    ==>
+    ["QBar", "QBaz", "fizz", "frob"]
+  , "instance Foo Quux where\n\
+    \  data Bar Quux a = QBar a | QBaz String deriving (Show)"
+    ==>
+    ["QBar", "QBaz"]
+  , "instance Foo Quux where\n\
+    \  data Bar Quux a = QBar { frob :: a }\n\
+    \                  | QBaz { fizz :: String }\n\
+    \                  deriving (Show)\n\
+    \  data IMRuunningOutOfNamesHere Quux = Whatever"
+    ==>
+    ["QBar", "QBaz", "Whatever", "fizz", "frob"]
+    -- in this test foo function should not affect tags found
+  , "instance Foo Quux where\n\
+    \  data Bar Quux a = QBar { frob :: a }\n\
+    \                  | QBaz { fizz :: String }\n\
+    \                  deriving (Show)\n\
+    \\n\
+    \  foo _ = QBaz \"hey there\""
+    ==>
+    ["QBar", "QBaz", "fizz", "frob"]
+  , "instance Foo Int where foo _ = 1"
+    ==>
+    []
+  , "instance Foo Quux where\n\
+    \  newtype Bar Quux a = QBar a \n\
+    \                     deriving (Show)\n\
+    \\n\
+    \  foo _ = QBaz \"hey there\""
+    ==>
+    ["QBar"]
+  , "instance Foo Quux where\n\
+    \  newtype Bar Quux a = QBar { frob :: a }"
+    ==>
+    ["QBar", "frob"]
+  ]
+  where
+    (==>) = test process
+
+testLiterate :: TestTree
+testLiterate = testGroup "literate"
+  [ "> class (X x) => C a b where\n>\tm :: a->b\n>\tn :: c\n"
+    ==>
+    ["C", "m", "n"]
+  , "Test\n\\begin{code}\nclass (X x) => C a b where\n\tm :: a->b\n\tn :: c\n\\end{code}"
+    ==>
+    ["C", "m", "n"]
+  ]
+  where
+    (==>) = test f
+    f = map untag . fst . FastTags.process "fn.lhs" False
+
+testPatterns :: TestTree
+testPatterns = testGroup "patterns"
+  [ "pattern Arrow a b = ConsT \"->\" [a, b]"
+    ==>
+    ["Arrow"]
+  , "pattern Arrow a b = ConsT \"->\" [a, b]\n\
+    \pattern Pair a b = [a, b]"
+    ==>
+    ["Arrow", "Pair"]
+  ]
+  where
+    (==>) = test process
+
+testFFI :: TestTree
+testFFI = testGroup "ffi"
+  [ "foreign import ccall foo :: Double -> IO Double" ==> ["foo"]
+  , "foreign import unsafe java foo :: Double -> IO Double" ==> ["foo"]
+  , "foreign import safe stdcall foo :: Double -> IO Double" ==> ["foo"]
+  ]
+  where
+    (==>) = test process
+
+process :: Text -> [String]
+process = map untag . fst . FastTags.process "fn.hs" False
+
+untag :: Pos TagVal -> String
+untag (Pos _ (TagVal _ name _)) = T.unpack name
+
+tokenize :: Text -> UnstrippedTokens
+tokenize =
+  Monoid.mconcat . map (FastTags.tokenize False) . FastTags.stripCpp . FastTags.annotate "fn"
+
+extractTokens :: UnstrippedTokens -> [Text]
+extractTokens = map (\token -> case FastTags.valOf token of
+  Token _ name -> name
+  Newline n -> T.pack ("nl " ++ show n)) . FastTags.unstrippedTokensOf