{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
module Language.LSP.Test.Files
  ( swapFiles
  , rootDir
  )
where

import           Language.LSP.Types
import           Language.LSP.Types.Lens hiding (id)
import           Control.Lens
import qualified Data.HashMap.Strict           as HM
import qualified Data.Text                     as T
import           Data.Maybe
import           System.Directory
import           System.FilePath
import Data.Time.Clock

data Event
  = ClientEv UTCTime FromClientMessage
  | ServerEv UTCTime FromServerMessage

swapFiles :: FilePath -> [Event] -> IO [Event]
swapFiles :: FilePath -> [Event] -> IO [Event]
swapFiles FilePath
relCurBaseDir [Event]
msgs = do
  let capturedBaseDir :: FilePath
capturedBaseDir = [Event] -> FilePath
rootDir [Event]
msgs

  FilePath
curBaseDir <- (FilePath -> FilePath -> FilePath
</> FilePath
relCurBaseDir) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getCurrentDirectory
  let transform :: Uri -> Uri
transform Uri
uri =
        let fp :: FilePath
fp = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
"Couldn't transform uri") (Uri -> Maybe FilePath
uriToFilePath Uri
uri)
            newFp :: FilePath
newFp = FilePath
curBaseDir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath -> FilePath
makeRelative FilePath
capturedBaseDir FilePath
fp
          in FilePath -> Uri
filePathToUri FilePath
newFp
      newMsgs :: [Event]
newMsgs = (Event -> Event) -> [Event] -> [Event]
forall a b. (a -> b) -> [a] -> [b]
map ((Uri -> Uri) -> Event -> Event
mapUris Uri -> Uri
transform) [Event]
msgs

  [Event] -> IO [Event]
forall (m :: * -> *) a. Monad m => a -> m a
return [Event]
newMsgs

rootDir :: [Event] -> FilePath
rootDir :: [Event] -> FilePath
rootDir (ClientEv UTCTime
_ (FromClientMess SMethod m
SInitialize Message m
req):[Event]
_) =
  FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
