{-# LANGUAGE GADTs             #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE ViewPatterns      #-}

module Ide.Plugin.ConfigUtils (
  pluginsToDefaultConfig,
  pluginsToVSCodeExtensionSchema,
  pluginsCustomConfigToMarkdownTables
  ) where

import           Control.Lens                  (at, (&), (?~))
import qualified Data.Aeson                    as A
import           Data.Aeson.Lens               (_Object)
import qualified Data.Aeson.Types              as A
import           Data.Default
import qualified Data.Dependent.Map            as DMap
import qualified Data.Dependent.Sum            as DSum
import           Data.List.Extra               (nubOrd)
import           Data.String                   (IsString (fromString))
import qualified Data.Text                     as T
import           GHC.TypeLits                  (symbolVal)
import           Ide.Plugin.Config
import           Ide.Plugin.Properties         (KeyNameProxy, MetaData (..),
                                                PluginCustomConfig (..),
                                                PluginCustomConfigParam (..),
                                                Properties (..),
                                                SPropertyKey (..),
                                                SomePropertyKeyWithMetaData (..),
                                                toDefaultJSON,
                                                toVSCodeExtensionSchema)
import           Ide.Types
import           Language.LSP.Protocol.Message

-- Attention:
-- 'diagnosticsOn' will never be added into the default config or the schema,
-- since diagnostics emit in arbitrary shake rules -- we don't know
-- whether a plugin is capable of producing diagnostics.

-- | Generates a default 'Config', but remains only effective items
pluginsToDefaultConfig :: IdePlugins a -> A.Value
pluginsToDefaultConfig :: forall a. IdePlugins a -> Value
pluginsToDefaultConfig IdePlugins {[PluginDescriptor a]
ipMap :: [PluginDescriptor a]
ipMap :: forall ideState. IdePlugins ideState -> [PluginDescriptor ideState]
..} =
  -- Use '_Object' and 'at' to get at the "plugin" key
  -- and actually set it.
  Config -> Value
forall a. ToJSON a => a -> Value
A.toJSON Config
defaultConfig Value -> (Value -> Value) -> Value
forall a b. a -> (a -> b) -> b
& (KeyMap Value -> Identity (KeyMap Value))
-> Value -> Identity Value
forall t. AsValue t => Prism' t (KeyMap Value)
Prism' Value (KeyMap Value)
_Object ((KeyMap Value -> Identity (KeyMap Value))
 -> Value -> Identity Value)
-> ((Maybe (IxValue (KeyMap Value)) -> Identity (Maybe Value))
    -> KeyMap Value -> Identity (KeyMap Value))
-> (Maybe (IxValue (KeyMap Value)) -> Identity (Maybe Value))
-> Value
-> Identity Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (KeyMap Value)
-> Lens' (KeyMap Value) (Maybe (IxValue (KeyMap Value)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
Index (KeyMap Value)
"plugin" ((Maybe (IxValue (KeyMap Value)) -> Identity (Maybe Value))
 -> Value -> Identity Value)
-> Value -> Value -> Value
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value
pluginSpecificDefaultConfigs
  where
    defaultConfig :: Config
defaultConfig = Config
forall a. Default a => a
def :: Config
    pluginSpecificDefaultConfigs :: Value
pluginSpecificDefaultConfigs = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [[Pair]] -> [Pair]
forall a. Monoid a => [a] -> a
mconcat ([[Pair]] -> [Pair]) -> [[Pair]] -> [Pair]
forall a b. (a -> b) -> a -> b
$ PluginDescriptor a -> [Pair]
forall ideState. PluginDescriptor ideState -> [Pair]
singlePlugin (PluginDescriptor a -> [Pair]) -> [PluginDescriptor a] -> [[Pair]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PluginDescriptor a]
ipMap
    -- Splice genericDefaultConfig and dedicatedDefaultConfig
    -- Example:
    --
    -- {
    --  "plugin-id": {
    --    "globalOn": true,
    --    "codeActionsOn": true,
    --    "codeLensOn": true,
    --    "config": {
    --      "property1": "foo"
    --     }
    --   }
    -- }
    singlePlugin :: PluginDescriptor ideState -> [A.Pair]
    singlePlugin :: forall ideState. PluginDescriptor ideState -> [Pair]
singlePlugin PluginDescriptor {pluginConfigDescriptor :: forall ideState. PluginDescriptor ideState -> ConfigDescriptor
pluginConfigDescriptor = ConfigDescriptor {Bool
CustomConfig
PluginConfig
configInitialGenericConfig :: PluginConfig
configHasDiagnostics :: Bool
configCustomConfig :: CustomConfig
configCustomConfig :: ConfigDescriptor -> CustomConfig
configHasDiagnostics :: ConfigDescriptor -> Bool
configInitialGenericConfig :: ConfigDescriptor -> PluginConfig
..}, Natural
[Text]
[PluginCommand ideState]
Maybe (ParserInfo (IdeCommand ideState))
Text
Rules ()
PluginId
PluginNotificationHandlers ideState
PluginHandlers ideState
DynFlagsModifications
pluginId :: PluginId
pluginDescription :: Text
pluginPriority :: Natural
pluginRules :: Rules ()
pluginCommands :: [PluginCommand ideState]
pluginHandlers :: PluginHandlers ideState
pluginNotificationHandlers :: PluginNotificationHandlers ideState
pluginModifyDynflags :: DynFlagsModifications
pluginCli :: Maybe (ParserInfo (IdeCommand ideState))
pluginFileType :: [Text]
pluginFileType :: forall ideState. PluginDescriptor ideState -> [Text]
pluginCli :: forall ideState.
PluginDescriptor ideState
-> Maybe (ParserInfo (IdeCommand ideState))
pluginModifyDynflags :: forall ideState. PluginDescriptor ideState -> DynFlagsModifications
pluginNotificationHandlers :: forall ideState.
PluginDescriptor ideState -> PluginNotificationHandlers ideState
pluginHandlers :: forall ideState.
PluginDescriptor ideState -> PluginHandlers ideState
pluginCommands :: forall ideState.
PluginDescriptor ideState -> [PluginCommand ideState]
pluginRules :: forall ideState. PluginDescriptor ideState -> Rules ()
pluginPriority :: forall ideState. PluginDescriptor ideState -> Natural
pluginDescription :: forall ideState. PluginDescriptor ideState -> Text
pluginId :: forall ideState. PluginDescriptor ideState -> PluginId
..} =
      let x :: [Pair]
x = [Pair]
genericDefaultConfig [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair]
dedicatedDefaultConfig
       in [String -> Key
forall a. IsString a => String -> a
fromString (Text -> String
T.unpack Text
pId) Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= [Pair] -> Value
A.object [Pair]
x | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Pair] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pair]
x]
      where
        (PluginHandlers (DMap IdeMethod (PluginHandler ideState)
-> [DSum IdeMethod (PluginHandler ideState)]
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *).
DMap k2 f -> [DSum k2 f]
DMap.toList -> [DSum IdeMethod (PluginHandler ideState)]
handlers)) = PluginHandlers ideState
pluginHandlers
        customConfigToDedicatedDefaultConfig :: CustomConfig -> [Pair]
