diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -11,21 +11,21 @@ he/she uses. Note, that haskdogs relies on some GNU programs as well as on Unix shell -commands such as 'cd', 'mkdir' and so on. Also it would run 'cabal' and ghc-pkg' +commands such as 'cd', 'mkdir' and so on. Also it would run 'stack' and ghc-pkg' in order to obtain package information. INSTALL ------- -Check the dependencies. Currently they are: cabal, ghc, hasktags, GNU find, +Check the dependencies. Currently they are: stack, hasktags, GNU find, which and shell. -0. cabal install hasktags haskdogs -1. git clone https://github.com/ierton/haskdogs -2. cd haskdogs -3. cabal configure && cabal install -4. export PATH="$HOME/.cabal/bin:$PATH" +Please follow stack's documentation(https://github.com/commercialhaskell/stack) to install stack. + $ stack install hasktags haskdogs + +Make sure that PATH contains path to your stack binaries directory ($HOME/.local/bin by default). + RUNNING ------- @@ -33,12 +33,14 @@ 2. cd to your Haskell project dir - $ cd $HOME/my-haskell-project + $ cd $HOME/my-haskell-project -3. run haskdogs (cmdline args will be passed to hasktags followed by a filelist generated) +3. Run haskdogs without arguments to generate tags file in Vim-compatible format - $ haskdogs + $ haskdogs +Emacs users would probably want to add -e option to build Emacs-compatible TAGS. + VIM HINT -------- @@ -78,7 +80,7 @@ Just copy the code above to your ~/.vimrc and reload the vim. -- -Sergey - +Sergey + diff --git a/haskdogs.cabal b/haskdogs.cabal --- a/haskdogs.cabal +++ b/haskdogs.cabal @@ -1,41 +1,47 @@ --- haskdogs.cabal auto-generated by cabal init. For additional --- options, see --- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr. --- The name of the package. Name: haskdogs -Version: 0.3.2 -Synopsis: Generate ctags file for haskell project directory and it's deps -Homepage: http://github.com/ierton/haskdogs +Version: 0.4.0 +Synopsis: Generate tags file for Haskell project and its nearest deps +Homepage: http://github.com/grwlf/haskdogs License: BSD3 License-file: LICENSE Author: Sergey Mironov -Maintainer: ierton@gmail.com +Maintainer: grrwlf@gmail.com Category: Development Build-type: Simple -Cabal-version: >=1.6 +Cabal-version: >=1.22 extra-source-files: README.md Description: - haskdogs is a small shellscript-like tool which creates tag file for entire - haskell project directory. It takes into account first-level dependencies by - recursively scanning imports and adding matching packages to the final - tag list. + Haskdogs is a 300-lines tool which creates tag file for entire Haskell + project directory. It takes into account first-level dependencies by + recursively scanning imports and adding matching packages to the final tag + list. - As a result, programmer can use his/her text editor supporting tags (vim, for - example) to jump directly to definition of any standard or foreign function - he/she uses. + As a result, programmer can use his/her text editor supporting tags (vim, + for example) to jump directly to definition of any standard or foreign + function he/she uses. - Note, that haskdogs calls some Unix shell commands like 'test' or 'mkdir' - so this tool will likely fail to work on pure Windows platforms. + Note, that haskdogs calls some Unix shell commands like 'grep' so this tool + will likely fail to work on pure Windows platforms. - Starting from 0.3, cmdline args will be passed to hasktags followed by a + Starting from 0.3, cmdline args will be passed to hasktags followed by a filelist generated. + Starting from 0.4, haskdogs will use stack toolchain. + Executable haskdogs + Default-language: Haskell2010 Hs-source-dirs: src - Main-is: haskdogs.hs - Build-depends: base >= 3 && < 5, Cabal >= 1.6, HSH >= 2.0.3, filepath >= 1.1.0.3 + Main-is: Main.hs + Build-depends: base >= 4.8 && < 5 + , filepath + , bytestring + , text + , directory + , optparse-applicative + , process + Ghc-options: -fwarn-tabs - + Source-repository head Type: git Location: http://github.com/ierton/haskdogs diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,227 @@ +{-# LANGUAGE RecordWildCards, ScopedTypeVariables, ViewPatterns #-} +module Main (main) where + +import Control.Monad +import Control.Applicative +import Control.Exception +import Data.Maybe +import Data.List +import System.IO +import System.Directory +import System.Process (readProcess) +import System.FilePath + +import Options.Applicative +import qualified Options.Applicative as O +import Data.Version + +{- + ___ _ _ + / _ \ _ __ | |_(_) ___ _ __ ___ +| | | | '_ \| __| |/ _ \| '_ \/ __| +| |_| | |_) | |_| | (_) | | | \__ \ + \___/| .__/ \__|_|\___/|_| |_|___/ + |_| +-} + +data Opts = Opts { + cli_dirlist_file :: FilePath + , cli_filelist_file :: FilePath + , cli_hasktags_args1 :: String + , cli_ghc_pkgs_args :: String + , cli_use_stack :: Tristate + , cli_use_sandbox :: Tristate + , cli_hasktags_args2 :: [String] + } deriving(Show) + +data Tristate = ON | OFF | AUTO + deriving(Eq, Ord, Show, Read) + +optsParser :: Parser Opts +optsParser = Opts + <$> strOption ( + long "dir-list" <> + short 'd' <> + metavar "FILE" <> + value "" <> + help "File containing directory list to process" ) + <*> strOption ( + long "file-list" <> + short 'f' <> + metavar "FILE" <> + value "" <> + help "File containing Haskell sources to process" ) + <*> strOption ( + long "hasktags-args" <> + metavar "OPTS" <> + value "-c -x" <> + help "Arguments to pass to hasktags") + <*> strOption ( + long "ghc-pkg-args" <> + metavar "OPTS" <> + value "" <> + help "Arguments to pass to ghc-pkgs") + <*> option auto ( + long "use-stack" <> + value AUTO <> + help "Execute ghc-pkg via stack") + <*> option auto ( + long "include-sandbox" <> + value AUTO <> + help "(!UNIMPLEMENTED!) Include .cabal-sandbox package databases") + <*> many (argument str (metavar "OPTS" <> help "More hasktags options")) + +exename, versionId :: String +exename = "haskdogs" +versionId = "0.4.0" + +version :: Parser (a -> a) +version = infoOption (exename ++ " version " ++ versionId) + (long "version" <> help "Show version number") + +opts = info (helper <*> version <*> optsParser) + ( fullDesc <> header (exename ++ " - Recursive hasktags-based TAGS generator for a Haskell project" )) + +{- + __ __ _ +| \/ | __ _(_)_ __ +| |\/| |/ _` | | '_ \ +| | | | (_| | | | | | +|_| |_|\__,_|_|_| |_| + +-} + +main :: IO() +main = do + + Opts {..} <- execParser opts + + let + -- Directory to unpack sources into + getDataDir :: IO FilePath + getDataDir = do + x <- ( ".haskdogs") <$> getHomeDirectory + createDirectoryIfMissing False x + return x + + cli_verbose = True + + vprint a + | cli_verbose = eprint a + | otherwise = return () + + eprint = hPutStrLn stderr + + runp nm args inp = do + vprint $ nm ++ " " ++ unwords args + readProcess nm args inp + + -- Run GNU which tool + checkapp :: String -> IO () + checkapp appname = do + (runp "which" [appname] [] >> return ()) `onException` + (eprint ("Please Install \"" ++ appname ++ "\" application")) + + hasapp :: String -> IO Bool + hasapp appname = do + vprint $ "Cheking for " ++ appname ++ " with GNU which" + (runp "which" [appname] [] >> return True) `catch` + (\(e::SomeException) -> vprint ("GNU which falied to find " ++ appname) >> return False) + + cwd <- getCurrentDirectory + datadir <- getDataDir + has_stack <- hasapp "stack" + + let + + readLinedFile f = + lines <$> (hGetContents =<< ( + if (f=="-") + then return stdin + else openFile f ReadMode)) + + readDirFile :: IO [FilePath] + readDirFile + | null cli_dirlist_file && null cli_filelist_file = return ["."] + | null cli_dirlist_file = return [] + | otherwise = readLinedFile cli_dirlist_file + + readSourceFile :: IO [FilePath] + readSourceFile + | null cli_filelist_file = return [] + | otherwise = readLinedFile cli_filelist_file + + cli_hasktags_args = (words cli_hasktags_args1) ++ cli_hasktags_args2 + + runp_ghc_pkgs args = go cli_use_stack where + go ON = runp "stack" (["exec", "ghc-pkg", "--"] ++ args) [] + go OFF = runp "ghc-pkg" args [] + go AUTO = if has_stack then go ON else go OFF + + cabal_or_stack = go cli_use_stack where + go ON = "stack" + go OFF = "cabal" + go AUTO = if has_stack then go ON else go OFF + + -- Finds *hs in dirs, but filter-out Setup.hs + findSources :: [FilePath] -> IO [FilePath] + findSources dirs = + filter (not . isSuffixOf "Setup.hs") . lines <$> + runp "find" (dirs ++ words "-type f -and ( -name *\\.hs -or -name *\\.lhs -or -name *\\.hsc )") [] + + grepImports :: String -> Maybe String + grepImports line = case words line of + ("import":"qualified":x:_) -> Just x + ("import":x:_) -> Just x + _ -> Nothing + + -- Produces list of imported modules for file.hs given + findModules :: [FilePath] -> IO [String] + findModules files = (catMaybes . map grepImports . lines) <$> runp "cat" files [] + + -- Maps import name to haskell package name + iname2module :: String -> IO (Maybe String) + iname2module iname = do + mod <- (listToMaybe . words) <$> (runp_ghc_pkgs ["--simple-output", "find-module", iname]) + vprint $ "Import " ++ iname ++ " resolved to " ++ (fromMaybe "NULL" mod) + return mod + + inames2modules :: [String] -> IO [FilePath] + inames2modules is = nub . sort . catMaybes <$> forM (nub is) iname2module + + -- Unapcks haskel package to the sourcedir + unpackModule :: FilePath -> IO (Maybe FilePath) + unpackModule ((datadir) -> p) = do + exists <- doesDirectoryExist (datadirp) + case exists of + True -> do + vprint $ "Already unpacked " ++ p + return (Just p) + False -> do + bracket_ (setCurrentDirectory datadir) (setCurrentDirectory cwd) $ + ( runp cabal_or_stack ["unpack", p] [] >> return (Just p) + ) `catch` + (\(_ :: SomeException) -> + eprint ("Can't unpack " ++ p) >> return Nothing + ) + + unpackModules :: [FilePath] -> IO [FilePath] + unpackModules ms = catMaybes <$> mapM unpackModule ms + + gentags :: IO () + gentags = do + checkapp "hasktags" + files <- do + dirs <- readDirFile + ss_local <- (++) <$> readSourceFile <*> findSources dirs + when (null ss_local) $ do + fail $ "haskdogs were not able to find any sources in " <> (intercalate ", " dirs) + ss_l1deps <- findModules ss_local >>= inames2modules >>= unpackModules >>= findSources + return $ ss_local ++ ss_l1deps + runp "hasktags" (cli_hasktags_args ++ files) [] + return () + + {- _real_main_ -} + gentags + + diff --git a/src/haskdogs.hs b/src/haskdogs.hs deleted file mode 100644 --- a/src/haskdogs.hs +++ /dev/null @@ -1,125 +0,0 @@ -module Main (main) where - -import HSH -import Data.List -import Control.Applicative -import Control.Monad -import System.IO -import System.Exit -import System.Environment -import System.FilePath - -eprint = hPutStrLn stderr - --- GNU find command line -find_in_dirs dirs p = ("find", dirs ++ (words "-type f -and -name") ++ [p]) - --- ghc-pkg command line -ghc_pkg_find m = ("ghc-pkg", ["find-module", m]) - --- cabal unpack command line -cabal_unpack p = ("cabal", ["unpack", p]) - --- Finds *hs in current dir, recursively -findSources :: [String] -> IO [String] -findSources [] = return [] -findSources d = run $ find_in_dirs d "*\\.hs" - --- Produces list of imported modules for file.hs given -findImports :: [String] -> IO [String] -findImports s = run $ catFrom s -|- extractImports - --- Search for 'import' declarations -extractImports = nub . sort . filter (/=[]) . map (grepImports . words) - -grepImports ("import":"qualified":x:_) = x -grepImports ("import":x:_) = x -grepImports _ = [] - --- Maps import name to haskell package name -iname2module :: String -> IO String -iname2module m = run $ ghc_pkg_find m -|- egrep "^ +[a-zA-Z]" -|- map (head . words) -|- highver - where highver [] = [] - highver s = last (lines s) - -inames2modules :: [String] -> IO [String] -inames2modules is = forM is (iname2module) >>= return . nub . sort . filter (/=[]) - -testdir dir fyes fno = do - ret <- run ("test",["-d", dir]) - case ret of - ExitSuccess -> fyes - _ -> fno - --- Unapcks haskel package to the sourcedir -unpackModule p = do - srcdir <- sourcedir - let fullpath = srcdir p - testdir fullpath - (do - eprint $ "Already unpacked " ++ p - return fullpath - ) - (do - cd srcdir - ec <- tryEC (runIO (cabal_unpack p)) - case ec of - Left _ -> return "" - Right _ -> return fullpath - ) - -unpackModules ms = filter (/="") <$> mapM unpackModule ms - --- Run GNU which tool -which :: String -> IO (String, IO (String,ExitCode)) -which n = run ("which", [n]) - -checkapp appname = do - (_,ec) <- which appname >>= return . snd >>= id - case ec of - ExitSuccess -> return () - _ -> do - eprint $ "Please Install \"" ++ appname ++ "\" application" - exitWith ec - --- Directory to unpack sources into -sourcedir = glob "~" >>= return . ( ".haskdogs") . head - -gentags dirs flags = do - checkapp "cabal" - checkapp "ghc-pkg" - checkapp "hasktags" - d <- sourcedir - testdir d (return ()) (run ("mkdir",["-p",d])) - files <- bracketCD "." $ do - ss_local <- findSources dirs - when (null ss_local) $ do - fail $ "haskdogs were not able to find any sources in " ++ (unwords dirs) - ss_l1deps <- findImports ss_local >>= inames2modules >>= unpackModules >>= findSources - return $ ss_local ++ ss_l1deps - runIO $ ("hasktags", flags ++ files) - -help = do - eprint "haskdogs: generates tags file for haskell project directory" - eprint "Usage:" - eprint " haskdogs [-d (FILE|'-')] [FLAGS]" - eprint " FLAGS will be passed to hasktags as-is followed by" - eprint " a list of files. Defaults to -c -x." - return () - -defflags = ["-c", "-x"] - -amain [] = gentags ["."] defflags -amain ("-d" : dirfile : flags) = do - file <- if (dirfile=="-") then return stdin else openFile dirfile ReadMode - dirs <- lines <$> hGetContents file - gentags dirs (if null flags then defflags else flags) -amain flags - | "-h" `elem` flags = help - | "--help" `elem` flags = help - | "-?" `elem` flags = help - | otherwise = gentags ["."] flags - -main :: IO() -main = getArgs >>= amain -