"Couldn't find root dir") (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ do
    Uri
rootUri <- Message m
RequestMessage 'Initialize
req RequestMessage 'Initialize
-> Getting (Maybe Uri) (RequestMessage 'Initialize) (Maybe Uri)
-> Maybe Uri
forall s a. s -> Getting a s a -> a
^. (InitializeParams -> Const (Maybe Uri) InitializeParams)
-> RequestMessage 'Initialize
-> Const (Maybe Uri) (RequestMessage 'Initialize)
forall s a. HasParams s a => Lens' s a
params ((InitializeParams -> Const (Maybe Uri) InitializeParams)
 -> RequestMessage 'Initialize
 -> Const (Maybe Uri) (RequestMessage 'Initialize))
-> ((Maybe Uri -> Const (Maybe Uri) (Maybe Uri))
    -> InitializeParams -> Const (Maybe Uri) InitializeParams)
-> Getting (Maybe Uri) (RequestMessage 'Initialize) (Maybe Uri)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Uri -> Const (Maybe Uri) (Maybe Uri))
-> InitializeParams -> Const (Maybe Uri) InitializeParams
forall s a. HasRootUri s a => Lens' s a
rootUri
    Uri -> Maybe FilePath
uriToFilePath Uri
rootUri
rootDir [Event]
_ = FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
"Couldn't find initialize request in session"

mapUris :: (Uri -> Uri) -> Event -> Event
mapUris :: (Uri -> Uri) -> Event -> Event
mapUris Uri -> Uri
f Event
event =
  case Event
event of
    ClientEv UTCTime
t FromClientMessage' SMethod
msg -> UTCTime -> FromClientMessage' SMethod -> Event
ClientEv UTCTime
t (FromClientMessage' SMethod -> FromClientMessage' SMethod
forall (a :: Method 'FromServer 'Request -> *).
FromClientMessage' a -> FromClientMessage' a
fromClientMsg FromClientMessage' SMethod
msg)
    ServerEv UTCTime
t FromServerMessage
msg -> UTCTime -> FromServerMessage -> Event
ServerEv UTCTime
t (FromServerMessage -> FromServerMessage
fromServerMsg FromServerMessage
msg)

  where
    --TODO: Handle all other URIs that might need swapped
    fromClientMsg :: FromClientMessage' a -> FromClientMessage' a
fromClientMsg (FromClientMess m :: SMethod m
m@SMethod m
SInitialize                 Message m
r) = SMethod m -> Message m -> FromClientMessage' a
forall (t :: MethodType) (m :: Method 'FromClient t)
       (a :: Method 'FromServer 'Request -> *).
SMethod m -> Message m -> FromClientMessage' a
FromClientMess SMethod m
m (Message m -> FromClientMessage' a)
-> Message m -> FromClientMessage' a
forall a b. (a -> b) -> a -> b
$ (InitializeParams -> Identity InitializeParams)
-> RequestMessage 'Initialize
-> Identity (RequestMessage 'Initialize)
forall s a. HasParams s a => Lens' s a
params ((InitializeParams -> Identity InitializeParams)
 -> RequestMessage 'Initialize
 -> Identity (RequestMessage 'Initialize))
-> InitializeParams
-> RequestMessage 'Initialize
-> RequestMessage 'Initialize
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InitializeParams -> InitializeParams
transformInit (Message m
RequestMessage 'Initialize
r RequestMessage 'Initialize
-> Getting
     InitializeParams (RequestMessage 'Initialize) InitializeParams
-> InitializeParams
forall s a. s -> Getting a s a -> a
^. Getting
  InitializeParams (RequestMessage 'Initialize) InitializeParams
forall s a. HasParams s a => Lens' s a
params) (RequestMessage 'Initialize -> RequestMessage 'Initialize)
-> RequestMessage 'Initialize -> RequestMessage 'Initialize
forall a b. (a -> b) -> a -> b
$ Message m
RequestMessage 'Initialize
r
    fromClientMsg (FromClientMess m :: SMethod m
m@SMethod m
STextDocumentDidOpen        Message m
n) = SMethod m -> Message m -> FromClientMessage' a
forall (t :: MethodType) (m :: Method 'FromClient t)
       (a :: Method 'FromServer 'Request -> *).
SMethod m -> Message m -> FromClientMessage' a
FromClientMess SMethod m
m (Message m -> FromClientMessage' a)
-> Message m -> FromClientMessage' a
forall a b. (a -> b) -> a -> b
$ Lens' (NotificationMessage 'TextDocumentDidOpen) TextDocumentItem
-> NotificationMessage 'TextDocumentDidOpen
-> NotificationMessage 'TextDocumentDidOpen
forall b a. HasUri b Uri => Lens' a b -> a -> a
swapUri ((DidOpenTextDocumentParams -> f DidOpenTextDocumentParams)
-> NotificationMessage 'TextDocumentDidOpen
-> f (NotificationMessage 'TextDocumentDidOpen)
forall s a. HasParams s a => Lens' s a
params ((DidOpenTextDocumentParams -> f DidOpenTextDocumentParams)
 -> NotificationMessage 'TextDocumentDidOpen
 -> f (NotificationMessage 'TextDocumentDidOpen))
-> ((TextDocumentItem -> f TextDocumentItem)
    -> DidOpenTextDocumentParams -> f DidOpenTextDocumentParams)
-> (TextDocumentItem -> f TextDocumentItem)
-> NotificationMessage 'TextDocumentDidOpen
-> f (NotificationMessage 'TextDocumentDidOpen)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentItem -> f TextDocumentItem)
-> DidOpenTextDocumentParams -> f DidOpenTextDocumentParams
forall s a. HasTextDocument s a => Lens' s a
textDocument) Message m
NotificationMessage 'TextDocumentDidOpen
n
    fromClientMsg (FromClientMess m :: SMethod m
m@SMethod m
STextDocumentDidChange      Message m
n) = SMethod m -> Message m -> FromClientMessage' a
forall (t :: MethodType) (m :: Method 'FromClient t)
       (a :: Method 'FromServer 'Request -> *).
SMethod m -> Message m -> FromClientMessage' a
FromClientMess SMethod m
m (Message m -> FromClientMessage' a)
-> Message m -> FromClientMessage' a
forall a b. (a -> b) -> a -> b
$ Lens'
  (NotificationMessage 'TextDocumentDidChange)
  VersionedTextDocumentIdentifier
-> NotificationMessage 'TextDocumentDidChange
-> NotificationMessage 'TextDocumentDidChange
forall b a. HasUri b Uri => Lens' a b -> a -> a
swapUri ((DidChangeTextDocumentParams -> f DidChangeTextDocumentParams)
-> NotificationMessage 'TextDocumentDidChange
-> f (NotificationMessage 'TextDocumentDidChange)
forall s a. HasParams s a => Lens' s a
params ((DidChangeTextDocumentParams -> f DidChangeTextDocumentParams)
 -> NotificationMessage 'TextDocumentDidChange
 -> f (NotificationMessage 'TextDocumentDidChange))
-> ((VersionedTextDocumentIdentifier
     -> f VersionedTextDocumentIdentifier)
    -> DidChangeTextDocumentParams -> f DidChangeTextDocumentParams)
-> (VersionedTextDocumentIdentifier
    -> f VersionedTextDocumentIdentifier)
-> NotificationMessage 'TextDocumentDidChange
-> f (NotificationMessage 'TextDocumentDidChange)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VersionedTextDocumentIdentifier
 -> f VersionedTextDocumentIdentifier)
-> DidChangeTextDocumentParams -> f DidChangeTextDocumentParams
forall s a. HasTextDocument s a => Lens' s a
textDocument) Message m
NotificationMessage 'TextDocumentDidChange
n
    fromClientMsg (FromClientMess m :: SMethod m
m@SMethod m
STextDocumentWillSave       Message m
n) = SMethod m -> Message m -> FromClientMessage' a
forall (t :: MethodType) (m :: Method 'FromClient t)
       (a :: Method 'FromServer 'Request -> *).
SMethod m -> Message m -> FromClientMessage' a
FromClientMess SMethod m
m (Message m -> FromClientMessage' a)
-> Message m -> FromClientMessage' a
forall a b. (a -> b) -> a -> b
$ Lens'
  (NotificationMessage 'TextDocumentWillSave) TextDocumentIdentifier
-> NotificationMessage 'TextDocumentWillSave
-> NotificationMessage 'TextDocumentWillSave
forall b a. HasUri b Uri => Lens' a b -> a -> a
swapUri ((WillSaveTextDocumentParams -> f WillSaveTextDocumentParams)
-> NotificationMessage 'TextDocumentWillSave
-> f (NotificationMessage 'TextDocumentWillSave)
forall s a. HasParams s a => Lens' s a
params ((WillSaveTextDocumentParams -> f WillSaveTextDocumentParams)
 -> NotificationMessage 'TextDocumentWillSave
 -> f (NotificationMessage 'TextDocumentWillSave))
-> ((TextDocumentIdentifier -> f TextDocumentIdentifier)
    -> WillSaveTextDocumentParams -> f WillSaveTextDocumentParams)
-> (TextDocumentIdentifier -> f TextDocumentIdentifier)
-> NotificationMessage 'TextDocumentWillSave
-> f (NotificationMessage 'TextDocumentWillSave)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentIdentifier -> f TextDocumentIdentifier)
-> WillSaveTextDocumentParams -> f WillSaveTextDocumentParams
forall s a. HasTextDocument s a => Lens' s a
textDocument) Message m
NotificationMessage 'TextDocumentWillSave
n
    fromClientMsg (FromClientMess m :: SMethod m
m@SMethod m
STextDocumentDidSave        Message m
n) = SMethod m -> Message m -> FromClientMessage' a
forall (t :: MethodType) (m :: Method 'FromClient t)
       (a :: Method 'FromServer 'Request -> *).
SMethod m -> Message m -> FromClientMessage' a
FromClientMess SMethod m
m (Message m -> FromClientMessage' a)
-> Message m -> FromClientMessage' a
forall a b. (a -> b) -> a -> b
$ Lens'
  (NotificationMessage 'TextDocumentDidSave) TextDocumentIdentifier
-> NotificationMessage 'TextDocumentDidSave
-> NotificationMessage 'TextDocumentDidSave
forall b a. HasUri b Uri => Lens' a b -> a -> a
swapUri ((DidSaveTextDocumentParams -> f DidSaveTextDocumentParams)
-> NotificationMessage 'TextDocumentDidSave
-> f (NotificationMessage 'TextDocumentDidSave)
forall s a. HasParams s a => Lens' s a
params ((DidSaveTextDocumentParams -> f DidSaveTextDocumentParams)
 -> NotificationMessage 'TextDocumentDidSave
 -> f (NotificationMessage 'TextDocumentDidSave))
-> ((TextDocumentIdentifier -> f TextDocumentIdentifier)
    -> DidSaveTextDocumentParams -> f DidSaveTextDocumentParams)
-> (TextDocumentIdentifier -> f TextDocumentIdentifier)
-> NotificationMessage 'TextDocumentDidSave
-> f (NotificationMessage 'TextDocumentDidSave)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentIdentifier -> f TextDocumentIdentifier)
-> DidSaveTextDocumentParams -> f DidSaveTextDocumentParams
forall s a. HasTextDocument s a => Lens' s a
textDocument) Message m
NotificationMessage 'TextDocumentDidSave
n
    fromClientMsg (FromClientMess m :: SMethod m
m@SMethod m
STextDocumentDidClose       Message m
n) = SMethod m -> Message m -> FromClientMessage' a
forall (t :: MethodType) (m :: Method 'FromClient t)
       (a :: Method 'FromServer 'Request -> *).
SMethod m -> Message m -> FromClientMessage' a
FromClientMess SMethod m
m (Message m -> FromClientMessage' a)
-> Message m -> FromClientMessage' a
forall a b. (a -> b) -> a -> b
$ Lens'
  (NotificationMessage 'TextDocumentDidClose) TextDocumentIdentifier
-> NotificationMessage 'TextDocumentDidClose
-> NotificationMessage 'TextDocumentDidClose
forall b a. HasUri b Uri => Lens' a b -> a -> a
swapUri ((DidCloseTextDocumentParams -> f DidCloseTextDocumentParams)
-> NotificationMessage 'TextDocumentDidClose
-> f (NotificationMessage 'TextDocumentDidClose)
forall s a. HasParams s a => Lens' s a
params ((DidCloseTextDocumentParams -> f DidCloseTextDocumentParams)
 -> NotificationMessage 'TextDocumentDidClose
 -> f (NotificationMessage 'TextDocumentDidClose))
-> ((TextDocumentIdentifier -> f TextDocumentIdentifier)
    -> DidCloseTextDocumentParams -> f DidCloseTextDocumentParams)
-> (TextDocumentIdentifier -> f TextDocumentIdentifier)
-> NotificationMessage 'TextDocumentDidClose
-> f (NotificationMessage 'TextDocumentDidClose)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentIdentifier -> f TextDocumentIdentifier)
-> DidCloseTextDocumentParams -> f DidCloseTextDocumentParams
forall s a. HasTextDocument s a => Lens' s a
textDocument) Message m
NotificationMessage 'TextDocumentDidClose
n
    fromClientMsg (FromClientMess m :: SMethod m
m@SMethod m
STextDocumentDocumentSymbol Message m
n) = SMethod m -> Message m -> FromClientMessage' a
forall (t :: MethodType) (m :: Method 'FromClient t)
       (a :: Method 'FromServer 'Request -> *).
SMethod m -> Message m -> FromClientMessage' a
FromClientMess SMethod m
m (Message m -> FromClientMessage' a)
-> Message m -> FromClientMessage' a
forall a b. (a -> b) -> a -> b
$ Lens'
  (RequestMessage 'TextDocumentDocumentSymbol) TextDocumentIdentifier
-> RequestMessage 'TextDocumentDocumentSymbol
-> RequestMessage 'TextDocumentDocumentSymbol
forall b a. HasUri b Uri => Lens' a b -> a -> a
swapUri ((DocumentSymbolParams -> f DocumentSymbolParams)
-> RequestMessage 'TextDocumentDocumentSymbol
-> f (RequestMessage 'TextDocumentDocumentSymbol)
forall s a. HasParams s a => Lens' s a
params ((DocumentSymbolParams -> f DocumentSymbolParams)
 -> RequestMessage 'TextDocumentDocumentSymbol
 -> f (RequestMessage 'TextDocumentDocumentSymbol))
-> ((TextDocumentIdentifier -> f TextDocumentIdentifier)
    -> DocumentSymbolParams -> f DocumentSymbolParams)
-> (TextDocumentIdentifier -> f TextDocumentIdentifier)
-> RequestMessage 'TextDocumentDocumentSymbol
-> f (RequestMessage 'TextDocumentDocumentSymbol)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentIdentifier -> f TextDocumentIdentifier)
-> DocumentSymbolParams -> f DocumentSymbolParams
forall s a. HasTextDocument s a => Lens' s a
textDocument) Message m
RequestMessage 'TextDocumentDocumentSymbol
n
    fromClientMsg (FromClientMess m :: SMethod m
m@SMethod m
STextDocumentRename         Message m
n) = SMethod m -> Message m -> FromClientMessage' a
forall (t :: MethodType) (m :: Method 'FromClient t)
       (a :: Method 'FromServer 'Request -> *).
SMethod m -> Message m -> FromClientMessage' a
FromClientMess SMethod m
m (Message m -> FromClientMessage' a)
-> Message m -> FromClientMessage' a
forall a b. (a -> b) -> a -> b
$ Lens' (RequestMessage 'TextDocumentRename) TextDocumentIdentifier
-> RequestMessage 'TextDocumentRename
-> RequestMessage 'TextDocumentRename
forall b a. HasUri b Uri => Lens' a b -> a -> a
swapUri ((RenameParams -> f RenameParams)
-> RequestMessage 'TextDocumentRename
-> f (RequestMessage 'TextDocumentRename)
forall s a. HasParams s a => Lens' s a
params ((RenameParams -> f RenameParams)
 -> RequestMessage 'TextDocumentRename
 -> f (RequestMessage 'TextDocumentRename))
-> ((TextDocumentIdentifier -> f TextDocumentIdentifier)
    -> RenameParams -> f RenameParams)
-> (TextDocumentIdentifier -> f TextDocumentIdentifier)
-> RequestMessage 'TextDocumentRename
-> f (RequestMessage 'TextDocumentRename)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentIdentifier -> f TextDocumentIdentifier)
-> RenameParams -> f RenameParams
forall s a. HasTextDocument s a => Lens' s a
textDocument) Message m
RequestMessage 'TextDocumentRename
n
    fromClientMsg FromClientMessage' a
x = FromClientMessage' a
x

    fromServerMsg :: FromServerMessage -> FromServerMessage
    fromServerMsg :: FromServerMessage -> FromServerMessage
fromServerMsg (FromServerMess m :: SMethod m
m@SMethod m
SWorkspaceApplyEdit Message m
r) = SMethod m -> Message m -> FromServerMessage
forall (t :: MethodType) (m :: Method 'FromServer t)
       (a :: Method 'FromClient 'Request -> *).
SMethod m -> Message m -> FromServerMessage' a
FromServerMess SMethod m
m (Message m -> FromServerMessage) -> Message m -> FromServerMessage
forall a b. (a -> b) -> a -> b
$ (ApplyWorkspaceEditParams -> Identity ApplyWorkspaceEditParams)
-> RequestMessage 'WorkspaceApplyEdit
-> Identity (RequestMessage 'WorkspaceApplyEdit)
forall s a. HasParams s a => Lens' s a
params ((ApplyWorkspaceEditParams -> Identity ApplyWorkspaceEditParams)
 -> RequestMessage 'WorkspaceApplyEdit
 -> Identity (RequestMessage 'WorkspaceApplyEdit))
-> ((WorkspaceEdit -> Identity WorkspaceEdit)
    -> ApplyWorkspaceEditParams -> Identity ApplyWorkspaceEditParams)
-> (WorkspaceEdit -> Identity WorkspaceEdit)
-> RequestMessage 'WorkspaceApplyEdit
-> Identity (RequestMessage 'WorkspaceApplyEdit)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceEdit -> Identity WorkspaceEdit)
-> ApplyWorkspaceEditParams -> Identity ApplyWorkspaceEditParams
forall s a. HasEdit s a => Lens' s a
edit ((WorkspaceEdit -> Identity WorkspaceEdit)
 -> RequestMessage 'WorkspaceApplyEdit
 -> Identity (RequestMessage 'WorkspaceApplyEdit))
-> WorkspaceEdit
-> RequestMessage 'WorkspaceApplyEdit
-> RequestMessage 'WorkspaceApplyEdit
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WorkspaceEdit -> WorkspaceEdit
swapWorkspaceEdit (Message m
RequestMessage 'WorkspaceApplyEdit
r RequestMessage 'WorkspaceApplyEdit
-> Getting
     WorkspaceEdit (RequestMessage 'WorkspaceApplyEdit) WorkspaceEdit
-> WorkspaceEdit
forall s a. s -> Getting a s a -> a
^. (ApplyWorkspaceEditParams
 -> Const WorkspaceEdit ApplyWorkspaceEditParams)
-> RequestMessage 'WorkspaceApplyEdit
-> Const WorkspaceEdit (RequestMessage 'WorkspaceApplyEdit)
forall s a. HasParams s a => Lens' s a
params ((ApplyWorkspaceEditParams
  -> Const WorkspaceEdit ApplyWorkspaceEditParams)
 -> RequestMessage 'WorkspaceApplyEdit
 -> Const WorkspaceEdit (RequestMessage 'WorkspaceApplyEdit))
-> ((WorkspaceEdit -> Const WorkspaceEdit WorkspaceEdit)
    -> ApplyWorkspaceEditParams
    -> Const WorkspaceEdit ApplyWorkspaceEditParams)
-> Getting
     WorkspaceEdit (RequestMessage 'WorkspaceApplyEdit) WorkspaceEdit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceEdit -> Const WorkspaceEdit WorkspaceEdit)
-> ApplyWorkspaceEditParams
-> Const WorkspaceEdit ApplyWorkspaceEditParams
forall s a. HasEdit s a => Lens' s a
edit) (RequestMessage 'WorkspaceApplyEdit
 -> RequestMessage 'WorkspaceApplyEdit)
-> RequestMessage 'WorkspaceApplyEdit
-> RequestMessage 'WorkspaceApplyEdit
forall a b. (a -> b) -> a -> b
$ Message m
RequestMessage 'WorkspaceApplyEdit
r
    fromServerMsg (FromServerMess m :: SMethod m
m@SMethod m
STextDocumentPublishDiagnostics Message m
n) = SMethod m -> Message m -> FromServerMessage
forall (t :: MethodType) (m :: Method 'FromServer t)
       (a :: Method 'FromClient 'Request -> *).
SMethod m -> Message m -> FromServerMessage' a
FromServerMess SMethod m
m (Message m -> FromServerMessage) -> Message m -> FromServerMessage
forall a b. (a -> b) -> a -> b
$ Lens'
  (NotificationMessage 'TextDocumentPublishDiagnostics)
  PublishDiagnosticsParams
-> NotificationMessage 'TextDocumentPublishDiagnostics
-> NotificationMessage 'TextDocumentPublishDiagnostics
forall b a. HasUri b Uri => Lens' a b -> a -> a
swapUri forall s a. HasParams s a => Lens' s a
Lens'
  (NotificationMessage 'TextDocumentPublishDiagnostics)
  PublishDiagnosticsParams
params Message m
NotificationMessage 'TextDocumentPublishDiagnostics
n
    fromServerMsg (FromServerRsp m :: SMethod m
m@SMethod m
STextDocumentDocumentSymbol ResponseMessage m
r) =
      let swapUri' :: (List DocumentSymbol |? List SymbolInformation) -> List DocumentSymbol |? List SymbolInformation
          swapUri' :: (List DocumentSymbol |? List SymbolInformation)
-> List DocumentSymbol |? List SymbolInformation
swapUri' (InR List SymbolInformation
si) = List SymbolInformation
-> List DocumentSymbol |? List SymbolInformation
forall a b. b -> a |? b
InR (Lens' SymbolInformation Location
-> SymbolInformation -> SymbolInformation
forall b a. HasUri b Uri => Lens' a b -> a -> a
swapUri forall s a. HasLocation s a => Lens' s a
Lens' SymbolInformation Location
location (SymbolInformation -> SymbolInformation)
-> List SymbolInformation -> List SymbolInformation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> List SymbolInformation
si)
          swapUri' (InL List DocumentSymbol
dss) = List DocumentSymbol
-> List DocumentSymbol |? List SymbolInformation
forall a b. a -> a |? b
InL List DocumentSymbol
dss -- no file locations here
      in SMethod m -> ResponseMessage m -> FromServerMessage
forall (m :: Method 'FromClient 'Request)
       (a :: Method 'FromClient 'Request -> *).
a m -> ResponseMessage m -> FromServerMessage' a
FromServerRsp SMethod m
m (ResponseMessage m -> FromServerMessage)
-> ResponseMessage m -> FromServerMessage
forall a b. (a -> b) -> a -> b
$ ResponseMessage m
r ResponseMessage m
-> (ResponseMessage m -> ResponseMessage m) -> ResponseMessage m
forall a b. a -> (a -> b) -> b
& (Either
   ResponseError (List DocumentSymbol |? List SymbolInformation)
 -> Identity
      (Either
         ResponseError (List DocumentSymbol |? List SymbolInformation)))
-> ResponseMessage m -> Identity (ResponseMessage m)
forall s a. HasResult s a => Lens' s a
result ((Either
    ResponseError (List DocumentSymbol |? List SymbolInformation)
  -> Identity
       (Either
          ResponseError (List DocumentSymbol |? List SymbolInformation)))
 -> ResponseMessage m -> Identity (ResponseMessage m))
-> (Either
      ResponseError (List DocumentSymbol |? List SymbolInformation)
    -> Either
         ResponseError (List DocumentSymbol |? List SymbolInformation))
-> ResponseMessage m
-> ResponseMessage m
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (((List DocumentSymbol |? List SymbolInformation)
 -> List DocumentSymbol |? List SymbolInformation)
-> Either
     ResponseError (List DocumentSymbol |? List SymbolInformation)
-> Either
     ResponseError (List DocumentSymbol |? List SymbolInformation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (List DocumentSymbol |? List SymbolInformation)
-> List DocumentSymbol |? List SymbolInformation
swapUri')
    fromServerMsg (FromServerRsp m :: SMethod m
m@SMethod m
STextDocumentRename ResponseMessage m
r) = SMethod m -> ResponseMessage m -> FromServerMessage
forall (m :: Method 'FromClient 'Request)
       (a :: Method 'FromClient 'Request -> *).
a m -> ResponseMessage m -> FromServerMessage' a
FromServerRsp SMethod m
m (ResponseMessage m -> FromServerMessage)
-> ResponseMessage m -> FromServerMessage
forall a b. (a -> b) -> a -> b
$ ResponseMessage m
r ResponseMessage m
-> (ResponseMessage m -> ResponseMessage m) -> ResponseMessage m
forall a b. a -> (a -> b) -> b
& (Either ResponseError WorkspaceEdit
 -> Identity (Either ResponseError WorkspaceEdit))
-> ResponseMessage m -> Identity (ResponseMessage m)
forall s a. HasResult s a => Lens' s a
result ((Either ResponseError WorkspaceEdit
  -> Identity (Either ResponseError WorkspaceEdit))
 -> ResponseMessage m -> Identity (ResponseMessage m))
-> (Either ResponseError WorkspaceEdit
    -> Either ResponseError WorkspaceEdit)
-> ResponseMessage m
-> ResponseMessage m
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((WorkspaceEdit -> WorkspaceEdit)
-> Either ResponseError WorkspaceEdit
-> Either ResponseError WorkspaceEdit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WorkspaceEdit -> WorkspaceEdit
swapWorkspaceEdit)
    fromServerMsg FromServerMessage
x = FromServerMessage
x

    swapWorkspaceEdit :: WorkspaceEdit -> WorkspaceEdit
    swapWorkspaceEdit :: WorkspaceEdit -> WorkspaceEdit
swapWorkspaceEdit WorkspaceEdit
e =
      let swapDocumentChangeUri :: DocumentChange -> DocumentChange
          swapDocumentChangeUri :: DocumentChange -> DocumentChange
swapDocumentChangeUri (InL TextDocumentEdit
textDocEdit) = TextDocumentEdit -> DocumentChange
forall a b. a -> a |? b
InL (TextDocumentEdit -> DocumentChange)
-> TextDocumentEdit -> DocumentChange
forall a b. (a -> b) -> a -> b
$ Lens' TextDocumentEdit VersionedTextDocumentIdentifier
-> TextDocumentEdit -> TextDocumentEdit
forall b a. HasUri b Uri => Lens' a b -> a -> a
swapUri forall s a. HasTextDocument s a => Lens' s a
Lens' TextDocumentEdit VersionedTextDocumentIdentifier
textDocument TextDocumentEdit
textDocEdit
          swapDocumentChangeUri (InR (InL CreateFile
createFile)) = (CreateFile |? (RenameFile |? DeleteFile)) -> DocumentChange
forall a b. b -> a |? b
InR ((CreateFile |? (RenameFile |? DeleteFile)) -> DocumentChange)
-> (CreateFile |? (RenameFile |? DeleteFile)) -> DocumentChange
forall a b. (a -> b) -> a -> b
$ CreateFile -> CreateFile |? (RenameFile |? DeleteFile)
forall a b. a -> a |? b
InL (CreateFile -> CreateFile |? (RenameFile |? DeleteFile))
-> CreateFile -> CreateFile |? (RenameFile |? DeleteFile)
forall a b. (a -> b) -> a -> b
$ Lens' CreateFile CreateFile -> CreateFile -> CreateFile
forall b a. HasUri b Uri => Lens' a b -> a -> a
swapUri forall a. a -> a
Lens' CreateFile CreateFile
id CreateFile
createFile
          -- for RenameFile, we swap `newUri`
          swapDocumentChangeUri (InR (InR (InL RenameFile
renameFile))) = (CreateFile |? (RenameFile |? DeleteFile)) -> DocumentChange
forall a b. b -> a |? b
InR ((CreateFile |? (RenameFile |? DeleteFile)) -> DocumentChange)
-> (CreateFile |? (RenameFile |? DeleteFile)) -> DocumentChange
forall a b. (a -> b) -> a -> b
$ (RenameFile |? DeleteFile)
-> CreateFile |? (RenameFile |? DeleteFile)
forall a b. b -> a |? b
InR ((RenameFile |? DeleteFile)
 -> CreateFile |? (RenameFile |? DeleteFile))
-> (RenameFile |? DeleteFile)
-> CreateFile |? (RenameFile |? DeleteFile)
forall a b. (a -> b) -> a -> b
$ RenameFile -> RenameFile |? DeleteFile
forall a b. a -> a |? b
InL (RenameFile -> RenameFile |? DeleteFile)
-> RenameFile -> RenameFile |? DeleteFile
forall a b. (a -> b) -> a -> b
$ (Uri -> Identity Uri) -> RenameFile -> Identity RenameFile
forall s a. HasNewUri s a => Lens' s a
newUri ((Uri -> Identity Uri) -> RenameFile -> Identity RenameFile)
-> Uri -> RenameFile -> RenameFile
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Uri -> Uri
f (RenameFile
renameFile RenameFile -> Getting Uri RenameFile Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri RenameFile Uri
forall s a. HasNewUri s a => Lens' s a
newUri) (RenameFile -> RenameFile) -> RenameFile -> RenameFile
forall a b. (a -> b) -> a -> b
$ RenameFile
renameFile
          swapDocumentChangeUri (InR (InR (InR DeleteFile
deleteFile))) = (CreateFile |? (RenameFile |? DeleteFile)) -> DocumentChange
forall a b. b -> a |? b
InR ((CreateFile |? (RenameFile |? DeleteFile)) -> DocumentChange)
-> (CreateFile |? (RenameFile |? DeleteFile)) -> DocumentChange
forall a b. (a -> b) -> a -> b
$ (RenameFile |? DeleteFile)
-> CreateFile |? (RenameFile |? DeleteFile)
forall a b. b -> a |? b
InR ((RenameFile |? DeleteFile)
 -> CreateFile |? (RenameFile |? DeleteFile))
-> (RenameFile |? DeleteFile)
-> CreateFile |? (RenameFile |? DeleteFile)
forall a b. (a -> b) -> a -> b
$ DeleteFile -> RenameFile |? DeleteFile
forall a b. b -> a |? b
InR (DeleteFile -> RenameFile |? DeleteFile)
-> DeleteFile -> RenameFile |? DeleteFile
forall a b. (a -> b) -> a -> b
$ Lens' DeleteFile DeleteFile -> DeleteFile -> DeleteFile
forall b a. HasUri b Uri => Lens' a b -> a -> a
swapUri forall a. a -> a
Lens' DeleteFile DeleteFile
id DeleteFile
deleteFile

          newDocChanges :: Maybe (List DocumentChange)
newDocChanges = (List DocumentChange -> List DocumentChange)
-> Maybe (List DocumentChange) -> Maybe (List DocumentChange)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DocumentChange -> DocumentChange)
-> List DocumentChange -> List DocumentChange
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DocumentChange -> DocumentChange
swapDocumentChangeUri) (Maybe (List DocumentChange) -> Maybe (List DocumentChange))
-> Maybe (List DocumentChange) -> Maybe (List DocumentChange)
forall a b. (a -> b) -> a -> b
$ WorkspaceEdit
e WorkspaceEdit
-> Getting
     (Maybe (List DocumentChange))
     WorkspaceEdit
     (Maybe (List DocumentChange))
-> Maybe (List DocumentChange)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (List DocumentChange))
  WorkspaceEdit
  (Maybe (List DocumentChange))
forall s a. HasDocumentChanges s a => Lens' s a
documentChanges
          newChanges :: Maybe (HashMap Uri (List TextEdit))
newChanges = (HashMap Uri (List TextEdit) -> HashMap Uri (List TextEdit))
-> Maybe (HashMap Uri (List TextEdit))
-> Maybe (HashMap Uri (List TextEdit))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Uri -> Uri)
-> HashMap Uri (List TextEdit) -> HashMap Uri (List TextEdit)
forall b. (Uri -> Uri) -> HashMap Uri b -> HashMap Uri b
swapKeys Uri -> Uri
f) (Maybe (HashMap Uri (List TextEdit))
 -> Maybe (HashMap Uri (List TextEdit)))
-> Maybe (HashMap Uri (List TextEdit))
-> Maybe (HashMap Uri (List TextEdit))
forall a b. (a -> b) -> a -> b
$ WorkspaceEdit
e WorkspaceEdit
-> Getting
     (Maybe (HashMap Uri (List TextEdit)))
     WorkspaceEdit
     (Maybe (HashMap Uri (List TextEdit)))
-> Maybe (HashMap Uri (List TextEdit))
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (HashMap Uri (List TextEdit)))
  WorkspaceEdit
  (Maybe (HashMap Uri (List TextEdit)))
forall s a. HasChanges s a => Lens' s a
changes
       in Maybe (HashMap Uri (List TextEdit))
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit Maybe (HashMap Uri (List TextEdit))
newChanges Maybe (List DocumentChange)
newDocChanges Maybe ChangeAnnotationMap
forall a. Maybe a
Nothing

    swapKeys :: (Uri -> Uri) -> HM.HashMap Uri b -> HM.HashMap Uri b
    swapKeys :: (Uri -> Uri) -> HashMap Uri b -> HashMap Uri b
swapKeys Uri -> Uri
f = (HashMap Uri b -> Uri -> b -> HashMap Uri b)
-> HashMap Uri b -> HashMap Uri b -> HashMap Uri b
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
HM.foldlWithKey' (\HashMap Uri b
acc Uri
k b
v -> Uri -> b -> HashMap Uri b -> HashMap Uri b
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (Uri -> Uri
f Uri
k) b
v HashMap Uri b
acc) HashMap Uri b
forall k v. HashMap k v
HM.empty

    swapUri :: HasUri b Uri => Lens' a b -> a -> a
    swapUri :: Lens' a b -> a -> a
swapUri Lens' a b
lens a
x =
      let newUri :: Uri
newUri = Uri -> Uri
f (a
x a -> Getting Uri a Uri -> Uri
forall s a. s -> Getting a s a -> a
^. (b -> Const Uri b) -> a -> Const Uri a
Lens' a b
lens ((b -> Const Uri b) -> a -> Const Uri a)
-> ((Uri -> Const Uri Uri) -> b -> Const Uri b)
-> Getting Uri a Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri) -> b -> Const Uri b
forall s a. HasUri s a => Lens' s a
uri)
        in ((b -> Identity b) -> a -> Identity a
Lens' a b
lens ((b -> Identity b) -> a -> Identity a)
-> ((Uri -> Identity Uri) -> b -> Identity b)
-> (Uri -> Identity Uri)
-> a
-> Identity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Identity Uri) -> b -> Identity b
forall s a. HasUri s a => Lens' s a
uri) ((Uri -> Identity Uri) -> a -> Identity a) -> Uri -> a -> a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Uri
newUri (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
x

    -- | Transforms rootUri/rootPath.
    transformInit :: InitializeParams -> InitializeParams
    transformInit :: InitializeParams -> InitializeParams
transformInit InitializeParams
x =
      let newRootUri :: Maybe Uri
newRootUri = (Uri -> Uri) -> Maybe Uri -> Maybe Uri
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Uri -> Uri
f (InitializeParams
x InitializeParams
-> ((Maybe Uri -> Const (Maybe Uri) (Maybe Uri))
    -> InitializeParams -> Const (Maybe Uri) InitializeParams)
-> Maybe Uri
forall s a. s -> Getting a s a -> a
^. (Maybe Uri -> Const (Maybe Uri) (Maybe Uri))
-> InitializeParams -> Const (Maybe Uri) InitializeParams
forall s a. HasRootUri s a => Lens' s a
rootUri)
          newRootPath :: Maybe Text
newRootPath = do
            FilePath
fp <- Text -> FilePath
T.unpack (Text -> FilePath) -> Maybe Text -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InitializeParams
x InitializeParams
-> Getting (Maybe Text) InitializeParams (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) InitializeParams (Maybe Text)
forall s a. HasRootPath s a => Lens' s a
rootPath
            let uri :: Uri
uri = FilePath -> Uri
filePathToUri FilePath
fp
            FilePath -> Text
T.pack (FilePath -> Text) -> Maybe FilePath -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Uri -> Maybe FilePath
uriToFilePath (Uri -> Uri
f Uri
uri)
        in ((Maybe Uri -> Identity (Maybe Uri))
-> InitializeParams -> Identity InitializeParams
forall s a. HasRootUri s a => Lens' s a
rootUri ((Maybe Uri -> Identity (Maybe Uri))
 -> InitializeParams -> Identity InitializeParams)
-> Maybe Uri -> InitializeParams -> InitializeParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Uri
newRootUri) (InitializeParams -> InitializeParams)
-> InitializeParams -> InitializeParams
forall a b. (a -> b) -> a -> b
$ ((Maybe Text -> Identity (Maybe Text))
-> InitializeParams -> Identity InitializeParams
forall s a. HasRootPath s a => Lens' s a
rootPath ((Maybe Text -> Identity (Maybe Text))
 -> InitializeParams -> Identity InitializeParams)
-> Maybe Text -> InitializeParams -> InitializeParams
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text
newRootPath) InitializeParams
x