{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE TypeFamilies       #-}
{-# LANGUAGE ViewPatterns       #-}
module Ide.Plugin.Config
    ( getConfigFromNotification
    , Config(..)
    , parseConfig
    , PluginConfig(..)
    , CheckParents(..)
    ) where

import           Control.Lens     (preview)
import           Data.Aeson       hiding (Error)
import qualified Data.Aeson       as A
import           Data.Aeson.Lens  (_String)
import qualified Data.Aeson.Types as A
import           Data.Default
import qualified Data.Map.Strict  as Map
import           Data.Maybe       (fromMaybe)
import qualified Data.Text        as T
import           GHC.Exts         (toList)
import           Ide.Types

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

-- | Given a DidChangeConfigurationNotification message, this function returns the parsed
-- Config object if possible.
getConfigFromNotification :: IdePlugins s -> Config -> A.Value -> Either T.Text Config
getConfigFromNotification :: forall s. IdePlugins s -> Config -> Value -> Either Text Config
getConfigFromNotification IdePlugins s
plugins Config
defaultValue Value
p =
  case (Value -> Parser Config) -> Value -> Result Config
forall a b. (a -> Parser b) -> a -> Result b
A.parse (IdePlugins s -> Config -> Value -> Parser Config
forall s. IdePlugins s -> Config -> Value -> Parser Config
parseConfig IdePlugins s
plugins Config
defaultValue) Value
p of
    A.Success Config
c -> Config -> Either Text Config
forall a b. b -> Either a b
Right Config
c
    A.Error String
err -> Text -> Either Text Config
forall a b. a -> Either a b
Left (Text -> Either Text Config) -> Text -> Either Text Config
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
err

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

parseConfig :: IdePlugins s -> Config -> Value -> A.Parser Config
parseConfig :: forall s. IdePlugins s -> Config -> Value -> Parser Config
parseConfig IdePlugins s
idePlugins Config
defValue = String -> (Object -> Parser Config) -> Value -> Parser Config
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"settings" ((Object -> Parser Config) -> Value -> Parser Config)
-> (Object -> Parser Config) -> Value -> Parser Config
forall a b. (a -> b) -> a -> b
$ \Object
o ->
  CheckParents
-> Bool
-> Text
-> Text
-> Int
-> Map PluginId PluginConfig
-> Config
Config
    (CheckParents
 -> Bool
 -> Text
 -> Text
 -> Int
 -> Map PluginId PluginConfig
 -> Config)
-> Parser CheckParents
-> Parser
     (Bool
      -> Text -> Text -> Int -> Map PluginId PluginConfig -> Config)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe CheckParents)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"checkParents"                            Parser (Maybe CheckParents) -> CheckParents -> Parser CheckParents
forall a. Parser (Maybe a) -> a -> Parser a
.!= Config -> CheckParents
checkParents Config
defValue
    Parser
  (Bool
   -> Text -> Text -> Int -> Map PluginId PluginConfig -> Config)
-> Parser Bool
-> Parser
     (Text -> Text -> Int -> Map PluginId PluginConfig -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"checkProject"                            Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Config -> Bool
checkProject Config
defValue
    Parser (Text -> Text -> Int -> Map PluginId PluginConfig -> Config)
-> Parser Text
-> Parser (Text -> Int -> Map PluginId PluginConfig -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"formattingProvider"                      Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
.!= Config -> Text
formattingProvider Config
defValue
    Parser (Text -> Int -> Map PluginId PluginConfig -> Config)
-> Parser Text
-> Parser (Int -> Map PluginId PluginConfig -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"cabalFormattingProvider"                 Parser (Maybe Text) -> Text -> Parser Text
forall a. Parser (Maybe a) -> a -> Parser a
.!= Config -> Text
cabalFormattingProvider Config
defValue
    Parser (Int -> Map PluginId PluginConfig -> Config)
-> Parser Int -> Parser (Map PluginId PluginConfig -> Config)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"maxCompletions"                          Parser (Maybe Int) -> Int -> Parser Int
forall a. Parser (Maybe a) -> a -> Parser a
.!= Config -> Int
maxCompletions Config
defValue
    Parser (Map PluginId PluginConfig -> Config)
-> Parser (Map PluginId PluginConfig) -> Parser Config
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Parser (Map PluginId PluginConfig))
-> Object -> Key -> Parser (Maybe (Map PluginId PluginConfig))
forall a. (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
A.explicitParseFieldMaybe (IdePlugins s -> Value -> Parser (Map PluginId PluginConfig)
forall s.
IdePlugins s -> Value -> Parser (Map PluginId PluginConfig)
parsePlugins IdePlugins s
idePlugins) Object
o Key
"plugin" Parser (Maybe (Map PluginId PluginConfig))
-> Map PluginId PluginConfig -> Parser (Map PluginId PluginConfig)
forall a. Parser (Maybe a) -> a -> Parser a
.!= Config -> Map PluginId PluginConfig
plugins Config
defValue

-- | Parse the 'PluginConfig'.
--   Since we need to fall back to default values if we do not find one in the input,
--   we need the map of plugin-provided defaults, as in 'parseConfig'.
parsePlugins :: IdePlugins s -> Value -> A.Parser (Map.Map PluginId PluginConfig)
parsePlugins :: forall s.
IdePlugins s -> Value -> Parser (Map PluginId PluginConfig)
parsePlugins (IdePlugins [PluginDescriptor s]
plugins) = String
-> (Object -> Parser (Map PluginId PluginConfig))
-> Value
-> Parser (Map PluginId PluginConfig)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Config.plugins" ((Object -> Parser (Map PluginId PluginConfig))
 -> Value -> Parser (Map PluginId PluginConfig))
-> (Object -> Parser (Map PluginId PluginConfig))
-> Value
-> Parser (Map PluginId PluginConfig)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
  let -- parseOne :: Key -> Value -> A.Parser (T.Text, PluginConfig)
      parseOne :: Key -> Value -> Parser (PluginId, PluginConfig)
parseOne ((Text -> PluginId) -> Maybe Text -> Maybe PluginId
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> PluginId
PluginId (Maybe Text -> Maybe PluginId)
-> (Key -> Maybe Text) -> Key -> Maybe PluginId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text -> Value -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First Text) Value Text
forall t. AsValue t => Prism' t Text
Prism' Value Text
_String (Value -> Maybe Text) -> (Key -> Value) -> Key -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Value
forall a. ToJSON a => a -> Value
toJSON -> Just PluginId
pId) Value
pConfig = do
        let defPluginConfig :: PluginConfig
defPluginConfig = PluginConfig -> Maybe PluginConfig -> PluginConfig
forall a. a -> Maybe a -> a
fromMaybe PluginConfig
forall a. Default a => a
def (Maybe PluginConfig -> PluginConfig)
-> Maybe PluginConfig -> PluginConfig
forall a b. (a -> b) -> a -> b
$ PluginId -> [(PluginId, PluginConfig)] -> Maybe PluginConfig
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup PluginId
pId [(PluginId, PluginConfig)]
defValue
        PluginConfig
pConfig' <- PluginConfig -> Value -> Parser PluginConfig
parsePluginConfig PluginConfig
defPluginConfig Value
pConfig
        (PluginId, PluginConfig) -> Parser (PluginId, PluginConfig)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (PluginId
pId, PluginConfig
pConfig')
      parseOne Key
_ Value
_ = String -> Parser (PluginId, PluginConfig)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected plugin id to be a string"
      defValue :: [(PluginId, PluginConfig)]
defValue = (PluginDescriptor s -> (PluginId, PluginConfig))
-> [PluginDescriptor s] -> [(PluginId, PluginConfig)]
forall a b. (a -> b) -> [a] -> [b]
map (\PluginDescriptor s
p -> (PluginDescriptor s -> PluginId
forall ideState. PluginDescriptor ideState -> PluginId
pluginId PluginDescriptor s
p, ConfigDescriptor -> PluginConfig
configInitialGenericConfig (PluginDescriptor s -> ConfigDescriptor
forall ideState. PluginDescriptor ideState -> ConfigDescriptor
pluginConfigDescriptor PluginDescriptor s
p))) [PluginDescriptor s]
plugins
  [(PluginId, PluginConfig)]
plugins <- ((Key, Value) -> Parser (PluginId, PluginConfig))
-> [(Key, Value)] -> Parser [(PluginId, PluginConfig)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Key -> Value -> Parser (PluginId, PluginConfig))
-> (Key, Value) -> Parser (PluginId, PluginConfig)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Value -> Parser (PluginId, PluginConfig)
parseOne) (Object -> [Item Object]
forall l. IsList l => l -> [Item l]
toList Object
o)
  Map PluginId PluginConfig -> Parser (Map PluginId PluginConfig)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map PluginId PluginConfig -> Parser (Map PluginId PluginConfig))
-> Map PluginId PluginConfig -> Parser (Map PluginId PluginConfig)
forall a b. (a -> b) -> a -> b
$ [(PluginId, PluginConfig)] -> Map PluginId PluginConfig
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(PluginId, PluginConfig)]
plugins

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