customConfigToDedicatedDefaultConfig (CustomConfig Properties r
p) = Properties r -> [Pair]
forall (r :: [PropertyKey]). Properties r -> [Pair]
toDefaultJSON Properties r
p
        -- Example:
        --
        -- {
        --   "codeActionsOn": true,
        --   "codeLensOn": true
        -- }
        --
        genericDefaultConfig :: [Pair]
genericDefaultConfig =
            let x :: [Pair]
x = [Key
"diagnosticsOn" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Bool
True | Bool
configHasDiagnostics]
                        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair] -> [Pair]
forall a. Ord a => [a] -> [a]
nubOrd ([[Pair]] -> [Pair]
forall a. Monoid a => [a] -> a
mconcat
                            (PluginConfig -> DSum IdeMethod (PluginHandler ideState) -> [Pair]
forall (f :: Method 'ClientToServer 'Request -> *).
PluginConfig -> DSum IdeMethod f -> [Pair]
handlersToGenericDefaultConfig PluginConfig
configInitialGenericConfig (DSum IdeMethod (PluginHandler ideState) -> [Pair])
-> [DSum IdeMethod (PluginHandler ideState)] -> [[Pair]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DSum IdeMethod (PluginHandler ideState)]
handlers))
            in case [Pair]
x of
                    -- If the plugin has only one capability, we produce globalOn instead of the specific one;
                    -- otherwise we omit globalOn
                    [Pair
_] -> [Key
"globalOn" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= PluginConfig -> Bool
plcGlobalOn PluginConfig
configInitialGenericConfig]
                    [Pair]
