diff --git a/README b/README
--- a/README
+++ b/README
@@ -1,13 +1,12 @@
-See vimrc for an example of how to keep the tags file up to date automatically.
-
-Design decisions:
+See vimrc for an example of how to keep the tags file up to date
+automatically.
 
-- Only top-level functions with type declarations are tagged.
+TODO:
 
-Not supported:
+- Lots of files are not in UTF8.  Use ByteString with a lenient decoder?
 
 - \ continuation in strings is not parsed correctly.
 
 - Literate haskell.
 
-- Infix operators.
+- Entire module indented.  But who does this?
diff --git a/fast-tags.cabal b/fast-tags.cabal
--- a/fast-tags.cabal
+++ b/fast-tags.cabal
@@ -1,19 +1,40 @@
 name: fast-tags
-version: 0.0.2
-cabal-version: >= 1.6
+version: 0.0.3
+cabal-version: >= 1.8
 build-type: Simple
 synopsis: Fast incremental vi 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 should be even
-    faster than hasktags because it uses Text instead of String.  It also
-    understands hsc files, though not literate haskell.  It's also less buggy
-    than hasktags.
+    than haskell-src or haskell-src-exts, so it's fast.  It understands
+    hsc files, though not literate haskell.
     .
     In addition, it will load an existing tags file and merge generated tags.
     .
     The intent is to bind it to vim's BufWrite autocommand to automatically
     keep the tags file up to date.
+    .
+    Changes since 0.0.2:
+    .
+    * Lots of speed ups, especially when given lots of files at once.
+    .
+    * Support for type families and GADTs.
+    .
+    * Support infix operators, multiple declarations per line, and fix various
+    other bugs that missed or gave bad tags.
+    .
+    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
+    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.
 
 category: Haskell, Development
 license: BSD3
