{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE TemplateHaskell       #-}
module Language.Haskell.LSP.Types.WorkspaceFolders where

import           Data.Aeson.TH
import           Data.Text                      ( Text )
import           Language.Haskell.LSP.Types.Constants
import           Language.Haskell.LSP.Types.List
import           Language.Haskell.LSP.Types.Message

{-
Workspace folders request (:arrow_right_hook:)
Since version 3.6.0

Many tools support more than one root folder per workspace. Examples for this
are VS Code’s multi-root support, Atom’s project folder support or Sublime’s
project support. If a client workspace consists of multiple roots then a server
typically needs to know about this. The protocol up to now assumes one root
folder which is announce to the server by the rootUri property of the
InitializeParams. If the client supports workspace folders and announces them
via the corrsponding workspaceFolders client capability the InitializeParams
contain an additional property workspaceFolders with the configured workspace
folders when the server starts.

The workspace/workspaceFolders request is sent from the server to the client to
fetch the current open list of workspace folders. Returns null in the response
if only a single file is open in the tool. Returns an empty array if a workspace
is open but no folders are configured.

Request:

method: ‘workspace/workspaceFolders’
params: none
Response:

result: WorkspaceFolder[] | null defines as follows:
export interface WorkspaceFolder {
	/**
	 * The associated URI for this workspace folder.
	 */
	uri: string;

	/**
	 * The name of the workspace folder. Defaults to the
	 * uri's basename.
	 */
	name: string;
}
error: code and message set in case an exception happens during the ‘workspace/workspaceFolders’ request
-}

data WorkspaceFolder =
  WorkspaceFolder
    { -- | The name of the workspace folder. Defaults to the uri's basename.
      WorkspaceFolder -> Text
_uri  :: Text
    -- | The name of the workspace folder. Defaults to the uri's basename.
    , WorkspaceFolder -> Text
_name :: Text
    } deriving (ReadPrec [WorkspaceFolder]
ReadPrec WorkspaceFolder
Int -> ReadS WorkspaceFolder
ReadS [WorkspaceFolder]
(Int -> ReadS WorkspaceFolder)
-> ReadS [WorkspaceFolder]
-> ReadPrec WorkspaceFolder
-> ReadPrec [WorkspaceFolder]
-> Read WorkspaceFolder
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WorkspaceFolder]
$creadListPrec :: ReadPrec [WorkspaceFolder]
readPrec :: ReadPrec WorkspaceFolder
$creadPrec :: ReadPrec WorkspaceFolder
readList :: ReadS [WorkspaceFolder]
$creadList :: ReadS [WorkspaceFolder]
readsPrec :: Int -> ReadS WorkspaceFolder
$creadsPrec :: Int -> ReadS WorkspaceFolder
Read, Int -> WorkspaceFolder -> ShowS
[WorkspaceFolder] -> ShowS
WorkspaceFolder -> String
(Int -> WorkspaceFolder -> ShowS)
-> (WorkspaceFolder -> String)
-> ([WorkspaceFolder] -> ShowS)
-> Show WorkspaceFolder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WorkspaceFolder] -> ShowS
$cshowList :: [WorkspaceFolder] -> ShowS
show :: WorkspaceFolder -> String
$cshow :: WorkspaceFolder -> String
showsPrec :: Int -> WorkspaceFolder -> ShowS
$cshowsPrec :: Int -> WorkspaceFolder -> ShowS
Show, WorkspaceFolder -> WorkspaceFolder -> Bool
(WorkspaceFolder -> WorkspaceFolder -> Bool)
-> (WorkspaceFolder -> WorkspaceFolder -> Bool)
-> Eq WorkspaceFolder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WorkspaceFolder -> WorkspaceFolder -> Bool
$c/= :: WorkspaceFolder -> WorkspaceFolder -> Bool
== :: WorkspaceFolder -> WorkspaceFolder -> Bool
$c== :: WorkspaceFolder -> WorkspaceFolder -> Bool
Eq)

deriveJSON lspOptions ''WorkspaceFolder

type WorkspaceFoldersRequest = RequestMessage ServerMethod () (Maybe (List WorkspaceFolder))
type WorkspaceFoldersResponse = ResponseMessage (Maybe (List WorkspaceFolder))

