{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Ide.Types
    (
      IdePlugins(..)
    , PluginDescriptor(..)
    , defaultPluginDescriptor
    , PluginCommand(..)
    , PluginId(..)
    , CommandId(..)
    , DiagnosticProvider(..)
    , DiagnosticProviderFunc(..)
    , SymbolsProvider
    , FormattingType(..)
    , FormattingProvider
    , noneProvider
    , HoverProvider
    , CodeActionProvider
    , CodeLensProvider
    , CommandFunction
    , ExecuteCommandProvider
    , CompletionProvider
    , RenameProvider
    , WithSnippets(..)
    ) where

import           Data.Aeson                    hiding (defaultOptions)
import qualified Data.Map  as Map
import qualified Data.Set                      as S
import           Data.String
import qualified Data.Text                     as T
import           Development.Shake
import           Ide.Plugin.Config
import qualified Language.Haskell.LSP.Core as LSP
import           Language.Haskell.LSP.Types
import           Text.Regex.TDFA.Text()

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


newtype IdePlugins ideState = IdePlugins
  { IdePlugins ideState -> Map PluginId (PluginDescriptor ideState)
ipMap :: Map.Map PluginId (PluginDescriptor ideState)}

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


data PluginDescriptor ideState =
  PluginDescriptor { PluginDescriptor ideState -> PluginId
pluginId                 :: !PluginId
                   , PluginDescriptor ideState -> Rules ()
pluginRules              :: !(Rules ())
                   , PluginDescriptor ideState -> [PluginCommand ideState]
pluginCommands           :: ![PluginCommand ideState]
                   , PluginDescriptor ideState -> Maybe (CodeActionProvider ideState)
pluginCodeActionProvider :: !(Maybe (CodeActionProvider ideState))
                   , PluginDescriptor ideState -> Maybe (CodeLensProvider ideState)
pluginCodeLensProvider   :: !(Maybe (CodeLensProvider ideState))
                   , PluginDescriptor ideState -> Maybe DiagnosticProvider
pluginDiagnosticProvider :: !(Maybe DiagnosticProvider)
                     -- ^ TODO: diagnostics are generally provided via rules,

                     -- this is probably redundant.

                   , PluginDescriptor ideState -> Maybe (HoverProvider ideState)
pluginHoverProvider      :: !(Maybe (HoverProvider ideState))
                   , PluginDescriptor ideState -> Maybe (SymbolsProvider ideState)
pluginSymbolsProvider    :: !(Maybe (SymbolsProvider ideState))
                   , PluginDescriptor ideState -> Maybe (FormattingProvider ideState IO)
pluginFormattingProvider :: !(Maybe (FormattingProvider ideState IO))
                   , PluginDescriptor ideState -> Maybe (CompletionProvider ideState)
pluginCompletionProvider :: !(Maybe (CompletionProvider ideState))
                   , PluginDescriptor ideState -> Maybe (RenameProvider ideState)
pluginRenameProvider     :: !(Maybe (RenameProvider ideState))
                   }

defaultPluginDescriptor :: PluginId -> PluginDescriptor ideState
defaultPluginDescriptor :: PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId =
  PluginId
-> Rules ()
-> [PluginCommand ideState]
-> Maybe (CodeActionProvider ideState)
-> Maybe (CodeLensProvider ideState)
-> Maybe DiagnosticProvider
-> Maybe (HoverProvider ideState)
-> Maybe (SymbolsProvider ideState)
-> Maybe (FormattingProvider ideState IO)
-> Maybe (CompletionProvider ideState)
-> Maybe (RenameProvider ideState)
-> PluginDescriptor ideState
forall ideState.
PluginId
-> Rules ()
-> [PluginCommand ideState]
-> Maybe (CodeActionProvider ideState)
-> Maybe (CodeLensProvider ideState)
-> Maybe DiagnosticProvider
-> Maybe (HoverProvider ideState)
-> Maybe (SymbolsProvider ideState)
-> Maybe (FormattingProvider ideState IO)
-> Maybe (CompletionProvider ideState)
-> Maybe (RenameProvider ideState)
-> PluginDescriptor ideState
PluginDescriptor
    PluginId
plId
    Rules ()
forall a. Monoid a => a
mempty
    [PluginCommand ideState]
forall a. Monoid a => a
mempty
    Maybe (CodeActionProvider ideState)
forall a. Maybe a
Nothing
    Maybe (CodeLensProvider ideState)
forall a. Maybe a
Nothing
    Maybe DiagnosticProvider
forall a. Maybe a
Nothing
    Maybe (HoverProvider ideState)
forall a. Maybe a
Nothing
    Maybe (SymbolsProvider ideState)
forall a. Maybe a
Nothing
    Maybe (FormattingProvider ideState IO)
forall a. Maybe a
Nothing
    Maybe (CompletionProvider ideState)
forall a. Maybe a
Nothing
    Maybe (RenameProvider ideState)
forall a. Maybe a
Nothing

-- instance Show PluginCommand where

--   show (PluginCommand i _ _) = "PluginCommand { name = " ++ show i ++ " }"


-- newtype CommandId = CommandId T.Text

--   deriving (Show, Read, Eq, Ord)

-- instance IsString CommandId where

--   fromString = CommandId . T.pack


-- data PluginCommand = forall a b. (FromJSON a, ToJSON b, Typeable b) =>

--   PluginCommand { commandId   :: CommandId

--                 , commandDesc :: T.Text

--                 , commandFunc :: a -> IO (Either ResponseError b)

--                 }


newtype CommandId = CommandId T.Text
  deriving (Int -> CommandId -> ShowS
[CommandId] -> ShowS
CommandId -> String
(Int -> CommandId -> ShowS)
-> (CommandId -> String)
-> ([CommandId] -> ShowS)
-> Show CommandId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommandId] -> ShowS
$cshowList :: [CommandId] -> ShowS
show :: CommandId -> String
$cshow :: CommandId -> String
showsPrec :: Int -> CommandId -> ShowS
$cshowsPrec :: Int -> CommandId -> ShowS
Show, ReadPrec [CommandId]
ReadPrec CommandId
Int -> ReadS CommandId
ReadS [CommandId]
(Int -> ReadS CommandId)
-> ReadS [CommandId]
-> ReadPrec CommandId
-> ReadPrec [CommandId]
-> Read CommandId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CommandId]
$creadListPrec :: ReadPrec [CommandId]
readPrec :: ReadPrec CommandId
$creadPrec :: ReadPrec CommandId
readList :: ReadS [CommandId]
$creadList :: ReadS [CommandId]
readsPrec :: Int -> ReadS CommandId
$creadsPrec :: Int -> ReadS CommandId
Read, CommandId -> CommandId -> Bool
(CommandId -> CommandId -> Bool)
-> (CommandId -> CommandId -> Bool) -> Eq CommandId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommandId -> CommandId -> Bool
$c/= :: CommandId -> CommandId -> Bool
== :: CommandId -> CommandId -> Bool
$c== :: CommandId -> CommandId -> Bool
Eq, Eq CommandId
Eq CommandId
-> (CommandId -> CommandId -> Ordering)
-> (CommandId -> CommandId -> Bool)
-> (CommandId -> CommandId -> Bool)
-> (CommandId -> CommandId -> Bool)
-> (CommandId -> CommandId -> Bool)
-> (CommandId -> CommandId -> CommandId)
-> (CommandId -> CommandId -> CommandId)
-> Ord CommandId
CommandId -> CommandId -> Bool
CommandId -> CommandId -> Ordering
CommandId -> CommandId -> CommandId
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 :: CommandId -> CommandId -> CommandId
$cmin :: CommandId -> CommandId -> CommandId
max :: CommandId -> CommandId -> CommandId
$cmax :: CommandId -> CommandId -> CommandId
>= :: CommandId -> CommandId -> Bool
$c>= :: CommandId -> CommandId -> Bool
> :: CommandId -> CommandId -> Bool
$c> :: CommandId -> CommandId -> Bool
<= :: CommandId -> CommandId -> Bool
$c<= :: CommandId -> CommandId -> Bool
< :: CommandId -> CommandId -> Bool
$c< :: CommandId -> CommandId -> Bool
compare :: CommandId -> CommandId -> Ordering
$ccompare :: CommandId -> CommandId -> Ordering
$cp1Ord :: Eq CommandId
Ord)
instance IsString CommandId where
  fromString :: String -> CommandId