_   -> [Pair]
x
        -- Example:
        --
        -- {
        --  "config": {
        --      "property1": "foo"
        --   }
        --}
        dedicatedDefaultConfig :: [Pair]
dedicatedDefaultConfig =
          let x :: [Pair]
x = CustomConfig -> [Pair]
customConfigToDedicatedDefaultConfig CustomConfig
configCustomConfig
           in [Key
"config" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= [Pair] -> Value
A.object [Pair]
x | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Pair] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pair]
x]

        (PluginId Text
pId) = PluginId
pluginId

        -- This function captures ide methods registered by the plugin, and then converts it to kv pairs
        handlersToGenericDefaultConfig :: PluginConfig -> DSum.DSum IdeMethod f -> [A.Pair]
        handlersToGenericDefaultConfig :: forall (f :: Method 'ClientToServer 'Request -> *).
PluginConfig -> DSum IdeMethod f -> [Pair]
handlersToGenericDefaultConfig PluginConfig{Bool
KeyMap Value
plcGlobalOn :: PluginConfig -> Bool
plcGlobalOn :: Bool
plcCallHierarchyOn :: Bool
plcCodeActionsOn :: Bool
plcCodeLensOn :: Bool
plcInlayHintsOn :: Bool
plcDiagnosticsOn :: Bool
plcHoverOn :: Bool
plcSymbolsOn :: Bool
plcSignatureHelpOn :: Bool
plcCompletionOn :: Bool
plcRenameOn :: Bool
plcSelectionRangeOn :: Bool
plcFoldingRangeOn :: Bool
plcSemanticTokensOn :: Bool
plcConfig :: KeyMap Value
plcConfig :: PluginConfig -> KeyMap Value
plcSemanticTokensOn :: PluginConfig -> Bool
plcFoldingRangeOn :: PluginConfig -> Bool
plcSelectionRangeOn :: PluginConfig -> Bool
plcRenameOn :: PluginConfig -> Bool
plcCompletionOn :: PluginConfig -> Bool
plcSignatureHelpOn :: PluginConfig -> Bool
plcSymbolsOn :: PluginConfig -> Bool
plcHoverOn :: PluginConfig -> Bool
plcDiagnosticsOn :: PluginConfig -> Bool
plcInlayHintsOn :: PluginConfig -> Bool
plcCodeLensOn :: PluginConfig -> Bool
plcCodeActionsOn :: PluginConfig -> Bool
plcCallHierarchyOn :: PluginConfig -> Bool
..} (IdeMethod SMethod a
m DSum.:=> f a
_) = case SMethod a
m of
          SMethod a
SMethod_TextDocumentCodeAction           -> [Key
"codeActionsOn" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Bool
plcCodeActionsOn]
          SMethod a
SMethod_TextDocumentCodeLens             -> [Key
"codeLensOn" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Bool
plcCodeLensOn]
          SMethod a
SMethod_TextDocumentInlayHint            -> [Key
"inlayHintsOn" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Bool
plcInlayHintsOn]
          SMethod a
SMethod_TextDocumentRename               -> [Key
"renameOn" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Bool
plcRenameOn]
          SMethod a
SMethod_TextDocumentHover                -> [Key
"hoverOn" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Bool
plcHoverOn]
          SMethod a
SMethod_TextDocumentDocumentSymbol       -> [Key
"symbolsOn" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Bool
plcSymbolsOn]
          SMethod a
SMethod_TextDocumentSignatureHelp        -> [Key
"signatureHelpOn" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Bool
plcSignatureHelpOn]
          SMethod a
SMethod_TextDocumentCompletion           -> [Key
"completionOn" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Bool
plcCompletionOn]
          SMethod a
SMethod_TextDocumentPrepareCallHierarchy -> [Key
"callHierarchyOn" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Bool
plcCallHierarchyOn]
          SMethod a
SMethod_TextDocumentSemanticTokensFull   -> [Key
"semanticTokensOn" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Bool
plcSemanticTokensOn]
          SMethod a
SMethod_TextDocumentSemanticTokensFullDelta -> [Key
"semanticTokensOn" Key -> Bool -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Bool
plcSemanticTokensOn]
          SMethod a
_                                 -> []

