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

import           Language.Haskell.LSP.Capture
import           Language.Haskell.LSP.Types
import           Language.Haskell.LSP.Types.Lens
import           Language.Haskell.LSP.Messages
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

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 (FromClient UTCTime
_ (ReqInitialize InitializeRequest
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 <- InitializeRequest
req InitializeRequest
-> Getting (Maybe Uri) InitializeRequest (Maybe Uri) -> Maybe Uri
forall s a. s -> Getting a s a -> a
^. (InitializeParams -> Const (Maybe Uri) InitializeParams)
-> InitializeRequest -> Const (Maybe Uri) InitializeRequest
forall s a. HasParams s a => Lens' s a
params ((InitializeParams -> Const (Maybe Uri) InitializeParams)
 -> InitializeRequest -> Const (Maybe Uri) InitializeRequest)
-> ((Maybe Uri -> Const (Maybe Uri) (Maybe Uri))
    -> InitializeParams -> Const (Maybe Uri) InitializeParams)
-> Getting (Maybe Uri) InitializeRequest (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
    FromClient UTCTime
t FromClientMessage
msg -> UTCTime -> FromClientMessage -> Event
FromClient UTCTime
t (FromClientMessage -> FromClientMessage
fromClientMsg FromClientMessage
msg)
    FromServer UTCTime
t FromServerMessage
msg -> UTCTime -> FromServerMessage -> Event
FromServer UTCTime
t (FromServerMessage -> FromServerMessage
fromServerMsg FromServerMessage
msg)

  where
    --TODO: Handle all other URIs that might need swapped
    fromClientMsg :: FromClientMessage -> FromClientMessage
fromClientMsg (NotDidOpenTextDocument DidOpenTextDocumentNotification
n) = DidOpenTextDocumentNotification -> FromClientMessage
NotDidOpenTextDocument (DidOpenTextDocumentNotification -> FromClientMessage)
-> DidOpenTextDocumentNotification -> FromClientMessage
forall a b. (a -> b) -> a -> b
$ Lens' DidOpenTextDocumentNotification TextDocumentItem
-> DidOpenTextDocumentNotification
-> DidOpenTextDocumentNotification
forall b a. HasUri b Uri => Lens' a b -> a -> a
swapUri ((DidOpenTextDocumentParams -> f DidOpenTextDocumentParams)
-> DidOpenTextDocumentNotification
-> f DidOpenTextDocumentNotification
forall s a. HasParams s a => Lens' s a
params ((DidOpenTextDocumentParams -> f DidOpenTextDocumentParams)
 -> DidOpenTextDocumentNotification
 -> f DidOpenTextDocumentNotification)
-> ((TextDocumentItem -> f TextDocumentItem)
    -> DidOpenTextDocumentParams -> f DidOpenTextDocumentParams)
-> (TextDocumentItem -> f TextDocumentItem)
-> DidOpenTextDocumentNotification
-> f DidOpenTextDocumentNotification
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) DidOpenTextDocumentNotification
n
    fromClientMsg (NotDidChangeTextDocument DidChangeTextDocumentNotification
n) = DidChangeTextDocumentNotification -> FromClientMessage
NotDidChangeTextDocument (DidChangeTextDocumentNotification -> FromClientMessage)
-> DidChangeTextDocumentNotification -> FromClientMessage
forall a b. (a -> b) -> a -> b
$ Lens'
  DidChangeTextDocumentNotification VersionedTextDocumentIdentifier
-> DidChangeTextDocumentNotification
-> DidChangeTextDocumentNotification
forall b a. HasUri b Uri => Lens' a b -> a -> a
swapUri ((DidChangeTextDocumentParams -> f DidChangeTextDocumentParams)
-> DidChangeTextDocumentNotification
-> f DidChangeTextDocumentNotification
forall s a. HasParams s a => Lens' s a
params ((DidChangeTextDocumentParams -> f DidChangeTextDocumentParams)
 -> DidChangeTextDocumentNotification
 -> f DidChangeTextDocumentNotification)
-> ((VersionedTextDocumentIdentifier
     -> f VersionedTextDocumentIdentifier)
    -> DidChangeTextDocumentParams -> f DidChangeTextDocumentParams)
-> (VersionedTextDocumentIdentifier
    -> f VersionedTextDocumentIdentifier)
-> DidChangeTextDocumentNotification
-> f DidChangeTextDocumentNotification
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) DidChangeTextDocumentNotification
n
    fromClientMsg (NotWillSaveTextDocument WillSaveTextDocumentNotification
n) = WillSaveTextDocumentNotification -> FromClientMessage
NotWillSaveTextDocument (WillSaveTextDocumentNotification -> FromClientMessage)
-> WillSaveTextDocumentNotification -> FromClientMessage
forall a b. (a -> b) -> a -> b
$ Lens' WillSaveTextDocumentNotification TextDocumentIdentifier
-> WillSaveTextDocumentNotification
-> WillSaveTextDocumentNotification
forall b a. HasUri b Uri => Lens' a b -> a -> a
swapUri ((WillSaveTextDocumentParams -> f WillSaveTextDocumentParams)
-> WillSaveTextDocumentNotification
-> f WillSaveTextDocumentNotification
forall s a. HasParams s a => Lens' s a
params ((WillSaveTextDocumentParams -> f WillSaveTextDocumentParams)
 -> WillSaveTextDocumentNotification
 -> f WillSaveTextDocumentNotification)
-> ((TextDocumentIdentifier -> f TextDocumentIdentifier)
    -> WillSaveTextDocumentParams -> f WillSaveTextDocumentParams)
-> (TextDocumentIdentifier -> f TextDocumentIdentifier)
-> WillSaveTextDocumentNotification
-> f WillSaveTextDocumentNotification
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) WillSaveTextDocumentNotification
n
    fromClientMsg (NotDidSaveTextDocument DidSaveTextDocumentNotification
n) = DidSaveTextDocumentNotification -> FromClientMessage
NotDidSaveTextDocument (DidSaveTextDocumentNotification -> FromClientMessage)
-> DidSaveTextDocumentNotification -> FromClientMessage
forall a b. (a -> b) -> a -> b
$ Lens' DidSaveTextDocumentNotification TextDocumentIdentifier
-> DidSaveTextDocumentNotification
-> DidSaveTextDocumentNotification
forall b a. HasUri b Uri => Lens' a b -> a -> a
swapUri ((DidSaveTextDocumentParams -> f DidSaveTextDocumentParams)
-> DidSaveTextDocumentNotification
-> f DidSaveTextDocumentNotification
forall s a. HasParams s a => Lens' s a
params ((DidSaveTextDocumentParams -> f DidSaveTextDocumentParams)
 -> DidSaveTextDocumentNotification
 -> f DidSaveTextDocumentNotification)
-> ((TextDocumentIdentifier -> f TextDocumentIdentifier)
    -> DidSaveTextDocumentParams -> f DidSaveTextDocumentParams)
-> (TextDocumentIdentifier -> f TextDocumentIdentifier)
-> DidSaveTextDocumentNotification
-> f DidSaveTextDocumentNotification
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) DidSaveTextDocumentNotification
n
    fromClientMsg (NotDidCloseTextDocument DidCloseTextDocumentNotification
n) = DidCloseTextDocumentNotification -> FromClientMessage
NotDidCloseTextDocument (DidCloseTextDocumentNotification -> FromClientMessage)
-> DidCloseTextDocumentNotification -> FromClientMessage
forall a b. (a -> b) -> a -> b
$ Lens' DidCloseTextDocumentNotification TextDocumentIdentifier
-> DidCloseTextDocumentNotification
-> DidCloseTextDocumentNotification
forall b a. HasUri b Uri => Lens' a b -> a -> a
swapUri ((DidCloseTextDocumentParams -> f DidCloseTextDocumentParams)
-> DidCloseTextDocumentNotification
-> f DidCloseTextDocumentNotification
forall s a. HasParams s a => Lens' s a
params ((DidCloseTextDocumentParams -> f DidCloseTextDocumentParams)
 -> DidCloseTextDocumentNotification
 -> f DidCloseTextDocumentNotification)
-> ((TextDocumentIdentifier -> f TextDocumentIdentifier)
    -> DidCloseTextDocumentParams -> f DidCloseTextDocumentParams)
-> (TextDocumentIdentifier -> f TextDocumentIdentifier)
-> DidCloseTextDocumentNotification
-> f DidCloseTextDocumentNotification
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) DidCloseTextDocumentNotification
n
    fromClientMsg (ReqInitialize InitializeRequest
r) = InitializeRequest -> FromClientMessage
ReqInitialize (InitializeRequest -> FromClientMessage)
-> InitializeRequest -> FromClientMessage
forall a b. (a -> b) -> a -> b
$ (InitializeParams -> Identity InitializeParams)
-> InitializeRequest -> Identity InitializeRequest
forall s a. HasParams s a => Lens' s a
params ((InitializeParams -> Identity InitializeParams)
 -> InitializeRequest -> Identity InitializeRequest)
-> InitializeParams -> InitializeRequest -> InitializeRequest
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InitializeParams -> InitializeParams
transformInit (InitializeRequest
r InitializeRequest
-> Getting InitializeParams InitializeRequest InitializeParams
-> InitializeParams
forall s a. s -> Getting a s a -> a
^. Getting InitializeParams InitializeRequest InitializeParams
forall s a. HasParams s a => Lens' s a
params) (InitializeRequest -> InitializeRequest)
-> InitializeRequest -> InitializeRequest
forall a b. (a -> b) -> a -> b
$ InitializeRequest
r
    fromClientMsg (ReqDocumentSymbols DocumentSymbolRequest
r) = DocumentSymbolRequest -> FromClientMessage
ReqDocumentSymbols (DocumentSymbolRequest -> FromClientMessage)
-> DocumentSymbolRequest -> FromClientMessage
forall a b. (a -> b) -> a -> b
$ Lens' DocumentSymbolRequest TextDocumentIdentifier
-> DocumentSymbolRequest -> DocumentSymbolRequest
forall b a. HasUri b Uri => Lens' a b -> a -> a
swapUri ((DocumentSymbolParams -> f DocumentSymbolParams)
-> DocumentSymbolRequest -> f DocumentSymbolRequest
forall s a. HasParams s a => Lens' s a
params ((DocumentSymbolParams -> f DocumentSymbolParams)
 -> DocumentSymbolRequest -> f DocumentSymbolRequest)
-> ((TextDocumentIdentifier -> f TextDocumentIdentifier)
    -> DocumentSymbolParams -> f DocumentSymbolParams)
-> (TextDocumentIdentifier -> f TextDocumentIdentifier)
-> DocumentSymbolRequest
-> f DocumentSymbolRequest
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) DocumentSymbolRequest
r
    fromClientMsg (ReqRename RenameRequest
r) = RenameRequest -> FromClientMessage
ReqRename (RenameRequest -> FromClientMessage)
-> RenameRequest -> FromClientMessage
forall a b. (a -> b) -> a -> b
$ Lens' RenameRequest TextDocumentIdentifier
-> RenameRequest -> RenameRequest
forall b a. HasUri b Uri => Lens' a b -> a -> a
swapUri ((RenameParams -> f RenameParams)
-> RenameRequest -> f RenameRequest
forall s a. HasParams s a => Lens' s a
params ((RenameParams -> f RenameParams)
 -> RenameRequest -> f RenameRequest)
-> ((TextDocumentIdentifier -> f TextDocumentIdentifier)
    -> RenameParams -> f RenameParams)
-> (TextDocumentIdentifier -> f TextDocumentIdentifier)
-> RenameRequest
-> f RenameRequest
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) RenameRequest
r
    fromClientMsg FromClientMessage
x = FromClientMessage
x

    fromServerMsg :: FromServerMessage -> FromServerMessage
    fromServerMsg :: FromServerMessage -> FromServerMessage
fromServerMsg (ReqApplyWorkspaceEdit ApplyWorkspaceEditRequest
r) =
      ApplyWorkspaceEditRequest -> FromServerMessage
ReqApplyWorkspaceEdit (ApplyWorkspaceEditRequest -> FromServerMessage)
-> ApplyWorkspaceEditRequest -> FromServerMessage
forall a b. (a -> b) -> a -> b
$ (ApplyWorkspaceEditParams -> Identity ApplyWorkspaceEditParams)
-> ApplyWorkspaceEditRequest -> Identity ApplyWorkspaceEditRequest
forall s a. HasParams s a => Lens' s a
params ((ApplyWorkspaceEditParams -> Identity ApplyWorkspaceEditParams)
 -> ApplyWorkspaceEditRequest -> Identity ApplyWorkspaceEditRequest)
-> ((WorkspaceEdit -> Identity WorkspaceEdit)
    -> ApplyWorkspaceEditParams -> Identity ApplyWorkspaceEditParams)
-> (WorkspaceEdit -> Identity WorkspaceEdit)
-> ApplyWorkspaceEditRequest
-> Identity ApplyWorkspaceEditRequest
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)
 -> ApplyWorkspaceEditRequest -> Identity ApplyWorkspaceEditRequest)
-> WorkspaceEdit
-> ApplyWorkspaceEditRequest
-> ApplyWorkspaceEditRequest
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WorkspaceEdit -> WorkspaceEdit
swapWorkspaceEdit (ApplyWorkspaceEditRequest
r ApplyWorkspaceEditRequest
-> Getting WorkspaceEdit ApplyWorkspaceEditRequest WorkspaceEdit
-> WorkspaceEdit
forall s a. s -> Getting a s a -> a
^. (ApplyWorkspaceEditParams
 -> Const WorkspaceEdit ApplyWorkspaceEditParams)
-> ApplyWorkspaceEditRequest
-> Const WorkspaceEdit ApplyWorkspaceEditRequest
forall s a. HasParams s a => Lens' s a
params ((ApplyWorkspaceEditParams
  -> Const WorkspaceEdit ApplyWorkspaceEditParams)
 -> ApplyWorkspaceEditRequest
 -> Const WorkspaceEdit ApplyWorkspaceEditRequest)
-> ((WorkspaceEdit -> Const WorkspaceEdit WorkspaceEdit)
    -> ApplyWorkspaceEditParams
    -> Const WorkspaceEdit ApplyWorkspaceEditParams)
-> Getting WorkspaceEdit ApplyWorkspaceEditRequest 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) (ApplyWorkspaceEditRequest -> ApplyWorkspaceEditRequest)
-> ApplyWorkspaceEditRequest -> ApplyWorkspaceEditRequest
forall a b. (a -> b) -> a -> b
$ ApplyWorkspaceEditRequest
r

    fromServerMsg (NotPublishDiagnostics PublishDiagnosticsNotification
n) = PublishDiagnosticsNotification -> FromServerMessage
NotPublishDiagnostics (PublishDiagnosticsNotification -> FromServerMessage)
-> PublishDiagnosticsNotification -> FromServerMessage
forall a b. (a -> b) -> a -> b
$ Lens' PublishDiagnosticsNotification PublishDiagnosticsParams
-> PublishDiagnosticsNotification -> PublishDiagnosticsNotification
forall b a. HasUri b Uri => Lens' a b -> a -> a
swapUri forall s a. HasParams s a => Lens' s a
Lens' PublishDiagnosticsNotification PublishDiagnosticsParams
params PublishDiagnosticsNotification
n

    fromServerMsg (RspDocumentSymbols DocumentSymbolsResponse
r) =
      let swapUri' :: DSResult -> DSResult
swapUri' (DSSymbolInformation List SymbolInformation
si) = List SymbolInformation -> DSResult
DSSymbolInformation (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' (DSDocumentSymbols List DocumentSymbol
dss) = List DocumentSymbol -> DSResult
DSDocumentSymbols List DocumentSymbol
dss -- no file locations here
      in DocumentSymbolsResponse -> FromServerMessage
