{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedLabels  #-}
{-# LANGUAGE OverloadedStrings #-}
module Ide.Plugin.Eval.Config
  ( properties
  , getEvalConfig
  , EvalConfig(..)
  ) where

import           Ide.Plugin.Config     (Config)
import           Ide.Plugin.Properties
import           Ide.PluginUtils       (usePropertyLsp)
import           Ide.Types             (PluginId)
import           Language.LSP.Server   (MonadLsp)

-- | The Eval plugin configuration. (see 'properties')
data EvalConfig = EvalConfig
  { EvalConfig -> Bool
eval_cfg_diff      :: Bool
  , EvalConfig -> Bool
eval_cfg_exception :: Bool
  }
  deriving (EvalConfig -> EvalConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvalConfig -> EvalConfig -> Bool
$c/= :: EvalConfig -> EvalConfig -> Bool
== :: EvalConfig -> EvalConfig -> Bool
$c== :: EvalConfig -> EvalConfig -> Bool
Eq, Eq EvalConfig
EvalConfig -> EvalConfig -> Bool
EvalConfig -> EvalConfig -> Ordering
EvalConfig -> EvalConfig -> EvalConfig
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EvalConfig -> EvalConfig -> EvalConfig
$cmin :: EvalConfig -> EvalConfig -> EvalConfig
max :: EvalConfig -> EvalConfig -> EvalConfig
$cmax :: EvalConfig -> EvalConfig -> EvalConfig
>= :: EvalConfig -> EvalConfig -> Bool
$c>= :: EvalConfig -> EvalConfig -> Bool
> :: EvalConfig -> EvalConfig -> Bool
$c> :: EvalConfig -> EvalConfig -> Bool
<= :: EvalConfig -> EvalConfig -> Bool
$c<= :: EvalConfig -> EvalConfig -> Bool
< :: EvalConfig -> EvalConfig -> Bool
$c< :: EvalConfig -> EvalConfig -> Bool
compare :: EvalConfig -> EvalConfig -> Ordering
$ccompare :: EvalConfig -> EvalConfig -> Ordering
Ord, Int -> EvalConfig -> ShowS
[EvalConfig] -> ShowS
EvalConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvalConfig] -> ShowS
$cshowList :: [EvalConfig] -> ShowS
show :: EvalConfig -> String
$cshow :: EvalConfig -> String
showsPrec :: Int -> EvalConfig -> ShowS
$cshowsPrec :: Int -> EvalConfig -> ShowS
Show)

properties :: Properties
    '[ 'PropertyKey "exception" 'TBoolean
     , 'PropertyKey "diff" 'TBoolean
     ]
properties :: Properties
  '[ 'PropertyKey "exception" 'TBoolean,
     'PropertyKey "diff" 'TBoolean]
properties = Properties '[]
emptyProperties
  forall a b. a -> (a -> b) -> b
& forall (s :: Symbol) (r :: [PropertyKey]).
(KnownSymbol s, NotElem s r) =>
KeyNameProxy s
-> Text
-> Bool
-> Properties r
-> Properties ('PropertyKey s 'TBoolean : r)
defineBooleanProperty forall a. IsLabel "diff" a => a
#diff
    Text
"Enable the diff output (WAS/NOW) of eval lenses" Bool
True
  forall a b. a -> (a -> b) -> b
& forall (s :: Symbol) (r :: [PropertyKey]).
(KnownSymbol s, NotElem s r) =>
KeyNameProxy s
-> Text
-> Bool
-> Properties r
-> Properties ('PropertyKey s 'TBoolean : r)
defineBooleanProperty forall a. IsLabel "exception" a => a
#exception
    Text
"Enable marking exceptions with `*** Exception:` similarly to doctest and GHCi." Bool
False

getEvalConfig :: (MonadLsp Config m) => PluginId -> m EvalConfig
getEvalConfig :: forall (m :: * -> *). MonadLsp Config m => PluginId -> m EvalConfig
getEvalConfig PluginId
plId =
    Bool -> Bool -> EvalConfig
EvalConfig
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]) (m :: * -> *).
(HasProperty s k t r, MonadLsp Config m) =>
KeyNameProxy s -> PluginId -> Properties r -> m (ToHsType t)
usePropertyLsp forall a. IsLabel "diff" a => a
#diff PluginId
plId Properties
  '[ 'PropertyKey "exception" 'TBoolean,
     'PropertyKey "diff" 'TBoolean]
properties
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]) (m :: * -> *).
(HasProperty s k t r, MonadLsp Config m) =>
KeyNameProxy s -> PluginId -> Properties r -> m (ToHsType t)
usePropertyLsp forall a. IsLabel "exception" a => a
#exception PluginId
plId Properties
  '[ 'PropertyKey "exception" 'TBoolean,
     'PropertyKey "diff" 'TBoolean]
properties