fromString = Text -> CommandId
CommandId (Text -> CommandId) -> (String -> Text) -> String -> CommandId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

data PluginCommand ideState = forall a. (FromJSON a) =>
  PluginCommand { PluginCommand ideState -> CommandId
commandId   :: CommandId
                , PluginCommand ideState -> Text
commandDesc :: T.Text
                , ()
commandFunc :: CommandFunction ideState a
                }


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


type CommandFunction ideState a = LSP.LspFuncs Config
                       -> ideState
                       -> a
                       -> IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))

type CodeActionProvider ideState = LSP.LspFuncs Config
                        -> ideState
                        -> PluginId
                        -> TextDocumentIdentifier
                        -> Range
                        -> CodeActionContext
                        -> IO (Either ResponseError (List CAResult))

type CompletionProvider ideState = LSP.LspFuncs Config
                        -> ideState
                        -> CompletionParams
                        -> IO (Either ResponseError CompletionResponseResult)



type CodeLensProvider ideState = LSP.LspFuncs Config
                      -> ideState
                      -> PluginId
                      -> CodeLensParams
                      -> IO (Either ResponseError (List CodeLens))

type RenameProvider ideState = LSP.LspFuncs Config
                    -> ideState
                    -> RenameParams
                    -> IO (Either ResponseError WorkspaceEdit)

