aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--app/Indexer.hs376
1 files changed, 204 insertions, 172 deletions
diff --git a/app/Indexer.hs b/app/Indexer.hs
index 88aa7ad..3b357a3 100644
--- a/app/Indexer.hs
+++ b/app/Indexer.hs
@@ -4,70 +4,79 @@
module Main where
-import Codec.Compression.GZip(compress)
-import Control.Exception (SomeException, handle)
-import Control.Monad (when)
-import Control.Monad.Logger (LogLevel(..), runLoggingT)
-import qualified Data.Aeson as A
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Lazy as BSL
-import qualified Data.ByteString.Lazy.Char8 as BSC
-import qualified Data.HashMap.Strict as HM
-import Data.Maybe (fromMaybe)
-import Data.Semigroup ((<>))
-import qualified Data.Serialize as S
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as TE
-import Data.Time (getZonedTime)
-import Data.Version (showVersion)
-import HaskellCodeExplorer.PackageInfo (createPackageInfo, ghcVersion)
-import qualified HaskellCodeExplorer.Types as HCE
-import Network.URI.Encode (encode)
-import Options.Applicative
- ( Parser
- , (<|>)
- , execParser
- , flag
- , fullDesc
- , help
- , helper
- , info
- , long
- , many
- , metavar
- , optional
- , progDesc
- , short
- , showDefault
- , strOption
- , value
- )
-import Paths_haskell_code_explorer as HSE (version)
-import System.Directory (createDirectoryIfMissing)
-import System.Exit (ExitCode(..), exitWith)
-import System.FilePath ((</>))
-import System.Log.FastLogger
- ( LoggerSet
- , ToLogStr(..)
- , defaultBufSize
- , fromLogStr
- , newFileLoggerSet
- , newStdoutLoggerSet
- , pushLogStrLn
- , rmLoggerSet
- )
+import Codec.Compression.GZip ( compress )
+import Control.Exception ( SomeException
+ , handle
+ )
+import Control.Monad ( when )
+import Control.Monad.Logger ( LogLevel(..)
+ , runLoggingT
+ )
+import qualified Data.Aeson as A
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as BSL
+import qualified Data.ByteString.Lazy.Char8 as BSC
+import qualified Data.HashMap.Strict as HM
+import Data.Maybe ( fromMaybe )
+import Data.Semigroup ( (<>) )
+import qualified Data.Serialize as S
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import Data.Time ( getZonedTime )
+import Data.Version ( showVersion )
+import HaskellCodeExplorer.PackageInfo
+ ( createPackageInfo
+ , ghcVersion
+ )
+import qualified HaskellCodeExplorer.Types as HCE
+import Network.URI.Encode ( encode )
+import Options.Applicative ( (<|>)
+ , Parser
+ , execParser
+ , flag
+ , fullDesc
+ , help
+ , helper
+ , info
+ , long
+ , many
+ , metavar
+ , optional
+ , progDesc
+ , short
+ , showDefault
+ , strOption
+ , value
+ )
+import Paths_haskell_code_explorer as HSE
+ ( version )
+import System.Directory ( createDirectoryIfMissing )
+import System.Exit ( ExitCode(..)
+ , exitWith
+ )
+import System.FilePath ( (</>) )
+import System.Log.FastLogger ( LoggerSet
+ , ToLogStr(..)
+ , defaultBufSize
+ , fromLogStr
+ , newFileLoggerSet
+ , newStdoutLoggerSet
+ , pushLogStrLn
+ , rmLoggerSet
+ )
data IndexerConfig = IndexerConfig
- { configPackageDirectoryPath :: FilePath
+ { configPackageDirectoryPath :: FilePath
, configPackageDistDirRelativePath :: Maybe FilePath
- , configOutputDirectoryName :: Maybe String
- , configLog :: !HCE.Log
- , configMinLogLevel :: !LogLevel
- , configSourceCodePreprocessing :: !HCE.SourceCodePreprocessing
- , configCompression :: !Compression
- , configGhcOptions :: [String]
- , configIgnoreDirectories :: [String]
- } deriving (Show, Eq)
+ , configOutputDirectoryName :: Maybe String
+ , configLog :: !HCE.Log
+ , configMinLogLevel :: !LogLevel
+ , configSourceCodePreprocessing :: !HCE.SourceCodePreprocessing
+ , configCompression :: !Compression
+ , configGhcOptions :: [String]
+ , configIgnoreDirectories :: [String]
+ }
+ deriving (Show, Eq)
data Compression
= Gzip
@@ -76,126 +85,149 @@ data Compression
versionInfo :: String
versionInfo =
- "haskell-code-indexer version " ++
- showVersion version ++ ", GHC version " ++ showVersion ghcVersion
+ "haskell-code-indexer version "
+ ++ showVersion version
+ ++ ", GHC version "
+ ++ showVersion ghcVersion
main :: IO ()
main = do
- let description =
- "haskell-code-indexer collects and saves information about the source code of a Cabal package. " ++
- versionInfo
- config <-
- execParser $
- info (helper <*> configParser) (fullDesc <> progDesc description)
- loggerSet <-
- case configLog config of
- HCE.ToFile logfile -> newFileLoggerSet defaultBufSize logfile
- HCE.StdOut -> newStdoutLoggerSet defaultBufSize
+ let
+ description =
+ "haskell-code-indexer collects and saves information about the source code of a Cabal package. "
+ ++ versionInfo
+ config <- execParser
+ $ info (helper <*> configParser) (fullDesc <> progDesc description)
+ loggerSet <- case configLog config of
+ HCE.ToFile logfile -> newFileLoggerSet defaultBufSize logfile
+ HCE.StdOut -> newStdoutLoggerSet defaultBufSize
let minLogLevel = configMinLogLevel config
logger loggerSet minLogLevel LevelInfo versionInfo
logger loggerSet minLogLevel LevelDebug $ show config
handle
- (\(e :: SomeException) -> do
- logger loggerSet minLogLevel LevelError (show e)
- rmLoggerSet loggerSet
- exitWith (ExitFailure 1)) $ do
- packageInfo <-
- runLoggingT
- (createPackageInfo
- (configPackageDirectoryPath config)
- (configPackageDistDirRelativePath config)
- (configSourceCodePreprocessing config)
- (configGhcOptions config)
- (configIgnoreDirectories config))
- (\_loc _source level msg -> logger loggerSet minLogLevel level msg)
- let outputDir =
- configPackageDirectoryPath config </>
- fromMaybe
- HCE.defaultOutputDirectoryName
- (configOutputDirectoryName config)
- createDirectoryIfMissing False outputDir
- logger loggerSet minLogLevel LevelDebug $ "Output directory : " ++ outputDir
- BS.writeFile
- (outputDir </> HCE.packageInfoBinaryFileName)
- (S.encode $ HCE.toCompactPackageInfo packageInfo)
- mapM_
- (\(HCE.HaskellModulePath path, modInfo) ->
- let (compressFunction, compressExtension) =
- case configCompression config of
- Gzip -> (compress, ".gz")
- NoCompression -> (id, "")
- filePath =
- outputDir </>
- (encode (T.unpack path) ++ ".json" ++ compressExtension)
- in BSL.writeFile filePath . compressFunction . A.encode $ modInfo) .
- HM.toList $
- HCE.moduleMap (packageInfo :: HCE.PackageInfo HCE.ModuleInfo)
- BSL.writeFile
- (outputDir </> HCE.packageInfoJsonFileName)
- (A.encode packageInfo)
- BSL.writeFile (outputDir </> "version.txt") (BSC.pack $ showVersion version)
- logger loggerSet minLogLevel LevelInfo ("Finished" :: T.Text)
- rmLoggerSet loggerSet
+ (\(e :: SomeException) -> do
+ logger loggerSet minLogLevel LevelError (show e)
+ rmLoggerSet loggerSet
+ exitWith (ExitFailure 1)
+ )
+ $ do
+ packageInfo <- runLoggingT
+ (createPackageInfo (configPackageDirectoryPath config)
+ (configPackageDistDirRelativePath config)
+ (configSourceCodePreprocessing config)
+ (configGhcOptions config)
+ (configIgnoreDirectories config)
+ )
+ (\_loc _source level msg -> logger loggerSet minLogLevel level msg)
+ let outputDir = configPackageDirectoryPath config </> fromMaybe
+ HCE.defaultOutputDirectoryName
+ (configOutputDirectoryName config)
+ createDirectoryIfMissing False outputDir
+ logger loggerSet minLogLevel LevelDebug
+ $ "Output directory : "
+ ++ outputDir
+ BS.writeFile (outputDir </> HCE.packageInfoBinaryFileName)
+ (S.encode $ HCE.toCompactPackageInfo packageInfo)
+ mapM_
+ (\(HCE.HaskellModulePath path, modInfo) ->
+ let (compressFunction, compressExtension) =
+ case configCompression config of
+ Gzip -> (compress, ".gz")
+ NoCompression -> (id, "")
+ filePath =
+ outputDir
+ </> ( encode (T.unpack path)
+ ++ ".json"
+ ++ compressExtension
+ )
+ in BSL.writeFile filePath . compressFunction . A.encode $ modInfo
+ )
+ . HM.toList
+ $ HCE.moduleMap (packageInfo :: HCE.PackageInfo HCE.ModuleInfo)
+ BSL.writeFile (outputDir </> HCE.packageInfoJsonFileName)
+ (A.encode packageInfo)
+ BSL.writeFile (outputDir </> "version.txt")
+ (BSC.pack $ showVersion version)
+ logger loggerSet minLogLevel LevelInfo ("Finished" :: T.Text)
+ rmLoggerSet loggerSet
configParser :: Parser IndexerConfig
configParser =
- IndexerConfig <$>
- strOption
- (long "package" <> short 'p' <> metavar "PATH" <> value "." <> showDefault <>
- help "Path to a Cabal package") <*>
- optional
- (strOption
- (long "dist" <> metavar "RELATIVE_PATH" <>
- help "Relative path to a dist directory")) <*>
- optional
- (strOption
- (long "output" <> metavar "DIRECTORY_NAME" <>
- help "Output directory (default is '.haskell-code-explorer')")) <*>
- (pure HCE.StdOut <|>
- (HCE.ToFile <$>
- strOption
- (long "logfile" <> metavar "PATH" <>
- help "Path to a log file (by default log is written to stdout)"))) <*>
- flag
- LevelInfo
- LevelDebug
- (long "verbose" <> short 'v' <> help "Write debug information to a log") <*>
- flag
- HCE.AfterPreprocessing
- HCE.BeforePreprocessing
- (long "before-preprocessing" <>
- help
- "Index source code before preprocessor pass (by default source code after preprocessing is indexed)") <*>
- flag
- Gzip
- NoCompression
- (long "no-compression" <>
- help
- "Do not compress json files (by default json files are compressed using gzip)") <*>
- many
- (strOption
- (long "ghc" <> metavar "OPTIONS" <> help "Command-line options for GHC")) <*>
- many
- (strOption
- (long "ignore" <> metavar "DIRECTORY_NAME" <>
- help "Directories to ignore (e.g. node_modules)"))
+ IndexerConfig
+ <$> strOption
+ ( long "package"
+ <> short 'p'
+ <> metavar "PATH"
+ <> value "."
+ <> showDefault
+ <> help "Path to a Cabal package"
+ )
+ <*> optional
+ (strOption
+ (long "dist" <> metavar "RELATIVE_PATH" <> help
+ "Relative path to a dist directory"
+ )
+ )
+ <*> optional
+ (strOption
+ (long "output" <> metavar "DIRECTORY_NAME" <> help
+ "Output directory (default is '.haskell-code-explorer')"
+ )
+ )
+ <*> ( pure HCE.StdOut
+ <|> (HCE.ToFile <$> strOption
+ (long "logfile" <> metavar "PATH" <> help
+ "Path to a log file (by default log is written to stdout)"
+ )
+ )
+ )
+ <*> flag
+ LevelInfo
+ LevelDebug
+ (long "verbose" <> short 'v' <> help
+ "Write debug information to a log"
+ )
+ <*> flag
+ HCE.AfterPreprocessing
+ HCE.BeforePreprocessing
+ ( long "before-preprocessing"
+ <> help
+ "Index source code before preprocessor pass (by default source code after preprocessing is indexed)"
+ )
+ <*> flag
+ Gzip
+ NoCompression
+ ( long "no-compression"
+ <> help
+ "Do not compress json files (by default json files are compressed using gzip)"
+ )
+ <*> many
+ (strOption
+ (long "ghc" <> metavar "OPTIONS" <> help
+ "Command-line options for GHC"
+ )
+ )
+ <*> many
+ (strOption
+ (long "ignore" <> metavar "DIRECTORY_NAME" <> help
+ "Directories to ignore (e.g. node_modules)"
+ )
+ )
logger :: ToLogStr msg => LoggerSet -> LogLevel -> LogLevel -> msg -> IO ()
-logger loggerSet minLogLevel logLevel msg =
- when (logLevel >= minLogLevel) $ do
- time <- getZonedTime
- let showLogLevel :: LogLevel -> T.Text
- showLogLevel LevelDebug = "[debug]"
- showLogLevel LevelInfo = "[info]"
- showLogLevel LevelWarn = "[warn]"
- showLogLevel LevelError = "[error]"
- showLogLevel (LevelOther t) = T.concat ["[",t,"]"]
- text =
- T.concat
- [ T.pack $ show time
- , " : "
- , showLogLevel logLevel
- , " "
- , TE.decodeUtf8 . fromLogStr . toLogStr $ msg
- ]
- pushLogStrLn loggerSet $ toLogStr text
+logger loggerSet minLogLevel logLevel msg = when (logLevel >= minLogLevel) $ do
+ time <- getZonedTime
+ let showLogLevel :: LogLevel -> T.Text
+ showLogLevel LevelDebug = "[debug]"
+ showLogLevel LevelInfo = "[info]"
+ showLogLevel LevelWarn = "[warn]"
+ showLogLevel LevelError = "[error]"
+ showLogLevel (LevelOther t) = T.concat ["[", t, "]"]
+ text = T.concat
+ [ T.pack $ show time
+ , " : "
+ , showLogLevel logLevel
+ , " "
+ , TE.decodeUtf8 . fromLogStr . toLogStr $ msg
+ ]
+ pushLogStrLn loggerSet $ toLogStr text