@@ -26,12 +47,13 @@
 extra-source-files: src/*.hs
 
 source-repository head
-    type: darcs
-    location: http://ofb.net/~elaforge/darcs/fast-tags/
+    type: git
+    location: git://github.com/elaforge/fast-tags.git
 
 executable fast-tags
     main-is: Main.hs
     hs-source-dirs: src
-    -- text 0.11.1.12 has a bug.
-    build-depends: base >= 3 && < 5, containers, text >= 0.11.1.13
+    build-depends: base >= 3 && < 5, containers,
+        -- text 0.11.1.12 has a bug.
+        text (> 0.11.1.12 || < 0.11.1.12)
     ghc-options: -Wall -fno-warn-name-shadowing
diff --git a/src/Main.hs b/src/Main.hs
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,5 +1,8 @@
-{-# LANGUAGE OverloadedStrings, PatternGuards #-}
-{- |
+{-# LANGUAGE OverloadedStrings, PatternGuards, ScopedTypeVariables #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+{- | Tagify haskell source.
+
     Annotate lines, strip comments, tokenize, then search for
     It loads the existing tags, and updates it for the given file.  Then
     a SaveBuf action runs tags every time you save a file.
@@ -13,10 +16,12 @@
 import qualified Data.Either as Either
 import qualified Data.List as List
 import qualified Data.Monoid as Monoid
+import qualified Data.Set as Set
 import qualified Data.Text as T
 import Data.Text (Text)
 import qualified Data.Text.IO as Text.IO
 
+import qualified Debug.Trace as Trace
 import qualified System.Console.GetOpt as GetOpt
 import qualified System.Environment as Environment
 import qualified System.Exit
@@ -31,28 +36,45 @@
         (flags, inputs, []) -> return (flags, inputs)
         (_, _, errs) -> usage $ "flag errors:\n" ++ List.intercalate ", " errs
     let output = last $ "tags" : [fn | Output fn <- flags]
+        verbose = Verbose `elem` flags
     oldTags <- fmap (maybe [vimMagicLine] T.lines) $
         catchENOENT $ Text.IO.readFile output
-    tags <- fmap concat (mapM processFile inputs)
+    newTags <- fmap concat $ 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
+        when verbose $ do
+            let line = show i ++ " of " ++ show (length inputs - 1)
+                    ++ ": " ++ fn
+            putStr $ '\r' : line ++ replicate (78 - length line) ' '
+            IO.hFlush IO.stdout
+        return newTags
+    when verbose $ putChar '\n'
 
-    let (warnings, newTags) = Either.partitionEithers $ map showTag tags
-    forM_ warnings $ \warn -> do
-        IO.hPutStrLn IO.stderr warn
     let write = if output == "-" then Text.IO.hPutStr IO.stdout
             else Text.IO.writeFile output
-    write $ T.unlines $
-        merge (List.sort newTags) (filter (not . isNewTag inputs) oldTags)
+
+    -- Turns out GHC will not float out the T.pack and it makes a big
+    -- performance difference.
+    let textFns = Set.fromList $ map (T.pack . ('\t':)) inputs
+        filtered = filter (not . isNewTag textFns) oldTags
+    write $ T.unlines $ merge (List.sort (map showTag newTags)) filtered
     where
     usage msg = putStr (GetOpt.usageInfo msg options)
         >> System.Exit.exitSuccess
 
-data Flag = Output FilePath
-    deriving (Show)
+data Flag = Output FilePath | Verbose
+    deriving (Eq, Show)
 
 options :: [GetOpt.OptDescr Flag]
 options =
     [ GetOpt.Option ['o'] [] (GetOpt.ReqArg Output "filename")
         "output file, defaults to 'tags'"
+    , GetOpt.Option ['v'] [] (GetOpt.NoArg Verbose)
+        "print files as they are tagged, useful to track down slow files"
     ]
 
 -- | Documented in vim :h tags-file-format.
@@ -61,9 +83,9 @@
 vimMagicLine :: Text
 vimMagicLine = "!_TAG_FILE_SORTED\t1\t~"
 
-isNewTag :: [FilePath] -> Text -> Bool
-isNewTag fns line = any (`T.isInfixOf` line) textFns
-    where textFns = map (T.pack . ('\t':)) fns
+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
 
 merge :: [Text] -> [Text] -> [Text]
 merge [] ys = ys
@@ -73,15 +95,15 @@
     | otherwise = y : merge (x:xs) ys
 
 
--- AbsoluteMark\tCmd/TimeStep.hs 67 ;" f
--- TODO use "file:" for non-exported symbols, this should make vim search for
--- them first within the file.
-showTag :: Tag -> Either String Text
-showTag (Pos (SrcPos fn lineno) (Tag text typ)) = Right $
+-- | 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)]
-showTag (Pos pos (Warning text)) = Left $ show pos ++ ": " ++ text
 
+-- | 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'
@@ -92,7 +114,7 @@
 
 -- * types
 
-data TagVal = Tag !Text !Type | Warning !String
+data TagVal = Tag !Text !Type
     deriving (Eq, Show)
 
 data Type = Module | Function | Class | Type | Constructor
@@ -101,13 +123,27 @@
 data TokenVal = Token !Text | Newline !Int
     deriving (Eq, Show)
 
-type Tag = Pos TagVal
+type Tag = Either String (Pos TagVal)
 type Token = Pos TokenVal
+
+-- | Newlines have to remain in the tokens because 'breakBlocks' relies on
+-- them.  But they make pattern matching on the tokens unreliable because
+-- 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)
+
+mapTokens :: ([Token] -> [Token]) -> UnstrippedTokens -> UnstrippedTokens
+mapTokens f (UnstrippedTokens tokens) = UnstrippedTokens (f tokens)
+
+unstrippedTokensOf :: UnstrippedTokens -> [Token]
+unstrippedTokensOf (UnstrippedTokens tokens) = tokens
+
 type Line = Pos Text
 
 data Pos a = Pos {
-    posOf :: SrcPos
-    , valOf :: a
+    posOf :: !SrcPos
+    , valOf :: !a
     }
 
 data SrcPos = SrcPos {
@@ -122,14 +158,19 @@
 
 processFile :: FilePath -> IO [Tag]
 processFile fn = fmap (process fn) (Text.IO.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 []
 
 process :: FilePath -> Text -> [Tag]
 process fn = dropDups tagText . concatMap blockTags . breakBlocks
-    . stripComments . concatMap tokenize . stripCpp . annotate fn
+    . stripComments . Monoid.mconcat . map tokenize . stripCpp . annotate fn
     where
-    tagText (Pos _ (Tag text _)) = text
-    tagText (Pos _ (Warning warn)) = T.pack warn
-
+    tagText (Right (Pos _ (Tag text _))) = text
+    tagText (Left warn) = T.pack warn
 
 -- * tokenize
 
@@ -141,8 +182,8 @@
 stripCpp :: [Line] -> [Line]
 stripCpp = filter $ not . ("#" `T.isPrefixOf`) . valOf
 
-tokenize :: Line -> [Token]
-tokenize (Pos pos line) = map (Pos pos) (tokenizeLine line)
+tokenize :: Line -> UnstrippedTokens
+tokenize (Pos pos line) = UnstrippedTokens $ map (Pos pos) (tokenizeLine line)
 
 tokenizeLine :: Text -> [TokenVal]
 tokenizeLine text = Newline nspaces : go line
@@ -156,45 +197,61 @@
             Token sym : go (T.drop (T.length sym) text)
         | c == '\'' = let (token, rest) = breakChar text
             in Token (T.cons c token) : go rest
-        | c == '"' = let (token, rest) = breakString cs
-            in Token (T.cons c token) : go rest
-        | Char.isSymbol c || Char.isPunctuation c =
-            Token (T.singleton c) : go cs
-        | otherwise =
-            let (token, rest) = T.span isIdent text in Token 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
-    isIdent c = Char.isAlphaNum c || c == '.' || c == '\'' || c == '_'
 
+startIdentChar :: Char -> Bool
+startIdentChar c = Char.isAlpha c || c == '_'
+
+identChar :: Char -> Bool
+identChar c = Char.isAlphaNum c || c == '.' || c == '\'' || c == '_'
+
+-- | Span a symbol, making sure to not eat comments.
+spanSymbol :: Text -> (Text, Text)
+spanSymbol text
+    | any (`T.isPrefixOf` post) [",", "--", "-}", "{-"] = (pre, post)
+    | Just (c, cs) <- T.uncons post, c == '-' || c == '{' =
+        let (pre2, post2) = spanSymbol cs
+        in (pre <> T.cons c pre2, post2)
+    | otherwise = (pre, post)
+    where
+    (pre, post) = T.break (\c -> T.any (==c) "-{," || not (symbolChar c)) text
+
+symbolChar :: Char -> Bool
+symbolChar c = Char.isSymbol c || Char.isPunctuation c
+
 breakChar :: Text -> (Text, Text)
 breakChar text
     | T.null text = ("", "")
     | T.head text == '\\' = T.splitAt 3 text
     | otherwise = T.splitAt 2 text
 
--- | Break after the ending double-quote of a string.
+-- | 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.
-breakString :: Text -> (Text, Text)
-breakString text = case T.uncons post of
-        Nothing -> (text, "")
-        Just (c, cs)
-            | c == '\\' && T.null cs -> (T.snoc pre c, "")
-            | c == '\\' && T.head cs == '"' ->
-                let (pre', post') = breakString (T.tail cs)
-                in (pre <> "\\\"" <> pre', post')
-            | c == '\\' ->
-                let (pre', post') = breakString cs
-                in (T.snoc pre c <> pre', post')
-            | otherwise -> (T.snoc pre c, cs)
-    where
-    (pre, post) = T.break (\c -> c == '\\' || c == '"') text
+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 == '"'
 
-stripComments :: [Token] -> [Token]
-stripComments = go 0
+stripComments :: UnstrippedTokens -> UnstrippedTokens
+stripComments = mapTokens (go 0)
     where
     go :: Int -> [Token] -> [Token]
     go _ [] = []
@@ -205,127 +262,170 @@
         | nest > 0 = go nest rest
         | otherwise = pos : go nest rest
 
-
--- | Break the input up into blocks based on indentation and strip out all
--- the newlines.  This way the blockTags doesn't need to worry about newlines.
-breakBlocks :: [Token] -> [[Token]]
-breakBlocks =
-    filter (not . null) . map (filter (not . isNewline)) . go . filterBlank
+-- | Break the input up into blocks based on indentation.
+breakBlocks :: UnstrippedTokens -> [UnstrippedTokens]
+breakBlocks = map UnstrippedTokens . filter (not . null) . go . filterBlank
+    . unstrippedTokensOf
     where
     go [] = []
-    go tokens = pre : breakBlocks post
-        -- Start the indent off at 1, this way the next line in the 0th column
-        -- will start a new block.
-        where (pre, post) = breakBlock True 1 tokens
+    go tokens = pre : go post
+        where (pre, post) = breakBlock tokens
     -- Blank lines mess up the indentation.
     filterBlank [] = []
     filterBlank (Pos _ (Newline _) : xs@(Pos _ (Newline _) : _)) =
         filterBlank xs
     filterBlank (x:xs) = x : filterBlank xs
 
--- | Take until newline, then take lines until there the indent decreases.
-breakBlock :: Bool -> Int -> [Token] -> ([Token], [Token])
-breakBlock _ _ [] = ([], [])
-breakBlock firstLine indent (t@(Pos _ (Newline lineIndent)) : ts)
-    -- An indent less than the established block indent means I'm done.
-    | lineIndent < indent = ([t], ts)
-    | otherwise =
-        let (pre, post) = breakBlock False blockIndent ts in (t:pre, post)
-    where blockIndent = if firstLine then lineIndent else indent
-breakBlock firstLine indent (t : ts) =
-    let (pre, post) = breakBlock firstLine indent ts in (t:pre, post)
+-- | Take until a newline, then take lines until the indent established after
+-- that newline decreases.
+breakBlock :: [Token] -> ([Token], [Token])
+breakBlock (t@(Pos _ tok):ts) = case tok of
+    Newline indent -> collectIndented indent ts
+    _ -> let (pre, post) = breakBlock ts in (t:pre, post)
+    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 _ [] = ([], [])
+breakBlock [] = ([], [])
 
 
 -- * extract tags
 
 -- | Get all the tags in one indented block.
---
--- Search for:
--- - module <word>
--- - newtype <word>
--- - type <word>
--- - data <word> * = <word> :: or | <word>
--- - class * => <word> * where - strip indent, look for <word> ::
--- - <word> :: emit as a definition
--- - whitespace: skip to next line
-blockTags :: [Token] -> [Tag]
-blockTags tokens = case tokens of
+blockTags :: UnstrippedTokens -> [Tag]
+blockTags tokens = case stripNewlines tokens of
     [] -> []
     Pos _ (Token "module") : Pos pos (Token name) : _ ->
         [mktag pos (snd (T.breakOnEnd "." name)) Module]
     -- newtype X * = X *
     Pos _ (Token "newtype") : Pos pos (Token name) : rest ->
         mktag pos name Type : newtypeTags pos rest
+    -- type family X ...
+    Pos _ (Token "type") : Pos _ (Token "family") : Pos pos (Token name) : _ ->
+        [mktag pos name Type]
     -- type X * = ...
     Pos _ (Token "type") : Pos pos (Token name) : _ -> [mktag pos name Type]
+    -- data family X ...
+    Pos _ (Token "data") : Pos _ (Token "family") : Pos pos (Token name) : _ ->
+        [mktag pos name Type]
     -- data X * = X { X :: *, X :: * }
     -- data X * where ...
-    Pos _ (Token "data") : Pos pos (Token name) : rest ->
-        mktag pos name Type : dataTags pos rest
+    Pos _ (Token "data") : Pos pos (Token name) : _ ->
+        mktag pos name Type : dataTags pos (mapTokens (drop 2) tokens)
     -- class * => X where X :: * ...
-    Pos pos (Token "class") : rest -> classTags pos rest
-    Pos pos (Token name) : Pos _ (Token "::") : _ -> [mktag pos name Function]
-    _ -> []
+    Pos pos (Token "class") : _ -> classTags pos (mapTokens (drop 1) tokens)
+    -- x, y, z :: *
+    stripped -> fst $ functionTags False stripped
 
-mktag :: SrcPos -> Text -> Type -> Pos TagVal
-mktag pos name typ = Pos pos (Tag name typ)
+-- | 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)
 
-warning :: SrcPos -> String -> Pos TagVal
-warning pos warn = Pos pos (Warning warn)
+-- | 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
+    go tags tokens = (tags, tokens)
 
-unexpected :: SrcPos -> [Token] -> [Token] -> String -> [Tag]
-unexpected prevPos tokens tokensHere declaration =
-    [warning pos ("unexpected " ++ thing ++ " after " ++ declaration)]
+functionName :: Bool -> Text -> Maybe Text
+functionName constructors text
+    | isFunction text = Just text
+    | isOperator text && not (T.null stripped) = Just stripped
+    | otherwise = Nothing
     where
-    thing = if null tokensHere then "end of block"
-        else show (valOf (head tokensHere))
-    pos
-        | not (null tokensHere) = posOf (head tokensHere)
-        | not (null tokens) = posOf (last tokens)
-        | otherwise = prevPos
+    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
 
 -- | * = X *
 newtypeTags :: SrcPos -> [Token] -> [Tag]
 newtypeTags prevPos tokens = case dropUntil "=" tokens of
     Pos pos (Token name) : _ -> [mktag pos name Constructor]
-    rest -> unexpected prevPos tokens rest "newtype * ="
+    rest -> unexpected prevPos (UnstrippedTokens tokens) rest "newtype * ="
 
 -- | [] (empty data declaration)
 -- * = X { X :: *, X :: * }
 -- * where X :: * X :: *
 -- * = X | X
-dataTags :: SrcPos -> [Token] -> [Tag]
-dataTags _ [] = [] -- empty data declaration
-dataTags prevPos tokens
-    -- if is gadt then...
-    | otherwise = case dropUntil "=" tokens of
+dataTags :: SrcPos -> UnstrippedTokens -> [Tag]
+dataTags prevPos unstripped
+    | any ((== Token "where") . valOf) (unstrippedTokensOf unstripped) =
+        concatMap gadtTags (whereBlock unstripped)
+    | otherwise = case dropUntil "=" (stripNewlines unstripped) of
+        [] -> [] -- empty data declaration
         Pos pos (Token name) : rest ->
             mktag pos name Constructor : collectRest rest
-        rest -> unexpected prevPos tokens rest "data * ="
+        rest -> unexpected prevPos unstripped rest "data * ="
     where
-    collectRest tokens = case tokens of
-        Pos pos (Token name) : Pos _ (Token "::") : rest ->
-            mktag pos name Function : collectRest rest
-        Pos _ (Token "|") : Pos pos (Token name) : rest ->
-            mktag pos name Constructor : collectRest rest
-        _ : rest -> collectRest rest
-        [] -> []
+    collectRest tokens
+        | (tags@(_:_), rest) <- functionTags False tokens =
+            tags ++ collectRest rest
+    collectRest (Pos _ (Token "|") : Pos pos (Token name) : rest) =
+        mktag pos name Constructor : collectRest rest
+    collectRest (_ : rest) = collectRest rest
+    collectRest [] = []
 
+gadtTags :: UnstrippedTokens -> [Tag]
+gadtTags = fst . functionTags True . stripNewlines
+
 -- | * => X where X :: * ...
-classTags :: SrcPos -> [Token] -> [Tag]
-classTags prevPos unstripped = case tokens of
-    Pos pos (Token name) : rest ->
-        mktag pos name Class : collectRest rest
-    rest -> unexpected prevPos tokens rest "class * =>"
+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
-    tokens = if any ((== Token "=>") . valOf) unstripped
-        then dropUntil "=>" unstripped else unstripped
-    collectRest tokens = case tokens of
-        Pos pos (Token name) : Pos _ (Token "::") : rest ->
-            mktag pos name Function : collectRest rest
-        _ : rest -> collectRest rest
-        [] -> []
+    dropContext tokens = if any ((== Token "=>") . valOf) tokens
+        then dropUntil "=>" tokens else tokens
 
+classBodyTags :: UnstrippedTokens -> [Tag]
+classBodyTags unstripped = case stripNewlines unstripped of
+    Pos _ (Token typedata) : Pos pos (Token name) : _
+        | typedata `elem` ["type", "data"] -> [mktag pos 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")
+
+
+-- * util
+
+mktag :: SrcPos -> Text -> Type -> Tag
+mktag pos name typ = Right $ Pos pos (Tag name typ)
+
+warning :: SrcPos -> String -> Tag
+warning pos warn = Left $ 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))
+    pos
+        | not (null tokensHere) = posOf (head tokensHere)
+        | not (null tokensBefore) = posOf (last tokensBefore)
+        | otherwise = prevPos
+
 dropLine :: [Token] -> [Token]
 dropLine = drop 1 . dropWhile (not . isNewline)
 
@@ -339,6 +439,9 @@
 
 -- * misc
 
+tracem :: (Show a) => String -> a -> a
+tracem msg x = Trace.trace (msg ++ ": " ++ show x) x
+
 (<>) :: (Monoid.Monoid a) => a -> a -> a
 (<>) = Monoid.mappend
 
@@ -348,6 +451,10 @@
     (const (return Nothing)) (fmap Just op)
 
 dropDups :: (Eq k) => (a -> k) -> [a] -> [a]
+dropDups key (x:xs) = go x xs
+    where
+    go a [] = [a]
+    go a (b:bs)
+        | key a == key b = go a bs
+        | otherwise = a : go b bs
 dropDups _ [] = []
-dropDups key (x:xs) = x : map snd (filter (not . equal) (zip (x:xs) xs))
-    where equal (x, y) = key x == key y
diff --git a/src/Main_test.hs b/src/Main_test.hs
--- a/src/Main_test.hs
+++ b/src/Main_test.hs
@@ -1,87 +1,165 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Main_test where
+import qualified Control.Exception as Exception
 import Control.Monad
-import qualified Data.Maybe as Maybe
+import qualified Data.Monoid as Monoid
 import qualified Data.Text as Text
+import Exception (assert)
+import qualified System.IO.Unsafe as Unsafe
 
 import qualified Main as Main
-import Main (Token, TokenVal(..), TagVal(..), Type(..))
+import Main (TokenVal(..), TagVal(..), Type(..), Tag, Pos(..))
 
 
--- This is kind of annoying without line numbers on equal and automatic
--- test_* collection...
+-- This is kind of annoying without automatic test_* collection...
 main = do
     test_tokenize
-    test_breakString
+    test_skipString
     test_stripComments
     test_process
 
 test_tokenize = do
-    let f = extractTokens . tokenize
-    equal (f "a::b->c") ["nl 0", "a", "::", "b", "->", "c"]
-    equal (f "x{-\n  bc#-}\n")
-        ["nl 0", "x", "{-", "nl 2", "bc", "#", "-}"]
-    equal (f "X.Y") ["nl 0", "X.Y"]
+    -- drop leading "nl 0"
+    let f = drop 1 . extractTokens . tokenize
+    equal assert (f "a::b->c") ["a", "::", "b", "->", "c"]
+    equal assert (f "x{-\n  bc#-}\n")
+        ["x", "{-", "nl 2", "bc", "#", "-}"]
+    equal assert (f "X.Y") ["X.Y"]
+    equal assert (f "x9") ["x9"]
+    -- equal assert (f "9x") ["nl 0", "9", "x"]
+    equal assert (f "x :+: y") ["x", ":+:", "y"]
+    equal assert (f "(#$)") ["(#$)"]
+    equal assert (f "$#-- hi") ["$#", "--", "hi"]
+    equal assert (f "(*), (-)") ["(*)", ",", "(-)"]
 
-test_breakString = do
-    let f = Main.breakString
-    equal (f "hi \" there") ("hi \"", " there")
-    equal (f "hi \\a \" there") ("hi \\a \"", " there")
-    equal (f "hi \\\" there\"") ("hi \\\" there\"", "")
-    equal (f "hi") ("hi", "")
+test_skipString = do
+    let f = Main.skipString
+    equal assert (f "hi \" there") " there"
+    equal assert (f "hi \\a \" there") " there"
+    equal assert (f "hi \\\" there\"") ""
+    equal assert (f "hi") ""
     -- String continuation isn't implemented yet.
-    equal (f "hi \\") ("hi \\", "")
+    equal assert (f "hi \\") ""
 
 test_stripComments = do
     let f = extractTokens . Main.stripComments . tokenize
-    equal (f "hello -- there") ["nl 0", "hello"]
-    equal (f "hello {- there -} fred") ["nl 0", "hello", "fred"]
-    equal (f "{-# LANG #-} hello {- there {- nested -} comment -} fred")
+    equal assert (f "hello -- there") ["nl 0", "hello"]
+    equal assert (f "hello {- there -} fred") ["nl 0", "hello", "fred"]
+    equal assert (f "{-# LANG #-} hello {- there {- nested -} comment -} fred")
         ["nl 0", "hello", "fred"]
 
 test_breakBlocks = do
-    let f = map extractTokens . Main.breakBlocks . tokenize
-    equal (f "1\n2\n") [["1"], ["2"]]
-    equal (f "1\n 1\n2\n") [["1", "1"], ["2"]]
-    equal (f "1\n 1\n 1\n2\n") [["1", "1", "1"], ["2"]]
+    let f = map (extractTokens . Main.UnstrippedTokens . Main.stripNewlines)
+            . Main.breakBlocks . tokenize
+    equal assert (f "1\n2\n") [["1"], ["2"]]
+    equal assert (f "1\n 1\n2\n") [["1", "1"], ["2"]]
+    equal assert (f "1\n 1\n 1\n2\n") [["1", "1", "1"], ["2"]]
     -- intervening blank lines are ignored
-    equal (f "1\n 1\n\n 1\n2\n") [["1", "1", "1"], ["2"]]
-    equal (f "1\n\n\n 1\n2\n") [["1", "1"], ["2"]]
+    equal assert (f "1\n 1\n\n 1\n2\n") [["1", "1", "1"], ["2"]]
+    equal assert (f "1\n\n\n 1\n2\n") [["1", "1"], ["2"]]
 
-test_process = do
-    let f = map Main.valOf . Main.process "fn"
-    equal (f "module Bar.Foo where\n") [Tag "Foo" Module]
-    equal (f "newtype Foo a b =\n\tBar x y z\n")
-        [Tag "Foo" Type, Tag "Bar" Constructor]
-    equal (f "data Foo a = Bar { field :: Field }")
-        [Tag "Foo" Type, Tag "Bar" Constructor, Tag "field" Function]
-    equal (f "data Foo = Bar | Baz")
-        [Tag "Foo" Type, Tag "Bar" Constructor, Tag "Baz" Constructor]
-    equal (f "class (X x) => C a b c where\n\tm :: a -> b\n\tn :: c -> d\n")
-        [Tag "C" Class, Tag "m" Function, Tag "n" Function]
-    equal (f "class A a where f :: X\n")
-        [Tag "A" Class, Tag "f" Function]
-    equal (f "data X\n") [Tag "X" Type]
+    equal assert (f "1\n 11\n 11\n") [["1", "11", "11"]]
+    equal assert (f " 11\n 11\n") [["11"], ["11"]]
 
-    -- The extra X is suppressed.
-    equal (f "data X = X Int\n") [Tag "X" Type]
+test_process = sequence_
+    [test_misc, test_data, test_gadt, test_families, test_functions, test_class]
 
-    equal (f "f :: A -> B\ng :: C -> D\ndata D = C {\n\tf :: A\n\t}\n")
+test_misc = do
+    let f text = [tag | Right (Pos _ tag) <- Main.process "fn" text]
+    equal assert (f "module Bar.Foo where\n") [Tag "Foo" Module]
+    equal assert (f "newtype Foo a b =\n\tBar x y z\n")
+        [Tag "Foo" Type, Tag "Bar" Constructor]
+    equal assert (f "f :: A -> B\ng :: C -> D\ndata D = C {\n\tf :: A\n\t}\n")
         [Tag "f" Function, Tag "g" Function, Tag "D" Type,
             Tag "C" Constructor, Tag "f" Function]
 
+test_unicode = do
+    let f = process
+    equal assert (f "數字 :: Int") ["數字"]
+    equal assert (f "(·), x :: Int") ["·", "x"]
 
-tokenize :: Text.Text -> [Token]
-tokenize = concat . map Main.tokenize . Main.stripCpp . Main.annotate "fn"
+test_data = do
+    let f = process
+    equal assert (f "data X\n") ["X"]
+    -- The extra X is suppressed.
+    equal assert (f "data X = X Int\n") ["X"]
+    equal assert (f "data Foo = Bar | Baz") ["Foo", "Bar", "Baz"]
+    equal assert (f "data Foo =\n\tBar\n\t| Baz") ["Foo", "Bar", "Baz"]
+    -- Records.
+    equal assert (f "data Foo a = Bar { field :: Field }")
+        ["Foo", "Bar", "field"]
+    equal assert (f "data R = R { a::X, b::Y }") ["R", "a", "b"]
+    equal assert (f "data R = R {\n\ta::X\n\t, b::Y\n\t}") ["R", "a", "b"]
+    equal assert (f "data R = R {\n\ta,b::X\n\t}") ["R", "a", "b"]
 
+    equal assert (f "data R = R {\n\ta :: !RealTime\n\t, b :: !RealTime\n\t}")
+        ["R", "a", "b"]
+
+test_gadt = do
+    let f = process
+    equal assert (f "data X where A :: X\n") ["X", "A"]
+    equal assert (f "data X where\n\tA :: X\n") ["X", "A"]
+    equal assert (f "data X where\n\tA :: X\n\tB :: X\n") ["X", "A", "B"]
+    equal assert (f "data X where\n\tA, B :: X\n") ["X", "A", "B"]
+
+test_families = do
+    let f = process
+    equal assert (f "type family X :: *\n") ["X"]
+    equal assert (f "data family X :: * -> *\n") ["X"]
+    equal assert (f "class C where\n\ttype X y :: *\n") ["C", "X"]
+    equal assert (f "class C where\n\tdata X y :: *\n") ["C", "X"]
+
+test_functions = do
+    let f = process
+    -- Multiple declarations.
+    equal assert (f "a,b::X") ["a", "b"]
+    -- With an operator.
+    equal assert (f "(+), a :: X") ["+", "a"]
+    -- Don't get fooled by literals.
+    equal assert (f "1 :: Int") []
+
+test_class = do
+    let f = process
+    equal assert (f "class (X x) => C a b where\n\tm :: a->b\n\tn :: c\n")
+        ["C", "m", "n"]
+    equal assert (f "class A a where f :: X\n") ["A", "f"]
+    -- indented inside where
+    equal assert (f "class X where\n\ta, (+) :: X\n") ["X", "a", "+"]
+    equal assert (f "class X where\n\ta :: X\n\tb, c :: Y")
+        ["X", "a", "b", "c"]
+    equal assert (f "class X\n\twhere\n\ta :: X\n\tb, c :: Y")
+        ["X", "a", "b", "c"]
+    equal assert (f "class X\n\twhere\n\ta ::\n\t\tX\n\tb :: Y")
+        ["X", "a", "b"]
+
+process :: Text.Text -> [String]
+process = map untag . Main.process "fn"
+
+untag :: Tag -> String
+untag (Right (Pos _ (Tag name _))) = Text.unpack name
+untag (Left warn) = "warn: " ++ warn
+
+tokenize :: Text.Text -> Main.UnstrippedTokens
+tokenize = Monoid.mconcat . map Main.tokenize . Main.stripCpp
+    . Main.annotate "fn"
+
 plist :: (Show a) => [a] -> IO ()
 plist xs = mapM_ (putStrLn . show) xs >> putChar '\n'
 
-extractTokens :: [Token] -> [Text.Text]
-extractTokens = Maybe.mapMaybe $ \token -> case Main.valOf token of
-    Token name -> Just name
-    Newline n -> Just (Text.pack ("nl " ++ show n))
+extractTokens :: Main.UnstrippedTokens -> [Text.Text]
+extractTokens = map (\token -> case Main.valOf token of
+    Token name -> name
+    Newline n -> Text.pack ("nl " ++ show n)) . Main.unstrippedTokensOf
 
-equal :: (Show a, Eq a) => a -> a -> IO ()
-equal x y = unless (x == y) $
-    putStrLn $ "__: " ++ show x ++ " /= " ++ show y
+equal :: (Show a, Eq a) => Assert z -> a -> a -> IO ()
+equal srcpos x y = unless (x == y) $
+    putStrLn $ "__ " ++ getSourceLoc srcpos ++ " " ++ show x ++ " /= " ++ show y
+
+type Assert a = Bool -> a -> String
+
+-- | Awful ghc hack to get source line location.
+getSourceLoc :: Assert a -> String
+getSourceLoc assert_ = takeWhile (/=' ') $ Unsafe.unsafePerformIO $
+    Exception.evaluate (assert_ False (error "Impossible"))
+        `Exception.catch` (\(Exception.AssertionFailed s) -> return s)
+
diff --git a/src/T.hs b/src/T.hs
new file mode 100644
--- /dev/null
+++ b/src/T.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE GADTs #-}
+module T where
+
+
+數字 :: Int
+數字 = 2
+
+(·) = (.)
+
+data X where
+    A, B :: X