parsePluginConfig :: PluginConfig -> Value -> A.Parser PluginConfig
parsePluginConfig :: PluginConfig -> Value -> Parser PluginConfig
parsePluginConfig PluginConfig
def = String
-> (Object -> Parser PluginConfig) -> Value -> Parser PluginConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"PluginConfig" ((Object -> Parser PluginConfig) -> Value -> Parser PluginConfig)
-> (Object -> Parser PluginConfig) -> Value -> Parser PluginConfig
forall a b. (a -> b) -> a -> b
$ \Object
o  -> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Object
-> PluginConfig
PluginConfig
      (Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Object
 -> PluginConfig)
-> Parser Bool
-> Parser
     (Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Object
      -> PluginConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"globalOn"         Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Bool
plcGlobalOn PluginConfig
def
      Parser
  (Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Object
   -> PluginConfig)
-> Parser Bool
-> Parser
     (Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Object
      -> PluginConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"callHierarchyOn"  Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Bool
plcCallHierarchyOn PluginConfig
def
      Parser
  (Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Object
   -> PluginConfig)
-> Parser Bool
-> Parser
     (Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Object
      -> PluginConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"semanticTokensOn" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Bool
plcSemanticTokensOn PluginConfig
def
      Parser
  (Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Object
   -> PluginConfig)
-> Parser Bool
-> Parser
     (Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Object
      -> PluginConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"codeActionsOn"    Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Bool
plcCodeActionsOn PluginConfig
def
      Parser
  (Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Object
   -> PluginConfig)
-> Parser Bool
-> Parser
     (Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Bool
      -> Object
      -> PluginConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"codeLensOn"       Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Bool
plcCodeLensOn    PluginConfig
def
      Parser
  (Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Bool
   -> Object
   -> PluginConfig)
-> Parser Bool
-> Parser
     (Bool
      -> Bool -> Bool -> Bool -> Bool -> Bool -> Object -> PluginConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"diagnosticsOn"    Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Bool
plcDiagnosticsOn PluginConfig
def -- AZ
      Parser
  (Bool
   -> Bool -> Bool -> Bool -> Bool -> Bool -> Object -> PluginConfig)
-> Parser Bool
-> Parser
     (Bool -> Bool -> Bool -> Bool -> Bool -> Object -> PluginConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"hoverOn"          Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Bool
plcHoverOn       PluginConfig
def
      Parser
  (Bool -> Bool -> Bool -> Bool -> Bool -> Object -> PluginConfig)
-> Parser Bool
-> Parser (Bool -> Bool -> Bool -> Bool -> Object -> PluginConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"symbolsOn"        Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Bool
plcSymbolsOn     PluginConfig
def
      Parser (Bool -> Bool -> Bool -> Bool -> Object -> PluginConfig)
-> Parser Bool
-> Parser (Bool -> Bool -> Bool -> Object -> PluginConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"completionOn"     Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Bool
plcCompletionOn  PluginConfig
def
      Parser (Bool -> Bool -> Bool -> Object -> PluginConfig)
-> Parser Bool -> Parser (Bool -> Bool -> Object -> PluginConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"renameOn"         Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Bool
plcRenameOn      PluginConfig
def
      Parser (Bool -> Bool -> Object -> PluginConfig)
-> Parser Bool -> Parser (Bool -> Object -> PluginConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"selectionRangeOn" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Bool
plcSelectionRangeOn PluginConfig
def
      Parser (Bool -> Object -> PluginConfig)
-> Parser Bool -> Parser (Object -> PluginConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"foldingRangeOn" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Bool
plcFoldingRangeOn PluginConfig
def
      Parser (Object -> PluginConfig)
-> Parser Object -> Parser PluginConfig
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Object)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"config"           Parser (Maybe Object) -> Object -> Parser Object
forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Object
plcConfig        PluginConfig
def

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