{-
DidChangeWorkspaceFolders Notification (:arrow_right:)
Since version 3.6.0

The workspace/didChangeWorkspaceFolders notification is sent from the client to
the server to inform the server about workspace folder configuration changes.
The notification is sent by default if both
ServerCapabilities/workspace/workspaceFolders and
ClientCapabilities/workspace/workspaceFolders are true; or if the server has
registered to receive this notification it first. To register for the
workspace/didChangeWorkspaceFolders send a client/registerCapability request
from the client to the server. The registration parameter must have a
registrations item of the following form, where id is a unique id used to
unregister the capability (the example uses a UUID):

{
	id: "28c6150c-bd7b-11e7-abc4-cec278b6b50a",
	method: "workspace/didChangeWorkspaceFolders"
}
Notification:

method: ‘workspace/didChangeWorkspaceFolders’
params: DidChangeWorkspaceFoldersParams defined as follows:
export interface DidChangeWorkspaceFoldersParams {
	/**
	 * The actual workspace folder change event.
	 */
	event: WorkspaceFoldersChangeEvent;
}

/**
 * The workspace folder change event.
 */
export interface WorkspaceFoldersChangeEvent {
	/**
	 * The array of added workspace folders
	 */
	added: WorkspaceFolder[];

	/**
	 * The array of the removed workspace folders
	 */
	removed: WorkspaceFolder[];
}
-}

-- | The workspace folder change event.
data WorkspaceFoldersChangeEvent =
  WorkspaceFoldersChangeEvent
    { WorkspaceFoldersChangeEvent -> List WorkspaceFolder
_added :: List WorkspaceFolder -- ^ The array of added workspace folders
    , WorkspaceFoldersChangeEvent -> List WorkspaceFolder
_removed :: List WorkspaceFolder -- ^ The array of the removed workspace folders
    } deriving (ReadPrec [WorkspaceFoldersChangeEvent]
ReadPrec WorkspaceFoldersChangeEvent
Int -> ReadS WorkspaceFoldersChangeEvent
ReadS [WorkspaceFoldersChangeEvent]
(Int -> ReadS WorkspaceFoldersChangeEvent)
-> ReadS [WorkspaceFoldersChangeEvent]
-> ReadPrec WorkspaceFoldersChangeEvent
-> ReadPrec [WorkspaceFoldersChangeEvent]
-> Read WorkspaceFoldersChangeEvent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WorkspaceFoldersChangeEvent]
$creadListPrec :: ReadPrec [WorkspaceFoldersChangeEvent]
readPrec :: ReadPrec WorkspaceFoldersChangeEvent
$creadPrec :: ReadPrec WorkspaceFoldersChangeEvent
readList :: ReadS [WorkspaceFoldersChangeEvent]
$creadList :: ReadS [WorkspaceFoldersChangeEvent]
readsPrec :: Int -> ReadS WorkspaceFoldersChangeEvent
$creadsPrec :: Int -> ReadS WorkspaceFoldersChangeEvent
Read, Int -> WorkspaceFoldersChangeEvent -> ShowS
[WorkspaceFoldersChangeEvent] -> ShowS
WorkspaceFoldersChangeEvent -> String
(Int -> WorkspaceFoldersChangeEvent -> ShowS)
-> (WorkspaceFoldersChangeEvent -> String)
-> ([WorkspaceFoldersChangeEvent] -> ShowS)
-> Show WorkspaceFoldersChangeEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WorkspaceFoldersChangeEvent] -> ShowS
$cshowList :: [WorkspaceFoldersChangeEvent] -> ShowS
show :: WorkspaceFoldersChangeEvent -> String
$cshow :: WorkspaceFoldersChangeEvent -> String
showsPrec :: Int -> WorkspaceFoldersChangeEvent -> ShowS
$cshowsPrec :: Int -> WorkspaceFoldersChangeEvent -> ShowS
Show, WorkspaceFoldersChangeEvent -> WorkspaceFoldersChangeEvent -> Bool
(WorkspaceFoldersChangeEvent
 -> WorkspaceFoldersChangeEvent -> Bool)