-- | Generates json schema used in haskell vscode extension
-- Similar to 'pluginsToDefaultConfig' but simpler, since schema has a flatten structure
pluginsToVSCodeExtensionSchema :: IdePlugins a -> A.Value
pluginsToVSCodeExtensionSchema :: forall a. IdePlugins a -> Value
pluginsToVSCodeExtensionSchema IdePlugins {[PluginDescriptor a]
ipMap :: forall ideState. IdePlugins ideState -> [PluginDescriptor ideState]
ipMap :: [PluginDescriptor a]
..} = [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [[Pair]] -> [Pair]
forall a. Monoid a => [a] -> a
mconcat ([[Pair]] -> [Pair]) -> [[Pair]] -> [Pair]
forall a b. (a -> b) -> a -> b
$ PluginDescriptor a -> [Pair]
forall ideState. PluginDescriptor ideState -> [Pair]
singlePlugin (PluginDescriptor a -> [Pair]) -> [PluginDescriptor a] -> [[Pair]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PluginDescriptor a]
ipMap
  where
    singlePlugin :: PluginDescriptor ideState -> [Pair]
singlePlugin PluginDescriptor {pluginConfigDescriptor :: forall ideState. PluginDescriptor ideState -> ConfigDescriptor
pluginConfigDescriptor = ConfigDescriptor {Bool
CustomConfig
PluginConfig
configCustomConfig :: ConfigDescriptor -> CustomConfig
configHasDiagnostics :: ConfigDescriptor -> Bool
configInitialGenericConfig :: ConfigDescriptor -> PluginConfig
configInitialGenericConfig :: PluginConfig
configHasDiagnostics :: Bool
configCustomConfig :: CustomConfig
..}, Natural
[Text]
[PluginCommand ideState]
Maybe (ParserInfo (IdeCommand ideState))
Text
Rules ()
PluginId
PluginNotificationHandlers ideState
PluginHandlers ideState
DynFlagsModifications
pluginFileType :: forall ideState. PluginDescriptor ideState -> [Text]
pluginCli :: forall ideState.
PluginDescriptor ideState
-> Maybe (ParserInfo (IdeCommand ideState))
pluginModifyDynflags :: forall ideState. PluginDescriptor ideState -> DynFlagsModifications
pluginNotificationHandlers :: forall ideState.
PluginDescriptor ideState -> PluginNotificationHandlers ideState
pluginHandlers :: forall ideState.
PluginDescriptor ideState -> PluginHandlers ideState
pluginCommands :: forall ideState.
PluginDescriptor ideState -> [PluginCommand ideState]
pluginRules :: forall ideState. PluginDescriptor ideState -> Rules ()
pluginPriority :: forall ideState. PluginDescriptor ideState -> Natural
pluginDescription :: forall ideState. PluginDescriptor ideState -> Text
pluginId :: forall ideState. PluginDescriptor ideState -> PluginId
pluginId :: PluginId
pluginDescription :: Text
pluginPriority :: Natural
pluginRules :: Rules ()
pluginCommands :: [PluginCommand ideState]
pluginHandlers :: PluginHandlers ideState
pluginNotificationHandlers :: PluginNotificationHandlers ideState
pluginModifyDynflags :: DynFlagsModifications
pluginCli :: Maybe (ParserInfo (IdeCommand ideState))
pluginFileType :: [Text]
..} = [Pair]
genericSchema [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair]
dedicatedSchema
      where
        (PluginHandlers (DMap IdeMethod (PluginHandler ideState)
-> [DSum IdeMethod (PluginHandler ideState)]
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *).
DMap k2 f -> [DSum k2 f]
DMap.toList -> [DSum IdeMethod (PluginHandler ideState)]
handlers)) = PluginHandlers ideState
pluginHandlers
        customConfigToDedicatedSchema :: CustomConfig -> [Pair]
customConfigToDedicatedSchema (CustomConfig Properties r
p) = Text -> Properties r -> [Pair]
forall (r :: [PropertyKey]). Text -> Properties r -> [Pair]
toVSCodeExtensionSchema (Text -> Text
withIdPrefix Text
"config.") Properties r
p
        (PluginId Text
pId) = PluginId
pluginId
        genericSchema :: [Pair]
genericSchema =
          let x :: [Pair]
x =
                [Text -> Key
toKey' Text
"diagnosticsOn" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Bool -> Value
schemaEntry Text
"diagnostics" Bool
True | Bool
configHasDiagnostics]
                  [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair] -> [Pair]
