{-# LANGUAGE DerivingStrategies #-}
{-# 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
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
-> SessionLoadingPreferenceConfig
-> Map PluginId PluginConfig
-> Config
Config
(CheckParents
-> Bool
-> Text
-> Text
-> Int
-> SessionLoadingPreferenceConfig
-> Map PluginId PluginConfig
-> Config)
-> Parser CheckParents
-> Parser
(Bool
-> Text
-> Text
-> Int
-> SessionLoadingPreferenceConfig
-> 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
-> SessionLoadingPreferenceConfig
-> Map PluginId PluginConfig
-> Config)
-> Parser Bool
-> Parser
(Text
-> Text
-> Int
-> SessionLoadingPreferenceConfig
-> 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
-> SessionLoadingPreferenceConfig
-> Map PluginId PluginConfig
-> Config)
-> Parser Text
-> Parser
(Text
-> Int
-> SessionLoadingPreferenceConfig
-> 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
-> SessionLoadingPreferenceConfig
-> Map PluginId PluginConfig
-> Config)
-> Parser Text
-> Parser
(Int
-> SessionLoadingPreferenceConfig
-> 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
-> SessionLoadingPreferenceConfig
-> Map PluginId PluginConfig
-> Config)
-> Parser Int
-> Parser
(SessionLoadingPreferenceConfig
-> 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
(SessionLoadingPreferenceConfig
-> Map PluginId PluginConfig -> Config)
-> Parser SessionLoadingPreferenceConfig
-> 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 SessionLoadingPreferenceConfig)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sessionLoading" Parser (Maybe SessionLoadingPreferenceConfig)
-> SessionLoadingPreferenceConfig
-> Parser SessionLoadingPreferenceConfig
forall a. Parser (Maybe a) -> a -> Parser a
.!= Config -> SessionLoadingPreferenceConfig
sessionLoading 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
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 -> 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
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