-> (WorkspaceFoldersChangeEvent
    -> WorkspaceFoldersChangeEvent -> Bool)
-> Eq WorkspaceFoldersChangeEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WorkspaceFoldersChangeEvent -> WorkspaceFoldersChangeEvent -> Bool
$c/= :: WorkspaceFoldersChangeEvent -> WorkspaceFoldersChangeEvent -> Bool
== :: WorkspaceFoldersChangeEvent -> WorkspaceFoldersChangeEvent -> Bool
$c== :: WorkspaceFoldersChangeEvent -> WorkspaceFoldersChangeEvent -> Bool
Eq)

deriveJSON lspOptions ''WorkspaceFoldersChangeEvent

data DidChangeWorkspaceFoldersParams = 
  DidChangeWorkspaceFoldersParams
    { DidChangeWorkspaceFoldersParams -> WorkspaceFoldersChangeEvent
_event :: WorkspaceFoldersChangeEvent
      -- ^ The actual workspace folder change event.
    } deriving (ReadPrec [DidChangeWorkspaceFoldersParams]
ReadPrec DidChangeWorkspaceFoldersParams
Int -> ReadS DidChangeWorkspaceFoldersParams
ReadS [DidChangeWorkspaceFoldersParams]
(Int -> ReadS DidChangeWorkspaceFoldersParams)
-> ReadS [DidChangeWorkspaceFoldersParams]
-> ReadPrec DidChangeWorkspaceFoldersParams
-> ReadPrec [DidChangeWorkspaceFoldersParams]
-> Read DidChangeWorkspaceFoldersParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DidChangeWorkspaceFoldersParams]
$creadListPrec :: ReadPrec [DidChangeWorkspaceFoldersParams]
readPrec :: ReadPrec DidChangeWorkspaceFoldersParams
$creadPrec :: ReadPrec DidChangeWorkspaceFoldersParams
readList :: ReadS [DidChangeWorkspaceFoldersParams]
$creadList :: ReadS [DidChangeWorkspaceFoldersParams]
readsPrec :: Int -> ReadS DidChangeWorkspaceFoldersParams
$creadsPrec :: Int -> ReadS DidChangeWorkspaceFoldersParams
Read, Int -> DidChangeWorkspaceFoldersParams -> ShowS
[DidChangeWorkspaceFoldersParams] -> ShowS
DidChangeWorkspaceFoldersParams -> String
(Int -> DidChangeWorkspaceFoldersParams -> ShowS)
-> (DidChangeWorkspaceFoldersParams -> String)
-> ([DidChangeWorkspaceFoldersParams] -> ShowS)
-> Show DidChangeWorkspaceFoldersParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DidChangeWorkspaceFoldersParams] -> ShowS
$cshowList :: [DidChangeWorkspaceFoldersParams] -> ShowS
show :: DidChangeWorkspaceFoldersParams -> String
$cshow :: DidChangeWorkspaceFoldersParams -> String
showsPrec :: Int -> DidChangeWorkspaceFoldersParams -> ShowS
$cshowsPrec :: Int -> DidChangeWorkspaceFoldersParams -> ShowS
Show, DidChangeWorkspaceFoldersParams
-> DidChangeWorkspaceFoldersParams -> Bool
(DidChangeWorkspaceFoldersParams
 -> DidChangeWorkspaceFoldersParams -> Bool)
-> (DidChangeWorkspaceFoldersParams
    -> DidChangeWorkspaceFoldersParams -> Bool)
-> Eq DidChangeWorkspaceFoldersParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DidChangeWorkspaceFoldersParams
-> DidChangeWorkspaceFoldersParams -> Bool
$c/= :: DidChangeWorkspaceFoldersParams
-> DidChangeWorkspaceFoldersParams -> Bool
== :: DidChangeWorkspaceFoldersParams
-> DidChangeWorkspaceFoldersParams -> Bool
$c== :: DidChangeWorkspaceFoldersParams
-> DidChangeWorkspaceFoldersParams -> Bool
Eq)

deriveJSON lspOptions ''DidChangeWorkspaceFoldersParams

type DidChangeWorkspaceFoldersNotification =
  NotificationMessage ClientMethod DidChangeWorkspaceFoldersParams