RspDocumentSymbols (DocumentSymbolsResponse -> FromServerMessage)
-> DocumentSymbolsResponse -> FromServerMessage
forall a b. (a -> b) -> a -> b
$ DocumentSymbolsResponse
r DocumentSymbolsResponse
-> (DocumentSymbolsResponse -> DocumentSymbolsResponse)
-> DocumentSymbolsResponse
forall a b. a -> (a -> b) -> b
& (Either ResponseError DSResult
 -> Identity (Either ResponseError DSResult))
-> DocumentSymbolsResponse -> Identity DocumentSymbolsResponse
forall s a. HasResult s a => Lens' s a
result ((Either ResponseError DSResult
  -> Identity (Either ResponseError DSResult))
 -> DocumentSymbolsResponse -> Identity DocumentSymbolsResponse)
-> (Either ResponseError DSResult -> Either ResponseError DSResult)
-> DocumentSymbolsResponse
-> DocumentSymbolsResponse
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((DSResult -> DSResult)
-> Either ResponseError DSResult -> Either ResponseError DSResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DSResult -> DSResult
swapUri')

    fromServerMsg (RspRename RenameResponse
r) = RenameResponse -> FromServerMessage
RspRename (RenameResponse -> FromServerMessage)
-> RenameResponse -> FromServerMessage
forall a b. (a -> b) -> a -> b
$ RenameResponse
r RenameResponse
-> (RenameResponse -> RenameResponse) -> RenameResponse
forall a b. a -> (a -> b) -> b
& (Either ResponseError WorkspaceEdit
 -> Identity (Either ResponseError WorkspaceEdit))
-> RenameResponse -> Identity RenameResponse
forall s a. HasResult s a => Lens' s a
result ((Either ResponseError WorkspaceEdit
  -> Identity (Either ResponseError WorkspaceEdit))
 -> RenameResponse -> Identity RenameResponse)
-> (Either ResponseError WorkspaceEdit
    -> Either ResponseError WorkspaceEdit)
-> RenameResponse
-> RenameResponse
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 newDocChanges :: Maybe (List TextDocumentEdit)
newDocChanges = (List TextDocumentEdit -> List TextDocumentEdit)
-> Maybe (List TextDocumentEdit) -> Maybe (List TextDocumentEdit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TextDocumentEdit -> TextDocumentEdit)
-> List TextDocumentEdit -> List TextDocumentEdit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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)) (Maybe (List TextDocumentEdit) -> Maybe (List TextDocumentEdit))
-> Maybe (List TextDocumentEdit) -> Maybe (List TextDocumentEdit)
forall a b. (a -> b) -> a -> b
$ WorkspaceEdit
e WorkspaceEdit
-> Getting
     (Maybe (List TextDocumentEdit))
     WorkspaceEdit
     (Maybe (List TextDocumentEdit))
-> Maybe (List TextDocumentEdit)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (List TextDocumentEdit))
  WorkspaceEdit
  (Maybe (List TextDocumentEdit))
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 TextDocumentEdit) -> WorkspaceEdit
WorkspaceEdit Maybe (HashMap Uri (List TextEdit))
newChanges Maybe (List TextDocumentEdit)
newDocChanges

    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