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

import           Control.Applicative
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
"Config" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    -- Officially, we use "haskell" as the section name but for
    -- backwards compatibility we also accept "languageServerHaskell"
    Maybe Value
c <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"haskell" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"languageServerHaskell"
    case Maybe Value
c of
      Maybe Value
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Config
defValue
      Just Value
s -> forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Config.settings") Value
s 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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
v 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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
v 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

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