{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE LambdaCase               #-}
{-# LANGUAGE OverloadedStrings        #-}
{-# LANGUAGE TypeApplications         #-}
{-# LANGUAGE DataKinds                #-}
{-# LANGUAGE OverloadedLabels         #-}

module Ide.Plugin.Fourmolu (
    descriptor,
    provider,
) where

import           Control.Exception               (IOException, try)
import           Control.Lens                    ((^.))
import           Control.Monad
import           Control.Monad.IO.Class
import           Data.Bifunctor                  (first)
import           Data.Maybe
import qualified Data.Text                       as T
import qualified Data.Text.IO                    as T
import           Development.IDE                 hiding (pluginHandlers)
import           Development.IDE.GHC.Compat      as Compat hiding (Cpp)
import qualified Development.IDE.GHC.Compat.Util as S
import           GHC.LanguageExtensions.Type     (Extension (Cpp))
import           Ide.Plugin.Properties
import           Ide.PluginUtils                 (makeDiffTextEdit, usePropertyLsp)
import           Ide.Types
import           Language.LSP.Server             hiding (defaultConfig)
import           Language.LSP.Types
import           Language.LSP.Types.Lens         (HasTabSize (tabSize))
import           Ormolu
import           System.Exit
import           System.FilePath
import           System.IO                       (stderr)
import           System.Process.Run              (proc, cwd)
import           System.Process.Text             (readCreateProcessWithExitCode)

descriptor :: PluginId -> PluginDescriptor IdeState
descriptor plId =
    (defaultPluginDescriptor plId)
        { pluginHandlers = mkFormattingHandlers $ provider plId
        }

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

provider :: PluginId -> FormattingHandler IdeState
provider plId ideState typ contents fp fo = withIndefiniteProgress title Cancellable $ do
    fileOpts <-
        maybe [] (convertDynFlags . hsc_dflags . hscEnv)
            <$> liftIO (runAction "Fourmolu" ideState $ use GhcSession fp)
    useCLI <- usePropertyLsp #external plId properties
    if useCLI
        then liftIO
            . fmap (join . first (mkError . show))
            . try @IOException
            $ do
                (exitCode, out, err) <-
                    readCreateProcessWithExitCode
                        ( proc "fourmolu" $
                            ["-d"]
                                <> catMaybes
                                    [ ("--start-line=" <>) . show <$> regionStartLine region
                                    , ("--end-line=" <>) . show <$> regionEndLine region
                                    ]
                                <> map ("-o" <>) fileOpts
                        ){cwd = Just $ takeDirectory fp'}
                        contents
                T.hPutStrLn stderr err
                case exitCode of
                    ExitSuccess ->
                        pure . Right $ makeDiffTextEdit contents out
                    ExitFailure n ->
                        pure . Left . responseError $ "Fourmolu failed with exit code " <> T.pack (show n)
        else do
            let format printerOpts =
                    first (mkError . show)
                        <$> try @OrmoluException (makeDiffTextEdit contents <$> ormolu config fp' (T.unpack contents))
                  where
                    config =
                        defaultConfig
                            { cfgDynOptions = map DynOption fileOpts
                            , cfgRegion = region
                            , cfgDebug = True
                            , cfgPrinterOpts =
                                fillMissingPrinterOpts
                                    (printerOpts <> lspPrinterOpts)
                                    defaultPrinterOpts
                            }
             in liftIO (loadConfigFile fp') >>= \case
                    ConfigLoaded file opts -> liftIO $ do
                        putStrLn $ "Loaded Fourmolu config from: " <> file
                        format opts
                    ConfigNotFound searchDirs -> liftIO $ do
                        putStrLn
                            . unlines
                            $ ("No " ++ show configFileName ++ " found in any of:") :
                            map ("  " ++) searchDirs
                        format mempty
                    ConfigParseError f (_, err) -> do
                        sendNotification SWindowShowMessage $
                            ShowMessageParams
                                { _xtype = MtError
                                , _message = errorMessage
                                }
                        return . Left $ responseError errorMessage
                      where
                        errorMessage = "Failed to load " <> T.pack f <> ": " <> T.pack err
  where
    fp' = fromNormalizedFilePath fp
    title = "Formatting " <> T.pack (takeFileName fp')
    mkError = responseError . ("Fourmolu: " <>) . T.pack
    lspPrinterOpts = mempty{poIndentation = Just $ fromIntegral $ fo ^. tabSize}
    region = case typ of
        FormatText ->
            RegionIndices Nothing Nothing
        FormatRange (Range (Position sl _) (Position el _)) ->
            RegionIndices (Just $ fromIntegral $ sl + 1) (Just $ fromIntegral $ el + 1)

convertDynFlags :: DynFlags -> [String]
convertDynFlags df =
    let pp = ["-pgmF=" <> p | not (null p)]
        p = sPgm_F $ Compat.settings df
        pm = map (("-fplugin=" <>) . moduleNameString) $ pluginModNames df
        ex = map showExtension $ S.toList $ extensionFlags df
        showExtension = \case
            Cpp -> "-XCPP"
            x   -> "-X" ++ show x
     in pp <> pm <> ex