{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
module Language.LSP.VFS (
VFS (..),
vfsMap,
VirtualFile (..),
lsp_version,
file_version,
file_text,
virtualFileText,
virtualFileVersion,
VfsLog (..),
emptyVFS,
openVFS,
changeFromClientVFS,
changeFromServerVFS,
persistFileVFS,
closeVFS,
CodePointPosition (..),
line,
character,
codePointPositionToPosition,
positionToCodePointPosition,
CodePointRange (..),
start,
end,
codePointRangeToRange,
rangeToCodePointRange,
rangeLinesFromVfs,
applyChanges,
applyChange,
changeChars,
) where
import Colog.Core (LogAction (..), Severity (..), WithSeverity (..), (<&))
import Control.Lens hiding (parts, (<.>))
import Control.Monad
import Control.Monad.State
import Data.Foldable (traverse_)
import Data.Hashable
import Data.Int (Int32)
import Data.List
import Data.Map.Strict qualified as Map
import Data.Ord
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Text.Utf16.Lines as Utf16 (Position (..))
import Data.Text.Utf16.Rope.Mixed (Rope)
import Data.Text.Utf16.Rope.Mixed qualified as Rope
import Language.LSP.Protocol.Lens qualified as J
import Language.LSP.Protocol.Message qualified as J
import Language.LSP.Protocol.Types qualified as J
import Prettyprinter hiding (line)
import System.Directory
import System.FilePath
import System.IO
{-# ANN module ("hlint: ignore Eta reduce" :: String) #-}
{-# ANN module ("hlint: ignore Redundant do" :: String) #-}
data VirtualFile = VirtualFile
{ VirtualFile -> Int32
_lsp_version :: !Int32
, VirtualFile -> Int
_file_version :: !Int
, VirtualFile -> Rope
_file_text :: !Rope
}
deriving (Int -> VirtualFile -> ShowS
[VirtualFile] -> ShowS
VirtualFile -> [Char]
(Int -> VirtualFile -> ShowS)
-> (VirtualFile -> [Char])
-> ([VirtualFile] -> ShowS)
-> Show VirtualFile
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VirtualFile -> ShowS
showsPrec :: Int -> VirtualFile -> ShowS
$cshow :: VirtualFile -> [Char]
show :: VirtualFile -> [Char]
$cshowList :: [VirtualFile] -> ShowS
showList :: [VirtualFile] -> ShowS
Show)
data VFS = VFS
{ VFS -> Map NormalizedUri VirtualFile
_vfsMap :: !(Map.Map J.NormalizedUri VirtualFile)
}
deriving (Int -> VFS -> ShowS
[VFS] -> ShowS
VFS -> [Char]
(Int -> VFS -> ShowS)
-> (VFS -> [Char]) -> ([VFS] -> ShowS) -> Show VFS
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VFS -> ShowS
showsPrec :: Int -> VFS -> ShowS
$cshow :: VFS -> [Char]
show :: VFS -> [Char]
$cshowList :: [VFS] -> ShowS
showList :: [VFS] -> ShowS
Show)
data VfsLog
= SplitInsideCodePoint Utf16.Position Rope
| URINotFound J.NormalizedUri
| Opening J.NormalizedUri
| Closing J.NormalizedUri
| PersistingFile J.NormalizedUri FilePath
| CantRecursiveDelete J.NormalizedUri
| DeleteNonExistent J.NormalizedUri
deriving (Int -> VfsLog -> ShowS
[VfsLog] -> ShowS
VfsLog -> [Char]
(Int -> VfsLog -> ShowS)
-> (VfsLog -> [Char]) -> ([VfsLog] -> ShowS) -> Show VfsLog
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VfsLog -> ShowS
showsPrec :: Int -> VfsLog -> ShowS
$cshow :: VfsLog -> [Char]
show :: VfsLog -> [Char]
$cshowList :: [VfsLog] -> ShowS
showList :: [VfsLog] -> ShowS
Show)
instance Pretty VfsLog where
pretty :: forall ann. VfsLog -> Doc ann
pretty (SplitInsideCodePoint Position
pos Rope
r) =
Doc ann
"VFS: asked to make change inside code point. Position" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Position -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow Position
pos Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"in" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Rope -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow Rope
r
pretty (URINotFound NormalizedUri
uri) = Doc ann
"VFS: don't know about URI" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> NormalizedUri -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. NormalizedUri -> Doc ann
pretty NormalizedUri
uri
pretty (Opening NormalizedUri
uri) = Doc ann
"VFS: opening" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> NormalizedUri -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. NormalizedUri -> Doc ann
pretty NormalizedUri
uri
pretty (Closing NormalizedUri
uri) = Doc ann
"VFS: closing" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> NormalizedUri -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. NormalizedUri -> Doc ann
pretty NormalizedUri
uri
pretty (PersistingFile NormalizedUri
uri [Char]
fp) = Doc ann
"VFS: Writing virtual file for" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> NormalizedUri -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. NormalizedUri -> Doc ann
pretty NormalizedUri
uri Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"to" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Char] -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow [Char]
fp
pretty (CantRecursiveDelete NormalizedUri
uri) =
Doc ann
"VFS: can't recursively delete" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> NormalizedUri -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. NormalizedUri -> Doc ann
pretty NormalizedUri
uri Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"because we don't track directory status"
pretty (DeleteNonExistent NormalizedUri
uri) = Doc ann
"VFS: asked to delete non-existent file" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> NormalizedUri -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. NormalizedUri -> Doc ann
pretty NormalizedUri
uri
makeFieldsNoPrefix ''VirtualFile
makeFieldsNoPrefix ''VFS
virtualFileText :: VirtualFile -> Text
virtualFileText :: VirtualFile -> Text
virtualFileText VirtualFile
vf = Rope -> Text
Rope.toText (VirtualFile -> Rope
_file_text VirtualFile
vf)
virtualFileVersion :: VirtualFile -> Int32
virtualFileVersion :: VirtualFile -> Int32
virtualFileVersion VirtualFile
vf = VirtualFile -> Int32
_lsp_version VirtualFile
vf
emptyVFS :: VFS
emptyVFS :: VFS
emptyVFS = Map NormalizedUri VirtualFile -> VFS
VFS Map NormalizedUri VirtualFile
forall a. Monoid a => a
mempty
openVFS :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.TMessage 'J.Method_TextDocumentDidOpen -> m ()
openVFS :: forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> TMessage
@'ClientToServer @'Notification 'Method_TextDocumentDidOpen
-> m ()
openVFS LogAction m (WithSeverity VfsLog)
logger TMessage
@'ClientToServer @'Notification 'Method_TextDocumentDidOpen
msg = do
let J.TextDocumentItem (Uri -> NormalizedUri
J.toNormalizedUri -> NormalizedUri
uri) LanguageKind
_ Int32
version Text
text = TMessage
@'ClientToServer @'Notification 'Method_TextDocumentDidOpen
TNotificationMessage @'ClientToServer 'Method_TextDocumentDidOpen
msg TNotificationMessage @'ClientToServer 'Method_TextDocumentDidOpen
-> Getting
TextDocumentItem
(TNotificationMessage @'ClientToServer 'Method_TextDocumentDidOpen)
TextDocumentItem
-> TextDocumentItem
forall s a. s -> Getting a s a -> a
^. (DidOpenTextDocumentParams
-> Const @(*) TextDocumentItem DidOpenTextDocumentParams)
-> TNotificationMessage
@'ClientToServer 'Method_TextDocumentDidOpen
-> Const
@(*)
TextDocumentItem
(TNotificationMessage @'ClientToServer 'Method_TextDocumentDidOpen)
forall s a. HasParams s a => Lens' s a
Lens'
(TNotificationMessage @'ClientToServer 'Method_TextDocumentDidOpen)
DidOpenTextDocumentParams
J.params ((DidOpenTextDocumentParams
-> Const @(*) TextDocumentItem DidOpenTextDocumentParams)
-> TNotificationMessage
@'ClientToServer 'Method_TextDocumentDidOpen
-> Const
@(*)
TextDocumentItem
(TNotificationMessage
@'ClientToServer 'Method_TextDocumentDidOpen))
-> ((TextDocumentItem
-> Const @(*) TextDocumentItem TextDocumentItem)
-> DidOpenTextDocumentParams
-> Const @(*) TextDocumentItem DidOpenTextDocumentParams)
-> Getting
TextDocumentItem
(TNotificationMessage @'ClientToServer 'Method_TextDocumentDidOpen)
TextDocumentItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentItem -> Const @(*) TextDocumentItem TextDocumentItem)
-> DidOpenTextDocumentParams
-> Const @(*) TextDocumentItem DidOpenTextDocumentParams
forall s a. HasTextDocument s a => Lens' s a
Lens' DidOpenTextDocumentParams TextDocumentItem
J.textDocument
vfile :: VirtualFile
vfile = Int32 -> Int -> Rope -> VirtualFile
VirtualFile Int32
version Int
0 (Text -> Rope
Rope.fromText Text
text)
LogAction m (WithSeverity VfsLog)
logger LogAction m (WithSeverity VfsLog) -> WithSeverity VfsLog -> m ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& NormalizedUri -> VfsLog
Opening NormalizedUri
uri VfsLog -> Severity -> WithSeverity VfsLog
forall msg. msg -> Severity -> WithSeverity msg
`WithSeverity` Severity
Debug
(Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> VFS -> Identity VFS
forall s a. HasVfsMap s a => Lens' s a
Lens' VFS (Map NormalizedUri VirtualFile)
vfsMap ((Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> VFS -> Identity VFS)
-> ((Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe VirtualFile))
-> Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> (Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe VirtualFile))
-> VFS
-> Identity VFS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NormalizedUri VirtualFile)
-> Lens'
(Map NormalizedUri VirtualFile)
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NormalizedUri VirtualFile)
NormalizedUri
uri ((Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe VirtualFile))
-> VFS -> Identity VFS)
-> Maybe VirtualFile -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= VirtualFile -> Maybe VirtualFile
forall a. a -> Maybe a
Just VirtualFile
vfile
changeFromClientVFS :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.TMessage 'J.Method_TextDocumentDidChange -> m ()
changeFromClientVFS :: forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> TMessage
@'ClientToServer @'Notification 'Method_TextDocumentDidChange
-> m ()
changeFromClientVFS LogAction m (WithSeverity VfsLog)
logger TMessage
@'ClientToServer @'Notification 'Method_TextDocumentDidChange
msg = do
let
J.DidChangeTextDocumentParams VersionedTextDocumentIdentifier
vid [TextDocumentContentChangeEvent]
changes = TMessage
@'ClientToServer @'Notification 'Method_TextDocumentDidChange
TNotificationMessage @'ClientToServer 'Method_TextDocumentDidChange
msg TNotificationMessage @'ClientToServer 'Method_TextDocumentDidChange
-> Getting
DidChangeTextDocumentParams
(TNotificationMessage
@'ClientToServer 'Method_TextDocumentDidChange)
DidChangeTextDocumentParams
-> DidChangeTextDocumentParams
forall s a. s -> Getting a s a -> a
^. Getting
DidChangeTextDocumentParams
(TNotificationMessage
@'ClientToServer 'Method_TextDocumentDidChange)
DidChangeTextDocumentParams
forall s a. HasParams s a => Lens' s a
Lens'
(TNotificationMessage
@'ClientToServer 'Method_TextDocumentDidChange)
DidChangeTextDocumentParams
J.params
J.VersionedTextDocumentIdentifier (Uri -> NormalizedUri
J.toNormalizedUri -> NormalizedUri
uri) Int32
version = VersionedTextDocumentIdentifier
vid
VFS
vfs <- m VFS
forall s (m :: * -> *). MonadState s m => m s
get
case VFS
vfs VFS
-> Getting (Maybe VirtualFile) VFS (Maybe VirtualFile)
-> Maybe VirtualFile
forall s a. s -> Getting a s a -> a
^. (Map NormalizedUri VirtualFile
-> Const @(*) (Maybe VirtualFile) (Map NormalizedUri VirtualFile))
-> VFS -> Const @(*) (Maybe VirtualFile) VFS
forall s a. HasVfsMap s a => Lens' s a
Lens' VFS (Map NormalizedUri VirtualFile)
vfsMap ((Map NormalizedUri VirtualFile
-> Const @(*) (Maybe VirtualFile) (Map NormalizedUri VirtualFile))
-> VFS -> Const @(*) (Maybe VirtualFile) VFS)
-> ((Maybe VirtualFile
-> Const @(*) (Maybe VirtualFile) (Maybe VirtualFile))
-> Map NormalizedUri VirtualFile
-> Const @(*) (Maybe VirtualFile) (Map NormalizedUri VirtualFile))
-> Getting (Maybe VirtualFile) VFS (Maybe VirtualFile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NormalizedUri VirtualFile)
-> Lens'
(Map NormalizedUri VirtualFile)
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NormalizedUri VirtualFile)
NormalizedUri
uri of
Just (VirtualFile Int32
_ Int
file_ver Rope
contents) -> do
Rope
contents' <- LogAction m (WithSeverity VfsLog)
-> Rope -> [TextDocumentContentChangeEvent] -> m Rope
forall (m :: * -> *).
Monad m =>
LogAction m (WithSeverity VfsLog)
-> Rope -> [TextDocumentContentChangeEvent] -> m Rope
applyChanges LogAction m (WithSeverity VfsLog)
logger Rope
contents [TextDocumentContentChangeEvent]
changes
(Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> VFS -> Identity VFS
forall s a. HasVfsMap s a => Lens' s a
Lens' VFS (Map NormalizedUri VirtualFile)
vfsMap ((Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> VFS -> Identity VFS)
-> ((Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe VirtualFile))
-> Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> (Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe VirtualFile))
-> VFS
-> Identity VFS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NormalizedUri VirtualFile)
-> Lens'
(Map NormalizedUri VirtualFile)
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NormalizedUri VirtualFile)
NormalizedUri
uri ((Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe VirtualFile))
-> VFS -> Identity VFS)
-> Maybe VirtualFile -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= VirtualFile -> Maybe VirtualFile
forall a. a -> Maybe a
Just (Int32 -> Int -> Rope -> VirtualFile
VirtualFile Int32
version (Int
file_ver Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Rope
contents')
Maybe VirtualFile
Nothing -> LogAction m (WithSeverity VfsLog)
logger LogAction m (WithSeverity VfsLog) -> WithSeverity VfsLog -> m ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& NormalizedUri -> VfsLog
URINotFound NormalizedUri
uri VfsLog -> Severity -> WithSeverity VfsLog
forall msg. msg -> Severity -> WithSeverity msg
`WithSeverity` Severity
Warning
applyCreateFile :: (MonadState VFS m) => J.CreateFile -> m ()
applyCreateFile :: forall (m :: * -> *). MonadState VFS m => CreateFile -> m ()
applyCreateFile (J.CreateFile Maybe ChangeAnnotationIdentifier
_ann AString "create"
_kind (Uri -> NormalizedUri
J.toNormalizedUri -> NormalizedUri
uri) Maybe CreateFileOptions
options) =
(Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> VFS -> Identity VFS
forall s a. HasVfsMap s a => Lens' s a
Lens' VFS (Map NormalizedUri VirtualFile)
vfsMap
((Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> VFS -> Identity VFS)
-> (Map NormalizedUri VirtualFile -> Map NormalizedUri VirtualFile)
-> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (VirtualFile -> VirtualFile -> VirtualFile)
-> NormalizedUri
-> VirtualFile
-> Map NormalizedUri VirtualFile
-> Map NormalizedUri VirtualFile
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith
(\VirtualFile
new VirtualFile
old -> if Bool
shouldOverwrite then VirtualFile
new else VirtualFile
old)
NormalizedUri
uri
(Int32 -> Int -> Rope -> VirtualFile
VirtualFile Int32
0 Int
0 Rope
forall a. Monoid a => a
mempty)
where
shouldOverwrite :: Bool
shouldOverwrite :: Bool
shouldOverwrite = case Maybe CreateFileOptions
options of
Maybe CreateFileOptions
Nothing -> Bool
False
Just (J.CreateFileOptions Maybe Bool
Nothing Maybe Bool
Nothing) -> Bool
False
Just (J.CreateFileOptions Maybe Bool
Nothing (Just Bool
True)) -> Bool
False
Just (J.CreateFileOptions Maybe Bool
Nothing (Just Bool
False)) -> Bool
True
Just (J.CreateFileOptions (Just Bool
True) Maybe Bool
Nothing) -> Bool
True
Just (J.CreateFileOptions (Just Bool
True) (Just Bool
True)) -> Bool
True
Just (J.CreateFileOptions (Just Bool
True) (Just Bool
False)) -> Bool
True
Just (J.CreateFileOptions (Just Bool
False) Maybe Bool
Nothing) -> Bool
False
Just (J.CreateFileOptions (Just Bool
False) (Just Bool
True)) -> Bool
False
Just (J.CreateFileOptions (Just Bool
False) (Just Bool
False)) -> Bool
False
applyRenameFile :: (MonadState VFS m) => J.RenameFile -> m ()
applyRenameFile :: forall (m :: * -> *). MonadState VFS m => RenameFile -> m ()
applyRenameFile (J.RenameFile Maybe ChangeAnnotationIdentifier
_ann AString "rename"
_kind (Uri -> NormalizedUri
J.toNormalizedUri -> NormalizedUri
oldUri) (Uri -> NormalizedUri
J.toNormalizedUri -> NormalizedUri
newUri) Maybe RenameFileOptions
options) = do
VFS
vfs <- m VFS
forall s (m :: * -> *). MonadState s m => m s
get
case VFS
vfs VFS
-> Getting
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
VFS
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
-> Maybe (IxValue (Map NormalizedUri VirtualFile))
forall s a. s -> Getting a s a -> a
^. (Map NormalizedUri VirtualFile
-> Const
@(*)
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
(Map NormalizedUri VirtualFile))
-> VFS
-> Const @(*) (Maybe (IxValue (Map NormalizedUri VirtualFile))) VFS
forall s a. HasVfsMap s a => Lens' s a
Lens' VFS (Map NormalizedUri VirtualFile)
vfsMap ((Map NormalizedUri VirtualFile
-> Const
@(*)
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
(Map NormalizedUri VirtualFile))
-> VFS
-> Const
@(*) (Maybe (IxValue (Map NormalizedUri VirtualFile))) VFS)
-> ((Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Const
@(*)
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
(Maybe (IxValue (Map NormalizedUri VirtualFile))))
-> Map NormalizedUri VirtualFile
-> Const
@(*)
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
(Map NormalizedUri VirtualFile))
-> Getting
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
VFS
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NormalizedUri VirtualFile)
-> Lens'
(Map NormalizedUri VirtualFile)
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NormalizedUri VirtualFile)
NormalizedUri
oldUri of
Maybe (IxValue (Map NormalizedUri VirtualFile))
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just IxValue (Map NormalizedUri VirtualFile)
file -> case VFS
vfs VFS
-> Getting
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
VFS
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
-> Maybe (IxValue (Map NormalizedUri VirtualFile))
forall s a. s -> Getting a s a -> a
^. (Map NormalizedUri VirtualFile
-> Const
@(*)
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
(Map NormalizedUri VirtualFile))
-> VFS
-> Const @(*) (Maybe (IxValue (Map NormalizedUri VirtualFile))) VFS
forall s a. HasVfsMap s a => Lens' s a
Lens' VFS (Map NormalizedUri VirtualFile)
vfsMap ((Map NormalizedUri VirtualFile
-> Const
@(*)
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
(Map NormalizedUri VirtualFile))
-> VFS
-> Const
@(*) (Maybe (IxValue (Map NormalizedUri VirtualFile))) VFS)
-> ((Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Const
@(*)
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
(Maybe (IxValue (Map NormalizedUri VirtualFile))))
-> Map NormalizedUri VirtualFile
-> Const
@(*)
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
(Map NormalizedUri VirtualFile))
-> Getting
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
VFS
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NormalizedUri VirtualFile)
-> Lens'
(Map NormalizedUri VirtualFile)
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NormalizedUri VirtualFile)
NormalizedUri
newUri of
Maybe (IxValue (Map NormalizedUri VirtualFile))
Nothing -> do
(Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> VFS -> Identity VFS
forall s a. HasVfsMap s a => Lens' s a
Lens' VFS (Map NormalizedUri VirtualFile)
vfsMap ((Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> VFS -> Identity VFS)
-> ((Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe (IxValue (Map NormalizedUri VirtualFile))))
-> Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> (Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe (IxValue (Map NormalizedUri VirtualFile))))
-> VFS
-> Identity VFS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NormalizedUri VirtualFile)
-> Lens'
(Map NormalizedUri VirtualFile)
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NormalizedUri VirtualFile)
NormalizedUri
oldUri ((Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe (IxValue (Map NormalizedUri VirtualFile))))
-> VFS -> Identity VFS)
-> Maybe (IxValue (Map NormalizedUri VirtualFile)) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (IxValue (Map NormalizedUri VirtualFile))
forall a. Maybe a
Nothing
(Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> VFS -> Identity VFS
forall s a. HasVfsMap s a => Lens' s a
Lens' VFS (Map NormalizedUri VirtualFile)
vfsMap ((Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> VFS -> Identity VFS)
-> ((Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe (IxValue (Map NormalizedUri VirtualFile))))
-> Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> (Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe (IxValue (Map NormalizedUri VirtualFile))))
-> VFS
-> Identity VFS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NormalizedUri VirtualFile)
-> Lens'
(Map NormalizedUri VirtualFile)
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NormalizedUri VirtualFile)
NormalizedUri
newUri ((Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe (IxValue (Map NormalizedUri VirtualFile))))
-> VFS -> Identity VFS)
-> Maybe (IxValue (Map NormalizedUri VirtualFile)) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= IxValue (Map NormalizedUri VirtualFile)
-> Maybe (IxValue (Map NormalizedUri VirtualFile))
forall a. a -> Maybe a
Just IxValue (Map NormalizedUri VirtualFile)
file
Just IxValue (Map NormalizedUri VirtualFile)
_ -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldOverwrite (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
(Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> VFS -> Identity VFS
forall s a. HasVfsMap s a => Lens' s a
Lens' VFS (Map NormalizedUri VirtualFile)
vfsMap ((Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> VFS -> Identity VFS)
-> ((Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe (IxValue (Map NormalizedUri VirtualFile))))
-> Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> (Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe (IxValue (Map NormalizedUri VirtualFile))))
-> VFS
-> Identity VFS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NormalizedUri VirtualFile)
-> Lens'
(Map NormalizedUri VirtualFile)
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NormalizedUri VirtualFile)
NormalizedUri
oldUri ((Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe (IxValue (Map NormalizedUri VirtualFile))))
-> VFS -> Identity VFS)
-> Maybe (IxValue (Map NormalizedUri VirtualFile)) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (IxValue (Map NormalizedUri VirtualFile))
forall a. Maybe a
Nothing
(Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> VFS -> Identity VFS
forall s a. HasVfsMap s a => Lens' s a
Lens' VFS (Map NormalizedUri VirtualFile)
vfsMap ((Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> VFS -> Identity VFS)
-> ((Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe (IxValue (Map NormalizedUri VirtualFile))))
-> Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> (Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe (IxValue (Map NormalizedUri VirtualFile))))
-> VFS
-> Identity VFS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NormalizedUri VirtualFile)
-> Lens'
(Map NormalizedUri VirtualFile)
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NormalizedUri VirtualFile)
NormalizedUri
newUri ((Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe (IxValue (Map NormalizedUri VirtualFile))))
-> VFS -> Identity VFS)
-> Maybe (IxValue (Map NormalizedUri VirtualFile)) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= IxValue (Map NormalizedUri VirtualFile)
-> Maybe (IxValue (Map NormalizedUri VirtualFile))
forall a. a -> Maybe a
Just IxValue (Map NormalizedUri VirtualFile)
file
where
shouldOverwrite :: Bool
shouldOverwrite :: Bool
shouldOverwrite = case Maybe RenameFileOptions
options of
Maybe RenameFileOptions
Nothing -> Bool
False
Just (J.RenameFileOptions Maybe Bool
Nothing Maybe Bool
Nothing) -> Bool
False
Just (J.RenameFileOptions Maybe Bool
Nothing (Just Bool
True)) -> Bool
False
Just (J.RenameFileOptions Maybe Bool
Nothing (Just Bool
False)) -> Bool
True
Just (J.RenameFileOptions (Just Bool
True) Maybe Bool
Nothing) -> Bool
True
Just (J.RenameFileOptions (Just Bool
True) (Just Bool
True)) -> Bool
True
Just (J.RenameFileOptions (Just Bool
True) (Just Bool
False)) -> Bool
True
Just (J.RenameFileOptions (Just Bool
False) Maybe Bool
Nothing) -> Bool
False
Just (J.RenameFileOptions (Just Bool
False) (Just Bool
True)) -> Bool
False
Just (J.RenameFileOptions (Just Bool
False) (Just Bool
False)) -> Bool
False
applyDeleteFile :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.DeleteFile -> m ()
applyDeleteFile :: forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog) -> DeleteFile -> m ()
applyDeleteFile LogAction m (WithSeverity VfsLog)
logger (J.DeleteFile Maybe ChangeAnnotationIdentifier
_ann AString "delete"
_kind (Uri -> NormalizedUri
J.toNormalizedUri -> NormalizedUri
uri) Maybe DeleteFileOptions
options) = do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe DeleteFileOptions
options Maybe DeleteFileOptions
-> Getting (First Bool) (Maybe DeleteFileOptions) Bool
-> Maybe Bool
forall s a. s -> Getting (First a) s a -> Maybe a
^? (DeleteFileOptions -> Const @(*) (First Bool) DeleteFileOptions)
-> Maybe DeleteFileOptions
-> Const @(*) (First Bool) (Maybe DeleteFileOptions)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((DeleteFileOptions -> Const @(*) (First Bool) DeleteFileOptions)
-> Maybe DeleteFileOptions
-> Const @(*) (First Bool) (Maybe DeleteFileOptions))
-> ((Bool -> Const @(*) (First Bool) Bool)
-> DeleteFileOptions -> Const @(*) (First Bool) DeleteFileOptions)
-> Getting (First Bool) (Maybe DeleteFileOptions) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Bool -> Const @(*) (First Bool) (Maybe Bool))
-> DeleteFileOptions -> Const @(*) (First Bool) DeleteFileOptions
forall s a. HasRecursive s a => Lens' s a
Lens' DeleteFileOptions (Maybe Bool)
J.recursive ((Maybe Bool -> Const @(*) (First Bool) (Maybe Bool))
-> DeleteFileOptions -> Const @(*) (First Bool) DeleteFileOptions)
-> ((Bool -> Const @(*) (First Bool) Bool)
-> Maybe Bool -> Const @(*) (First Bool) (Maybe Bool))
-> (Bool -> Const @(*) (First Bool) Bool)
-> DeleteFileOptions
-> Const @(*) (First Bool) DeleteFileOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const @(*) (First Bool) Bool)
-> Maybe Bool -> Const @(*) (First Bool) (Maybe Bool)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
LogAction m (WithSeverity VfsLog)
logger LogAction m (WithSeverity VfsLog) -> WithSeverity VfsLog -> m ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& NormalizedUri -> VfsLog
CantRecursiveDelete NormalizedUri
uri VfsLog -> Severity -> WithSeverity VfsLog
forall msg. msg -> Severity -> WithSeverity msg
`WithSeverity` Severity
Warning
Maybe (IxValue (Map NormalizedUri VirtualFile))
old <- (Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> VFS -> Identity VFS
forall s a. HasVfsMap s a => Lens' s a
Lens' VFS (Map NormalizedUri VirtualFile)
vfsMap ((Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> VFS -> Identity VFS)
-> ((Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe (IxValue (Map NormalizedUri VirtualFile))))
-> Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> (Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe (IxValue (Map NormalizedUri VirtualFile))))
-> VFS
-> Identity VFS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NormalizedUri VirtualFile)
-> Lens'
(Map NormalizedUri VirtualFile)
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NormalizedUri VirtualFile)
NormalizedUri
uri ((Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe (IxValue (Map NormalizedUri VirtualFile))))
-> VFS -> Identity VFS)
-> Maybe (IxValue (Map NormalizedUri VirtualFile))
-> m (Maybe (IxValue (Map NormalizedUri VirtualFile)))
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m b
<.= Maybe (IxValue (Map NormalizedUri VirtualFile))
forall a. Maybe a
Nothing
case Maybe (IxValue (Map NormalizedUri VirtualFile))
old of
Maybe (IxValue (Map NormalizedUri VirtualFile))
Nothing
| Maybe DeleteFileOptions
options Maybe DeleteFileOptions
-> Getting (First Bool) (Maybe DeleteFileOptions) Bool
-> Maybe Bool
forall s a. s -> Getting (First a) s a -> Maybe a
^? (DeleteFileOptions -> Const @(*) (First Bool) DeleteFileOptions)
-> Maybe DeleteFileOptions
-> Const @(*) (First Bool) (Maybe DeleteFileOptions)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((DeleteFileOptions -> Const @(*) (First Bool) DeleteFileOptions)
-> Maybe DeleteFileOptions
-> Const @(*) (First Bool) (Maybe DeleteFileOptions))
-> ((Bool -> Const @(*) (First Bool) Bool)
-> DeleteFileOptions -> Const @(*) (First Bool) DeleteFileOptions)
-> Getting (First Bool) (Maybe DeleteFileOptions) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Bool -> Const @(*) (First Bool) (Maybe Bool))
-> DeleteFileOptions -> Const @(*) (First Bool) DeleteFileOptions
forall s a. HasIgnoreIfNotExists s a => Lens' s a
Lens' DeleteFileOptions (Maybe Bool)
J.ignoreIfNotExists ((Maybe Bool -> Const @(*) (First Bool) (Maybe Bool))
-> DeleteFileOptions -> Const @(*) (First Bool) DeleteFileOptions)
-> ((Bool -> Const @(*) (First Bool) Bool)
-> Maybe Bool -> Const @(*) (First Bool) (Maybe Bool))
-> (Bool -> Const @(*) (First Bool) Bool)
-> DeleteFileOptions
-> Const @(*) (First Bool) DeleteFileOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const @(*) (First Bool) Bool)
-> Maybe Bool -> Const @(*) (First Bool) (Maybe Bool)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True ->
LogAction m (WithSeverity VfsLog)
logger LogAction m (WithSeverity VfsLog) -> WithSeverity VfsLog -> m ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& NormalizedUri -> VfsLog
CantRecursiveDelete NormalizedUri
uri VfsLog -> Severity -> WithSeverity VfsLog
forall msg. msg -> Severity -> WithSeverity msg
`WithSeverity` Severity
Warning
Maybe (IxValue (Map NormalizedUri VirtualFile))
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
applyTextDocumentEdit :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.TextDocumentEdit -> m ()
applyTextDocumentEdit :: forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog) -> TextDocumentEdit -> m ()
applyTextDocumentEdit LogAction m (WithSeverity VfsLog)
logger (J.TextDocumentEdit OptionalVersionedTextDocumentIdentifier
vid [TextEdit |? AnnotatedTextEdit]
edits) = do
let sortedEdits :: [TextEdit |? AnnotatedTextEdit]
sortedEdits = ((TextEdit |? AnnotatedTextEdit) -> Down Range)
-> [TextEdit |? AnnotatedTextEdit]
-> [TextEdit |? AnnotatedTextEdit]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Range -> Down Range
forall a. a -> Down a
Down (Range -> Down Range)
-> ((TextEdit |? AnnotatedTextEdit) -> Range)
-> (TextEdit |? AnnotatedTextEdit)
-> Down Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextEdit |? AnnotatedTextEdit) -> Range
editRange) [TextEdit |? AnnotatedTextEdit]
edits
changeEvents :: [TextDocumentContentChangeEvent]
changeEvents = ((TextEdit |? AnnotatedTextEdit) -> TextDocumentContentChangeEvent)
-> [TextEdit |? AnnotatedTextEdit]
-> [TextDocumentContentChangeEvent]
forall a b. (a -> b) -> [a] -> [b]
map (TextEdit |? AnnotatedTextEdit) -> TextDocumentContentChangeEvent
editToChangeEvent [TextEdit |? AnnotatedTextEdit]
sortedEdits
vid' :: VersionedTextDocumentIdentifier
vid' = Uri -> Int32 -> VersionedTextDocumentIdentifier
J.VersionedTextDocumentIdentifier (OptionalVersionedTextDocumentIdentifier
vid OptionalVersionedTextDocumentIdentifier
-> Getting Uri OptionalVersionedTextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri OptionalVersionedTextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' OptionalVersionedTextDocumentIdentifier Uri
J.uri) (case OptionalVersionedTextDocumentIdentifier
vid OptionalVersionedTextDocumentIdentifier
-> Getting
(Int32 |? Null)
OptionalVersionedTextDocumentIdentifier
(Int32 |? Null)
-> Int32 |? Null
forall s a. s -> Getting a s a -> a
^. Getting
(Int32 |? Null)
OptionalVersionedTextDocumentIdentifier
(Int32 |? Null)
forall s a. HasVersion s a => Lens' s a
Lens' OptionalVersionedTextDocumentIdentifier (Int32 |? Null)
J.version of J.InL Int32
v -> Int32
v; J.InR Null
_ -> Int32
0)
ps :: DidChangeTextDocumentParams
ps = VersionedTextDocumentIdentifier
-> [TextDocumentContentChangeEvent] -> DidChangeTextDocumentParams
J.DidChangeTextDocumentParams VersionedTextDocumentIdentifier
vid' [TextDocumentContentChangeEvent]
changeEvents
notif :: TNotificationMessage @'ClientToServer 'Method_TextDocumentDidChange
notif = Text
-> SMethod
@'ClientToServer @'Notification 'Method_TextDocumentDidChange
-> MessageParams
@'ClientToServer @'Notification 'Method_TextDocumentDidChange
-> TNotificationMessage
@'ClientToServer 'Method_TextDocumentDidChange
forall (f :: MessageDirection) (m :: Method f 'Notification).
Text
-> SMethod @f @'Notification m
-> MessageParams @f @'Notification m
-> TNotificationMessage @f m
J.TNotificationMessage Text
"" SMethod
@'ClientToServer @'Notification 'Method_TextDocumentDidChange
J.SMethod_TextDocumentDidChange DidChangeTextDocumentParams
MessageParams
@'ClientToServer @'Notification 'Method_TextDocumentDidChange
ps
LogAction m (WithSeverity VfsLog)
-> TMessage
@'ClientToServer @'Notification 'Method_TextDocumentDidChange
-> m ()
forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> TMessage
@'ClientToServer @'Notification 'Method_TextDocumentDidChange
-> m ()
changeFromClientVFS LogAction m (WithSeverity VfsLog)
logger TMessage
@'ClientToServer @'Notification 'Method_TextDocumentDidChange
TNotificationMessage @'ClientToServer 'Method_TextDocumentDidChange
notif
where
editRange :: J.TextEdit J.|? J.AnnotatedTextEdit -> J.Range
editRange :: (TextEdit |? AnnotatedTextEdit) -> Range
editRange (J.InR AnnotatedTextEdit
e) = AnnotatedTextEdit
e AnnotatedTextEdit -> Getting Range AnnotatedTextEdit Range -> Range
forall s a. s -> Getting a s a -> a
^. Getting Range AnnotatedTextEdit Range
forall s a. HasRange s a => Lens' s a
Lens' AnnotatedTextEdit Range
J.range
editRange (J.InL TextEdit
e) = TextEdit
e TextEdit -> Getting Range TextEdit Range -> Range
forall s a. s -> Getting a s a -> a
^. Getting Range TextEdit Range
forall s a. HasRange s a => Lens' s a
Lens' TextEdit Range
J.range
editToChangeEvent :: J.TextEdit J.|? J.AnnotatedTextEdit -> J.TextDocumentContentChangeEvent
editToChangeEvent :: (TextEdit |? AnnotatedTextEdit) -> TextDocumentContentChangeEvent
editToChangeEvent (J.InR AnnotatedTextEdit
e) = (TextDocumentContentChangePartial
|? TextDocumentContentChangeWholeDocument)
-> TextDocumentContentChangeEvent
J.TextDocumentContentChangeEvent ((TextDocumentContentChangePartial
|? TextDocumentContentChangeWholeDocument)
-> TextDocumentContentChangeEvent)
-> (TextDocumentContentChangePartial
|? TextDocumentContentChangeWholeDocument)
-> TextDocumentContentChangeEvent
forall a b. (a -> b) -> a -> b
$ TextDocumentContentChangePartial
-> TextDocumentContentChangePartial
|? TextDocumentContentChangeWholeDocument
forall a b. a -> a |? b
J.InL (TextDocumentContentChangePartial
-> TextDocumentContentChangePartial
|? TextDocumentContentChangeWholeDocument)
-> TextDocumentContentChangePartial
-> TextDocumentContentChangePartial
|? TextDocumentContentChangeWholeDocument
forall a b. (a -> b) -> a -> b
$ J.TextDocumentContentChangePartial{$sel:_range:TextDocumentContentChangePartial :: Range
_range = AnnotatedTextEdit
e AnnotatedTextEdit -> Getting Range AnnotatedTextEdit Range -> Range
forall s a. s -> Getting a s a -> a
^. Getting Range AnnotatedTextEdit Range
forall s a. HasRange s a => Lens' s a
Lens' AnnotatedTextEdit Range
J.range, $sel:_rangeLength:TextDocumentContentChangePartial :: Maybe UInt
_rangeLength = Maybe UInt
forall a. Maybe a
Nothing, $sel:_text:TextDocumentContentChangePartial :: Text
_text = AnnotatedTextEdit
e AnnotatedTextEdit -> Getting Text AnnotatedTextEdit Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text AnnotatedTextEdit Text
forall s a. HasNewText s a => Lens' s a
Lens' AnnotatedTextEdit Text
J.newText}
editToChangeEvent (J.InL TextEdit
e) = (TextDocumentContentChangePartial
|? TextDocumentContentChangeWholeDocument)
-> TextDocumentContentChangeEvent
J.TextDocumentContentChangeEvent ((TextDocumentContentChangePartial
|? TextDocumentContentChangeWholeDocument)
-> TextDocumentContentChangeEvent)
-> (TextDocumentContentChangePartial
|? TextDocumentContentChangeWholeDocument)
-> TextDocumentContentChangeEvent
forall a b. (a -> b) -> a -> b
$ TextDocumentContentChangePartial
-> TextDocumentContentChangePartial
|? TextDocumentContentChangeWholeDocument
forall a b. a -> a |? b
J.InL (TextDocumentContentChangePartial
-> TextDocumentContentChangePartial
|? TextDocumentContentChangeWholeDocument)
-> TextDocumentContentChangePartial
-> TextDocumentContentChangePartial
|? TextDocumentContentChangeWholeDocument
forall a b. (a -> b) -> a -> b
$ J.TextDocumentContentChangePartial{$sel:_range:TextDocumentContentChangePartial :: Range
_range = TextEdit
e TextEdit -> Getting Range TextEdit Range -> Range
forall s a. s -> Getting a s a -> a
^. Getting Range TextEdit Range
forall s a. HasRange s a => Lens' s a
Lens' TextEdit Range
J.range, $sel:_rangeLength:TextDocumentContentChangePartial :: Maybe UInt
_rangeLength = Maybe UInt
forall a. Maybe a
Nothing, $sel:_text:TextDocumentContentChangePartial :: Text
_text = TextEdit
e TextEdit -> Getting Text TextEdit Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text TextEdit Text
forall s a. HasNewText s a => Lens' s a
Lens' TextEdit Text
J.newText}
applyDocumentChange :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.DocumentChange -> m ()
applyDocumentChange :: forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog) -> DocumentChange -> m ()
applyDocumentChange LogAction m (WithSeverity VfsLog)
logger (J.InL TextDocumentEdit
change) = LogAction m (WithSeverity VfsLog) -> TextDocumentEdit -> m ()
forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog) -> TextDocumentEdit -> m ()
applyTextDocumentEdit LogAction m (WithSeverity VfsLog)
logger TextDocumentEdit
change
applyDocumentChange LogAction m (WithSeverity VfsLog)
_ (J.InR (J.InL CreateFile
change)) = CreateFile -> m ()
forall (m :: * -> *). MonadState VFS m => CreateFile -> m ()
applyCreateFile CreateFile
change
applyDocumentChange LogAction m (WithSeverity VfsLog)
_ (J.InR (J.InR (J.InL RenameFile
change))) = RenameFile -> m ()
forall (m :: * -> *). MonadState VFS m => RenameFile -> m ()
applyRenameFile RenameFile
change
applyDocumentChange LogAction m (WithSeverity VfsLog)
logger (J.InR (J.InR (J.InR DeleteFile
change))) = LogAction m (WithSeverity VfsLog) -> DeleteFile -> m ()
forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog) -> DeleteFile -> m ()
applyDeleteFile LogAction m (WithSeverity VfsLog)
logger DeleteFile
change
changeFromServerVFS :: forall m. MonadState VFS m => LogAction m (WithSeverity VfsLog) -> J.TMessage 'J.Method_WorkspaceApplyEdit -> m ()
changeFromServerVFS :: forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> TMessage @'ServerToClient @'Request 'Method_WorkspaceApplyEdit
-> m ()
changeFromServerVFS LogAction m (WithSeverity VfsLog)
logger TMessage @'ServerToClient @'Request 'Method_WorkspaceApplyEdit
msg = do
let J.ApplyWorkspaceEditParams Maybe Text
_label WorkspaceEdit
edit = TMessage @'ServerToClient @'Request 'Method_WorkspaceApplyEdit
TRequestMessage @'ServerToClient 'Method_WorkspaceApplyEdit
msg TRequestMessage @'ServerToClient 'Method_WorkspaceApplyEdit
-> Getting
ApplyWorkspaceEditParams
(TRequestMessage @'ServerToClient 'Method_WorkspaceApplyEdit)
ApplyWorkspaceEditParams
-> ApplyWorkspaceEditParams
forall s a. s -> Getting a s a -> a
^. Getting
ApplyWorkspaceEditParams
(TRequestMessage @'ServerToClient 'Method_WorkspaceApplyEdit)
ApplyWorkspaceEditParams
forall s a. HasParams s a => Lens' s a
Lens'
(TRequestMessage @'ServerToClient 'Method_WorkspaceApplyEdit)
ApplyWorkspaceEditParams
J.params
J.WorkspaceEdit Maybe (Map Uri [TextEdit])
mChanges Maybe [DocumentChange]
mDocChanges Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
_anns = WorkspaceEdit
edit
case Maybe [DocumentChange]
mDocChanges of
Just [DocumentChange]
docChanges -> [DocumentChange] -> m ()
applyDocumentChanges [DocumentChange]
docChanges
Maybe [DocumentChange]
Nothing -> case Maybe (Map Uri [TextEdit])
mChanges of
Just Map Uri [TextEdit]
cs -> [DocumentChange] -> m ()
applyDocumentChanges ([DocumentChange] -> m ()) -> [DocumentChange] -> m ()
forall a b. (a -> b) -> a -> b
$ (TextDocumentEdit -> DocumentChange)
-> [TextDocumentEdit] -> [DocumentChange]
forall a b. (a -> b) -> [a] -> [b]
map TextDocumentEdit -> DocumentChange
forall a b. a -> a |? b
J.InL ([TextDocumentEdit] -> [DocumentChange])
-> [TextDocumentEdit] -> [DocumentChange]
forall a b. (a -> b) -> a -> b
$ ([TextDocumentEdit] -> Uri -> [TextEdit] -> [TextDocumentEdit])
-> [TextDocumentEdit] -> Map Uri [TextEdit] -> [TextDocumentEdit]
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' [TextDocumentEdit] -> Uri -> [TextEdit] -> [TextDocumentEdit]
changeToTextDocumentEdit [] Map Uri [TextEdit]
cs
Maybe (Map Uri [TextEdit])
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where
changeToTextDocumentEdit :: [TextDocumentEdit] -> Uri -> [TextEdit] -> [TextDocumentEdit]
changeToTextDocumentEdit [TextDocumentEdit]
acc Uri
uri [TextEdit]
edits =
[TextDocumentEdit]
acc [TextDocumentEdit] -> [TextDocumentEdit] -> [TextDocumentEdit]
forall a. [a] -> [a] -> [a]
++ [OptionalVersionedTextDocumentIdentifier
-> [TextEdit |? AnnotatedTextEdit] -> TextDocumentEdit
J.TextDocumentEdit (Uri -> (Int32 |? Null) -> OptionalVersionedTextDocumentIdentifier
J.OptionalVersionedTextDocumentIdentifier Uri
uri (Int32 -> Int32 |? Null
forall a b. a -> a |? b
J.InL Int32
0)) ((TextEdit -> TextEdit |? AnnotatedTextEdit)
-> [TextEdit] -> [TextEdit |? AnnotatedTextEdit]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextEdit -> TextEdit |? AnnotatedTextEdit
forall a b. a -> a |? b
J.InL [TextEdit]
edits)]
applyDocumentChanges :: [J.DocumentChange] -> m ()
applyDocumentChanges :: [DocumentChange] -> m ()
applyDocumentChanges = (DocumentChange -> m ()) -> [DocumentChange] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (LogAction m (WithSeverity VfsLog) -> DocumentChange -> m ()
forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog) -> DocumentChange -> m ()
applyDocumentChange LogAction m (WithSeverity VfsLog)
logger) ([DocumentChange] -> m ())
-> ([DocumentChange] -> [DocumentChange])
-> [DocumentChange]
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DocumentChange -> Maybe Int32)
-> [DocumentChange] -> [DocumentChange]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn DocumentChange -> Maybe Int32
project
project :: J.DocumentChange -> Maybe J.Int32
project :: DocumentChange -> Maybe Int32
project (J.InL TextDocumentEdit
textDocumentEdit) = case TextDocumentEdit
textDocumentEdit TextDocumentEdit
-> Getting (Int32 |? Null) TextDocumentEdit (Int32 |? Null)
-> Int32 |? Null
forall s a. s -> Getting a s a -> a
^. (OptionalVersionedTextDocumentIdentifier
-> Const
@(*) (Int32 |? Null) OptionalVersionedTextDocumentIdentifier)
-> TextDocumentEdit -> Const @(*) (Int32 |? Null) TextDocumentEdit
forall s a. HasTextDocument s a => Lens' s a
Lens' TextDocumentEdit OptionalVersionedTextDocumentIdentifier
J.textDocument ((OptionalVersionedTextDocumentIdentifier
-> Const
@(*) (Int32 |? Null) OptionalVersionedTextDocumentIdentifier)
-> TextDocumentEdit -> Const @(*) (Int32 |? Null) TextDocumentEdit)
-> Getting
(Int32 |? Null)
OptionalVersionedTextDocumentIdentifier
(Int32 |? Null)
-> Getting (Int32 |? Null) TextDocumentEdit (Int32 |? Null)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
(Int32 |? Null)
OptionalVersionedTextDocumentIdentifier
(Int32 |? Null)
forall s a. HasVersion s a => Lens' s a
Lens' OptionalVersionedTextDocumentIdentifier (Int32 |? Null)
J.version of
J.InL Int32
v -> Int32 -> Maybe Int32
forall a. a -> Maybe a
Just Int32
v
Int32 |? Null
_ -> Maybe Int32
forall a. Maybe a
Nothing
project DocumentChange
_ = Maybe Int32
forall a. Maybe a
Nothing
virtualFileName :: FilePath -> J.NormalizedUri -> VirtualFile -> FilePath
virtualFileName :: [Char] -> NormalizedUri -> VirtualFile -> [Char]
virtualFileName [Char]
prefix NormalizedUri
uri (VirtualFile Int32
_ Int
file_ver Rope
_) =
let uri_raw :: Uri
uri_raw = NormalizedUri -> Uri
J.fromNormalizedUri NormalizedUri
uri
basename :: [Char]
basename = [Char] -> ShowS -> Maybe [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" ShowS
takeFileName (Uri -> Maybe [Char]
J.uriToFilePath Uri
uri_raw)
padLeft :: Int -> Int -> String
padLeft :: Int -> Int -> [Char]
padLeft Int
n Int
num =
let numString :: [Char]
numString = Int -> [Char]
forall a. Show a => a -> [Char]
show Int
num
in Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
numString) Char
'0' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
numString
in [Char]
prefix [Char] -> ShowS
</> [Char]
basename [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"-" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Int -> [Char]
padLeft Int
5 Int
file_ver [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"-" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Uri -> Int
forall a. Hashable a => a -> Int
hash Uri
uri_raw) [Char] -> ShowS
<.> ShowS
takeExtensions [Char]
basename
persistFileVFS :: (MonadIO m) => LogAction m (WithSeverity VfsLog) -> FilePath -> VFS -> J.NormalizedUri -> Maybe (FilePath, m ())
persistFileVFS :: forall (m :: * -> *).
MonadIO m =>
LogAction m (WithSeverity VfsLog)
-> [Char] -> VFS -> NormalizedUri -> Maybe ([Char], m ())
persistFileVFS LogAction m (WithSeverity VfsLog)
logger [Char]
dir VFS
vfs NormalizedUri
uri =
case VFS
vfs VFS
-> Getting (Maybe VirtualFile) VFS (Maybe VirtualFile)
-> Maybe VirtualFile
forall s a. s -> Getting a s a -> a
^. (Map NormalizedUri VirtualFile
-> Const @(*) (Maybe VirtualFile) (Map NormalizedUri VirtualFile))
-> VFS -> Const @(*) (Maybe VirtualFile) VFS
forall s a. HasVfsMap s a => Lens' s a
Lens' VFS (Map NormalizedUri VirtualFile)
vfsMap ((Map NormalizedUri VirtualFile
-> Const @(*) (Maybe VirtualFile) (Map NormalizedUri VirtualFile))
-> VFS -> Const @(*) (Maybe VirtualFile) VFS)
-> ((Maybe VirtualFile
-> Const @(*) (Maybe VirtualFile) (Maybe VirtualFile))
-> Map NormalizedUri VirtualFile
-> Const @(*) (Maybe VirtualFile) (Map NormalizedUri VirtualFile))
-> Getting (Maybe VirtualFile) VFS (Maybe VirtualFile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NormalizedUri VirtualFile)
-> Lens'
(Map NormalizedUri VirtualFile)
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NormalizedUri VirtualFile)
NormalizedUri
uri of
Maybe VirtualFile
Nothing -> Maybe ([Char], m ())
forall a. Maybe a
Nothing
Just VirtualFile
vf ->
let tfn :: [Char]
tfn = [Char] -> NormalizedUri -> VirtualFile -> [Char]
virtualFileName [Char]
dir NormalizedUri
uri VirtualFile
vf
action :: m ()
action = do
Bool
exists <- IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist [Char]
tfn
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let contents :: Text
contents = Rope -> Text
Rope.toText (VirtualFile -> Rope
_file_text VirtualFile
vf)
writeRaw :: Handle -> IO ()
writeRaw Handle
h = do
Handle -> NewlineMode -> IO ()
hSetNewlineMode Handle
h NewlineMode
noNewlineTranslation
Handle -> TextEncoding -> IO ()
hSetEncoding Handle
h TextEncoding
utf8
Handle -> Text -> IO ()
T.hPutStr Handle
h Text
contents
LogAction m (WithSeverity VfsLog)
logger LogAction m (WithSeverity VfsLog) -> WithSeverity VfsLog -> m ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& NormalizedUri -> [Char] -> VfsLog
PersistingFile NormalizedUri
uri [Char]
tfn VfsLog -> Severity -> WithSeverity VfsLog
forall msg. msg -> Severity -> WithSeverity msg
`WithSeverity` Severity
Debug
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withFile [Char]
tfn IOMode
WriteMode Handle -> IO ()
writeRaw
in ([Char], m ()) -> Maybe ([Char], m ())
forall a. a -> Maybe a
Just ([Char]
tfn, m ()
action)
closeVFS :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.TMessage 'J.Method_TextDocumentDidClose -> m ()
closeVFS :: forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> TMessage
@'ClientToServer @'Notification 'Method_TextDocumentDidClose
-> m ()
closeVFS LogAction m (WithSeverity VfsLog)
logger TMessage
@'ClientToServer @'Notification 'Method_TextDocumentDidClose
msg = do
let J.DidCloseTextDocumentParams (J.TextDocumentIdentifier (Uri -> NormalizedUri
J.toNormalizedUri -> NormalizedUri
uri)) = TMessage
@'ClientToServer @'Notification 'Method_TextDocumentDidClose
TNotificationMessage @'ClientToServer 'Method_TextDocumentDidClose
msg TNotificationMessage @'ClientToServer 'Method_TextDocumentDidClose
-> Getting
DidCloseTextDocumentParams
(TNotificationMessage
@'ClientToServer 'Method_TextDocumentDidClose)
DidCloseTextDocumentParams
-> DidCloseTextDocumentParams
forall s a. s -> Getting a s a -> a
^. Getting
DidCloseTextDocumentParams
(TNotificationMessage
@'ClientToServer 'Method_TextDocumentDidClose)
DidCloseTextDocumentParams
forall s a. HasParams s a => Lens' s a
Lens'
(TNotificationMessage
@'ClientToServer 'Method_TextDocumentDidClose)
DidCloseTextDocumentParams
J.params
LogAction m (WithSeverity VfsLog)
logger LogAction m (WithSeverity VfsLog) -> WithSeverity VfsLog -> m ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& NormalizedUri -> VfsLog
Closing NormalizedUri
uri VfsLog -> Severity -> WithSeverity VfsLog
forall msg. msg -> Severity -> WithSeverity msg
`WithSeverity` Severity
Debug
(Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> VFS -> Identity VFS
forall s a. HasVfsMap s a => Lens' s a
Lens' VFS (Map NormalizedUri VirtualFile)
vfsMap ((Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> VFS -> Identity VFS)
-> ((Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe (IxValue (Map NormalizedUri VirtualFile))))
-> Map NormalizedUri VirtualFile
-> Identity (Map NormalizedUri VirtualFile))
-> (Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe (IxValue (Map NormalizedUri VirtualFile))))
-> VFS
-> Identity VFS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NormalizedUri VirtualFile)
-> Lens'
(Map NormalizedUri VirtualFile)
(Maybe (IxValue (Map NormalizedUri VirtualFile)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NormalizedUri VirtualFile)
NormalizedUri
uri ((Maybe (IxValue (Map NormalizedUri VirtualFile))
-> Identity (Maybe (IxValue (Map NormalizedUri VirtualFile))))
-> VFS -> Identity VFS)
-> Maybe (IxValue (Map NormalizedUri VirtualFile)) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (IxValue (Map NormalizedUri VirtualFile))
forall a. Maybe a
Nothing
applyChanges :: (Monad m) => LogAction m (WithSeverity VfsLog) -> Rope -> [J.TextDocumentContentChangeEvent] -> m Rope
applyChanges :: forall (m :: * -> *).
Monad m =>
LogAction m (WithSeverity VfsLog)
-> Rope -> [TextDocumentContentChangeEvent] -> m Rope
applyChanges LogAction m (WithSeverity VfsLog)
logger = (Rope -> TextDocumentContentChangeEvent -> m Rope)
-> Rope -> [TextDocumentContentChangeEvent] -> m Rope
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (LogAction m (WithSeverity VfsLog)
-> Rope -> TextDocumentContentChangeEvent -> m Rope
forall (m :: * -> *).
Monad m =>
LogAction m (WithSeverity VfsLog)
-> Rope -> TextDocumentContentChangeEvent -> m Rope
applyChange LogAction m (WithSeverity VfsLog)
logger)
applyChange :: (Monad m) => LogAction m (WithSeverity VfsLog) -> Rope -> J.TextDocumentContentChangeEvent -> m Rope
applyChange :: forall (m :: * -> *).
Monad m =>
LogAction m (WithSeverity VfsLog)
-> Rope -> TextDocumentContentChangeEvent -> m Rope
applyChange LogAction m (WithSeverity VfsLog)
logger Rope
str (J.TextDocumentContentChangeEvent (J.InL TextDocumentContentChangePartial
e))
| J.Range (J.Position UInt
sl UInt
sc) (J.Position UInt
fl UInt
fc) <- TextDocumentContentChangePartial
e TextDocumentContentChangePartial
-> Getting Range TextDocumentContentChangePartial Range -> Range
forall s a. s -> Getting a s a -> a
^. Getting Range TextDocumentContentChangePartial Range
forall s a. HasRange s a => Lens' s a
Lens' TextDocumentContentChangePartial Range
J.range
, Text
txt <- TextDocumentContentChangePartial
e TextDocumentContentChangePartial
-> Getting Text TextDocumentContentChangePartial Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text TextDocumentContentChangePartial Text
forall s a. HasText s a => Lens' s a
Lens' TextDocumentContentChangePartial Text
J.text =
LogAction m (WithSeverity VfsLog)
-> Rope -> Position -> Position -> Text -> m Rope
forall (m :: * -> *).
Monad m =>
LogAction m (WithSeverity VfsLog)
-> Rope -> Position -> Position -> Text -> m Rope
changeChars LogAction m (WithSeverity VfsLog)
logger Rope
str (Word -> Word -> Position
Utf16.Position (UInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
sl) (UInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
sc)) (Word -> Word -> Position
Utf16.Position (UInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
fl) (UInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
fc)) Text
txt
applyChange LogAction m (WithSeverity VfsLog)
_ Rope
_ (J.TextDocumentContentChangeEvent (J.InR TextDocumentContentChangeWholeDocument
e)) =
Rope -> m Rope
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rope -> m Rope) -> Rope -> m Rope
forall a b. (a -> b) -> a -> b
$ Text -> Rope
Rope.fromText (Text -> Rope) -> Text -> Rope
forall a b. (a -> b) -> a -> b
$ TextDocumentContentChangeWholeDocument
e TextDocumentContentChangeWholeDocument
-> Getting Text TextDocumentContentChangeWholeDocument Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text TextDocumentContentChangeWholeDocument Text
forall s a. HasText s a => Lens' s a
Lens' TextDocumentContentChangeWholeDocument Text
J.text
changeChars :: (Monad m) => LogAction m (WithSeverity VfsLog) -> Rope -> Utf16.Position -> Utf16.Position -> Text -> m Rope
changeChars :: forall (m :: * -> *).
Monad m =>
LogAction m (WithSeverity VfsLog)
-> Rope -> Position -> Position -> Text -> m Rope
changeChars LogAction m (WithSeverity VfsLog)
logger Rope
str Position
start Position
finish Text
new = do
case Position -> Rope -> Maybe (Rope, Rope)
Rope.utf16SplitAtPosition Position
finish Rope
str of
Maybe (Rope, Rope)
Nothing -> LogAction m (WithSeverity VfsLog)
logger LogAction m (WithSeverity VfsLog) -> WithSeverity VfsLog -> m ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& Position -> Rope -> VfsLog
SplitInsideCodePoint Position
finish Rope
str VfsLog -> Severity -> WithSeverity VfsLog
forall msg. msg -> Severity -> WithSeverity msg
`WithSeverity` Severity
Warning m () -> m Rope -> m Rope
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Rope -> m Rope
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rope
str
Just (Rope
before, Rope
after) -> case Position -> Rope -> Maybe (Rope, Rope)
Rope.utf16SplitAtPosition Position
start Rope
before of
Maybe (Rope, Rope)
Nothing -> LogAction m (WithSeverity VfsLog)
logger LogAction m (WithSeverity VfsLog) -> WithSeverity VfsLog -> m ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& Position -> Rope -> VfsLog
SplitInsideCodePoint Position
start Rope
before VfsLog -> Severity -> WithSeverity VfsLog
forall msg. msg -> Severity -> WithSeverity msg
`WithSeverity` Severity
Warning m () -> m Rope -> m Rope
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Rope -> m Rope
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rope
str
Just (Rope
before', Rope
_) -> Rope -> m Rope
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rope -> m Rope) -> Rope -> m Rope
forall a b. (a -> b) -> a -> b
$ [Rope] -> Rope
forall a. Monoid a => [a] -> a
mconcat [Rope
before', Text -> Rope
Rope.fromText Text
new, Rope
after]
data CodePointPosition = CodePointPosition
{ CodePointPosition -> UInt
_line :: J.UInt
, CodePointPosition -> UInt
_character :: J.UInt
}
deriving (Int -> CodePointPosition -> ShowS
[CodePointPosition] -> ShowS
CodePointPosition -> [Char]
(Int -> CodePointPosition -> ShowS)
-> (CodePointPosition -> [Char])
-> ([CodePointPosition] -> ShowS)
-> Show CodePointPosition
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CodePointPosition -> ShowS
showsPrec :: Int -> CodePointPosition -> ShowS
$cshow :: CodePointPosition -> [Char]
show :: CodePointPosition -> [Char]
$cshowList :: [CodePointPosition] -> ShowS
showList :: [CodePointPosition] -> ShowS
Show, ReadPrec [CodePointPosition]
ReadPrec CodePointPosition
Int -> ReadS CodePointPosition
ReadS [CodePointPosition]
(Int -> ReadS CodePointPosition)
-> ReadS [CodePointPosition]
-> ReadPrec CodePointPosition
-> ReadPrec [CodePointPosition]
-> Read CodePointPosition
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CodePointPosition
readsPrec :: Int -> ReadS CodePointPosition
$creadList :: ReadS [CodePointPosition]
readList :: ReadS [CodePointPosition]
$creadPrec :: ReadPrec CodePointPosition
readPrec :: ReadPrec CodePointPosition
$creadListPrec :: ReadPrec [CodePointPosition]
readListPrec :: ReadPrec [CodePointPosition]
Read, CodePointPosition -> CodePointPosition -> Bool
(CodePointPosition -> CodePointPosition -> Bool)
-> (CodePointPosition -> CodePointPosition -> Bool)
-> Eq CodePointPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CodePointPosition -> CodePointPosition -> Bool
== :: CodePointPosition -> CodePointPosition -> Bool
$c/= :: CodePointPosition -> CodePointPosition -> Bool
/= :: CodePointPosition -> CodePointPosition -> Bool
Eq, Eq CodePointPosition
Eq CodePointPosition =>
(CodePointPosition -> CodePointPosition -> Ordering)
-> (CodePointPosition -> CodePointPosition -> Bool)
-> (CodePointPosition -> CodePointPosition -> Bool)
-> (CodePointPosition -> CodePointPosition -> Bool)
-> (CodePointPosition -> CodePointPosition -> Bool)
-> (CodePointPosition -> CodePointPosition -> CodePointPosition)
-> (CodePointPosition -> CodePointPosition -> CodePointPosition)
-> Ord CodePointPosition
CodePointPosition -> CodePointPosition -> Bool
CodePointPosition -> CodePointPosition -> Ordering
CodePointPosition -> CodePointPosition -> CodePointPosition
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
$ccompare :: CodePointPosition -> CodePointPosition -> Ordering
compare :: CodePointPosition -> CodePointPosition -> Ordering
$c< :: CodePointPosition -> CodePointPosition -> Bool
< :: CodePointPosition -> CodePointPosition -> Bool
$c<= :: CodePointPosition -> CodePointPosition -> Bool
<= :: CodePointPosition -> CodePointPosition -> Bool
$c> :: CodePointPosition -> CodePointPosition -> Bool
> :: CodePointPosition -> CodePointPosition -> Bool
$c>= :: CodePointPosition -> CodePointPosition -> Bool
>= :: CodePointPosition -> CodePointPosition -> Bool
$cmax :: CodePointPosition -> CodePointPosition -> CodePointPosition
max :: CodePointPosition -> CodePointPosition -> CodePointPosition
$cmin :: CodePointPosition -> CodePointPosition -> CodePointPosition
min :: CodePointPosition -> CodePointPosition -> CodePointPosition
Ord)
data CodePointRange = CodePointRange
{ CodePointRange -> CodePointPosition
_start :: CodePointPosition
, CodePointRange -> CodePointPosition
_end :: CodePointPosition
}
deriving (Int -> CodePointRange -> ShowS
[CodePointRange] -> ShowS
CodePointRange -> [Char]
(Int -> CodePointRange -> ShowS)
-> (CodePointRange -> [Char])
-> ([CodePointRange] -> ShowS)
-> Show CodePointRange
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CodePointRange -> ShowS
showsPrec :: Int -> CodePointRange -> ShowS
$cshow :: CodePointRange -> [Char]
show :: CodePointRange -> [Char]
$cshowList :: [CodePointRange] -> ShowS
showList :: [CodePointRange] -> ShowS
Show, ReadPrec [CodePointRange]
ReadPrec CodePointRange
Int -> ReadS CodePointRange
ReadS [CodePointRange]
(Int -> ReadS CodePointRange)
-> ReadS [CodePointRange]
-> ReadPrec CodePointRange
-> ReadPrec [CodePointRange]
-> Read CodePointRange
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CodePointRange
readsPrec :: Int -> ReadS CodePointRange
$creadList :: ReadS [CodePointRange]
readList :: ReadS [CodePointRange]
$creadPrec :: ReadPrec CodePointRange
readPrec :: ReadPrec CodePointRange
$creadListPrec :: ReadPrec [CodePointRange]
readListPrec :: ReadPrec [CodePointRange]
Read, CodePointRange -> CodePointRange -> Bool
(CodePointRange -> CodePointRange -> Bool)
-> (CodePointRange -> CodePointRange -> Bool) -> Eq CodePointRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CodePointRange -> CodePointRange -> Bool
== :: CodePointRange -> CodePointRange -> Bool
$c/= :: CodePointRange -> CodePointRange -> Bool
/= :: CodePointRange -> CodePointRange -> Bool
Eq, Eq CodePointRange
Eq CodePointRange =>
(CodePointRange -> CodePointRange -> Ordering)
-> (CodePointRange -> CodePointRange -> Bool)
-> (CodePointRange -> CodePointRange -> Bool)
-> (CodePointRange -> CodePointRange -> Bool)
-> (CodePointRange -> CodePointRange -> Bool)
-> (CodePointRange -> CodePointRange -> CodePointRange)
-> (CodePointRange -> CodePointRange -> CodePointRange)
-> Ord CodePointRange
CodePointRange -> CodePointRange -> Bool
CodePointRange -> CodePointRange -> Ordering
CodePointRange -> CodePointRange -> CodePointRange
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
$ccompare :: CodePointRange -> CodePointRange -> Ordering
compare :: CodePointRange -> CodePointRange -> Ordering
$c< :: CodePointRange -> CodePointRange -> Bool
< :: CodePointRange -> CodePointRange -> Bool
$c<= :: CodePointRange -> CodePointRange -> Bool
<= :: CodePointRange -> CodePointRange -> Bool
$c> :: CodePointRange -> CodePointRange -> Bool
> :: CodePointRange -> CodePointRange -> Bool
$c>= :: CodePointRange -> CodePointRange -> Bool
>= :: CodePointRange -> CodePointRange -> Bool
$cmax :: CodePointRange -> CodePointRange -> CodePointRange
max :: CodePointRange -> CodePointRange -> CodePointRange
$cmin :: CodePointRange -> CodePointRange -> CodePointRange
min :: CodePointRange -> CodePointRange -> CodePointRange
Ord)
makeFieldsNoPrefix ''CodePointPosition
makeFieldsNoPrefix ''CodePointRange
extractLine :: Rope.Rope -> Word -> Maybe Rope.Rope
Rope
rope Word
l = do
let lastLine :: Word
lastLine = Position -> Word
Utf16.posLine (Position -> Word) -> Position -> Word
forall a b. (a -> b) -> a -> b
$ Rope -> Position
Rope.utf16LengthAsPosition Rope
rope
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Word
l Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
lastLine
let (Rope
_, Rope
suffix) = Word -> Rope -> (Rope, Rope)
Rope.splitAtLine Word
l Rope
rope
(Rope
prefix, Rope
_) = Word -> Rope -> (Rope, Rope)
Rope.splitAtLine Word
1 Rope
suffix
Rope -> Maybe Rope
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rope
prefix
codePointPositionToPosition :: VirtualFile -> CodePointPosition -> Maybe J.Position
codePointPositionToPosition :: VirtualFile -> CodePointPosition -> Maybe Position
codePointPositionToPosition VirtualFile
vFile (CodePointPosition UInt
l UInt
c) = do
let text :: Rope
text = VirtualFile -> Rope
_file_text VirtualFile
vFile
Rope
lineRope <- Rope -> Word -> Maybe Rope
extractLine Rope
text (Word -> Maybe Rope) -> Word -> Maybe Rope
forall a b. (a -> b) -> a -> b
$ UInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
l
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ UInt
c UInt -> UInt -> Bool
forall a. Ord a => a -> a -> Bool
<= Word -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rope -> Word
Rope.charLength Rope
lineRope)
Position -> Maybe Position
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Position -> Maybe Position) -> Position -> Maybe Position
forall a b. (a -> b) -> a -> b
$ UInt -> UInt -> Position
J.Position UInt
l (Word -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> UInt) -> Word -> UInt
forall a b. (a -> b) -> a -> b
$ Rope -> Word
Rope.utf16Length (Rope -> Word) -> Rope -> Word
forall a b. (a -> b) -> a -> b
$ (Rope, Rope) -> Rope
forall a b. (a, b) -> a
fst ((Rope, Rope) -> Rope) -> (Rope, Rope) -> Rope
forall a b. (a -> b) -> a -> b
$ Word -> Rope -> (Rope, Rope)
Rope.charSplitAt (UInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
c) Rope
lineRope)
codePointRangeToRange :: VirtualFile -> CodePointRange -> Maybe J.Range
codePointRangeToRange :: VirtualFile -> CodePointRange -> Maybe Range
codePointRangeToRange VirtualFile
vFile (CodePointRange CodePointPosition
b CodePointPosition
e) =
Position -> Position -> Range
J.Range (Position -> Position -> Range)
-> Maybe Position -> Maybe (Position -> Range)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VirtualFile -> CodePointPosition -> Maybe Position
codePointPositionToPosition VirtualFile
vFile CodePointPosition
b Maybe (Position -> Range) -> Maybe Position -> Maybe Range
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> VirtualFile -> CodePointPosition -> Maybe Position
codePointPositionToPosition VirtualFile
vFile CodePointPosition
e
positionToCodePointPosition :: VirtualFile -> J.Position -> Maybe CodePointPosition
positionToCodePointPosition :: VirtualFile -> Position -> Maybe CodePointPosition
positionToCodePointPosition VirtualFile
vFile (J.Position UInt
l UInt
c) = do
let text :: Rope
text = VirtualFile -> Rope
_file_text VirtualFile
vFile
Rope
lineRope <- Rope -> Word -> Maybe Rope
extractLine Rope
text (Word -> Maybe Rope) -> Word -> Maybe Rope
forall a b. (a -> b) -> a -> b
$ UInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
l
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ UInt
c UInt -> UInt -> Bool
forall a. Ord a => a -> a -> Bool
<= Word -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Rope -> Word
Rope.utf16Length Rope
lineRope)
UInt -> UInt -> CodePointPosition
CodePointPosition UInt
l (UInt -> CodePointPosition)
-> ((Rope, Rope) -> UInt) -> (Rope, Rope) -> CodePointPosition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> UInt) -> ((Rope, Rope) -> Word) -> (Rope, Rope) -> UInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rope -> Word
Rope.charLength (Rope -> Word) -> ((Rope, Rope) -> Rope) -> (Rope, Rope) -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rope, Rope) -> Rope
forall a b. (a, b) -> a
fst ((Rope, Rope) -> CodePointPosition)
-> Maybe (Rope, Rope) -> Maybe CodePointPosition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> Rope -> Maybe (Rope, Rope)
Rope.utf16SplitAt (UInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
c) Rope
lineRope
rangeToCodePointRange :: VirtualFile -> J.Range -> Maybe CodePointRange
rangeToCodePointRange :: VirtualFile -> Range -> Maybe CodePointRange
rangeToCodePointRange VirtualFile
vFile (J.Range Position
b Position
e) =
CodePointPosition -> CodePointPosition -> CodePointRange
CodePointRange (CodePointPosition -> CodePointPosition -> CodePointRange)
-> Maybe CodePointPosition
-> Maybe (CodePointPosition -> CodePointRange)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VirtualFile -> Position -> Maybe CodePointPosition
positionToCodePointPosition VirtualFile
vFile Position
b Maybe (CodePointPosition -> CodePointRange)
-> Maybe CodePointPosition -> Maybe CodePointRange
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> VirtualFile -> Position -> Maybe CodePointPosition
positionToCodePointPosition VirtualFile
vFile Position
e
rangeLinesFromVfs :: VirtualFile -> J.Range -> T.Text
rangeLinesFromVfs :: VirtualFile -> Range -> Text
rangeLinesFromVfs (VirtualFile Int32
_ Int
_ Rope
ropetext) (J.Range (J.Position UInt
lf UInt
_cf) (J.Position UInt
lt UInt
_ct)) = Text
r
where
(Rope
_, Rope
s1) = Word -> Rope -> (Rope, Rope)
Rope.splitAtLine (UInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
lf) Rope
ropetext
(Rope
s2, Rope
_) = Word -> Rope -> (Rope, Rope)
Rope.splitAtLine (UInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt
lt UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
lf)) Rope
s1
r :: Text
r = Rope -> Text
Rope.toText Rope
s2