type DiagnosticProviderFuncSync
  = DiagnosticTrigger -> Uri
  -> IO (Either ResponseError (Map.Map Uri (S.Set Diagnostic)))

type DiagnosticProviderFuncAsync
  = DiagnosticTrigger -> Uri
  -> (Map.Map Uri (S.Set Diagnostic) -> IO ())
  -> IO (Either ResponseError ())

data DiagnosticProviderFunc
  = DiagnosticProviderSync  DiagnosticProviderFuncSync
  | DiagnosticProviderAsync DiagnosticProviderFuncAsync


data DiagnosticProvider = DiagnosticProvider
     { DiagnosticProvider -> Set DiagnosticTrigger
dpTrigger :: S.Set DiagnosticTrigger -- AZ:should this be a NonEmptyList?

     , DiagnosticProvider -> DiagnosticProviderFunc
dpFunc    :: DiagnosticProviderFunc
     }

data DiagnosticTrigger = DiagnosticOnOpen
                       | DiagnosticOnChange
                       | DiagnosticOnSave
                       deriving (Int -> DiagnosticTrigger -> ShowS
[DiagnosticTrigger] -> ShowS
DiagnosticTrigger -> String
(Int -> DiagnosticTrigger -> ShowS)
-> (DiagnosticTrigger -> String)
-> ([DiagnosticTrigger] -> ShowS)
-> Show DiagnosticTrigger
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DiagnosticTrigger] -> ShowS
$cshowList :: [DiagnosticTrigger] -> ShowS
show :: DiagnosticTrigger -> String
$cshow :: DiagnosticTrigger -> String
showsPrec :: Int -> DiagnosticTrigger -> ShowS
$cshowsPrec :: Int -> DiagnosticTrigger -> ShowS
Show,Eq DiagnosticTrigger
Eq DiagnosticTrigger
-> (DiagnosticTrigger -> DiagnosticTrigger -> Ordering)
-> (DiagnosticTrigger -> DiagnosticTrigger -> Bool)
-> (DiagnosticTrigger -> DiagnosticTrigger -> Bool)
-> (DiagnosticTrigger -> DiagnosticTrigger -> Bool)
-> (DiagnosticTrigger -> DiagnosticTrigger -> Bool)
-> (DiagnosticTrigger -> DiagnosticTrigger -> DiagnosticTrigger)
-> (DiagnosticTrigger -> DiagnosticTrigger -> DiagnosticTrigger)
-> Ord DiagnosticTrigger
DiagnosticTrigger -> DiagnosticTrigger -> Bool
DiagnosticTrigger -> DiagnosticTrigger -> Ordering
DiagnosticTrigger -> DiagnosticTrigger -> DiagnosticTrigger
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 :: DiagnosticTrigger -> DiagnosticTrigger -> DiagnosticTrigger
$cmin :: DiagnosticTrigger -> DiagnosticTrigger -> DiagnosticTrigger
max :: DiagnosticTrigger -> DiagnosticTrigger -> DiagnosticTrigger
$cmax :: DiagnosticTrigger -> DiagnosticTrigger -> DiagnosticTrigger
>= :: DiagnosticTrigger -> DiagnosticTrigger -> Bool
$c>= :: DiagnosticTrigger -> DiagnosticTrigger -> Bool
> :: DiagnosticTrigger -> DiagnosticTrigger -> Bool
$c> :: DiagnosticTrigger -> DiagnosticTrigger -> Bool
<= :: DiagnosticTrigger -> DiagnosticTrigger -> Bool
$c<= :: DiagnosticTrigger -> DiagnosticTrigger -> Bool
< :: DiagnosticTrigger -> DiagnosticTrigger -> Bool
$c< :: DiagnosticTrigger -> DiagnosticTrigger -> Bool
compare :: DiagnosticTrigger -> DiagnosticTrigger -> Ordering
$ccompare :: DiagnosticTrigger -> DiagnosticTrigger -> Ordering
$cp1Ord :: Eq DiagnosticTrigger
Ord,DiagnosticTrigger -> DiagnosticTrigger -> Bool
(DiagnosticTrigger -> DiagnosticTrigger -> Bool)
-> (DiagnosticTrigger -> DiagnosticTrigger -> Bool)
-> Eq DiagnosticTrigger
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiagnosticTrigger -> DiagnosticTrigger -> Bool
$c/= :: DiagnosticTrigger -> DiagnosticTrigger -> Bool
== :: DiagnosticTrigger -> DiagnosticTrigger -> Bool
$c== :: DiagnosticTrigger -> DiagnosticTrigger -> Bool
Eq)