forall a. Ord a => [a] -> [a]
nubOrd ([[Pair]] -> [Pair]
forall a. Monoid a => [a] -> a
mconcat (PluginConfig -> DSum IdeMethod (PluginHandler ideState) -> [Pair]
handlersToGenericSchema PluginConfig
configInitialGenericConfig (DSum IdeMethod (PluginHandler ideState) -> [Pair])
-> [DSum IdeMethod (PluginHandler ideState)] -> [[Pair]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DSum IdeMethod (PluginHandler ideState)]
handlers))
           in case [Pair]
x of
                -- If the plugin has only one capability, we produce globalOn instead of the specific one;
                -- otherwise we don't produce globalOn at all
                [Pair
_] -> [Text -> Key
toKey' Text
"globalOn" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Bool -> Value
schemaEntry Text
"plugin" (PluginConfig -> Bool
plcGlobalOn PluginConfig
configInitialGenericConfig)]
                [Pair]
_   -> [Pair]
x
        dedicatedSchema :: [Pair]
dedicatedSchema = CustomConfig -> [Pair]
customConfigToDedicatedSchema CustomConfig
configCustomConfig
        handlersToGenericSchema :: PluginConfig -> DSum IdeMethod (PluginHandler ideState) -> [Pair]
handlersToGenericSchema PluginConfig{Bool
KeyMap Value
plcGlobalOn :: PluginConfig -> Bool
plcConfig :: PluginConfig -> KeyMap Value
plcSemanticTokensOn :: PluginConfig -> Bool
plcFoldingRangeOn :: PluginConfig -> Bool
plcSelectionRangeOn :: PluginConfig -> Bool
plcRenameOn :: PluginConfig -> Bool
plcCompletionOn :: PluginConfig -> Bool
plcSignatureHelpOn :: PluginConfig -> Bool
plcSymbolsOn :: PluginConfig -> Bool
plcHoverOn :: PluginConfig -> Bool
plcDiagnosticsOn :: PluginConfig -> Bool
plcInlayHintsOn :: PluginConfig -> Bool
plcCodeLensOn :: PluginConfig -> Bool
plcCodeActionsOn :: PluginConfig -> Bool
plcCallHierarchyOn :: PluginConfig -> Bool
plcGlobalOn :: Bool
plcCallHierarchyOn :: Bool
plcCodeActionsOn :: Bool
plcCodeLensOn :: Bool
plcInlayHintsOn :: Bool
plcDiagnosticsOn :: Bool
plcHoverOn :: Bool
plcSymbolsOn :: Bool
plcSignatureHelpOn :: Bool
plcCompletionOn :: Bool
plcRenameOn :: Bool
plcSelectionRangeOn :: Bool
plcFoldingRangeOn :: Bool
plcSemanticTokensOn :: Bool
plcConfig :: KeyMap Value
..} (IdeMethod SMethod a
m DSum.:=> PluginHandler ideState a
_) = case SMethod a
m of
          SMethod a
SMethod_TextDocumentCodeAction           -> [Text -> Key
toKey' Text
"codeActionsOn" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Bool -> Value
schemaEntry Text
"code actions" Bool
plcCodeActionsOn]
          SMethod a
SMethod_TextDocumentCodeLens             -> [Text -> Key
toKey' Text
"codeLensOn" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Bool -> Value
schemaEntry Text
"code lenses" Bool
plcCodeLensOn]
          SMethod a
SMethod_TextDocumentInlayHint            -> [Text -> Key
toKey' Text
"inlayHintsOn" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Bool -> Value
schemaEntry Text
"inlay hints" Bool
plcInlayHintsOn]
          SMethod a
SMethod_TextDocumentRename               -> [Text -> Key
toKey' Text
"renameOn" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Bool -> Value
schemaEntry Text
"rename" Bool
plcRenameOn]
          SMethod a
SMethod_TextDocumentHover                -> [Text -> Key
toKey' Text
"hoverOn" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Bool -> Value
schemaEntry Text
"hover" Bool
plcHoverOn]
          SMethod a
SMethod_TextDocumentDocumentSymbol       -> [Text -> Key
toKey' Text
"symbolsOn" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Bool -> Value
schemaEntry Text
"symbols" Bool
plcSymbolsOn]
          SMethod a
SMethod_TextDocumentSignatureHelp        -> [Text -> Key
toKey' Text
"signatureHelpOn" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Bool -> Value
schemaEntry Text
"signature help" Bool
plcSignatureHelpOn]
          SMethod a
SMethod_TextDocumentCompletion           -> [Text -> Key
toKey' Text
"completionOn" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Bool -> Value
schemaEntry Text
"completions" Bool
plcCompletionOn]
          SMethod a
