diff --git a/AUTHORS b/AUTHORS new file mode 100644 --- /dev/null +++ b/AUTHORS @@ -0,0 +1,1 @@ +Bit Connor diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,19 @@ +Copyright (C) 2011 The lushtags Authors (see AUTHORS file) + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,60 @@ +lushtags +======== + +Create ctags compatible tags files for Haskell programs + +Similar programs are [hasktags][1], [gasbag][2], [hothasktags][3], and GHC's +builtin ctags generation. + +lushtags differs from these by being designed to have smooth integration with +the [Vim Tagbar][4] plugin. + +Tagbar is nice because it deals with creating tags automatically. There is no +need to manually run commands or keep track of tag files. Just open any Haskell +file in Vim and the Tagbar window will instantly show an interactive browsable +list of all the functions and declarations in the file. This window also +updates automatically as you edit the file. + +The tags created by lushtags are marked with several extensions, so that when +used with Tagbar you get these features: + +- Type signatures are displayed for functions. +- Tags are properly scoped so that, for example, data declarations appear as a + tree with their constructors scoped as children. +- Definitions that are exported from the module are marked as "public" and + appear emphasized in Tagbar. +- Tag locations are internally stored as patterns, not line numbers, so that + you can correctly jump to tags even if they have moved in the source code + during editing. + +![screenshot](https://github.com/bitc/lushtags/raw/master/doc/screenshot-tagbar-2011-09-19.png) + +[1]: http://hackage.haskell.org/package/hasktags +[2]: http://kingfisher.nfshost.com/sw/gasbag/ +[3]: http://hackage.haskell.org/package/hothasktags +[4]: http://majutsushi.github.com/tagbar/ + +Using lushtags with Vim and the Tagbar plugin +--------------------------------------------- + +1. Build and install the lushtags executable + + $ cabal configure + $ cabal build + $ cabal install + +2. Install the Tagbar plugin. Tagbar can be found at + + + + +3. Install the included Haskell Tagbar configuration: + + $ cp util/tagbar-haskell.vim ~/.vim/plugin/ + +4. Try it out: + + $ vim Hello.hs + +Now open the Tagbar with the command `:TagbarOpen`. An interactive sidebar will +appear with all of the tags in your Haskell source file. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/doc/screenshot-tagbar-2011-09-19.png b/doc/screenshot-tagbar-2011-09-19.png new file mode 100644 Binary files /dev/null and b/doc/screenshot-tagbar-2011-09-19.png differ diff --git a/lushtags.cabal b/lushtags.cabal new file mode 100644 --- /dev/null +++ b/lushtags.cabal @@ -0,0 +1,59 @@ +name: lushtags +version: 0.0.1 +cabal-version: >=1.10 +build-type: Simple +license: MIT +license-file: LICENSE +author: Bit Connor +homepage: https://github.com/bitc/lushtags +maintainer: bit@mutantlemon.com +category: Development +synopsis: Create ctags compatible tags files for Haskell programs +description: + > Create ctags compatible tags files for Haskell programs + > + > Similar programs are [hasktags][1], [gasbag][2], [hothasktags][3], and GHC's + > builtin ctags generation. + > + > lushtags differs from these by being designed to have smooth integration with + > the [Vim Tagbar][4] plugin. + > + > Tagbar is nice because it deals with creating tags automatically. There is no + > need to manually run commands or keep track of tag files. Just open any Haskell + > file in Vim and the Tagbar window will instantly show an interactive browsable + > list of all the functions and declarations in the file. This window also + > updates automatically as you edit the file. + > + > The tags created by lushtags are marked with several extensions, so that when + > used with Tagbar you get these features: + > + > - Type signatures are displayed for functions. + > - Tags are properly scoped so that, for example, data declarations appear as a + > tree with their constructors scoped as children. + > - Definitions that are exported from the module are marked as "public" and + > appear emphasized in Tagbar. + > - Tag locations are internally stored as patterns, not line numbers, so that + > you can correctly jump to tags even if they have moved in the source code + > during editing. + > + > ![screenshot](https://github.com/bitc/lushtags/raw/master/doc/screenshot-tagbar-2011-09-19.png) + > + > [1]: http://hackage.haskell.org/package/hasktags + > [2]: http://kingfisher.nfshost.com/sw/gasbag/ + > [3]: http://hackage.haskell.org/package/hothasktags + > [4]: http://majutsushi.github.com/tagbar/ + +source-repository head + type: git + location: git://github.com/bitc/lushtags.git + +executable lushtags + hs-source-dirs: src + main-is: Main.hs + other-modules: Tags + default-language: Haskell98 + ghc-options: -Wall + build-depends: base >= 4 && < 5, + vector == 0.9.*, + text == 0.11.*, + haskell-src-exts == 1.11.* diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,78 @@ +---------------------------------------------------------------------------- +-- | +-- Module : Main +-- License : MIT (see LICENSE) +-- Authors : Bit Connor +-- +-- Maintainer : Bit Connor +-- Stability : unstable +-- Portability : portable +-- +-- lushtags, Create ctags compatible tags files for Haskell programs +-- +----------------------------------------------------------------------------- + +module Main (main) where + +import Data.List (isPrefixOf, partition) +import Data.Vector(Vector, fromList) +import Language.Haskell.Exts.Annotated (parseFileContentsWithMode, ParseMode(..), knownExtensions, ParseResult(ParseOk, ParseFailed)) +import System.Environment (getArgs, getProgName) +import System.IO (hPutStrLn, stderr) +import qualified Data.Text as T (unpack, lines, pack, unlines) +import qualified Data.Text.IO as T (readFile, putStr) + +import Tags (Tag, createTags, tagToString) + +main :: IO () +main = do + rawArgs <- getArgs + let (options, files) = getOptions rawArgs + ignore_parse_error = "--ignore-parse-error" `elem` options + case files of + [] -> do + progName <- getProgName + hPutStrLn stderr $ "Usage: " ++ progName ++ " [options] [--] " + filename:_ -> processFile filename ignore_parse_error >>= printTags + +printTags :: [Tag] -> IO () +printTags tags = + T.putStr $ T.unlines $ map (T.pack . tagToString) tags + +processFile :: FilePath -> Bool -> IO [Tag] +processFile file ignore_parse_error = do + (fileContents, fileLines) <- loadFile file + case parseFileContentsWithMode parseMode fileContents of + ParseFailed loc message -> + if ignore_parse_error then + return [] + else + -- TODO Better error reporting + fail $ "Parse error: " ++ show loc ++ ": " ++ message + ParseOk parsedModule -> return $ createTags (parsedModule, fileLines) + where + parseMode = ParseMode + { parseFilename = file + , extensions = knownExtensions + , ignoreLanguagePragmas = False + , ignoreLinePragmas = True + , fixities = Nothing + } + +loadFile :: FilePath -> IO (String, Vector String) +loadFile file = do + text <- T.readFile file + let fullContents = T.unpack text + let textLines = T.lines text + let stringLines = map T.unpack textLines + let fileLines = fromList stringLines + return (fullContents, fileLines) + +getOptions :: [String] -> ([String], [String]) +getOptions args = + let (start, end) = span (/= "--") args + (options, nonOptions) = partition (isPrefixOf "-") start + in (options, nonOptions ++ dropSep end) + where + dropSep ("--":xs) = xs + dropSep xs = xs diff --git a/src/Tags.hs b/src/Tags.hs new file mode 100644 --- /dev/null +++ b/src/Tags.hs @@ -0,0 +1,218 @@ +---------------------------------------------------------------------------- +-- | +-- Module : Tags +-- License : MIT (see LICENSE) +-- Authors : Bit Connor +-- +-- Maintainer : Bit Connor +-- Stability : unstable +-- Portability : portable +-- +-- Extract Tags from a Haskell Module +-- +----------------------------------------------------------------------------- + +module Tags + ( + Tag(..) + , createTags + , tagToString + ) where + +import Data.Vector(Vector, (!)) +import Language.Haskell.Exts.Annotated (SrcSpan(..), SrcSpanInfo(..)) +import Language.Haskell.Exts.Annotated.Syntax +import Language.Haskell.Exts.Pretty (prettyPrintStyleMode, Style(..), Mode(OneLineMode), defaultMode) + +data Tag = Tag + { tagName :: String + , tagFile :: String + , tagPattern :: String + , tagKind :: TagKind + , tagLine :: Int + , tagParent :: Maybe (TagKind, String) + , tagSignature :: Maybe String + , tagAccess :: Maybe TagAccess + } + deriving (Eq, Ord, Show) + +data TagKind + = TModule + | TExport + | TImport + | TType + | TData + | TNewType + | TConstructor + | TFunction + deriving (Eq, Ord, Show) + +-- Access modifiers comes from the C++ world. Haskell doesn't have them, but +-- they are useful for marking our tags with similar meanings. For example, +-- marking all exported functions as public, or marking qualified imports +-- differently from unqualified ones. +data TagAccess + = AccessPublic + | AccessPrivate + | AccessProtected + deriving (Eq, Ord, Show) + +-- First letter of each kind name must be unique! +tagKindName :: TagKind -> String +tagKindName TModule = "module" +tagKindName TExport = "export" +tagKindName TImport = "import" +tagKindName TType = "type" +tagKindName TData = "data" +tagKindName TNewType = "newtype" +tagKindName TConstructor = "constructor" +tagKindName TFunction = "function" + +tagKindLetter :: TagKind -> Char +tagKindLetter = head . tagKindName + +tagToString :: Tag -> String +tagToString tag = + let parentStr = case tagParent tag of + Nothing -> "" + Just (kind, name) -> "\t" ++ tagKindName kind ++ ":" ++ name + signatureStr = case tagSignature tag of + Nothing -> "" + Just sig -> "\tsignature:("++ sig ++ ")" + accessStr = case tagAccess tag of + Nothing -> "" + Just AccessPublic -> "\taccess:public" + Just AccessPrivate -> "\taccess:private" + Just AccessProtected -> "\taccess:protected" + in tagName tag ++ "\t" ++ + tagFile tag ++ "\t" ++ + tagPattern tag ++ ";\"\t" ++ + tagKindLetter (tagKind tag) : "\t" ++ + "line:" ++ show (tagLine tag) ++ + parentStr ++ + signatureStr ++ + accessStr + +type FileLines = Vector String +type TagC = FileLines -> Tag + +createTags :: (Module SrcSpanInfo, FileLines) -> [Tag] +createTags (Module _ mbHead _ imports decls, fileLines) = + let moduleTags = map tagC (maybe [] createModuleTags mbHead) + importTags = map (tagC . createImportTag) imports + declsTags = map tagC (concatMap createDeclTags decls) + exportTags = filter ((==TExport) . tagKind) moduleTags + -- TODO If there is no ModuleHead then apply public access modifier to all + -- declarations tags + in moduleTags ++ importTags ++ (applyAccessModifiers exportTags declsTags) + where + tagC :: TagC -> Tag + tagC = ($ fileLines) +createTags _ = error "TODO Module is XmlPage/XmlHybrid (!)" + +-- Apply a public access modifier to all declarations that are listed in the +-- module export specification +applyAccessModifiers :: [Tag] -> [Tag] -> [Tag] +applyAccessModifiers exportTags declTags = map applySingle declTags + where + applySingle :: Tag -> Tag + applySingle tag = + let name = tagName tag + exported = any ((==name) . tagName) exportTags + in if exported + then tag { tagAccess = Just AccessPublic } + else tag + +createTag :: String -> TagKind -> Maybe (TagKind, String) -> Maybe String -> Maybe TagAccess -> SrcSpanInfo -> TagC +createTag name kind parent signature access (SrcSpanInfo (SrcSpan file line _ _ _) _) fileLines = Tag + { tagName = name + , tagFile = file + -- TODO This probably needs to be escaped: + , tagPattern = "/^" ++ (fileLines ! (line - 1)) ++ "$/" + , tagKind = kind + , tagLine = line + , tagParent = parent + , tagSignature = signature + , tagAccess = access + } + +createModuleTags :: ModuleHead SrcSpanInfo -> [TagC] +createModuleTags (ModuleHead _ (ModuleName moduleLoc moduleName) _ mbExportSpecList) = + case mbExportSpecList of + Nothing -> [moduleTag] + Just (ExportSpecList _ exports) -> + moduleTag : map createExportTag exports + where + moduleTag = createTag moduleName TModule Nothing Nothing Nothing moduleLoc + createExportTag :: ExportSpec SrcSpanInfo -> TagC + createExportTag exportSpec = + let (name, loc) = extractExportSpec exportSpec + in createTag name TExport Nothing Nothing Nothing loc + +createImportTag :: ImportDecl SrcSpanInfo -> TagC +createImportTag (ImportDecl loc (ModuleName _ name) qualified _ _ mbAlias mbSpecs) = + let signature = case mbAlias of + Nothing -> Nothing + Just (ModuleName _ alias) -> Just alias + access = case mbSpecs of + Just (ImportSpecList _ False _) -> + if qualified then Just AccessProtected else Nothing + Just (ImportSpecList _ True _) -> + -- imported names are excluded by 'hiding' + if qualified then Just AccessProtected else Just AccessPrivate + Nothing -> if qualified then Just AccessProtected else Just AccessPublic + in createTag name TImport Nothing signature access loc + +createDeclTags :: Decl SrcSpanInfo -> [TagC] +createDeclTags (TypeDecl _ hd _) = + let (name, loc) = extractDeclHead hd + in [createTag name TType Nothing Nothing Nothing loc] +createDeclTags (DataDecl _ dataOrNew _ hd constructors _) = + let (name, loc) = extractDeclHead hd + kind = case dataOrNew of + DataType _ -> TData + NewType _ -> TNewType + dataTag = createTag name kind Nothing Nothing Nothing loc + in dataTag : map (createConstructorTag (kind, name)) constructors +createDeclTags (TypeSig _ names t) = + map createFunctionTag names + where + sig = prettyPrintStyleMode (Style OneLineMode 0 0) defaultMode t + createFunctionTag :: Name SrcSpanInfo -> TagC + createFunctionTag name = + let (n, loc) = extractName name + in createTag n TFunction Nothing (Just sig) Nothing loc +createDeclTags _ = [] + +-- TODO Also create tags for record fields +createConstructorTag :: (TagKind, String) -> QualConDecl SrcSpanInfo -> TagC +createConstructorTag parent (QualConDecl _ _ _ con) = + let (name, loc) = extractConDecl con + in createTag name TConstructor (Just parent) Nothing Nothing loc + +extractExportSpec :: ExportSpec SrcSpanInfo -> (String, SrcSpanInfo) +extractExportSpec (EVar _ name) = extractQName name +extractExportSpec (EAbs _ name) = extractQName name +extractExportSpec (EThingAll _ name) = extractQName name +extractExportSpec (EThingWith _ name _) = extractQName name +extractExportSpec (EModuleContents _ (ModuleName loc name)) = (name, loc) + +extractDeclHead :: DeclHead SrcSpanInfo -> (String, SrcSpanInfo) +extractDeclHead (DHead _ name _) = extractName name +extractDeclHead (DHInfix _ _ name _) = extractName name +extractDeclHead (DHParen _ hd') = extractDeclHead hd' + +extractConDecl :: ConDecl SrcSpanInfo -> (String, SrcSpanInfo) +extractConDecl (ConDecl _ name _) = extractName name +extractConDecl (InfixConDecl _ _ name _) = extractName name +extractConDecl (RecDecl _ name _) = extractName name + +extractName :: Name SrcSpanInfo -> (String, SrcSpanInfo) +extractName (Ident loc name) = (name, loc) +extractName (Symbol loc name) = (name, loc) + +extractQName :: QName SrcSpanInfo -> (String, SrcSpanInfo) +extractQName (Qual loc (ModuleName _ moduleName) name) = + (moduleName ++ "." ++ fst (extractName name), loc) +extractQName (UnQual loc name) = (fst (extractName name), loc) +extractQName (Special loc _) = ("_special_", loc) -- TODO diff --git a/util/tagbar-haskell.vim b/util/tagbar-haskell.vim new file mode 100644 --- /dev/null +++ b/util/tagbar-haskell.vim @@ -0,0 +1,42 @@ +" This is a Haskell configuration for the Vim Tagbar plugin that uses +" lushtags. +" +" Tagbar can be found at: +" http://www.vim.org/scripts/script.php?script_id=3465 +" http://majutsushi.github.com/tagbar/ +" +" Paste this in to your vimrc file +" OR copy this file into your .vim/plugin directory +" OR load it from your vimrc file by adding a line like: +" +" source /path/to/tagbar-haskell.vim + +if executable('lushtags') + let g:tagbar_type_haskell = { + \ 'ctagsbin' : 'lushtags', + \ 'ctagsargs' : '--ignore-parse-error --', + \ 'kinds' : [ + \ 'm:module:0', + \ 'e:exports:1', + \ 'i:imports:1', + \ 't:declarations:0', + \ 'd:declarations:1', + \ 'n:declarations:1', + \ 'f:functions:0', + \ 'c:constructors:0' + \ ], + \ 'sro' : '.', + \ 'kind2scope' : { + \ 'd' : 'data', + \ 'n' : 'newtype', + \ 'c' : 'constructor', + \ 't' : 'type' + \ }, + \ 'scope2kind' : { + \ 'data' : 'd', + \ 'newtype' : 'n', + \ 'constructor' : 'c', + \ 'type' : 't' + \ } + \ } +endif