{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
module HlsPlugins where

import           Ide.Logger                        (Pretty (pretty), Recorder,
                                                    WithPriority, cmapWithPrio)
import           Ide.PluginUtils                   (pluginDescToIdePlugins)
import           Ide.Types                         (IdePlugins,
                                                    PluginId (PluginId))

-- fixed plugins
import           Development.IDE                   (IdeState)
import qualified Development.IDE.Plugin.HLS.GhcIde as GhcIde

-- haskell-language-server optional plugins
#if hls_qualifyImportedNames
import qualified Ide.Plugin.QualifyImportedNames   as QualifyImportedNames
#endif

#if hls_callHierarchy
import qualified Ide.Plugin.CallHierarchy          as CallHierarchy
#endif
#if hls_cabal
import qualified Ide.Plugin.Cabal                  as Cabal
#endif
#if hls_class
import qualified Ide.Plugin.Class                  as Class
#endif

#if hls_eval
import qualified Ide.Plugin.Eval                   as Eval
#endif

#if hls_importLens
import qualified Ide.Plugin.ExplicitImports        as ExplicitImports
#endif



#if hls_rename
import qualified Ide.Plugin.Rename                 as Rename
#endif

#if hls_retrie
import qualified Ide.Plugin.Retrie                 as Retrie
#endif

#if hls_hlint
import qualified Ide.Plugin.Hlint                  as Hlint
#endif

#if hls_stan
import qualified Ide.Plugin.Stan                   as Stan
#endif

#if hls_moduleName
import qualified Ide.Plugin.ModuleName             as ModuleName
#endif

#if hls_pragmas
import qualified Ide.Plugin.Pragmas                as Pragmas
#endif

#if hls_splice
import qualified Ide.Plugin.Splice                 as Splice
#endif

#if hls_alternateNumberFormat
import qualified Ide.Plugin.AlternateNumberFormat  as AlternateNumberFormat
#endif

#if hls_codeRange
import qualified Ide.Plugin.CodeRange              as CodeRange
#endif

#if hls_changeTypeSignature
import qualified Ide.Plugin.ChangeTypeSignature    as ChangeTypeSignature
#endif

#if hls_gadt
import qualified Ide.Plugin.GADT                   as GADT
#endif

#if explicitFixity
import qualified Ide.Plugin.ExplicitFixity         as ExplicitFixity
#endif

#if explicitFields
import qualified Ide.Plugin.ExplicitFields         as ExplicitFields
#endif

#if hls_overloaded_record_dot
import qualified Ide.Plugin.OverloadedRecordDot    as OverloadedRecordDot
#endif

-- formatters

#if hls_floskell
import qualified Ide.Plugin.Floskell               as Floskell
#endif

#if hls_fourmolu
import qualified Ide.Plugin.Fourmolu               as Fourmolu
#endif

#if hls_cabalfmt
import qualified Ide.Plugin.CabalFmt               as CabalFmt
#endif

#if hls_ormolu
import qualified Ide.Plugin.Ormolu                 as Ormolu
#endif

#if hls_stylishHaskell
import qualified Ide.Plugin.StylishHaskell         as StylishHaskell
#endif

#if hls_refactor
import qualified Development.IDE.Plugin.CodeAction as Refactor
#endif

#if hls_semanticTokens
import qualified Ide.Plugin.SemanticTokens         as SemanticTokens
#endif


data Log = forall a. (Pretty a) => Log PluginId a

instance Pretty Log where
  pretty :: forall ann. Log -> Doc ann
pretty (Log (PluginId Text
pId) a
a) = Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
pId Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
": " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> a -> Doc ann
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty a
a

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

-- | The plugins configured for use in this instance of the language
-- server.
-- These can be freely added or removed to tailor the available
-- features of the server.

idePlugins :: Recorder (WithPriority Log) -> IdePlugins IdeState
idePlugins :: Recorder (WithPriority Log) -> IdePlugins IdeState
idePlugins Recorder (WithPriority Log)
recorder = [PluginDescriptor IdeState] -> IdePlugins IdeState
forall ideState. [PluginDescriptor ideState] -> IdePlugins ideState
pluginDescToIdePlugins [PluginDescriptor IdeState]
allPlugins
  where
    pluginRecorder :: forall log. (Pretty log) => PluginId -> Recorder (WithPriority log)
    pluginRecorder :: forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder PluginId
pluginId = (log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio (PluginId -> log -> Log
forall a. Pretty a => PluginId -> a -> Log
Log PluginId
pluginId) Recorder (WithPriority Log)
recorder
    allPlugins :: [PluginDescriptor IdeState]
allPlugins =
#if hls_cabal
      let pId :: PluginId
pId = PluginId
"cabal" in Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
Cabal.descriptor (PluginId -> Recorder (WithPriority Log)
forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder PluginId
pId) PluginId
pId PluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_pragmas
      PluginId -> PluginDescriptor IdeState
Pragmas.suggestPragmaDescriptor  PluginId
"pragmas-suggest" PluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
      PluginId -> PluginDescriptor IdeState
Pragmas.completionDescriptor  PluginId
"pragmas-completion" PluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
      PluginId -> PluginDescriptor IdeState
Pragmas.suggestDisableWarningDescriptor  PluginId
"pragmas-disable" PluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_floskell
      PluginId -> PluginDescriptor IdeState
Floskell.descriptor PluginId
"floskell" PluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_fourmolu
      let pId :: PluginId
pId = PluginId
"fourmolu" in Recorder (WithPriority LogEvent)
-> PluginId -> PluginDescriptor IdeState
Fourmolu.descriptor (PluginId -> Recorder (WithPriority LogEvent)
forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder PluginId
pId) PluginId
pIdPluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_cabalfmt
      -- this pId needs to be kept in sync with the hardcoded
      -- cabalFormattingProvider in the Default Config
      let pId :: PluginId
pId = PluginId
"cabal-fmt" in Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
CabalFmt.descriptor (PluginId -> Recorder (WithPriority Log)
forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder PluginId
pId) PluginId
pIdPluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_ormolu
      let pId :: PluginId
pId = PluginId
"ormolu" in Recorder (WithPriority LogEvent)
-> PluginId -> PluginDescriptor IdeState
Ormolu.descriptor (PluginId -> Recorder (WithPriority LogEvent)
forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder PluginId
pId) PluginId
pId PluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_stylishHaskell
      PluginId -> PluginDescriptor IdeState
StylishHaskell.descriptor PluginId
"stylish-haskell" PluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_rename
      let pId :: PluginId
pId = PluginId
"rename" in Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
Rename.descriptor (PluginId -> Recorder (WithPriority Log)
forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder PluginId
pId) PluginId
pIdPluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_retrie
      PluginId -> PluginDescriptor IdeState
Retrie.descriptor PluginId
"retrie" PluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_callHierarchy
      PluginId -> PluginDescriptor IdeState
CallHierarchy.descriptor PluginId
"callHierarchy" PluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_semanticTokens
      let pId :: PluginId
pId = PluginId
"semanticTokens" in Recorder (WithPriority SemanticLog)
-> PluginId -> PluginDescriptor IdeState
SemanticTokens.descriptor (PluginId -> Recorder (WithPriority SemanticLog)
forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder PluginId
pId) PluginId
pIdPluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_class
      let pId :: PluginId
pId = PluginId
"class" in Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
Class.descriptor (PluginId -> Recorder (WithPriority Log)
forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder PluginId
pId) PluginId
pIdPluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_eval
      let pId :: PluginId
pId = PluginId
"eval" in Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
Eval.descriptor (PluginId -> Recorder (WithPriority Log)
forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder PluginId
pId) PluginId
pIdPluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_importLens
      let pId :: PluginId
pId = PluginId
"importLens" in Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
ExplicitImports.descriptor (PluginId -> Recorder (WithPriority Log)
forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder PluginId
pId) PluginId
pIdPluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_qualifyImportedNames
      PluginId -> PluginDescriptor IdeState
QualifyImportedNames.descriptor PluginId
"qualifyImportedNames" PluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_moduleName
      let pId :: PluginId
pId = PluginId
"moduleName" in Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
ModuleName.descriptor (PluginId -> Recorder (WithPriority Log)
forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder PluginId
pId) PluginId
pIdPluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_hlint
      let pId :: PluginId
pId = PluginId
"hlint" in Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
Hlint.descriptor (PluginId -> Recorder (WithPriority Log)
forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder PluginId
pId) PluginId
pIdPluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_stan
      let pId :: PluginId
pId = PluginId
"stan" in Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
Stan.descriptor (PluginId -> Recorder (WithPriority Log)
forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder PluginId
pId) PluginId
pId PluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_splice
      PluginId -> PluginDescriptor IdeState
Splice.descriptor PluginId
"splice" PluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_alternateNumberFormat
      let pId :: PluginId
pId = PluginId
"alternateNumberFormat" in Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
AlternateNumberFormat.descriptor (PluginId -> Recorder (WithPriority Log)
forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder PluginId
pId) PluginId
pId PluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_codeRange
      let pId :: PluginId
pId = PluginId
"codeRange" in Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
CodeRange.descriptor (PluginId -> Recorder (WithPriority Log)
forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder PluginId
pId) PluginId
pIdPluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_changeTypeSignature
      PluginId -> PluginDescriptor IdeState
ChangeTypeSignature.descriptor PluginId
"changeTypeSignature" PluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_gadt
      PluginId -> PluginDescriptor IdeState
GADT.descriptor PluginId
"gadt" PluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_refactor
      let pId :: PluginId
pId = PluginId
"ghcide-code-actions-imports-exports" in Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
Refactor.iePluginDescriptor (PluginId -> Recorder (WithPriority Log)
forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder PluginId
pId) PluginId
pId PluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
      let pId :: PluginId
pId = PluginId
"ghcide-code-actions-type-signatures" in Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
Refactor.typeSigsPluginDescriptor (PluginId -> Recorder (WithPriority Log)
forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder     PluginId
pId) PluginId
pId PluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
      let pId :: PluginId
pId = PluginId
"ghcide-code-actions-bindings" in Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
Refactor.bindingsPluginDescriptor (PluginId -> Recorder (WithPriority Log)
forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder PluginId
pId) PluginId
pId PluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
      let pId :: PluginId
pId = PluginId
"ghcide-code-actions-fill-holes" in Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
Refactor.fillHolePluginDescriptor (PluginId -> Recorder (WithPriority Log)
forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder PluginId
pId) PluginId
pId PluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
      let pId :: PluginId
pId = PluginId
"ghcide-extend-import-action" in Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
Refactor.extendImportPluginDescriptor (PluginId -> Recorder (WithPriority Log)
forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder PluginId
pId) PluginId
pId PluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if explicitFixity
      let pId :: PluginId
pId = PluginId
"explicit-fixity" in Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
ExplicitFixity.descriptor (PluginId -> Recorder (WithPriority Log)
forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder PluginId
pId) PluginId
pId PluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if explicitFields
      let pId :: PluginId
pId = PluginId
"explicit-fields" in Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
ExplicitFields.descriptor (PluginId -> Recorder (WithPriority Log)
forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder PluginId
pId) PluginId
pId PluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
#if hls_overloaded_record_dot
      let pId :: PluginId
pId = PluginId
"overloaded-record-dot" in Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
OverloadedRecordDot.descriptor (PluginId -> Recorder (WithPriority Log)
forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder PluginId
pId) PluginId
pId PluginDescriptor IdeState
-> [PluginDescriptor IdeState] -> [PluginDescriptor IdeState]
forall a. a -> [a] -> [a]
:
#endif
      Recorder (WithPriority Log) -> [PluginDescriptor IdeState]
GhcIde.descriptors (PluginId -> Recorder (WithPriority Log)
forall log. Pretty log => PluginId -> Recorder (WithPriority log)
pluginRecorder PluginId
"ghcide")