SMethod_TextDocumentPrepareCallHierarchy -> [Text -> Key
toKey' Text
"callHierarchyOn" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Bool -> Value
schemaEntry Text
"call hierarchy" Bool
plcCallHierarchyOn]
          SMethod a
SMethod_TextDocumentSemanticTokensFull   -> [Text -> Key
toKey' Text
"semanticTokensOn" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Bool -> Value
schemaEntry Text
"semantic tokens" Bool
plcSemanticTokensOn]
          SMethod a
SMethod_TextDocumentSemanticTokensFullDelta   -> [Text -> Key
toKey' Text
"semanticTokensOn" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Bool -> Value
schemaEntry Text
"semantic tokens" Bool
plcSemanticTokensOn]
          SMethod a
_                                        -> []
        schemaEntry :: Text -> Bool -> Value
schemaEntry Text
desc Bool
defaultVal =
          [Pair] -> Value
A.object
            [ Key
"scope" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"resource",
              Key
"type" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String Text
"boolean",
              Key
"default" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Bool -> Value
A.Bool Bool
defaultVal,
              Key
"description" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text -> Value
A.String (Text
"Enables " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
desc)
            ]
        withIdPrefix :: Text -> Text
withIdPrefix Text
x = Text
"haskell.plugin." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x
        toKey' :: Text -> Key
toKey' = String -> Key
forall a. IsString a => String -> a
fromString (String -> Key) -> (Text -> String) -> Text -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
withIdPrefix


-- | Generates markdown tables for custom config
pluginsCustomConfigToMarkdownTables :: IdePlugins a -> T.Text
pluginsCustomConfigToMarkdownTables :: forall a. IdePlugins a -> Text
pluginsCustomConfigToMarkdownTables IdePlugins {[PluginDescriptor a]
ipMap :: forall ideState. IdePlugins ideState -> [PluginDescriptor ideState]
ipMap :: [PluginDescriptor a]
..} = [Text] -> Text
T.unlines
    ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (PluginCustomConfig -> Text) -> [PluginCustomConfig] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map PluginCustomConfig -> Text
renderCfg
    ([PluginCustomConfig] -> [Text]) -> [PluginCustomConfig] -> [Text]
forall a b. (a -> b) -> a -> b
$ (PluginCustomConfig -> Bool)
-> [PluginCustomConfig] -> [PluginCustomConfig]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(PluginCustomConfig Text
_ [PluginCustomConfigParam]
params) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [PluginCustomConfigParam] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PluginCustomConfigParam]
params)
    ([PluginCustomConfig] -> [PluginCustomConfig])
-> [PluginCustomConfig] -> [PluginCustomConfig]
forall a b. (a -> b) -> a -> b
$ (PluginDescriptor a -> PluginCustomConfig)
-> [PluginDescriptor a] -> [PluginCustomConfig]
forall a b. (a -> b) -> [a] -> [b]
map PluginDescriptor a -> PluginCustomConfig
forall ideState. PluginDescriptor ideState -> PluginCustomConfig
toPluginCustomConfig [PluginDescriptor a]
ipMap
  where
    toPluginCustomConfig :: PluginDescriptor ideState -> PluginCustomConfig
    toPluginCustomConfig :: forall ideState. PluginDescriptor ideState -> PluginCustomConfig
toPluginCustomConfig PluginDescriptor {pluginConfigDescriptor :: forall ideState. PluginDescriptor ideState -> ConfigDescriptor
pluginConfigDescriptor = ConfigDescriptor {configCustomConfig :: ConfigDescriptor -> CustomConfig
configCustomConfig = CustomConfig
c}, pluginId :: forall ideState. PluginDescriptor ideState -> PluginId
pluginId = PluginId Text
pId} =
        PluginCustomConfig { pcc'Name :: Text
pcc'Name = Text
pId, pcc'Params :: [PluginCustomConfigParam]
pcc'Params = CustomConfig -> [PluginCustomConfigParam]
toPluginCustomConfigParams CustomConfig
c}
    toPluginCustomConfigParams :: CustomConfig -> [PluginCustomConfigParam]
    toPluginCustomConfigParams :: CustomConfig -> [PluginCustomConfigParam]