-- type HoverProvider = Uri -> Position -> IO (Either ResponseError [Hover])

type HoverProvider ideState = ideState -> TextDocumentPositionParams -> IO (Either ResponseError (Maybe Hover))

type SymbolsProvider ideState = LSP.LspFuncs Config
                     -> ideState
                     -> DocumentSymbolParams
                     -> IO (Either ResponseError [DocumentSymbol])

type ExecuteCommandProvider ideState = ideState
                            -> ExecuteCommandParams
                            -> IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))

newtype WithSnippets = WithSnippets Bool

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


newtype PluginId = PluginId T.Text
  deriving (Int -> PluginId -> ShowS
[PluginId] -> ShowS
PluginId -> String
(Int -> PluginId -> ShowS)
-> (PluginId -> String) -> ([PluginId] -> ShowS) -> Show PluginId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PluginId] -> ShowS
$cshowList :: [PluginId] -> ShowS
show :: PluginId -> String
$cshow :: PluginId -> String
showsPrec :: Int -> PluginId -> ShowS
$cshowsPrec :: Int -> PluginId -> ShowS
Show, ReadPrec [PluginId]
ReadPrec PluginId
Int -> ReadS PluginId
ReadS [PluginId]
(Int -> ReadS PluginId)
-> ReadS [PluginId]
-> ReadPrec PluginId
-> ReadPrec [PluginId]
-> Read PluginId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PluginId]
$creadListPrec :: ReadPrec [PluginId]
readPrec :: ReadPrec PluginId
$creadPrec :: ReadPrec PluginId
readList :: ReadS [PluginId]
$creadList :: ReadS [PluginId]
readsPrec :: Int -> ReadS PluginId
$creadsPrec :: Int -> ReadS PluginId
Read, PluginId -> PluginId -> Bool
(PluginId -> PluginId -> Bool)
-> (PluginId -> PluginId -> Bool) -> Eq PluginId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PluginId -> PluginId -> Bool
$c/= :: PluginId -> PluginId -> Bool
== :: PluginId -> PluginId -> Bool
$c== :: PluginId -> PluginId -> Bool
Eq, Eq PluginId
Eq PluginId
-> (PluginId -> PluginId -> Ordering)
-> (PluginId -> PluginId -> Bool)
-> (PluginId -> PluginId -> Bool)
-> (PluginId -> PluginId -> Bool)
-> (PluginId -> PluginId -> Bool)
-> (PluginId -> PluginId -> PluginId)
-> (PluginId -> PluginId -> PluginId)
-> Ord PluginId
PluginId -> PluginId -> Bool
PluginId -> PluginId -> Ordering
PluginId -> PluginId -> PluginId
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 :: PluginId -> PluginId -> PluginId
$cmin :: PluginId -> PluginId -> PluginId
max :: PluginId -> PluginId -> PluginId
$cmax :: PluginId -> PluginId -> PluginId
>= :: PluginId -> PluginId -> Bool
$c>= :: PluginId -> PluginId -> Bool
> :: PluginId -> PluginId -> Bool
$c> :: PluginId -> PluginId -> Bool
<= :: PluginId -> PluginId -> Bool
$c<= :: PluginId -> PluginId -> Bool
< :: PluginId -> PluginId -> Bool
$c< :: PluginId -> PluginId -> Bool
compare :: PluginId -> PluginId -> Ordering
$ccompare :: PluginId -> PluginId -> Ordering
$cp1Ord :: Eq PluginId
Ord)
instance IsString PluginId where
  fromString :: String -> PluginId
