import Prelude

import Control.Applicative ((<|>), many, optional)
import Control.Monad (unless, when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger
  ( LogLevel(LevelDebug, LevelError, LevelInfo), defaultOutput, logInfo, runLoggingT
  )
import Control.Monad.State (execStateT, put)
import Data.Foldable (foldrM, for_)
import Data.Set (Set)
import Data.Text (Text, pack)
import System.Exit (ExitCode(ExitFailure, ExitSuccess), exitWith)
import System.FilePath.Posix ((</>))
import System.IO (stdout)
import qualified Data.Set as Set
import qualified Options.Applicative as Opt

import Data.Prune.Apply (Apply(ApplySafe, ApplySmart), SomeApply(SomeApply), runApply, writeApply)
import Data.Prune.Cabal (findCabalFiles, parseCabalFiles, parseCabalProjectFile)
import Data.Prune.Confirm (confirm)
import Data.Prune.Dependency (getDependencyByModule)
import Data.Prune.ImportParser (getCompilableUsedDependencies)
import Data.Prune.Section.Parser (readCabalSections)
import Data.Prune.Stack (parseStackYaml)
import qualified Data.Prune.Confirm as Confirm
import qualified Data.Prune.Types as T

data Opts = Opts
  { optsProjectRoot :: FilePath
  , optsNoDefaultIgnore :: Bool
  , optsNoIgnoreSelf :: Bool
  , optsExtraIgnoreList :: [T.DependencyName]
  , optsPackages :: [Text]
  , optsVerbosity :: T.Verbosity
  , optsBuildSystem :: Maybe T.BuildSystem
  , optsApply :: Bool
  , optsNoVerify :: Bool
  , optsStrategy :: T.ApplyStrategy
  }

defaultIgnoreList :: Set T.DependencyName
defaultIgnoreList = Set.fromList
  [ T.DependencyName "base" -- ignore base because it's needed for info modules etc
  , T.DependencyName "hedgehog" -- ignore because some packages use hedgehog discovery
  , T.DependencyName "hspec" -- ignore because some packages use hspec discovery
  , T.DependencyName "hspec-discover" -- ignore because some packages use hspec discovery
  , T.DependencyName "tasty" -- ignore because some packages use tasty discovery
  , T.DependencyName "tasty-hedgehog" -- ignore because some packages use tasty discovery
  , T.DependencyName "tasty-hspec" -- ignore because some packages use tasty discovery
  , T.DependencyName "tasty-hunit" -- ignore because some packages use tasty discovery
  ]

verbosityToLogLevel :: T.Verbosity -> Maybe LogLevel
verbosityToLogLevel = \case
  T.Silent -> Nothing
  T.Error -> Just LevelError
  T.Info -> Just LevelInfo
  T.Debug -> Just LevelDebug

parseArgs :: IO Opts
parseArgs = Opt.execParser (Opt.info (Opt.helper <*> parser) $ Opt.progDesc "Prune a Haskell project's dependencies")
  where
    parser = Opts
      <$> Opt.strOption (
        Opt.long "project-root"
          <> Opt.metavar "PROJECT_ROOT"
          <> Opt.help "Project root"
          <> Opt.value "."
          <> Opt.showDefault )
      <*> Opt.switch (
        Opt.long "no-default-ignore"
          <> Opt.help ("Don't use the default ignore list (" <> show (Set.toList defaultIgnoreList) <> ")") )
      <*> Opt.switch (
        Opt.long "no-ignore-self"
          <> Opt.help "Error if an executable doesn't use the library it's defined with" )
      <*> many ( T.DependencyName . pack <$> Opt.strOption (
        Opt.long "extra-ignore"
          <> Opt.metavar "EXTRA_IGNORE"
          <> Opt.help "Dependencies(s) to ignore in addition to the default ignore list" ) )
      <*> many ( pack <$> Opt.strOption (
        Opt.long "package"
          <> Opt.metavar "PACKAGE"
          <> Opt.help "Package name(s)" ) )
      <*> Opt.option (Opt.maybeReader T.parseVerbosity) (
        Opt.long "verbosity"
          <> Opt.metavar "VERBOSITY"
          <> Opt.help ("Set the verbosity level (one of " <> show T.allVerbosities <> ")")
          <> Opt.value T.Error
          <> Opt.showDefault )
      <*> optional ( Opt.option (Opt.maybeReader T.parseBuildSystem) (
        Opt.long "build-system"
          <> Opt.metavar "BUILD_SYSTEM"
          <> Opt.help ("Build system to use instead of inference (one of " <> show T.allBuildSystems <> ")") ) )
      <*> Opt.switch (
        Opt.long "apply"
          <> Opt.help "Apply changes" )
      <*> Opt.switch (
        Opt.long "no-verify"
          <> Opt.help "Do not ask for verification when applying (implies --apply)" )
      <*> Opt.option (Opt.maybeReader T.parseApplyStrategy) (
        Opt.long "strategy"
          <> Opt.help ("Strategy to use to apply (one of " <> show T.allApplyStrategies <> ")")
          <> Opt.value T.ApplyStrategySmart
          <> Opt.showDefault )

main :: IO ()
main = do
  Opts {..} <- parseArgs

  let shouldApply = T.validateShouldApply (optsApply, optsNoVerify)

  when (shouldApply == T.ShouldApply) $ do
    putStrLn $ Confirm.warn "Applying results ignores package.yaml files"
    putStrLn $ Confirm.warn "In addition, it could result in unexpected changes to cabal files"
    T.unlessM (confirm "Do you want to continue? (Y/n)") $
      exitWith ExitSuccess

  let ignoreList = Set.fromList optsExtraIgnoreList <> if optsNoDefaultIgnore then mempty else defaultIgnoreList
      logger ma = runLoggingT ma $ case verbosityToLogLevel optsVerbosity of
        Nothing -> \_ _ _ _ -> pure ()
        Just level -> \loc src lvl str -> when (lvl >= level) $ defaultOutput stdout loc src lvl str

  (buildSystem, packageDirs) <- case optsBuildSystem of
    Just T.Stack -> parseStackYaml (optsProjectRoot </> "stack.yaml")
    Just T.CabalProject -> parseCabalProjectFile (optsProjectRoot </> "cabal.project")
    Just T.Cabal -> findCabalFiles optsProjectRoot
    Nothing -> parseStackYaml (optsProjectRoot </> "stack.yaml")
      <|> parseCabalProjectFile (optsProjectRoot </> "cabal.project")
      <|> findCabalFiles optsProjectRoot
  code <- logger $ do
    $logInfo $ "Using build system " <> pack (show buildSystem)
    $logInfo $ "Using ignore list " <> pack (show (Set.toList ignoreList))
    packages <- parseCabalFiles packageDirs ignoreList optsPackages

    dependencyByModule <- getDependencyByModule optsProjectRoot buildSystem packages
    flip execStateT ExitSuccess $ for_ packages $ \package@T.Package {..} -> do

      apInit <- case optsStrategy of
        T.ApplyStrategySafe -> pure $ SomeApply $ ApplySafe packageFile packageDescription mempty
        T.ApplyStrategySmart -> do
          let onFailure str = do
                liftIO $ putStrLn $ Confirm.err $ "Failed to parse cabal sections for " <> packageFile <> " due to " <> str
                put $ ExitFailure 1
                pure mempty
          sections <- either onFailure pure =<< liftIO (readCabalSections packageFile)
          pure $ SomeApply $ ApplySmart packageFile sections mempty

      let addSelf = if optsNoIgnoreSelf then id else Set.insert (T.DependencyName packageName)
          runCompilable compilable@T.Compilable {..} (oldShouldFail, oldUsed, oldStrip) = do
            usedDependencies <- addSelf <$> getCompilableUsedDependencies dependencyByModule compilable
            let (baseUsedDependencies, otherUsedDependencies) = Set.partition (flip Set.member packageBaseDependencies) usedDependencies
                otherUnusedDependencies = Set.difference compilableDependencies otherUsedDependencies
            case Set.null otherUnusedDependencies of
              True -> pure (oldShouldFail, baseUsedDependencies <> oldUsed, oldStrip)
              False -> do
                (shouldFail, strip) <- liftIO $ runApply oldStrip package otherUnusedDependencies (Just compilable) shouldApply
                pure (shouldFail || oldShouldFail, baseUsedDependencies <> oldUsed, strip)
      (targetsShouldFail, targetsUsedDependencies, targetsStrip) <- foldrM runCompilable (False, mempty, apInit) packageCompilables

      let baseUnusedDependencies = Set.difference packageBaseDependencies targetsUsedDependencies
      (finalShouldFail, stripFinal) <- case Set.null baseUnusedDependencies of
        True -> pure (False, targetsStrip)
        False -> liftIO $ runApply targetsStrip package baseUnusedDependencies Nothing shouldApply

      when (targetsShouldFail || finalShouldFail) $ put $ ExitFailure 1
      unless (shouldApply == T.ShouldNotApply) $
        liftIO $ writeApply stripFinal

  exitWith code