toPluginCustomConfigParams (CustomConfig Properties r
p) = Properties r -> [PluginCustomConfigParam]
forall (r :: [PropertyKey]).
Properties r -> [PluginCustomConfigParam]
toPluginCustomConfigParams' Properties r
p
    toPluginCustomConfigParams' :: Properties r -> [PluginCustomConfigParam]
    toPluginCustomConfigParams' :: forall (r :: [PropertyKey]).
Properties r -> [PluginCustomConfigParam]
toPluginCustomConfigParams' Properties r
EmptyProperties = []
    toPluginCustomConfigParams' (ConsProperties (KeyNameProxy s
keyNameProxy :: KeyNameProxy s) (SPropertyKey k
k :: SPropertyKey k) (MetaData t
m :: MetaData t) Properties ks
xs) =
        SomePropertyKeyWithMetaData -> PluginCustomConfigParam
toEntry (SPropertyKey k -> MetaData t -> SomePropertyKeyWithMetaData
forall (k :: PropertyKey) (s :: Symbol) (t :: PropertyType).
(k ~ 'PropertyKey s t) =>
SPropertyKey k -> MetaData t -> SomePropertyKeyWithMetaData
SomePropertyKeyWithMetaData SPropertyKey k
k MetaData t
m) PluginCustomConfigParam
-> [PluginCustomConfigParam] -> [PluginCustomConfigParam]
forall a. a -> [a] -> [a]
: Properties ks -> [PluginCustomConfigParam]
forall (r :: [PropertyKey]).
Properties r -> [PluginCustomConfigParam]
toPluginCustomConfigParams' Properties ks
xs
        where
            toEntry :: SomePropertyKeyWithMetaData -> PluginCustomConfigParam
            toEntry :: SomePropertyKeyWithMetaData -> PluginCustomConfigParam
toEntry (SomePropertyKeyWithMetaData SPropertyKey k
SNumber MetaData {Text
ToHsType t
defaultValue :: ToHsType t
description :: Text
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
..}) =
                PluginCustomConfigParam {
                    pccp'Name :: Text
pccp'Name = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ KeyNameProxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal KeyNameProxy s
keyNameProxy,
                    pccp'Description :: Text
pccp'Description = Text
description,
                    pccp'Default :: Text
pccp'Default = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
ToHsType t
defaultValue,
                    pccp'EnumValues :: [Text]
pccp'EnumValues = []
                }
            toEntry (SomePropertyKeyWithMetaData SPropertyKey k
SInteger MetaData {Text
ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
defaultValue :: ToHsType t
description :: Text
..}) =
                PluginCustomConfigParam {
                    pccp'Name :: Text
pccp'Name = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ KeyNameProxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal KeyNameProxy s
keyNameProxy,
                    pccp'Description :: Text
pccp'Description = Text
description,
                    pccp'Default :: Text
pccp'Default = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
ToHsType t
defaultValue,
                    pccp'EnumValues :: [Text]
pccp'EnumValues = []
                }
            toEntry (SomePropertyKeyWithMetaData SPropertyKey k
SString MetaData {Text
ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
defaultValue :: ToHsType t
description :: Text
..}) =
                PluginCustomConfigParam {
                    pccp'Name :: Text
pccp'Name = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ KeyNameProxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal KeyNameProxy s
keyNameProxy,
                    pccp'Description :: Text
pccp'Description = Text
description,
                    pccp'Default :: Text
pccp'Default = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. Show a => a -> String
show Text
ToHsType t
defaultValue,
                    pccp'EnumValues :: [Text]
pccp'EnumValues = []
                }
            toEntry (SomePropertyKeyWithMetaData SPropertyKey k
SBoolean MetaData {Text
ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
defaultValue :: ToHsType t
description :: Text
..}) =
                PluginCustomConfigParam {
                    pccp'Name :: Text
pccp'Name = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ KeyNameProxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal KeyNameProxy s
keyNameProxy,
                    pccp'Description :: Text
pccp'Description = Text
description,
                    pccp'Default :: Text
pccp'Default = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> String
forall a. Show a => a -> String
show Bool
ToHsType t
defaultValue,
                    pccp'EnumValues :: [Text]
pccp'EnumValues = []
                }
            toEntry (SomePropertyKeyWithMetaData (SObject Proxy a
_) MetaData {Text
ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
defaultValue :: ToHsType t
description :: Text
..}) =
                PluginCustomConfigParam {
                    pccp'Name :: Text
pccp'Name = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ KeyNameProxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal KeyNameProxy s
keyNameProxy,
                    pccp'Description :: Text
pccp'Description = Text
description,
                    pccp'Default :: Text
pccp'Default = Text
"TODO: nested object", -- T.pack $ show defaultValue,
                    pccp'EnumValues :: [Text]
pccp'EnumValues = []
                }
            toEntry (SomePropertyKeyWithMetaData (SArray Proxy a
_) MetaData {Text
ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
defaultValue :: ToHsType t
description :: Text
..}) =
                PluginCustomConfigParam {
                    pccp'Name :: Text
pccp'Name = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ KeyNameProxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal KeyNameProxy s
keyNameProxy,
                    pccp'Description :: Text
pccp'Description = Text
description,
                    pccp'Default :: Text
pccp'Default = Text
"TODO: Array values", -- T.pack $ show defaultValue,
                    pccp'EnumValues :: [Text]
pccp'EnumValues = []
                }
            toEntry (SomePropertyKeyWithMetaData (SEnum Proxy a
_) EnumMetaData {[Text]
[ToHsType t]
Text
ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
defaultValue :: ToHsType t
description :: Text
enumValues :: [ToHsType t]
enumDescriptions :: [Text]
enumDescriptions :: forall (t :: PropertyType). MetaData t -> [Text]
enumValues :: forall (t :: PropertyType). MetaData t -> [ToHsType t]
..}) =
                PluginCustomConfigParam {
                    pccp'Name :: Text
pccp'Name = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ KeyNameProxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal KeyNameProxy s
keyNameProxy,
                    pccp'Description :: Text
pccp'Description = Text
description,
                    pccp'Default :: Text
pccp'Default = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
ToHsType t
defaultValue,
                    pccp'EnumValues :: [Text]
pccp'EnumValues = (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show) [a]
[ToHsType t]
enumValues
                }
            toEntry (SomePropertyKeyWithMetaData SPropertyKey k
SProperties PropertiesMetaData {Text
Properties rs
ToHsType t
description :: forall (t :: PropertyType). MetaData t -> Text
defaultValue :: forall (t :: PropertyType). MetaData t -> ToHsType t
defaultValue :: ToHsType t
description :: Text
childrenProperties :: Properties rs
childrenProperties :: ()
..}) =
                PluginCustomConfigParam {
                    pccp'Name :: Text
pccp'Name = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ KeyNameProxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal KeyNameProxy s
keyNameProxy,
                    pccp'Description :: Text
pccp'Description = Text
description,
                    pccp'Default :: Text
pccp'Default = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ KeyMap Value -> String
forall a. Show a => a -> String
show KeyMap Value
ToHsType t
defaultValue,
                    pccp'EnumValues :: [Text]
pccp'EnumValues = []
                }
    renderCfg :: PluginCustomConfig -> T.Text
    renderCfg :: PluginCustomConfig -> Text
renderCfg (PluginCustomConfig Text
pId [PluginCustomConfigParam]
pccParams) =
        [Text] -> Text
T.unlines (Text
pluginHeader Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
tableHeader Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [PluginCustomConfigParam] -> [Text]
rows [PluginCustomConfigParam]
pccParams)
        where
            pluginHeader :: Text
pluginHeader = Text
"## " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pId
            tableHeader :: Text
tableHeader =
                Text
"| Property | Description | Default | Allowed values |" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                Text
"| --- | --- | --- | --- |"
            rows :: [PluginCustomConfigParam] -> [Text]
rows = (PluginCustomConfigParam -> Text)
-> [PluginCustomConfigParam] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map PluginCustomConfigParam -> Text
renderRow
            renderRow :: PluginCustomConfigParam -> Text
renderRow PluginCustomConfigParam {[Text]
Text
pccp'Name :: PluginCustomConfigParam -> Text
pccp'Description :: PluginCustomConfigParam -> Text
pccp'Default :: PluginCustomConfigParam -> Text
pccp'EnumValues :: PluginCustomConfigParam -> [Text]
pccp'Name :: Text
pccp'Description :: Text
pccp'Default :: Text
pccp'EnumValues :: [Text]
..} =
                Text
"| `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pccp'Name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pccp'Description Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" | `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pccp'Default Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"` | " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
renderEnum [Text]
pccp'EnumValues Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" |"
            renderEnum :: [Text] -> Text
renderEnum [] = Text
" &nbsp; " -- Placeholder to prevent missing cells
            renderEnum [Text]
vs = Text
"<ul> " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> [Text] -> Text
T.intercalate Text
" " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
x -> Text
"<li><code>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"</code></li>") [Text]
vs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" </ul>"