{-# LANGUAGE CPP               #-}
{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedLabels  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}
{-# LANGUAGE TypeOperators     #-}
module Ide.Plugin.Ormolu
  ( descriptor
  , provider
  , LogEvent
  )
where

import           Control.Exception               (Handler (..), IOException,
                                                  SomeException (..), catches,
                                                  handle)
import           Control.Monad.Except            (ExceptT (ExceptT), runExceptT,
                                                  throwError)
import           Control.Monad.Extra
import           Control.Monad.IO.Class          (liftIO)
import           Control.Monad.Trans
import           Control.Monad.Trans.Except      (ExceptT (..), mapExceptT,
                                                  runExceptT)
import           Data.Functor                    ((<&>))
import           Data.List                       (intercalate)
import           Data.Maybe                      (catMaybes)
import           Data.Text                       (Text)
import qualified Data.Text                       as T
import           Development.IDE                 hiding (pluginHandlers)
import           Development.IDE.GHC.Compat      (hsc_dflags, moduleNameString)
import qualified Development.IDE.GHC.Compat      as D
import qualified Development.IDE.GHC.Compat.Util as S
import           GHC.LanguageExtensions.Type
import           Ide.Plugin.Error                (PluginError (PluginInternalError))
import           Ide.Plugin.Properties
import           Ide.PluginUtils
import           Ide.Types                       hiding (Config)
import qualified Ide.Types                       as Types
import           Language.LSP.Protocol.Message
import           Language.LSP.Protocol.Types
import           Language.LSP.Server             hiding (defaultConfig)
import           Ormolu
import           System.Exit
import           System.FilePath
import           System.Process.Run              (cwd, proc)
import           System.Process.Text             (readCreateProcessWithExitCode)
import           Text.Read                       (readMaybe)

-- ---------------------------------------------------------------------

descriptor :: Recorder (WithPriority LogEvent) -> PluginId -> PluginDescriptor IdeState
descriptor recorder plId =
  (defaultPluginDescriptor plId)
    { pluginHandlers = mkFormattingHandlers $ provider recorder plId,
      pluginConfigDescriptor = defaultConfigDescriptor {configCustomConfig = mkCustomConfig properties}
    }

properties :: Properties '[ 'PropertyKey "external" 'TBoolean]
properties =
  emptyProperties
    & defineBooleanProperty
      #external
      "Call out to an external \"ormolu\" executable, rather than using the bundled library"
      False

-- ---------------------------------------------------------------------

provider :: Recorder (WithPriority LogEvent) -> PluginId -> FormattingHandler IdeState
provider recorder plId ideState typ contents fp _ = ExceptT $ withIndefiniteProgress title Cancellable $ runExceptT $ do
  fileOpts <-
      maybe [] (fromDyn . hsc_dflags . hscEnv)
          <$> liftIO (runAction "Ormolu" ideState $ use GhcSession fp)
  useCLI <- liftIO $ runAction "Ormolu" ideState $ usePropertyAction #external plId properties

  if useCLI
      then mapExceptT liftIO $ ExceptT
           $ handle @IOException
          (pure . Left . PluginInternalError . T.pack . show)
           $ runExceptT $ cliHandler fileOpts
      else do
          logWith recorder Debug $ LogCompiledInVersion VERSION_ormolu

          let
            fmt :: T.Text -> Config RegionIndices -> IO (Either SomeException T.Text)
            fmt cont conf = flip catches handlers $ do
#if MIN_VERSION_ormolu(0,5,3)
              cabalInfo <- getCabalInfoForSourceFile fp' <&> \case
                CabalNotFound                -> Nothing
                CabalDidNotMention cabalInfo -> Just cabalInfo
                CabalFound cabalInfo         -> Just cabalInfo
#if MIN_VERSION_ormolu(0,7,0)
              (fixityOverrides, moduleReexports) <- getDotOrmoluForSourceFile fp'
              let conf' = refineConfig ModuleSource cabalInfo (Just fixityOverrides) (Just moduleReexports) conf
#else
              fixityOverrides <- traverse getFixityOverridesForSourceFile cabalInfo
              let conf' = refineConfig ModuleSource cabalInfo fixityOverrides conf
#endif
              let cont' = cont
#else
              let conf' = conf
                  cont' = T.unpack cont
#endif
              Right <$> ormolu conf' fp' cont'
            handlers =
              [ Handler $ pure . Left . SomeException @OrmoluException
              , Handler $ pure . Left . SomeException @IOException
              ]

          res <- liftIO $ fmt contents defaultConfig { cfgDynOptions = map DynOption fileOpts, cfgRegion = region }
          ret res
 where
   fp' = fromNormalizedFilePath fp

   region :: RegionIndices
   region = case typ of
       FormatText ->
           RegionIndices Nothing Nothing
       FormatRange (Range (Position sl _) (Position el _)) ->
           RegionIndices (Just $ fromIntegral $ sl + 1) (Just $ fromIntegral $ el + 1)

   title = T.pack $ "Formatting " <> takeFileName (fromNormalizedFilePath fp)

   ret :: Either SomeException T.Text -> ExceptT PluginError (LspM Types.Config) ([TextEdit] |? Null)
   ret (Left err)  = throwError $ PluginInternalError . T.pack $ "ormoluCmd: " ++ show err
   ret (Right new) = pure $ InL $ makeDiffTextEdit contents new

   fromDyn :: D.DynFlags -> [String]
   fromDyn df =
     let
       pp =
         let p = D.sPgm_F $ D.settings df
         in  ["-pgmF=" <> p | not (null p)]
       pm = ("-fplugin=" <>) . moduleNameString <$> D.pluginModNames df
       ex = showExtension <$> S.toList (D.extensionFlags df)
     in pp <> pm <> ex

   cliHandler :: [String] -> ExceptT PluginError IO ([TextEdit] |? Null)
   cliHandler fileOpts = do
       CLIVersionInfo{noCabal} <- do -- check Ormolu version so that we know which flags to use
           (exitCode, out, _err) <- liftIO $ readCreateProcessWithExitCode ( proc "ormolu" ["--version"] ) ""
           let version = do
                   guard $ exitCode == ExitSuccess
                   "ormolu" : v : _ <- pure $ T.words out
                   traverse (readMaybe @Int . T.unpack) $ T.splitOn "." v
           case version of
               Just v -> do
                   logWith recorder Debug $ LogExternalVersion v
                   pure CLIVersionInfo
                       { noCabal = v >= [0, 7]
                       }
               Nothing -> do
                   logWith recorder Debug $ LogExternalVersion []
                   logWith recorder Warning $ NoVersion out
                   pure CLIVersionInfo
                       { noCabal = True
                       }
       (exitCode, out, err) <- do -- run Ormolu
           let commandArgs = map ("-o" <>) fileOpts
                       -- "The --stdin-input-file option is necessary when using input from
                       -- stdin and accounting for .cabal files" as per Ormolu documentation
                       <> (if noCabal then ["--no-cabal"] else ["--stdin-input-file", fp'])
                       <> catMaybes
                           [ ("--start-line=" <>) . show <$> regionStartLine region
                           , ("--end-line=" <>) . show <$> regionEndLine region
                           ]
               cwd = takeDirectory fp'
           logWith recorder Debug $ LogOrmoluCommand commandArgs cwd
           liftIO $ readCreateProcessWithExitCode (proc "ormolu" commandArgs) {cwd = Just cwd} contents
       case exitCode of
           ExitSuccess -> do
               when (not $ T.null err) $ logWith recorder Debug $ StdErr err
               pure $ InL $ makeDiffTextEdit contents out
           ExitFailure n -> do
               logWith recorder Info $ StdErr err
               throwError $ PluginInternalError $ "Ormolu failed with exit code " <> T.pack (show n)

newtype CLIVersionInfo =   CLIVersionInfo
    { noCabal :: Bool
    }

data LogEvent
    = NoVersion Text
    | StdErr Text
    | LogCompiledInVersion String
    | LogExternalVersion [Int]
    | LogOrmoluCommand [String] FilePath
    deriving (Show)

instance Pretty LogEvent where
    pretty = \case
        NoVersion t -> "Couldn't get Ormolu version:" <> line <> indent 2 (pretty t)
        StdErr t -> "Ormolu stderr:" <> line <> indent 2 (pretty t)
        LogCompiledInVersion v -> "Using compiled in ormolu-" <> pretty v
        LogExternalVersion v ->
            "Using external ormolu"
            <> if null v then "" else "-"
            <> pretty (intercalate "." $ map show v)
        LogOrmoluCommand commandArgs cwd -> "Running: `ormolu " <> pretty (unwords commandArgs) <> "` in directory " <> pretty cwd

showExtension :: Extension -> String
showExtension Cpp   = "-XCPP"
showExtension other = "-X" ++ show other