{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}

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

import           Control.Exception           (try)
import           Control.Monad.IO.Class      (liftIO)
import qualified Data.Text                   as T
import           Development.IDE             hiding (pluginHandlers)
import           Development.IDE.GHC.Compat  (moduleNameString)
import qualified DynFlags                    as D
import qualified EnumSet                     as S
import           GHC.LanguageExtensions.Type
import           GhcPlugins                  (HscEnv (hsc_dflags))
import           Ide.PluginUtils
import           Ide.Types
import           Language.LSP.Server         hiding (defaultConfig)
import           Language.LSP.Types
import           Ormolu
import           System.FilePath             (takeFileName)

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

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

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

provider :: FormattingHandler IdeState
provider ideState typ contents fp _ = withIndefiniteProgress title Cancellable $ liftIO $ do
  ghc <- runAction "Ormolu" ideState $ use GhcSession fp
  let df = hsc_dflags . hscEnv <$> ghc
  fileOpts <- case df of
    Nothing -> pure []
    Just df -> pure $ fromDyn df

  let
    fullRegion = RegionIndices Nothing Nothing
    rangeRegion s e = RegionIndices (Just $ s + 1) (Just $ e + 1)
    mkConf o region = defaultConfig { cfgDynOptions = o, cfgRegion = region }
    fmt :: T.Text -> Config RegionIndices -> IO (Either OrmoluException T.Text)
    fmt cont conf =
      try @OrmoluException $ ormolu conf (fromNormalizedFilePath fp) $ T.unpack cont

  case typ of
    FormatText -> ret <$> fmt contents (mkConf fileOpts fullRegion)
    FormatRange (Range (Position sl _) (Position el _)) ->
      ret <$> fmt contents (mkConf fileOpts (rangeRegion sl el))
 where
   title = T.pack $ "Formatting " <> takeFileName (fromNormalizedFilePath fp)

   ret :: Either OrmoluException T.Text -> Either ResponseError (List TextEdit)
   ret (Left err)  = Left . responseError . T.pack $ "ormoluCmd: " ++ show err
   ret (Right new) = Right $ makeDiffTextEdit contents new

   fromDyn :: D.DynFlags -> [DynOption]
   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
       DynOption <$> pp <> pm <> ex

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