fromString = Text -> PluginId
PluginId (Text -> PluginId) -> (String -> Text) -> String -> PluginId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

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



-- | Format the given Text as a whole or only a @Range@ of it.

-- Range must be relative to the text to format.

-- To format the whole document, read the Text from the file and use 'FormatText'

-- as the FormattingType.

data FormattingType = FormatText
                    | FormatRange Range


-- | To format a whole document, the 'FormatText' @FormattingType@ can be used.

-- It is required to pass in the whole Document Text for that to happen, an empty text

-- and file uri, does not suffice.

type FormattingProvider ideState m
        = LSP.LspFuncs Config
        -> ideState
        -> FormattingType  -- ^ How much to format

        -> T.Text -- ^ Text to format

        -> NormalizedFilePath -- ^ location of the file being formatted

        -> FormattingOptions -- ^ Options for the formatter

        -> m (Either ResponseError (List TextEdit)) -- ^ Result of the formatting


noneProvider :: FormattingProvider ideState IO
noneProvider :: FormattingProvider ideState IO
noneProvider LspFuncs Config
_ ideState
_ FormattingType
_ Text
_ NormalizedFilePath
_ FormattingOptions
_ = Either ResponseError (List TextEdit)
-> IO (Either ResponseError (List TextEdit))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError (List TextEdit)
 -> IO (Either ResponseError (List TextEdit)))
-> Either ResponseError (List TextEdit)
-> IO (Either ResponseError (List TextEdit))
forall a b. (a -> b) -> a -> b
$ List TextEdit -> Either ResponseError (List TextEdit)
forall a b. b -> Either a b
Right ([TextEdit] -> List TextEdit
forall a. [a] -> List a
List [])