content: {-# LANGUAGE DuplicateRecordFields #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE OverloadedStrings #-}
  
  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
    )
  
  data IndexerConfig = IndexerConfig
    { 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)
  
  data Compression
    = Gzip
    | NoCompression
    deriving (Show, Eq)
  
  versionInfo :: String
  versionInfo =
    "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 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
  
  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)"))
  
  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
  