diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,31 @@
+Copyright Evan Laforge 2011
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Evan Laforge nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
diff --git a/README b/README
new file mode 100644
--- /dev/null
+++ b/README
@@ -0,0 +1,13 @@
+See vimrc for an example of how to keep the tags file up to date automatically.
+
+Design decisions:
+
+- Only top-level functions with type declarations are tagged.
+
+Not supported:
+
+- \ continuation in strings is not parsed correctly.
+
+- Literate haskell.
+
+- Infix operators.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/fast-tags.cabal b/fast-tags.cabal
new file mode 100644
--- /dev/null
+++ b/fast-tags.cabal
@@ -0,0 +1,36 @@
+name: fast-tags
+version: 0.0.1
+cabal-version: >= 1.6
+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.
+    .
+    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.
+
+category: Haskell, Development
+license: BSD3
+license-file: LICENSE
+author: Evan Laforge
+maintainer: Evan Laforge <qdunkan@gmail.com>
+stability: experimental
+tested-with: GHC>=7.0.3
+data-files: README
+extra-source-files: src/*.hs
+
+source-repository head
+    type: darcs
+    location: http://ofb.net/~elaforge/darcs/fast-tags/
+
+executable fast-tags
+    main-is: Main.hs
+    hs-source-dirs: src
+    build-depends: base >= 3 && < 5, containers, text
+    ghc-options: -Wall -fno-warn-name-shadowing
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,353 @@
+{-# LANGUAGE OverloadedStrings, PatternGuards #-}
+{- |
+    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.
+    Or extend lushtags, the question is complete parsing ok?  It means I can't
+    do it on save, since I'd have to invoke the build system to de-hsc.
+-}
+module Main where
+import qualified Control.Exception as Exception
+import Control.Monad
+import qualified Data.Char as Char
+import qualified Data.Either as Either
+import qualified Data.List as List
+import qualified Data.Monoid as Monoid
+import qualified Data.Text as T
+import Data.Text (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 qualified System.IO.Error as IO.Error
+
+
+main :: IO ()
+main = do
+    args <- Environment.getArgs
+    (flags, inputs) <- case GetOpt.getOpt GetOpt.Permute options args of
+        (flags, inputs, []) -> return (flags, inputs)
+        (_, _, errs) -> usage $ "flag errors:\n" ++ List.intercalate ", " errs
+    let output = last $ "tags" : [fn | Output fn <- flags]
+    oldTags <- fmap (maybe [vimMagicLine] T.lines) $
+        catchENOENT $ Text.IO.readFile output
+    tags <- fmap concat (mapM processFile inputs)
+
+    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)
+    where
+    usage msg = putStr (GetOpt.usageInfo msg options)
+        >> System.Exit.exitSuccess
+
+data Flag = Output FilePath
+    deriving (Show)
+
+options :: [GetOpt.OptDescr Flag]
+options =
+    [ GetOpt.Option ['o'] [] (GetOpt.ReqArg Output "blorch")
+        "output file, defaults to 'tags'"
+    ]
+
+-- | 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 :: [FilePath] -> Text -> Bool
+isNewTag fns line = any (`T.isInfixOf` line) textFns
+    where textFns = map (T.pack . ('\t':)) fns
+
+merge :: [Text] -> [Text] -> [Text]
+merge [] ys = ys
+merge xs [] = xs
+merge (x:xs) (y:ys)
+    | x <= y = x : merge xs (y:ys)
+    | 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 $
+    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
+
+showType :: Type -> Char
+showType typ = case typ of
+    Module -> 'm'
+    Function -> 'f'
+    Class -> 'c'
+    Type -> 't'
+    Constructor -> 'C'
+
+-- * types
+
+data TagVal = Tag !Text !Type | Warning !String
+    deriving (Eq, Show)
+
+data Type = Module | Function | Class | Type | Constructor
+    deriving (Eq, Show)
+
+data TokenVal = Token !Text | Newline !Int
+    deriving (Eq, Show)
+
+type Tag = Pos TagVal
+type Token = Pos TokenVal
+type Line = Pos Text
+
+data Pos a = Pos {
+    posOf :: SrcPos
+    , valOf :: a
+    }
+
+data SrcPos = SrcPos {
+    posFile :: !FilePath
+    , posLine :: !Int
+    }
+
+instance (Show a) => Show (Pos a) where
+    show (Pos pos val) = show pos ++ ":" ++ show val
+instance Show SrcPos where
+    show (SrcPos fn line) = fn ++ ":" ++ show line
+
+processFile :: FilePath -> IO [Tag]
+processFile fn = fmap (process fn) (Text.IO.readFile fn)
+
+process :: FilePath -> Text -> [Tag]
+process fn = dropDups tagText . concatMap blockTags . breakBlocks
+    . stripComments . concatMap tokenize . stripCpp . annotate fn
+    where
+    tagText (Pos _ (Tag text _)) = text
+    tagText (Pos _ (Warning warn)) = T.pack warn
+
+
+-- * tokenize
+
+annotate :: FilePath -> Text -> [Line]
+annotate fn text =
+    [Pos (SrcPos fn num) line | (num, line) <- zip [1..] (T.lines text)]
+
+-- | Also strips out hsc detritus.
+stripCpp :: [Line] -> [Line]
+stripCpp = filter $ not . ("#" `T.isPrefixOf`) . valOf
+
+tokenize :: Line -> [Token]
+tokenize (Pos pos line) = map (Pos pos) (tokenizeLine line)
+
+tokenizeLine :: Text -> [TokenVal]
+tokenizeLine text = Newline nspaces : go line
+    where
+    nspaces = 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 == '"' = 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
+        where
+        text = T.dropWhile Char.isSpace unstripped
+        c = T.head text
+        cs = T.tail text
+    isIdent c = Char.isAlphaNum c || c == '.' || c == '\'' || 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.
+--
+-- 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
+
+stripComments :: [Token] -> [Token]
+stripComments = 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
+
+
+-- | 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
+    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
+    -- 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)
+
+
+-- * 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
+    [] -> []
+    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 X * = ...
+    Pos _ (Token "type") : 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
+    -- class * => X where X :: * ...
+    Pos pos (Token "class") : rest -> classTags pos rest
+    Pos pos (Token name) : Pos _ (Token "::") : _ -> [mktag pos name Function]
+    _ -> []
+
+mktag :: SrcPos -> Text -> Type -> Pos TagVal
+mktag pos name typ = Pos pos (Tag name typ)
+
+warning :: SrcPos -> String -> Pos TagVal
+warning pos warn = Pos pos (Warning warn)
+
+unexpected :: SrcPos -> [Token] -> [Token] -> String -> [Tag]
+unexpected prevPos tokens 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 tokens) = posOf (last tokens)
+        | otherwise = prevPos
+
+-- | * = 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 * ="
+
+-- | [] (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
+        Pos pos (Token name) : rest ->
+            mktag pos name Constructor : collectRest rest
+        rest -> unexpected prevPos tokens 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
+        [] -> []
+
+-- | * => 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 * =>"
+    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
+        [] -> []
+
+dropLine :: [Token] -> [Token]
+dropLine = drop 1 . dropWhile (not . isNewline)
+
+isNewline :: Token -> Bool
+isNewline (Pos _ (Newline _)) = True
+isNewline _ = False
+
+dropUntil :: Text -> [Token] -> [Token]
+dropUntil token = drop 1 . dropWhile ((/= Token token) . valOf)
+
+
+-- * misc
+
+(<>) :: (Monoid.Monoid a) => a -> a -> a
+(<>) = Monoid.mappend
+
+-- | 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)
+
+dropDups :: (Eq k) => (a -> k) -> [a] -> [a]
+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
new file mode 100644
--- /dev/null
+++ b/src/Main_test.hs
@@ -0,0 +1,87 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main_test where
+import Control.Monad
+import qualified Data.Maybe as Maybe
+import qualified Data.Text as Text
+
+import qualified Main as Main
+import Main (Token, TokenVal(..), TagVal(..), Type(..))
+
+
+-- This is kind of annoying without line numbers on equal and automatic
+-- test_* collection...
+main = do
+    test_tokenize
+    test_breakString
+    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"]
+
+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", "")
+    -- String continuation isn't implemented yet.
+    equal (f "hi \\") ("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")
+        ["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"]]
+    -- 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"]]
+
+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]
+
+    -- The extra X is suppressed.
+    equal (f "data X = X Int\n") [Tag "X" Type]
+
+    equal (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]
+
+
+tokenize :: Text.Text -> [Token]
+tokenize = concat . 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))
+
+equal :: (Show a, Eq a) => a -> a -> IO ()
+equal x y = unless (x == y) $
+    putStrLn $ "__: " ++ show x ++ " /= " ++ show y