{-# 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 forall a b. (a -> Parser b) -> a -> Result b
A.parse (forall s. IdePlugins s -> Config -> Value -> Parser Config
parseConfig IdePlugins s
plugins Config
defaultValue) Value
p of
    A.Success Config
c -> forall a b. b -> Either a b
Right Config
c
    A.Error String
err -> forall a b. a -> Either a b
Left 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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"settings" forall a b. (a -> b) -> a -> b
$ \Object
o ->
  CheckParents
-> Bool
-> Text
-> Text
-> Int
-> Map PluginId PluginConfig
-> Config
Config
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"checkParents"                            forall a. Parser (Maybe a) -> a -> Parser a
.!= Config -> CheckParents
checkParents Config
defValue
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"checkProject"                            forall a. Parser (Maybe a) -> a -> Parser a
.!= Config -> Bool
checkProject Config
defValue
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"formattingProvider"                      forall a. Parser (Maybe a) -> a -> Parser a
.!= Config -> Text
formattingProvider Config
defValue
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"cabalFormattingProvider"                 forall a. Parser (Maybe a) -> a -> Parser a
.!= Config -> Text
cabalFormattingProvider Config
defValue
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"maxCompletions"                          forall a. Parser (Maybe a) -> a -> Parser a
.!= Config -> Int
maxCompletions Config
defValue
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. (Value -> Parser a) -> Object -> Key -> Parser (Maybe a)
A.explicitParseFieldMaybe (forall s.
IdePlugins s -> Value -> Parser (Map PluginId PluginConfig)
parsePlugins IdePlugins s
idePlugins) Object
o Key
"plugin" 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) = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Config.plugins" 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 (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> PluginId
PluginId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview forall t. AsValue t => Prism' t Text
_String forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON -> Just PluginId
pId) Value
pConfig = do
        let defPluginConfig :: PluginConfig
defPluginConfig = forall a. a -> Maybe a -> a
fromMaybe forall a. Default a => a
def forall a b. (a -> b) -> a -> b
$ 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
        forall (m :: * -> *) a. Monad m => a -> m a
return (PluginId
pId, PluginConfig
pConfig')
      parseOne Key
_ Value
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected plugin id to be a string"
      defValue :: [(PluginId, PluginConfig)]
defValue = forall a b. (a -> b) -> [a] -> [b]
map (\PluginDescriptor s
p -> (forall ideState. PluginDescriptor ideState -> PluginId
pluginId PluginDescriptor s
p, ConfigDescriptor -> PluginConfig
configInitialGenericConfig (forall ideState. PluginDescriptor ideState -> ConfigDescriptor
pluginConfigDescriptor PluginDescriptor s
p))) [PluginDescriptor s]
plugins
  [(PluginId, PluginConfig)]
plugins <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Value -> Parser (PluginId, PluginConfig)
parseOne) (forall l. IsList l => l -> [Item l]
toList Object
o)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 = forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"PluginConfig" forall a b. (a -> b) -> a -> b
$ \Object
o  -> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Object
-> PluginConfig
PluginConfig
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"globalOn"         forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Bool
plcGlobalOn PluginConfig
def
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"callHierarchyOn"  forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Bool
plcCallHierarchyOn PluginConfig
def
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"codeActionsOn"    forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Bool
plcCodeActionsOn PluginConfig
def
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"codeLensOn"       forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Bool
plcCodeLensOn    PluginConfig
def
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"diagnosticsOn"    forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Bool
plcDiagnosticsOn PluginConfig
def -- AZ
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"hoverOn"          forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Bool
plcHoverOn       PluginConfig
def
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"symbolsOn"        forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Bool
plcSymbolsOn     PluginConfig
def
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"completionOn"     forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Bool
plcCompletionOn  PluginConfig
def
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"renameOn"         forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Bool
plcRenameOn      PluginConfig
def
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"selectionRangeOn" forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Bool
plcSelectionRangeOn PluginConfig
def
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"foldingRangeOn" forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Bool
plcFoldingRangeOn PluginConfig
def
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"config"           forall a. Parser (Maybe a) -> a -> Parser a
.!= PluginConfig -> Object
plcConfig        PluginConfig
def

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