haskdogs 0.5.4 → 0.6.0
raw patch · 3 files changed
+130/−97 lines, 3 filesdep +process-extrasdep −bytestringdep −process
Dependencies added: process-extras
Dependencies removed: bytestring, process
Files
- README.md +18/−4
- haskdogs.cabal +2/−3
- src/Main.hs +110/−90
README.md view
@@ -46,8 +46,9 @@ haskdogs - Recursive hasktags-based TAGS generator for a Haskell project Usage: haskdogs [--version] [-d|--dir-list FILE] [-f|--file-list FILE]- [--hasktags-args OPTS] [--stack-args OPTS] [--ghc-pkg-args OPTS]- [--use-stack ARG] [--deps-dir PATH] [--raw] [OPTS]+ [-i|--input FILE] [--hasktags-args OPTS] [--stack-args OPTS]+ [--ghc-pkg-args OPTS] [--use-stack ARG] [--deps-dir PATH]+ [--raw] [-q|--quiet] [OPTS] Available options: -h,--help Show this help text@@ -56,6 +57,8 @@ read from stdin) -f,--file-list FILE File containing Haskell sources to process (use '-' to read from stdin)+ -i,--input FILE Single Haskell file to process (use '-' to read+ Haskell source from stdin) --hasktags-args OPTS Arguments to pass to hasktags. -c -x is the default. Not for raw mode. --stack-args OPTS Arguments to pass to stack@@ -63,14 +66,14 @@ --use-stack ARG Execute ghc-pkg via stack, arg is ON, OFF or AUTO (the default) --deps-dir PATH Specify the directory PATH to place the dependencies- of the project. Default is [/home/grwlf/.haskdogs]+ of the project. Default is [$HOME/.haskdogs] --raw Don't execute hasktags, print list of files to tag on the STDOUT. The output may be piped into hasktags like this: `haskdogs --raw | hasktags -c -x STDIN'+ -q,--quiet Don't print verbose messages OPTS More hasktags options, use `--' to pass flags starting with `-'. Not for raw mode. - The following error could be caused by (over)strict Haskell policy regarding Unicode locale: @@ -130,4 +133,15 @@ nix-shell -p haskellPackages.haskdogs haskellPackages.hasktags haskellPackages.cabal-install ghc (nix-shell) $ haskdogs ++TIPS+-----++* create tags for specific package++ ``echo 'import Control.Lens' | haskdogs -i -``++* incremental update++ ``haskdogs -i % --hasktags-args "-x -c -a" | sort -u -o tags tags``
haskdogs.cabal view
@@ -1,5 +1,5 @@ Name: haskdogs-Version: 0.5.4+Version: 0.6.0 Synopsis: Generate tags file for Haskell project and its nearest deps Homepage: http://github.com/grwlf/haskdogs License: BSD3@@ -35,11 +35,10 @@ Main-is: Main.hs Build-depends: base >= 4.8 && < 5 , filepath- , bytestring , text , directory , optparse-applicative- , process+ , process-extras , containers , hasktags
src/Main.hs view
@@ -1,22 +1,28 @@-{-# LANGUAGE RecordWildCards, ScopedTypeVariables, ViewPatterns #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-} module Main (main) where -import Control.Monad import Control.Applicative import Control.Exception-import Data.Maybe+import Control.Monad import Data.List-import System.IO+import Data.Maybe import System.Directory-import System.Process (readProcess) import System.FilePath--import Data.Monoid((<>))+import System.IO+import System.Exit (ExitCode(..))+import System.Process.Text (readProcessWithExitCode)+import Data.Monoid ((<>)) import Data.Set (Set)-import qualified Data.Set as Set-import Options.Applicative-import qualified Options.Applicative as O+import Data.Text (Text, unpack, pack) import Data.Version (showVersion)+import Options.Applicative++import qualified Data.Text as Text+import qualified Data.Text.IO as Text+import qualified Data.Set as Set import qualified Paths_haskdogs as Paths {-@@ -29,22 +35,23 @@ -} data Opts = Opts {- cli_dirlist_file :: FilePath- , cli_filelist_file :: FilePath+ cli_dirlist_file :: FilePath+ , cli_filelist_file :: FilePath+ , cli_input_file :: FilePath , cli_hasktags_args1 :: String- , cli_stack_args :: String- , cli_ghc_pkgs_args :: String- , cli_use_stack :: Tristate- , cli_deps_dir :: FilePath- , cli_raw_mode :: Bool- -- , cli_use_sandbox :: Tristate+ , cli_stack_args :: String+ , cli_ghc_pkgs_args :: String+ , cli_use_stack :: Tristate+ , cli_deps_dir :: FilePath+ , cli_raw_mode :: Bool+ , cli_verbose :: Bool , cli_hasktags_args2 :: [String] } deriving(Show) data Tristate = ON | OFF | AUTO deriving(Eq, Ord, Show, Read) -def_hasktags_args = words "-c -x"+defHasktagsArgs = words "-c -x" optsParser :: FilePath -> Parser Opts optsParser def_deps_dir = Opts@@ -61,15 +68,21 @@ value "" <> help "File containing Haskell sources to process (use '-' to read from stdin)" ) <*> strOption (+ long "input" <>+ short 'i' <>+ metavar "FILE" <>+ value "" <>+ help "Single Haskell file to process (use '-' to read Haskell source from stdin)" )+ <*> strOption ( long "hasktags-args" <> metavar "OPTS" <> value "" <>- help ("Arguments to pass to hasktags. " ++ unwords def_hasktags_args ++ " is the default. Not for raw mode."))+ help ("Arguments to pass to hasktags. " <> unwords defHasktagsArgs <> " is the default. Not for raw mode.")) <*> strOption ( long "stack-args" <> metavar "OPTS" <> value "" <>- help ("Arguments to pass to stack"))+ help "Arguments to pass to stack") <*> strOption ( long "ghc-pkg-args" <> metavar "OPTS" <>@@ -87,21 +100,21 @@ <*> flag False True ( long "raw" <> help "Don't execute hasktags, print list of files to tag on the STDOUT. The output may be piped into hasktags like this: `haskdogs --raw | hasktags -c -x STDIN'")- -- <*> option auto (- -- long "include-sandbox" <>- -- value AUTO <>- -- help "(!UNIMPLEMENTED!) Include .cabal-sandbox package databases")+ <*> flag True False (+ long "quiet" <>+ short 'q' <>+ help "Don't print verbose messages") <*> many (argument str (metavar "OPTS" <> help "More hasktags options, use `--' to pass flags starting with `-'. Not for raw mode.")) exename :: String exename = "haskdogs" versionParser :: Parser (a -> a)-versionParser = infoOption (exename ++ " version " ++ (showVersion Paths.version))+versionParser = infoOption (exename <> " version " <> showVersion Paths.version) (long "version" <> help "Show version number") -opts def_deps_dir = info (helper <*> versionParser <*> (optsParser def_deps_dir))- ( fullDesc <> header (exename ++ " - Recursive hasktags-based TAGS generator for a Haskell project" ))+opts def_deps_dir = info (helper <*> versionParser <*> optsParser def_deps_dir)+ ( fullDesc <> header (exename <> " - Recursive hasktags-based TAGS generator for a Haskell project" )) {- __ __ _@@ -120,7 +133,7 @@ Opts {..} <- execParser (opts def_deps_dir) let- cli_hasktags_args = (words cli_hasktags_args1) ++ cli_hasktags_args2+ cli_hasktags_args = words cli_hasktags_args1 <> cli_hasktags_args2 -- Directory to unpack sources into getDataDir :: IO FilePath@@ -128,8 +141,6 @@ createDirectoryIfMissing False cli_deps_dir return cli_deps_dir - cli_verbose = True- vprint a | cli_verbose = eprint a | otherwise = return ()@@ -137,23 +148,26 @@ eprint = hPutStrLn stderr runp nm args inp = do- vprint $ "> " ++ nm ++ " " ++ unwords args- readProcess nm args inp+ vprint $ "> " <> nm <> " " <> unwords args+ (ec, out, err) <- readProcessWithExitCode nm args inp+ case ec of+ ExitSuccess -> return out+ ec -> ioError (userError $ nm <> " " <> show args <> " exited with error code " <> show ec <> " and output:\n" <> init (unpack err)) -- Run GNU which tool checkapp :: String -> IO ()- checkapp appname = do- (runp "which" [appname] [] >> return ()) `onException`- (eprint ("Please Install \"" ++ appname ++ "\" application"))+ checkapp appname =+ void (runp "which" [appname] "") `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)+ vprint $ "Cheking for " <> appname <> " with GNU which"+ (runp "which" [appname] "" >> return True) `catch`+ (\(e::SomeException) -> vprint ("GNU which falied to find " <> appname) >> return False) - when ((not $ null cli_hasktags_args) && cli_raw_mode) $ do- fail $ "--raw is incompatible with passing hasktags arguments"+ when (not (null cli_hasktags_args) && cli_raw_mode) $+ fail "--raw is incompatible with passing hasktags arguments" cwd <- getCurrentDirectory datadir <- getDataDir@@ -162,26 +176,30 @@ let + readLinedFile :: FilePath -> IO [Text] readLinedFile f =- lines <$> (hGetContents =<< (- if (f=="-")+ Text.lines <$> (Text.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 && null cli_filelist_file && null cli_input_file = return ["."] | null cli_dirlist_file = return []- | otherwise = readLinedFile cli_dirlist_file+ | otherwise = map unpack <$> readLinedFile cli_dirlist_file - readSourceFile :: IO (Set FilePath)- readSourceFile- | null cli_filelist_file = return Set.empty- | otherwise = Set.fromList <$> readLinedFile cli_filelist_file+ readSourceFile :: IO (Set Text)+ readSourceFile = do+ files1 <- if | null cli_filelist_file -> return Set.empty+ | otherwise -> Set.fromList <$> readLinedFile cli_filelist_file+ files2 <- if | null cli_input_file -> return Set.empty+ | otherwise -> return $ Set.singleton (pack cli_input_file)+ return $ files1 <> files2 runp_ghc_pkgs args = go cli_use_stack where- go ON = runp "stack" (["exec", "ghc-pkg"] ++ (words cli_stack_args) ++ ["--"] ++ (words cli_ghc_pkgs_args) ++ args) []- go OFF = runp "ghc-pkg" (words cli_ghc_pkgs_args ++ args) []+ go ON = runp "stack" (["exec", "ghc-pkg"] <> words cli_stack_args <> ["--"] <> words cli_ghc_pkgs_args <> args) ""+ go OFF = runp "ghc-pkg" (words cli_ghc_pkgs_args <> args) "" go AUTO = case (has_stack,has_cabal) of (True,_) -> go ON@@ -198,73 +216,75 @@ (False,False) -> fail "Either `stack` or `cabal` should be installed" -- Finds *hs in dirs, but filter-out Setup.hs- findSources :: [FilePath] -> IO (Set FilePath)+ findSources :: [FilePath] -> IO (Set Text) findSources [] = return Set.empty findSources dirs =- Set.fromList . filter (not . isSuffixOf "Setup.hs") . lines <$>- runp "find" (dirs ++ words "-type f -and ( -name *\\.hs -or -name *\\.lhs -or -name *\\.hsc )") []+ Set.fromList . filter (not . Text.isSuffixOf "Setup.hs") . Text.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 (filter (/=';') x)- ("import":x:_) -> Just (filter (/=';') x)+ grepImports :: Text -> Maybe Text+ grepImports line =+ case Text.words line of+ ("import":"qualified":x:_) -> Just (Text.filter (/=';') x)+ ("import":x:_) -> Just (Text.filter (/=';') x) _ -> Nothing - -- Produces list of imported modules for file.hs given- findModules :: Set FilePath -> IO [String]- findModules files = (catMaybes . map grepImports . lines) <$> runp "cat" (Set.toList files) []+ -- Scan input files, produces list of imported modules+ findModules :: Set Text -> IO [Text]+ findModules files =+ fmap concat . mapM (fmap (mapMaybe grepImports) . readLinedFile . unpack) $ Set.toList files -- Maps import name to haskell package name- iname2module :: String -> IO (Maybe String)+ iname2module :: Text -> IO (Maybe Text) iname2module iname = do- mod <- (listToMaybe . words) <$> (runp_ghc_pkgs ["--simple-output", "find-module", iname])- vprint $ "Import " ++ iname ++ " resolved to " ++ (fromMaybe "NULL" mod)- return mod+ mod <- listToMaybe . Text.words <$> runp_ghc_pkgs ["--simple-output", "find-module", unpack iname]+ vprint $ "Import " <> unpack iname <> " resolved to " <> maybe "NULL" unpack mod+ return mod - inames2modules :: [String] -> IO [FilePath]- inames2modules is = nub . sort . catMaybes <$> forM (nub is) iname2module+ inames2modules :: [Text] -> IO [FilePath]+ inames2modules inames = map unpack . nub . sort . catMaybes <$> mapM iname2module (nub inames) -- Unapcks haskel package to the sourcedir unpackModule :: FilePath -> IO (Maybe FilePath) unpackModule mod = do let p = datadir</>mod exists <- doesDirectoryExist p- case exists of- True -> do- vprint $ "Already unpacked " ++ mod+ if exists+ then do+ vprint $ "Already unpacked " <> mod return (Just p)- False -> do+ else bracket_ (setCurrentDirectory datadir) (setCurrentDirectory cwd) $- ( runp cabal_or_stack ["unpack", mod] [] >> return (Just p)+ ( runp cabal_or_stack ["unpack", mod] "" >> return (Just p) ) `catch` (\(_ :: SomeException) ->- eprint ("Can't unpack " ++ mod) >> return Nothing+ eprint ("Can't unpack " <> mod) >> return Nothing ) unpackModules :: [FilePath] -> IO [FilePath] unpackModules ms = catMaybes <$> mapM unpackModule ms + getFiles :: IO (Set Text)+ getFiles = do+ dirs <- readDirFile+ ss_local <- mappend <$> readSourceFile <*> findSources dirs+ when (null ss_local) $+ fail $ "Haskdogs were not able to find any sources in " <> intercalate ", " dirs+ ss_l1deps <- findModules ss_local >>= inames2modules >>= unpackModules >>= findSources+ return $ Set.filter (/= "-") ss_local `mappend` ss_l1deps+ gentags :: IO () gentags = do checkapp "hasktags"- files <- do- dirs <- readDirFile- ss_local <- Set.union <$> 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 `mappend` ss_l1deps- case cli_raw_mode of- True -> do- forM_ (Set.toList files) $ \f-> do- putStrLn f- False -> do- sfiles <- pure $ unlines $ Set.toList files- vprint sfiles- runp "hasktags" ((if null cli_hasktags_args then def_hasktags_args else cli_hasktags_args) ++ ["STDIN"]) sfiles+ files <- getFiles+ if cli_raw_mode+ then+ forM_ (Set.toList files) Text.putStrLn+ else do+ let sfiles = Text.unlines $ Set.toList files+ vprint (unpack sfiles)+ runp "hasktags" ((if null cli_hasktags_args then defHasktagsArgs else cli_hasktags_args) <> ["STDIN"]) sfiles putStrLn "\nSuccess" {- _real_main_ -} gentags--