hothasktags 0.3.3 → 0.3.4
raw patch · 2 files changed
+280/−173 lines, 2 filesdep +arraydep +optparse-applicativedep +splitdep −cmdargs
Dependencies added: array, optparse-applicative, split
Dependencies removed: cmdargs
Files
- Main.hs +276/−169
- hothasktags.cabal +4/−4
Main.hs view
@@ -1,32 +1,39 @@-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE PatternGuards #-} module Main where +import Options.Applicative import qualified Language.Haskell.Exts.Annotated as L-import System.Console.CmdArgs-import System.IO (hPutStrLn, stderr, stdout, IOMode(..), openFile, hClose)-import qualified Data.Map as Map+import System.IO+import GHC.IO.Handle (HandlePosition)+import qualified Data.Map.Strict as Map import qualified Language.Preprocessor.Cpphs as CPP-import Control.Monad (forM)+import Control.Exception (ErrorCall(..), catch, evaluate)+import System.Exit (exitFailure)+import Control.Monad+import qualified Data.Array.Unboxed as A import Data.List (sort) import Data.Maybe (fromMaybe)-import System.FilePath.Posix (takeFileName)+import Data.List.Split (endBy) type Database = Map.Map String (L.Module L.SrcSpanInfo)+type LineInfo = Map.Map FilePath (A.Array Int (HandlePosition, String)) -data Defn = Defn FilePath Int -- file, line+data Defn = Defn FilePath Int Int -- file, line, end col deriving Show localDecls :: L.Module L.SrcSpanInfo -> Map.Map String Defn localDecls (L.Module _ _ _ _ decls) = Map.fromList $ concatMap extract decls where- extract (L.TypeDecl _ head _) = extractDeclHead head- extract (L.TypeFamDecl _ head _) = extractDeclHead head- extract (L.DataDecl _ _ _ head decls _) = extractDeclHead head ++ concatMap extractQualConDecl decls- extract (L.GDataDecl _ _ _ head _ decls _) = extractDeclHead head ++ concatMap extractGadtDecl decls- extract (L.DataFamDecl _ _ head _) = extractDeclHead head- extract (L.ClassDecl _ _ head _ clsdecls) = extractDeclHead head ++ concatMap extractClassDecl (fromMaybe [] clsdecls)+ extract (L.TypeDecl _ hd _) = extractDeclHead hd+ extract (L.TypeFamDecl _ hd _) = extractDeclHead hd+ extract (L.DataDecl _ _ _ hd decls' _) =+ extractDeclHead hd ++ concatMap extractQualConDecl decls'+ extract (L.GDataDecl _ _ _ hd _ decls' _) =+ extractDeclHead hd ++ concatMap extractGadtDecl decls'+ extract (L.DataFamDecl _ _ hd _) = extractDeclHead hd+ extract (L.ClassDecl _ _ hd _ clsdecls) =+ extractDeclHead hd ++ concatMap extractClassDecl (fromMaybe [] clsdecls) extract (L.TypeSig _ names _) = concatMap extractName names extract (L.FunBind _ (L.Match _ name _ _ _ : _)) = extractName name extract (L.FunBind _ (L.InfixMatch _ _ name _ _ _ : _)) = extractName name@@ -50,8 +57,10 @@ extractPat (L.PBangPat _ pat) = extractPat pat extractPat _ = [] - extractQualConDecl (L.QualConDecl _ _ _ (L.ConDecl _ name _)) = extractName name- extractQualConDecl (L.QualConDecl _ _ _ (L.RecDecl _ name fields)) = extractName name ++ concatMap extractFieldDecl fields+ extractQualConDecl (L.QualConDecl _ _ _ (L.ConDecl _ name _)) =+ extractName name+ extractQualConDecl (L.QualConDecl _ _ _ (L.RecDecl _ name fields)) =+ extractName name ++ concatMap extractFieldDecl fields extractQualConDecl _ = [] extractFieldDecl (L.FieldDecl _ names _) = concatMap extractName names@@ -59,234 +68,332 @@ extractGadtDecl (L.GadtDecl _ name _ _) = extractName name extractClassDecl (L.ClsDecl _ decl) = extract decl- extractClassDecl (L.ClsDataFam _ _ head _) = extractDeclHead head- extractClassDecl (L.ClsTyFam _ head _) = extractDeclHead head+ extractClassDecl (L.ClsDataFam _ _ hd _) = extractDeclHead hd+ extractClassDecl (L.ClsTyFam _ hd _) = extractDeclHead hd extractClassDecl _ = [] extractName (L.Ident loc name) = [(name, getLoc loc)]- extractName (L.Symbol _ _) = [] -- no symbols for now+ extractName (L.Symbol loc name) = [(name, getLoc loc)] localDecls _ = Map.empty getLoc :: L.SrcSpanInfo -> Defn-getLoc (L.SrcSpanInfo (L.SrcSpan file line _ _ _) _) = Defn file line+getLoc (L.SrcSpanInfo (L.SrcSpan file line _ _ ecol) _) =+ Defn file line ecol thingMembers :: L.Module L.SrcSpanInfo -> String -> [String] thingMembers (L.Module _ _ _ _ decls) name = concatMap extract decls- where- extract (L.DataDecl _ _ _ head condecls _) | nameOfHead head == Just name = concatMap getQualConDecl condecls- extract (L.GDataDecl _ _ _ head _ condecls _) | nameOfHead head == Just name = concatMap getGadtDecl condecls- extract (L.ClassDecl _ _ head _ (Just classdecls)) | nameOfHead head == Just name = concatMap getClassDecl classdecls+ where+ extract (L.DataDecl _ _ _ hd condecls _)+ | nameOfHead hd == Just name = concatMap getQualConDecl condecls+ extract (L.GDataDecl _ _ _ hd _ condecls _)+ | nameOfHead hd == Just name = concatMap getGadtDecl condecls+ extract (L.ClassDecl _ _ hd _ (Just classdecls))+ | nameOfHead hd == Just name = concatMap getClassDecl classdecls extract _ = [] - getQualConDecl (L.QualConDecl _ _ _ (L.ConDecl _ (L.Ident _ name) _)) = [name]- getQualConDecl (L.QualConDecl _ _ _ (L.RecDecl _ (L.Ident _ name) fields)) = name : concatMap getField fields+ getQualConDecl (L.QualConDecl _ _ _ (L.ConDecl _ (L.Ident _ name') _)) =+ [name']+ getQualConDecl (L.QualConDecl _ _ _ (L.RecDecl _ (L.Ident _ name') flds)) =+ name' : concatMap getField flds getQualConDecl _ = [] - getGadtDecl (L.GadtDecl _ name _ _) = getName name- + getGadtDecl (L.GadtDecl _ name' _ _) = getName name'+ getField (L.FieldDecl _ names _) = concatMap getName names - getClassDecl (L.ClsDecl _ (L.FunBind _ (L.Match _ name _ _ _ : _))) = getName name- getClassDecl (L.ClsDecl _ (L.PatBind _ (L.PVar _ name) _ _)) = getName name + getClassDecl (L.ClsDecl _ (L.FunBind _ (L.Match _ name' _ _ _ : _))) =+ getName name'+ getClassDecl (L.ClsDecl _ (L.PatBind _ (L.PVar _ name') _ _)) =+ getName name' getClassDecl _ = [] - getName (L.Ident _ name) = [name]+ getName (L.Ident _ name') = [name'] getName _ = [] - nameOfHead (L.DHead _ (L.Ident _ name)) = Just name- nameOfHead (L.DHInfix _ _ (L.Ident _ name)) = Just name+ nameOfHead (L.DHead _ (L.Ident _ name')) = Just name'+ nameOfHead (L.DHInfix _ _ (L.Ident _ name')) = Just name' nameOfHead (L.DHParen _ h) = nameOfHead h nameOfHead _ = Nothing thingMembers _ _ = [] modExports :: Database -> String -> Map.Map String Defn-modExports db modname = - case Map.lookup modname db of- Nothing -> Map.empty- Just mod -> Map.filterWithKey (\k _ -> exported mod k) (localDecls mod)+modExports db modname = case Map.lookup modname db of+ Nothing -> Map.empty+ Just mod' -> Map.filterWithKey (\k _ -> exported mod' k) (localDecls mod') exported :: L.Module L.SrcSpanInfo -> String -> Bool-exported mod@(L.Module _ (Just (L.ModuleHead _ _ _ (Just (L.ExportSpecList _ specs)))) _ _ _) name = any (matchesSpec name) specs- where- matchesSpec name (L.EVar _ _ (L.UnQual _ (L.Ident _ name'))) = name == name'- matchesSpec name (L.EAbs _ (L.UnQual _ (L.Ident _ name'))) = name == name'- matchesSpec name (L.EThingAll _ (L.UnQual _ (L.Ident _ name'))) = name == name' || (name `elem` thingMembers mod name')- matchesSpec name (L.EThingWith _ (L.UnQual _ (L.Ident _ name')) cnames) = name == name' || any (matchesCName name) cnames- matchesSpec _ (L.EModuleContents _ (L.ModuleName _ _)) = False -- XXX wrong, moduleScope handles it though+exported mod'@(L.Module _+ (Just (L.ModuleHead _ _ _+ (Just (L.ExportSpecList _ specs)))) _ _ _) name =+ any (matchesSpec name) specs+ where+ matchesSpec nm (L.EVar _ _ (L.UnQual _ (L.Ident _ name'))) = nm == name'+ matchesSpec nm (L.EAbs _ (L.UnQual _ (L.Ident _ name'))) = nm == name'+ matchesSpec nm (L.EThingAll _ (L.UnQual _ (L.Ident _ name'))) =+ nm == name' || (nm `elem` thingMembers mod' name')+ matchesSpec nm (L.EThingWith _ (L.UnQual _ (L.Ident _ name')) cnames) =+ nm == name' || any (matchesCName nm) cnames+ -- XXX this is wrong, moduleScope handles it though+ matchesSpec _ (L.EModuleContents _ (L.ModuleName _ _)) = False matchesSpec _ _ = False- - matchesCName name (L.VarName _ (L.Ident _ name')) = name == name'- matchesCName name (L.ConName _ (L.Ident _ name')) = name == name'++ matchesCName nm (L.VarName _ (L.Ident _ name')) = nm == name'+ matchesCName nm (L.ConName _ (L.Ident _ name')) = nm == name' matchesCName _ _ = False exported _ _ = True moduleScope :: Database -> L.Module L.SrcSpanInfo -> Map.Map String Defn-moduleScope db mod@(L.Module _ modhead _ imports _) = Map.unions $ moduleItself : localDecls mod : map extractImport imports+moduleScope db mod'@(L.Module _ modhead _ imports _) =+ Map.unions $ moduleItself : localDecls mod' : map extractImport imports where-- moduleItself = moduleDecl modhead `Map.union` enclosingFilename mod+ moduleItself = moduleDecl modhead - moduleDecl (Just (L.ModuleHead l (L.ModuleName _ name) _ _)) = Map.singleton name (getLoc l)- moduleDecl _ = Map.empty+ moduleDecl (Just (L.ModuleHead l (L.ModuleName _ name) _ _)) =+ Map.singleton name (getLoc l)+ moduleDecl _ = Map.empty - enclosingFilename (L.Module l _ _ _ _) = Map.singleton (filename l) (getLoc l)- enclosingFilename _ = Map.empty+ extractImport decl@(L.ImportDecl { L.importModule = L.ModuleName _ name+ , L.importSpecs = spec+ }) =+ let extraExports+ | Just (L.ModuleHead _ _ _+ (Just (L.ExportSpecList _ especs))) <- modhead =+ Map.unions [ modExports db modname |+ L.EModuleContents _ (L.ModuleName _ modname)+ <- especs ]+ | otherwise = Map.empty in - filename (L.SrcSpanInfo (L.SrcSpan file _ _ _ _) _) = takeFileName file- - extractImport decl@(L.ImportDecl { L.importModule = L.ModuleName _ name, L.importSpecs = spec }) = - Map.unions [- if L.importQualified decl then Map.empty else names,- Map.mapKeys ((name ++ ".") ++) names,- case L.importAs decl of- Nothing -> Map.empty- Just (L.ModuleName _ name') -> Map.mapKeys ((name' ++ ".") ++) names,- extraExports- ]- + Map.unions [+ if L.importQualified decl+ then Map.empty+ else names+ , Map.mapKeys ((name ++ ".") ++) names+ , case L.importAs decl of+ Nothing -> Map.empty+ Just (L.ModuleName _ name') ->+ Map.mapKeys ((name' ++ ".") ++) names+ , extraExports+ ] where- names | Just (L.ImportSpecList _ True specs) <- spec = normalExports `Map.difference` (Map.fromList (map (flip (,) ()) (concatMap specName specs)))- | Just (L.ImportSpecList _ False specs) <- spec = Map.filterWithKey (\k _ -> k `elem` concatMap specName specs) normalExports- | otherwise = normalExports-- normalExports = modExports db name+ names | Just (L.ImportSpecList _ True specs) <- spec =+ let s = map (flip (,) ()) (concatMap specName specs) in+ normalExports `Map.difference` Map.fromList s+ | Just (L.ImportSpecList _ False specs) <- spec =+ let f k _ = k `elem` concatMap specName specs in+ Map.filterWithKey f normalExports+ | otherwise = normalExports - specName (L.IVar _ _ (L.Ident _ name)) = [name]- specName (L.IAbs _ (L.Ident _ name)) = [name]- specName (L.IThingAll _ (L.Ident _ name)) = [name] -- XXX incorrect, need its member names- specName (L.IThingWith _ (L.Ident _ name) cnames) = name : concatMap cname cnames- specName _ = []+ normalExports = modExports db name - cname (L.VarName _ (L.Ident _ name)) = [name]- cname (L.ConName _ (L.Ident _ name)) = [name]- cname _ = []+ specName (L.IVar _ _ (L.Ident _ name')) = [name']+ specName (L.IAbs _ (L.Ident _ name')) = [name']+ -- XXX incorrect, need its member names+ specName (L.IThingAll _ (L.Ident _ name')) = [name']+ specName (L.IThingWith _ (L.Ident _ name') cnames) =+ name' : concatMap cname cnames+ specName _ = [] - extraExports | Just (L.ModuleHead _ _ _ (Just (L.ExportSpecList _ especs))) <- modhead =- Map.unions [ modExports db modname | L.EModuleContents _ (L.ModuleName _ modname) <- especs ]- | otherwise = Map.empty+ cname (L.VarName _ (L.Ident _ name')) = [name']+ cname (L.ConName _ (L.Ident _ name')) = [name']+ cname _ = [] moduleScope _ _ = Map.empty -makeTag :: FilePath -> (String, Defn) -> String-makeTag refFile (name, Defn file line) = name ++ "\t" ++ file ++ "\t" ++ show line ++ ";\"\t" ++ "file:" ++ refFile+makeVimTags :: FilePath -> Map.Map String Defn -> LineInfo -> IO [String]+makeVimTags refFile m _ = pure $ map (makeTag refFile) (Map.assocs m)+ where+ makeTag refFile' (name, Defn file line _) =+ name ++ "\t" ++ file ++ "\t" ++ show line ++ ";\"\t" ++ "file:" +++ refFile' -makeTags :: FilePath -> Map.Map String Defn -> [String]-makeTags refFile = map (makeTag refFile) . Map.assocs+makeEmacsTags :: FilePath -> Map.Map String Defn -> LineInfo -> IO [String]+makeEmacsTags refFile m li = do+ tags <- mapM (makeTag refFile) (Map.assocs m)+ let tagsLen = show (sum $ map length tags)+ return $ "\x0c":(refFile ++ "," ++ tagsLen):tags+ where+ makeTag _ (name, Defn file line ecol) = do+ ms <- catch (evaluate $ li Map.! file) $ \(ErrorCall _) -> do+ hPutStrLn stderr $ "hothasktags: couldn't find '" ++ file ++ "'"+ exitFailure+ let linenum = show line+ (offset, leader) =+ let x = ms A.! (line - 1) in+ (show $ fst x, take (ecol - 1) $ snd x)+ return $ leader ++ "\x7f" ++ name ++ "\x01" ++ linenum ++ "," ++ offset haskellSource :: [L.Extension] -> HotHasktags -> FilePath -> IO String haskellSource exts conf file = do contents <- readFile file let needsCpp = not . null $- [ ()- | Just (_language, extsFile) <- [L.readExtensions contents],- L.EnableExtension L.CPP <- extsFile ]- ++ [ () | L.EnableExtension L.CPP <- exts ]- if not needsCpp- then return contents- else do- cppOpts <- either recoverCppOptFail return- (CPP.parseOptions (hh_cpphs conf))- CPP.runCpphs (addOpts cppOpts) file contents- where+ [ () | Just (_language, extsFile) <- [L.readExtensions contents],+ L.EnableExtension L.CPP <- extsFile ]+ ++ [ () | L.EnableExtension L.CPP <- exts ]+ if not needsCpp then return contents else do+ cppOpts <- either recoverCppOptFail return+ (CPP.parseOptions (hhCpphs conf))+ CPP.runCpphs (addOpts cppOpts) file contents+ where addOpts defOpts = defOpts { CPP.boolopts = (CPP.boolopts defOpts) { CPP.hashline = False },- CPP.defines = map splitDefines (hh_define conf) ++ CPP.defines defOpts,- CPP.includes = hh_include conf ++ CPP.includes defOpts }+ CPP.defines = map splitDefines (hhDefine conf) +++ CPP.defines defOpts,+ CPP.includes = hhInclude conf ++ CPP.includes defOpts } recoverCppOptFail err = do hPutStrLn stderr $ "cpphs parse error arguments:" ++ err return CPP.defaultCpphsOptions - splitDefines :: String -> (String,String)- splitDefines s = let (a,b) = break (=='=') s- in (a, case drop 1 b of- [] -> "1"- b' -> b')- - + splitDefines s = let (a,b) = break (=='=') s in+ (a, case drop 1 b of+ [] -> "1"+ b' -> b')+ makeDatabase :: [L.Extension] -> HotHasktags -> IO Database-makeDatabase exts conf = do- fmap (Map.fromList . concat) . forM (hh_files conf) $ \file -> do+makeDatabase exts conf =+ fmap (Map.fromList . concat) . forM (hhFiles conf) $ \file -> do result <- L.parseFileContentsWithMode (mode file) `fmap` haskellSource exts conf file case result of- L.ParseOk mod@(L.Module _ (Just (L.ModuleHead _ (L.ModuleName _ name) _ _)) _ _ _) -> do- return [(name, mod)]- L.ParseFailed loc str -> do- hPutStrLn stderr $ "Parse error: " ++ show loc ++ ": " ++ str- return []- _ -> do+ L.ParseOk mod'@(L.Module _ moduleHead _ _ _) ->+ return [(moduleName moduleHead, mod')]+ L.ParseFailed loc str' -> do+ hPutStrLn stderr $ "Parse error: " ++ show loc ++ ": " ++ str' return []- where- mode filename = L.ParseMode {- L.parseFilename = filename,- L.extensions = exts,- L.ignoreLanguagePragmas = False,- L.ignoreLinePragmas = False,- L.fixities = Nothing,- L.baseLanguage = L.Haskell2010+ _ -> return []+ where+ moduleName (Just (L.ModuleHead _ (L.ModuleName _ name) _ _)) = name+ -- for files without a module decl, i.e. implicit Main+ moduleName Nothing = ""++ mode filename = L.ParseMode+ { L.parseFilename = filename+ , L.extensions = exts+ , L.ignoreLanguagePragmas = False+ , L.ignoreLinePragmas = False+ , L.fixities = Nothing+ , L.baseLanguage = L.Haskell2010 } moduleFile :: L.Module L.SrcSpanInfo -> FilePath moduleFile (L.Module (L.SrcSpanInfo (L.SrcSpan file _ _ _ _) _) _ _ _ _) = file-moduleFile _ = error "Wtf is an XmlPage/XmlHybrid?"+-- these could be converted with sModule; see Language.Haskell.Exts.Simplify+moduleFile _ = error "Sorry, XmlPage/XmlHybrid modules are not supported" -data HotHasktags = HotHasktags {- hh_files, hh_language, hh_define, hh_include, hh_output, hh_cpphs :: [String] }- deriving (Data,Typeable,Show)+data TagsType = VimTags | EmacsTags deriving (Eq) -defaultHotHasktags :: HotHasktags-defaultHotHasktags = HotHasktags { - hh_files = []- &= args- &= typ "FILE",- hh_language = []- &= help "Additional language extensions to use when parsing a file. \- \LANGUAGE pragmas are currently obeyed. Always includes at least \- \MultiParamTypeClasses ExistentialQuantification \- \and FlexibleContexts"- &= name "X",- hh_define = []- &= name "D"- &= help "Define for cpphs. -Dx is a shortcut for the flags -c -Dx",- hh_include = []- &= name "I"- &= typ "DIR"- &= help "Add a directory to where cpphs looks for .h includes. Note that \- \paths are currently interpreted as relative to the directory \- \containing the source file \- \-Ifoo is a shortcut for -c -Ifoo",- hh_output = []- &= name "output" &= name "O"- &= explicit- &= typ "FILE"- &= help "Name of output file. Default is to write to stdout",- hh_cpphs = []- &= name "cpp" &= name "c"- &= explicit- &= help "Pass the next argument as an option for cpphs. For example:\n\- \`hothasktags -c --strip -XCPP foo.hs'\- \ see `cpphs --help`"}+data HotHasktags = HotHasktags+ { hhLanguage, hhDefine, hhInclude, hhCpphs :: [String]+ , hhOutput :: Maybe FilePath+ , hhTagstype :: TagsType+ , hhSplitOnNUL :: Bool+ , hhFiles :: [FilePath]+ } +optParser :: Parser HotHasktags+optParser = HotHasktags+ <$> many (strOption+ ( short 'X'+ <> long "hh-language"+ <> metavar "ITEM"+ <> help "Additional language extensions to use when parsing a file. \+ \LANGUAGE pragmas are currently obeyed. Always includes at \+ \least MultiParamTypeClasses, ExistentialQuantification, \+ \and FlexibleContexts" ))+ <*> many (strOption+ ( short 'D'+ <> long "hh-define"+ <> metavar "ITEM"+ <> help "Define for cpphs. -Dx is a shortcut for the flags -c -Dx" ))+ <*> many (strOption+ ( short 'I'+ <> long "hh-include"+ <> metavar "DIR"+ <> help "Add a directory to where cpphs looks for .h includes. Note \+ \that paths are currently interpreted as relative to the \+ \directory containing the source file.\n\+ \-Ifoo is a shortcut for -c -Ifoo" ))+ <*> many (strOption+ ( short 'c'+ <> long "cpp"+ <> metavar "ITEM"+ <> help "Pass the next argument as an option for cpphs. For example:\n\+ \`hothasktags -c --strip -XCPP foo.hs'" ))+ <*> optional (strOption+ ( short 'O'+ <> long "output"+ <> metavar "FILE"+ <> help "Name of output file. Default is to write to stdout" ))+ <*> flag VimTags EmacsTags+ ( short 'e'+ <> help "Emit Emacs tags" )+ <*> switch+ ( short '0'+ <> long "null"+ <> help "Split stdin on NUL instead of newline" )+ <*> many (argument str (metavar "FILE"))++linePositions :: Handle -> IO (Int, [(HandlePosition, String)])+linePositions h = go 1 []+ where+ go lineno acc = do+ pos <- hTell h+ ln <- hGetLine h+ atEOF <- hIsEOF h+ let res = (pos, ln):acc+ if atEOF then return (lineno, reverse res) else go (lineno + 1) res++emacsLineInfo :: [FilePath] -> IO LineInfo+emacsLineInfo files = do+ filesContents <- forM files $ \f -> withFile f ReadMode linePositions+ return $ Map.fromList+ [(path, A.array (0, numLines - 1) (zip [0..] ls))+ | (path, (numLines, ls)) <- zip files filesContents]++stdinFileList :: Bool -> IO [FilePath]+stdinFileList onNull = liftM splitter getContents+ where+ splitter = if onNull then endBy "\0" else lines+ main :: IO () main = do- conf <- cmdArgs defaultHotHasktags- let exts = map L.classifyExtension $ hh_language conf ++- words "MultiParamTypeClasses ExistentialQuantification FlexibleContexts"+ let opts = info (helper <*> optParser)+ ( fullDesc+ <> progDesc "The hothasktags program" )+ conf <- execParser opts+ let exts = map L.classifyExtension $ hhLanguage conf +++ ["MultiParamTypeClasses", "ExistentialQuantification",+ "FlexibleContexts"] case unwords [ ext | L.UnknownExtension ext <- exts ] of [] -> return () unknown -> hPutStrLn stderr $ "Unknown extensions on command line: " ++ unknown- database <- makeDatabase exts conf - let tags = sort $ concatMap (\mod -> makeTags (moduleFile mod) (moduleScope database mod)) (Map.elems database)- handle <- case (hh_output conf) of- [] -> return stdout- file:_ -> openFile file WriteMode+ conf' <- case hhFiles conf of+ [] -> liftM (\x -> conf { hhFiles = x })+ $ stdinFileList (hhSplitOnNUL conf)+ _ -> return conf+ lineInfo <- if hhTagstype conf' == EmacsTags+ then emacsLineInfo $ hhFiles conf'+ else return Map.empty+ database <- makeDatabase exts conf'+ let (fMakeTags, fSort) = if hhTagstype conf' == EmacsTags+ then (makeEmacsTags, id)+ else (makeVimTags, sort)+ makeTags x = fMakeTags (moduleFile x)+ (moduleScope database x)+ lineInfo+ ts <- do+ ts <- mapM makeTags $ Map.elems database+ return (fSort $ concat ts) - mapM_ (hPutStrLn handle) tags+ handle <- case hhOutput conf' of+ Nothing -> return stdout+ Just file -> openFile file WriteMode - case (hh_output conf) of- [] -> return ()- _ -> hClose handle+ mapM_ (hPutStrLn handle) ts++ case hhOutput conf' of+ Nothing -> return ()+ _ -> hClose handle
hothasktags.cabal view
@@ -1,5 +1,5 @@ name: hothasktags-version: 0.3.3+version: 0.3.4 cabal-version: >= 1.6 build-type: Simple author: Luke Palmer <lrpalmer@gmail.com>@@ -26,8 +26,6 @@ > find . | egrep '\.hs$' | xargs hothasktags > tags . will index all the hs files under the current directory.- .- hothasktags does not work with the emacs tag file format. Sorry. homepage: http://github.com/luqui/hothasktags source-repository head type: git@@ -35,10 +33,12 @@ executable hothasktags build-depends: base == 4.*,+ array, containers, filepath, haskell-src-exts >= 1.14, cpphs >= 1.11 && < 1.20,- cmdargs+ optparse-applicative,+ split main-is: Main.hs ghc-options: -W