{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# OPTIONS_GHC -Wwarn #-}
{-# LANGUAGE LambdaCase            #-}

{- |
Eval Plugin entry point.
-}
module Ide.Plugin.Eval (
    descriptor,
    Log(..)
    ) where

import           Development.IDE              (IdeState)
import           Development.IDE.Types.Logger (Pretty (pretty), Recorder,
                                               WithPriority, cmapWithPrio)
import qualified Ide.Plugin.Eval.CodeLens     as CL
import           Ide.Plugin.Eval.Config
import           Ide.Plugin.Eval.Rules        (rules)
import qualified Ide.Plugin.Eval.Rules        as EvalRules
import           Ide.Types                    (ConfigDescriptor (..),
                                               PluginDescriptor (..), PluginId,
                                               defaultConfigDescriptor,
                                               defaultPluginDescriptor,
                                               mkCustomConfig, mkPluginHandler)
import           Language.LSP.Types

newtype Log = LogEvalRules EvalRules.Log deriving Int -> Log -> ShowS
[Log] -> ShowS
Log -> String
(Int -> Log -> ShowS)
-> (Log -> String) -> ([Log] -> ShowS) -> Show Log
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Log] -> ShowS
$cshowList :: [Log] -> ShowS
show :: Log -> String
$cshow :: Log -> String
showsPrec :: Int -> Log -> ShowS
$cshowsPrec :: Int -> Log -> ShowS
Show

instance Pretty Log where
  pretty :: Log -> Doc ann
pretty = \case
    LogEvalRules Log
log -> Log -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Log
log

-- |Plugin descriptor
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
descriptor :: Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
descriptor Recorder (WithPriority Log)
recorder PluginId
plId =
    (PluginId -> PluginDescriptor IdeState
forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
        { pluginHandlers :: PluginHandlers IdeState
pluginHandlers = SClientMethod 'TextDocumentCodeLens
-> PluginMethodHandler IdeState 'TextDocumentCodeLens
-> PluginHandlers IdeState
forall (m :: Method 'FromClient 'Request) ideState.
PluginMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SClientMethod 'TextDocumentCodeLens
STextDocumentCodeLens PluginMethodHandler IdeState 'TextDocumentCodeLens
CL.codeLens
        , pluginCommands :: [PluginCommand IdeState]
pluginCommands = [PluginId -> PluginCommand IdeState
CL.evalCommand PluginId
plId]
        , pluginRules :: Rules ()
pluginRules = Recorder (WithPriority Log) -> Rules ()
rules ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogEvalRules Recorder (WithPriority Log)
recorder)
        , pluginConfigDescriptor :: ConfigDescriptor
pluginConfigDescriptor = ConfigDescriptor
defaultConfigDescriptor
                                   { configCustomConfig :: CustomConfig
configCustomConfig = Properties
  '[ 'PropertyKey "exception" 'TBoolean,
     'PropertyKey "diff" 'TBoolean]
-> CustomConfig
forall (r :: [PropertyKey]). Properties r -> CustomConfig
mkCustomConfig Properties
  '[ 'PropertyKey "exception" 'TBoolean,
     'PropertyKey "diff" 'TBoolean]
properties
                                   }
        }