{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
-- So we can keep using the old prettyprinter modules (which have a better
-- compatibility range) for now.
{-# OPTIONS_GHC -Wno-deprecations #-}

{- |
Handles the "Language.LSP.Types.TextDocumentDidChange" \/
"Language.LSP.Types.TextDocumentDidOpen" \/
"Language.LSP.Types.TextDocumentDidClose" messages to keep an in-memory
`filesystem` of the current client workspace.  The server can access and edit
files in the client workspace by operating on the "VFS" in "LspFuncs".
-}
module Language.LSP.VFS (
  VFS (..),
  vfsMap,
  VirtualFile (..),
  lsp_version,
  file_version,
  file_text,
  virtualFileText,
  virtualFileVersion,
  VfsLog (..),

  -- * Managing the VFS
  emptyVFS,
  openVFS,
  changeFromClientVFS,
  changeFromServerVFS,
  persistFileVFS,
  closeVFS,

  -- * Positions and transformations
  CodePointPosition (..),
  line,
  character,
  codePointPositionToPosition,
  positionToCodePointPosition,
  CodePointRange (..),
  start,
  end,
  codePointRangeToRange,
  rangeToCodePointRange,

  -- * manipulating the file contents
  rangeLinesFromVfs,
  PosPrefixInfo (..),
  getCompletionPrefix,

  -- * for tests
  applyChanges,
  applyChange,
  changeChars,
) where

import Colog.Core (LogAction (..), Severity (..), WithSeverity (..), (<&))
import Control.Lens hiding (parts, (<.>))
import Control.Monad
import Control.Monad.State
import Data.Char (isAlphaNum, isUpper)
import Data.Foldable (traverse_)
import Data.Hashable
import Data.Int (Int32)
import Data.List
import Data.Map.Strict qualified as Map
import Data.Maybe
import Data.Ord
import Data.Row
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Text.Prettyprint.Doc hiding (line)
import Data.Text.Rope qualified as URope
import Data.Text.Utf16.Rope (Rope)
import Data.Text.Utf16.Rope 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 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
  -- ^ The LSP version of the document
  , VirtualFile -> Int
_file_version :: !Int
  -- ^ This number is only incremented whilst the file
  -- remains in the map.
  , VirtualFile -> Rope
_file_text :: !Rope
  -- ^ The full contents of the document
  }
  deriving (Int -> VirtualFile -> ShowS
[VirtualFile] -> ShowS
VirtualFile -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [VirtualFile] -> ShowS
$cshowList :: [VirtualFile] -> ShowS
show :: VirtualFile -> [Char]
$cshow :: VirtualFile -> [Char]
showsPrec :: Int -> VirtualFile -> ShowS
$cshowsPrec :: Int -> VirtualFile -> ShowS
Show)

data VFS = VFS
  { VFS -> Map NormalizedUri VirtualFile
_vfsMap :: !(Map.Map J.NormalizedUri VirtualFile)
  }
  deriving (Int -> VFS -> ShowS
[VFS] -> ShowS
VFS -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [VFS] -> ShowS
$cshowList :: [VFS] -> ShowS
show :: VFS -> [Char]
$cshow :: VFS -> [Char]
showsPrec :: Int -> VFS -> ShowS
$cshowsPrec :: Int -> VFS -> ShowS
Show)

data VfsLog
  = SplitInsideCodePoint Rope.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]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [VfsLog] -> ShowS
$cshowList :: [VfsLog] -> ShowS
show :: VfsLog -> [Char]
$cshow :: VfsLog -> [Char]
showsPrec :: Int -> VfsLog -> ShowS
$cshowsPrec :: Int -> 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" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
viaShow Position
pos forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"in" forall ann. Doc ann -> Doc ann -> 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" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty NormalizedUri
uri
  pretty (Opening NormalizedUri
uri) = Doc ann
"VFS: opening" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty NormalizedUri
uri
  pretty (Closing NormalizedUri
uri) = Doc ann
"VFS: closing" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty NormalizedUri
uri
  pretty (PersistingFile NormalizedUri
uri [Char]
fp) = Doc ann
"VFS: Writing virtual file for" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty NormalizedUri
uri forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"to" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
viaShow [Char]
fp
  pretty (CantRecursiveDelete NormalizedUri
uri) =
    Doc ann
"VFS: can't recursively delete" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty NormalizedUri
uri 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" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> 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 forall a. Monoid a => a
mempty

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

-- | Applies the changes from a 'J.DidOpenTextDocument' to the 'VFS'
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) Text
_ Int32
version Text
text = TMessage
  @'ClientToServer @'Notification 'Method_TextDocumentDidOpen
msg forall s a. s -> Getting a s a -> a
^. forall s a. HasParams s a => Lens' s a
J.params forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasTextDocument s a => Lens' s a
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 forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& NormalizedUri -> VfsLog
Opening NormalizedUri
uri forall msg. msg -> Severity -> WithSeverity msg
`WithSeverity` Severity
Debug
  forall s a. HasVfsMap s a => Lens' s a
vfsMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at NormalizedUri
uri forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just VirtualFile
vfile

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

-- | Applies a 'DidChangeTextDocumentNotification' to the 'VFS'
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
msg forall s a. s -> Getting a s a -> a
^. forall s a. HasParams s a => Lens' s a
J.params
    -- the client shouldn't be sending over a null version, only the server, but we just use 0 if that happens
    J.VersionedTextDocumentIdentifier (Uri -> NormalizedUri
J.toNormalizedUri -> NormalizedUri
uri) Int32
version = VersionedTextDocumentIdentifier
vid
  VFS
vfs <- forall s (m :: * -> *). MonadState s m => m s
get
  case VFS
vfs forall s a. s -> Getting a s a -> a
^. forall s a. HasVfsMap s a => Lens' s a
vfsMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at NormalizedUri
uri of
    Just (VirtualFile Int32
_ Int
file_ver Rope
contents) -> do
      Rope
contents' <- forall (m :: * -> *).
Monad m =>
LogAction m (WithSeverity VfsLog)
-> Rope -> [TextDocumentContentChangeEvent] -> m Rope
applyChanges LogAction m (WithSeverity VfsLog)
logger Rope
contents [TextDocumentContentChangeEvent]
changes
      forall s a. HasVfsMap s a => Lens' s a
vfsMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at NormalizedUri
uri forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just (Int32 -> Int -> Rope -> VirtualFile
VirtualFile Int32
version (Int
file_ver forall a. Num a => a -> a -> a
+ Int
1) Rope
contents')
    Maybe VirtualFile
Nothing -> LogAction m (WithSeverity VfsLog)
logger forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& NormalizedUri -> VfsLog
URINotFound NormalizedUri
uri 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) =
  forall s a. HasVfsMap s a => Lens' s a
vfsMap
    forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= 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 forall a. Monoid a => a
mempty)
 where
  shouldOverwrite :: Bool
  shouldOverwrite :: Bool
shouldOverwrite = case Maybe CreateFileOptions
options of
    Maybe CreateFileOptions
Nothing -> Bool
False -- default
    Just (J.CreateFileOptions Maybe Bool
Nothing Maybe Bool
Nothing) -> Bool
False -- default
    Just (J.CreateFileOptions Maybe Bool
Nothing (Just Bool
True)) -> Bool
False -- `ignoreIfExists` is True
    Just (J.CreateFileOptions Maybe Bool
Nothing (Just Bool
False)) -> Bool
True -- `ignoreIfExists` is False
    Just (J.CreateFileOptions (Just Bool
True) Maybe Bool
Nothing) -> Bool
True -- `overwrite` is True
    Just (J.CreateFileOptions (Just Bool
True) (Just Bool
True)) -> Bool
True -- `overwrite` wins over `ignoreIfExists`
    Just (J.CreateFileOptions (Just Bool
True) (Just Bool
False)) -> Bool
True -- `overwrite` is True
    Just (J.CreateFileOptions (Just Bool
False) Maybe Bool
Nothing) -> Bool
False -- `overwrite` is False
    Just (J.CreateFileOptions (Just Bool
False) (Just Bool
True)) -> Bool
False -- `overwrite` is False
    Just (J.CreateFileOptions (Just Bool
False) (Just Bool
False)) -> Bool
False -- `overwrite` wins over `ignoreIfExists`

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 <- forall s (m :: * -> *). MonadState s m => m s
get
  case VFS
vfs forall s a. s -> Getting a s a -> a
^. forall s a. HasVfsMap s a => Lens' s a
vfsMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at NormalizedUri
oldUri of
    -- nothing to rename
    Maybe (IxValue (Map NormalizedUri VirtualFile))
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just IxValue (Map NormalizedUri VirtualFile)
file -> case VFS
vfs forall s a. s -> Getting a s a -> a
^. forall s a. HasVfsMap s a => Lens' s a
vfsMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at NormalizedUri
newUri of
      -- the target does not exist, just move over
      Maybe (IxValue (Map NormalizedUri VirtualFile))
Nothing -> do
        forall s a. HasVfsMap s a => Lens' s a
vfsMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at NormalizedUri
oldUri forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
        forall s a. HasVfsMap s a => Lens' s a
vfsMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at NormalizedUri
newUri forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. a -> Maybe a
Just IxValue (Map NormalizedUri VirtualFile)
file
      Just IxValue (Map NormalizedUri VirtualFile)
_ -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldOverwrite forall a b. (a -> b) -> a -> b
$ do
        forall s a. HasVfsMap s a => Lens' s a
vfsMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at NormalizedUri
oldUri forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing
        forall s a. HasVfsMap s a => Lens' s a
vfsMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at NormalizedUri
newUri forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= 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 -- default
    Just (J.RenameFileOptions Maybe Bool
Nothing Maybe Bool
Nothing) -> Bool
False -- default
    Just (J.RenameFileOptions Maybe Bool
Nothing (Just Bool
True)) -> Bool
False -- `ignoreIfExists` is True
    Just (J.RenameFileOptions Maybe Bool
Nothing (Just Bool
False)) -> Bool
True -- `ignoreIfExists` is False
    Just (J.RenameFileOptions (Just Bool
True) Maybe Bool
Nothing) -> Bool
True -- `overwrite` is True
    Just (J.RenameFileOptions (Just Bool
True) (Just Bool
True)) -> Bool
True -- `overwrite` wins over `ignoreIfExists`
    Just (J.RenameFileOptions (Just Bool
True) (Just Bool
False)) -> Bool
True -- `overwrite` is True
    Just (J.RenameFileOptions (Just Bool
False) Maybe Bool
Nothing) -> Bool
False -- `overwrite` is False
    Just (J.RenameFileOptions (Just Bool
False) (Just Bool
True)) -> Bool
False -- `overwrite` is False
    Just (J.RenameFileOptions (Just Bool
False) (Just Bool
False)) -> Bool
False -- `overwrite` wins over `ignoreIfExists`

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
  -- NOTE: we are ignoring the `recursive` option here because we don't know which file is a directory
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe DeleteFileOptions
options forall s a. s -> Getting (First a) s a -> Maybe a
^? forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasRecursive s a => Lens' s a
J.recursive forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True) forall a b. (a -> b) -> a -> b
$
    LogAction m (WithSeverity VfsLog)
logger forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& NormalizedUri -> VfsLog
CantRecursiveDelete NormalizedUri
uri forall msg. msg -> Severity -> WithSeverity msg
`WithSeverity` Severity
Warning
  -- Remove and get the old value so we can check if it was missing
  Maybe (IxValue (Map NormalizedUri VirtualFile))
old <- forall s a. HasVfsMap s a => Lens' s a
vfsMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at NormalizedUri
uri forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m b
<.= forall a. Maybe a
Nothing
  case Maybe (IxValue (Map NormalizedUri VirtualFile))
old of
    -- It's not entirely clear what the semantics of 'ignoreIfNotExists' are, but if it
    -- doesn't exist and we're not ignoring it, let's at least log it.
    Maybe (IxValue (Map NormalizedUri VirtualFile))
Nothing
      | Maybe DeleteFileOptions
options forall s a. s -> Getting (First a) s a -> Maybe a
^? forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasIgnoreIfNotExists s a => Lens' s a
J.ignoreIfNotExists forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Bool
True ->
          LogAction m (WithSeverity VfsLog)
logger forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& NormalizedUri -> VfsLog
CantRecursiveDelete NormalizedUri
uri forall msg. msg -> Severity -> WithSeverity msg
`WithSeverity` Severity
Warning
    Maybe (IxValue (Map NormalizedUri VirtualFile))
_ -> 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
  -- all edits are supposed to be applied at once
  -- so apply from bottom up so they don't affect others
  let sortedEdits :: [TextEdit |? AnnotatedTextEdit]
sortedEdits = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextEdit |? AnnotatedTextEdit) -> Range
editRange) [TextEdit |? AnnotatedTextEdit]
edits
      changeEvents :: [TextDocumentContentChangeEvent]
changeEvents = forall a b. (a -> b) -> [a] -> [b]
map (TextEdit |? AnnotatedTextEdit) -> TextDocumentContentChangeEvent
editToChangeEvent [TextEdit |? AnnotatedTextEdit]
sortedEdits
      -- TODO: is this right?
      vid' :: VersionedTextDocumentIdentifier
vid' = Uri -> Int32 -> VersionedTextDocumentIdentifier
J.VersionedTextDocumentIdentifier (OptionalVersionedTextDocumentIdentifier
vid forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
J.uri) (case OptionalVersionedTextDocumentIdentifier
vid forall s a. s -> Getting a s a -> a
^. forall s a. HasVersion s a => Lens' s a
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 = 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
ps
  forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> TMessage
     @'ClientToServer @'Notification 'Method_TextDocumentDidChange
-> m ()
changeFromClientVFS LogAction m (WithSeverity VfsLog)
logger 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasRange s a => Lens' s a
J.range
  editRange (J.InL TextEdit
e) = TextEdit
e forall s a. s -> Getting a s a -> a
^. forall s a. HasRange s a => Lens' s a
J.range

  editToChangeEvent :: J.TextEdit J.|? J.AnnotatedTextEdit -> J.TextDocumentContentChangeEvent
  editToChangeEvent :: (TextEdit |? AnnotatedTextEdit) -> TextDocumentContentChangeEvent
editToChangeEvent (J.InR AnnotatedTextEdit
e) = (Rec
   ((.+)
      @(*)
      (Extend @(*) "range" Range ('R @(*) ('[] @(LT (*)))))
      ((.+)
         @(*)
         (Extend @(*) "rangeLength" (Maybe UInt) ('R @(*) ('[] @(LT (*)))))
         ((.+) @(*) ((.==) @(*) "text" Text) ('R @(*) ('[] @(LT (*)))))))
 |? Rec
      ((.+) @(*) ((.==) @(*) "text" Text) ('R @(*) ('[] @(LT (*))))))
-> TextDocumentContentChangeEvent
J.TextDocumentContentChangeEvent forall a b. (a -> b) -> a -> b
$ forall a b. a -> a |? b
J.InL forall a b. (a -> b) -> a -> b
$ forall a. IsLabel "range" a => a
#range forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec ((.==) @(*) l a)
.== AnnotatedTextEdit
e forall s a. s -> Getting a s a -> a
^. forall s a. HasRange s a => Lens' s a
J.range forall (l :: Row (*)) (r :: Row (*)).
FreeForall @(*) l =>
Rec l -> Rec r -> Rec ((.+) @(*) l r)
.+ forall a. IsLabel "rangeLength" a => a
#rangeLength forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec ((.==) @(*) l a)
.== forall a. Maybe a
Nothing forall (l :: Row (*)) (r :: Row (*)).
FreeForall @(*) l =>
Rec l -> Rec r -> Rec ((.+) @(*) l r)
.+ forall a. IsLabel "text" a => a
#text forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec ((.==) @(*) l a)
.== AnnotatedTextEdit
e forall s a. s -> Getting a s a -> a
^. forall s a. HasNewText s a => Lens' s a
J.newText
  editToChangeEvent (J.InL TextEdit
e) = (Rec
   ((.+)
      @(*)
      (Extend @(*) "range" Range ('R @(*) ('[] @(LT (*)))))
      ((.+)
         @(*)
         (Extend @(*) "rangeLength" (Maybe UInt) ('R @(*) ('[] @(LT (*)))))
         ((.+) @(*) ((.==) @(*) "text" Text) ('R @(*) ('[] @(LT (*)))))))
 |? Rec
      ((.+) @(*) ((.==) @(*) "text" Text) ('R @(*) ('[] @(LT (*))))))
-> TextDocumentContentChangeEvent
J.TextDocumentContentChangeEvent forall a b. (a -> b) -> a -> b
$ forall a b. a -> a |? b
J.InL forall a b. (a -> b) -> a -> b
$ forall a. IsLabel "range" a => a
#range forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec ((.==) @(*) l a)
.== TextEdit
e forall s a. s -> Getting a s a -> a
^. forall s a. HasRange s a => Lens' s a
J.range forall (l :: Row (*)) (r :: Row (*)).
FreeForall @(*) l =>
Rec l -> Rec r -> Rec ((.+) @(*) l r)
.+ forall a. IsLabel "rangeLength" a => a
#rangeLength forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec ((.==) @(*) l a)
.== forall a. Maybe a
Nothing forall (l :: Row (*)) (r :: Row (*)).
FreeForall @(*) l =>
Rec l -> Rec r -> Rec ((.+) @(*) l r)
.+ forall a. IsLabel "text" a => a
#text forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec ((.==) @(*) l a)
.== TextEdit
e forall s a. s -> Getting a s a -> a
^. forall s a. HasNewText s a => Lens' s a
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) = 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)) = forall (m :: * -> *). MonadState VFS m => CreateFile -> m ()
applyCreateFile CreateFile
change
applyDocumentChange LogAction m (WithSeverity VfsLog)
_ (J.InR (J.InR (J.InL RenameFile
change))) = forall (m :: * -> *). MonadState VFS m => RenameFile -> m ()
applyRenameFile RenameFile
change
applyDocumentChange LogAction m (WithSeverity VfsLog)
logger (J.InR (J.InR (J.InR DeleteFile
change))) = forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog) -> DeleteFile -> m ()
applyDeleteFile LogAction m (WithSeverity VfsLog)
logger DeleteFile
change

-- | Applies the changes from a 'ApplyWorkspaceEditRequest' to the 'VFS'
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
msg forall s a. s -> Getting a s a -> a
^. forall s a. HasParams s a => Lens' s a
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 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. a -> a |? b
J.InL forall a b. (a -> b) -> a -> b
$ 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
 where
  changeToTextDocumentEdit :: [TextDocumentEdit] -> Uri -> [TextEdit] -> [TextDocumentEdit]
changeToTextDocumentEdit [TextDocumentEdit]
acc Uri
uri [TextEdit]
edits =
    [TextDocumentEdit]
acc forall a. [a] -> [a] -> [a]
++ [OptionalVersionedTextDocumentIdentifier
-> [TextEdit |? AnnotatedTextEdit] -> TextDocumentEdit
J.TextDocumentEdit (Uri -> (Int32 |? Null) -> OptionalVersionedTextDocumentIdentifier
J.OptionalVersionedTextDocumentIdentifier Uri
uri (forall a b. a -> a |? b
J.InL Int32
0)) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> a |? b
J.InL [TextEdit]
edits)]

  applyDocumentChanges :: [J.DocumentChange] -> m ()
  applyDocumentChanges :: [DocumentChange] -> m ()
applyDocumentChanges = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog) -> DocumentChange -> m ()
applyDocumentChange LogAction m (WithSeverity VfsLog)
logger) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn DocumentChange -> Maybe Int32
project

  -- for sorting [DocumentChange]
  project :: J.DocumentChange -> Maybe J.Int32
  project :: DocumentChange -> Maybe Int32
project (J.InL TextDocumentEdit
textDocumentEdit) = case TextDocumentEdit
textDocumentEdit forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasVersion s a => Lens' s a
J.version of
    J.InL Int32
v -> forall a. a -> Maybe a
Just Int32
v
    Int32 |? Null
_ -> forall a. Maybe a
Nothing
  project DocumentChange
_ = 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" ShowS
takeFileName (Uri -> Maybe [Char]
J.uriToFilePath Uri
uri_raw)
      -- Given a length and a version number, pad the version number to
      -- the given n. Does nothing if the version number string is longer
      -- than the given length.
      padLeft :: Int -> Int -> String
      padLeft :: Int -> Int -> [Char]
padLeft Int
n Int
num =
        let numString :: [Char]
numString = forall a. Show a => a -> [Char]
show Int
num
         in forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
numString) Char
'0' forall a. [a] -> [a] -> [a]
++ [Char]
numString
   in [Char]
prefix [Char] -> ShowS
</> [Char]
basename forall a. [a] -> [a] -> [a]
++ [Char]
"-" forall a. [a] -> [a] -> [a]
++ Int -> Int -> [Char]
padLeft Int
5 Int
file_ver forall a. [a] -> [a] -> [a]
++ [Char]
"-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a. Hashable a => a -> Int
hash Uri
uri_raw) [Char] -> ShowS
<.> ShowS
takeExtensions [Char]
basename

-- | Write a virtual file to a file in the given directory if it exists in the VFS.
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 forall s a. s -> Getting a s a -> a
^. forall s a. HasVfsMap s a => Lens' s a
vfsMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at NormalizedUri
uri of
    Maybe VirtualFile
Nothing -> 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist [Char]
tfn
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists 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
                    -- We honour original file line endings
                    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 forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& NormalizedUri -> [Char] -> VfsLog
PersistingFile NormalizedUri
uri [Char]
tfn forall msg. msg -> Severity -> WithSeverity msg
`WithSeverity` Severity
Debug
              forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withFile [Char]
tfn IOMode
WriteMode Handle -> IO ()
writeRaw
       in 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
msg forall s a. s -> Getting a s a -> a
^. forall s a. HasParams s a => Lens' s a
J.params
  LogAction m (WithSeverity VfsLog)
logger forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& NormalizedUri -> VfsLog
Closing NormalizedUri
uri forall msg. msg -> Severity -> WithSeverity msg
`WithSeverity` Severity
Debug
  forall s a. HasVfsMap s a => Lens' s a
vfsMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at NormalizedUri
uri forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= forall a. Maybe a
Nothing

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

{- | Apply the list of changes.
 Changes should be applied in the order that they are
 received from the client.
-}
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 = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (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 Rec
  ((.+)
     @(*)
     (Extend @(*) "range" Range ('R @(*) ('[] @(LT (*)))))
     ((.+)
        @(*)
        (Extend @(*) "rangeLength" (Maybe UInt) ('R @(*) ('[] @(LT (*)))))
        ((.+) @(*) ((.==) @(*) "text" Text) ('R @(*) ('[] @(LT (*)))))))
e))
  | J.Range (J.Position UInt
sl UInt
sc) (J.Position UInt
fl UInt
fc) <- Rec
  ((.+)
     @(*)
     (Extend @(*) "range" Range ('R @(*) ('[] @(LT (*)))))
     ((.+)
        @(*)
        (Extend @(*) "rangeLength" (Maybe UInt) ('R @(*) ('[] @(LT (*)))))
        ((.+) @(*) ((.==) @(*) "text" Text) ('R @(*) ('[] @(LT (*)))))))
e forall (l :: Symbol) (r :: Row (*)).
KnownSymbol l =>
Rec r -> Label l -> (.!) @(*) r l
.! forall a. IsLabel "range" a => a
#range
  , (.!)
  @(*)
  ('R
     @(*)
     ((':)
        @(LT (*))
        ((':->) @(*) "range" Range)
        ((':)
           @(LT (*))
           ((':->) @(*) "rangeLength" (Maybe UInt))
           ((':) @(LT (*)) ((':->) @(*) "text" Text) ('[] @(LT (*)))))))
  "text"
txt <- Rec
  ((.+)
     @(*)
     (Extend @(*) "range" Range ('R @(*) ('[] @(LT (*)))))
     ((.+)
        @(*)
        (Extend @(*) "rangeLength" (Maybe UInt) ('R @(*) ('[] @(LT (*)))))
        ((.+) @(*) ((.==) @(*) "text" Text) ('R @(*) ('[] @(LT (*)))))))
e forall (l :: Symbol) (r :: Row (*)).
KnownSymbol l =>
Rec r -> Label l -> (.!) @(*) r l
.! forall a. IsLabel "text" a => a
#text =
      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
Rope.Position (forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
sl) (forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
sc)) (Word -> Word -> Position
Rope.Position (forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
fl) (forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
fc)) (.!)
  @(*)
  ('R
     @(*)
     ((':)
        @(LT (*))
        ((':->) @(*) "range" Range)
        ((':)
           @(LT (*))
           ((':->) @(*) "rangeLength" (Maybe UInt))
           ((':) @(LT (*)) ((':->) @(*) "text" Text) ('[] @(LT (*)))))))
  "text"
txt
applyChange LogAction m (WithSeverity VfsLog)
_ Rope
_ (J.TextDocumentContentChangeEvent (J.InR Rec ((.+) @(*) ((.==) @(*) "text" Text) ('R @(*) ('[] @(LT (*)))))
e)) =
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Rope
Rope.fromText forall a b. (a -> b) -> a -> b
$ Rec ((.+) @(*) ((.==) @(*) "text" Text) ('R @(*) ('[] @(LT (*)))))
e forall (l :: Symbol) (r :: Row (*)).
KnownSymbol l =>
Rec r -> Label l -> (.!) @(*) r l
.! forall a. IsLabel "text" a => a
#text

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

{- | Given a 'Rope', start and end positions, and some new text, replace
 the given range with the new text. If the given positions lie within
 a code point then this does nothing (returns the original 'Rope') and logs.
-}
changeChars :: (Monad m) => LogAction m (WithSeverity VfsLog) -> Rope -> Rope.Position -> Rope.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.splitAtPosition Position
finish Rope
str of
    Maybe (Rope, Rope)
Nothing -> LogAction m (WithSeverity VfsLog)
logger forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& Position -> Rope -> VfsLog
SplitInsideCodePoint Position
finish Rope
str forall msg. msg -> Severity -> WithSeverity msg
`WithSeverity` Severity
Warning forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Rope
str
    Just (Rope
before, Rope
after) -> case Position -> Rope -> Maybe (Rope, Rope)
Rope.splitAtPosition Position
start Rope
before of
      Maybe (Rope, Rope)
Nothing -> LogAction m (WithSeverity VfsLog)
logger forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& Position -> Rope -> VfsLog
SplitInsideCodePoint Position
start Rope
before forall msg. msg -> Severity -> WithSeverity msg
`WithSeverity` Severity
Warning forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure Rope
str
      Just (Rope
before', Rope
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Rope
before', Text -> Rope
Rope.fromText Text
new, Rope
after]

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

{- | A position, like a 'J.Position', but where the offsets in the line are measured in
 Unicode code points instead of UTF-16 code units.
-}
data CodePointPosition = CodePointPosition
  { CodePointPosition -> UInt
_line :: J.UInt
  -- ^ Line position in a document (zero-based).
  , CodePointPosition -> UInt
_character :: J.UInt
  -- ^ Character offset on a line in a document in *code points* (zero-based).
  }
  deriving (Int -> CodePointPosition -> ShowS
[CodePointPosition] -> ShowS
CodePointPosition -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CodePointPosition] -> ShowS
$cshowList :: [CodePointPosition] -> ShowS
show :: CodePointPosition -> [Char]
$cshow :: CodePointPosition -> [Char]
showsPrec :: Int -> CodePointPosition -> ShowS
$cshowsPrec :: Int -> CodePointPosition -> ShowS
Show, ReadPrec [CodePointPosition]
ReadPrec CodePointPosition
Int -> ReadS CodePointPosition
ReadS [CodePointPosition]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CodePointPosition]
$creadListPrec :: ReadPrec [CodePointPosition]
readPrec :: ReadPrec CodePointPosition
$creadPrec :: ReadPrec CodePointPosition
readList :: ReadS [CodePointPosition]
$creadList :: ReadS [CodePointPosition]
readsPrec :: Int -> ReadS CodePointPosition
$creadsPrec :: Int -> ReadS CodePointPosition
Read, CodePointPosition -> CodePointPosition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodePointPosition -> CodePointPosition -> Bool
$c/= :: CodePointPosition -> CodePointPosition -> Bool
== :: CodePointPosition -> CodePointPosition -> Bool
$c== :: CodePointPosition -> CodePointPosition -> Bool
Eq, Eq 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
min :: CodePointPosition -> CodePointPosition -> CodePointPosition
$cmin :: CodePointPosition -> CodePointPosition -> CodePointPosition
max :: CodePointPosition -> CodePointPosition -> CodePointPosition
$cmax :: CodePointPosition -> CodePointPosition -> CodePointPosition
>= :: CodePointPosition -> CodePointPosition -> Bool
$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
compare :: CodePointPosition -> CodePointPosition -> Ordering
$ccompare :: CodePointPosition -> CodePointPosition -> Ordering
Ord)

{- | A range, like a 'J.Range', but where the offsets in the line are measured in
 Unicode code points instead of UTF-16 code units.
-}
data CodePointRange = CodePointRange
  { CodePointRange -> CodePointPosition
_start :: CodePointPosition
  -- ^ The range's start position.
  , CodePointRange -> CodePointPosition
_end :: CodePointPosition
  -- ^ The range's end position.
  }
  deriving (Int -> CodePointRange -> ShowS
[CodePointRange] -> ShowS
CodePointRange -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CodePointRange] -> ShowS
$cshowList :: [CodePointRange] -> ShowS
show :: CodePointRange -> [Char]
$cshow :: CodePointRange -> [Char]
showsPrec :: Int -> CodePointRange -> ShowS
$cshowsPrec :: Int -> CodePointRange -> ShowS
Show, ReadPrec [CodePointRange]
ReadPrec CodePointRange
Int -> ReadS CodePointRange
ReadS [CodePointRange]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CodePointRange]
$creadListPrec :: ReadPrec [CodePointRange]
readPrec :: ReadPrec CodePointRange
$creadPrec :: ReadPrec CodePointRange
readList :: ReadS [CodePointRange]
$creadList :: ReadS [CodePointRange]
readsPrec :: Int -> ReadS CodePointRange
$creadsPrec :: Int -> ReadS CodePointRange
Read, CodePointRange -> CodePointRange -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodePointRange -> CodePointRange -> Bool
$c/= :: CodePointRange -> CodePointRange -> Bool
== :: CodePointRange -> CodePointRange -> Bool
$c== :: CodePointRange -> CodePointRange -> Bool
Eq, Eq 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
min :: CodePointRange -> CodePointRange -> CodePointRange
$cmin :: CodePointRange -> CodePointRange -> CodePointRange
max :: CodePointRange -> CodePointRange -> CodePointRange
$cmax :: CodePointRange -> CodePointRange -> CodePointRange
>= :: CodePointRange -> CodePointRange -> Bool
$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
compare :: CodePointRange -> CodePointRange -> Ordering
$ccompare :: CodePointRange -> CodePointRange -> Ordering
Ord)

makeFieldsNoPrefix ''CodePointPosition
makeFieldsNoPrefix ''CodePointRange

{- Note [Converting between code points and code units]
This is inherently a somewhat expensive operation, but we take some care to minimize the cost.
In particular, we use the good asymptotics of 'Rope' to our advantage:
- We extract the single line that we are interested in in time logarithmic in the number of lines.
- We then split the line at the given position, and check how long the prefix is, which takes
linear time in the length of the (single) line.

We also may need to convert the line back and forth between ropes with different indexing. Again
this is linear time in the length of the line.

So the overall process is logarithmic in the number of lines, and linear in the length of the specific
line. Which is okay-ish, so long as we don't have very long lines.
-}

{- | Extracts a specific line from a 'Rope.Rope'.
 Logarithmic in the number of lines.
-}
extractLine :: Rope.Rope -> Word -> Maybe Rope.Rope
extractLine :: Rope -> Word -> Maybe Rope
extractLine Rope
rope Word
l = do
  -- Check for the line being out of bounds
  let lastLine :: Word
lastLine = Position -> Word
Rope.posLine forall a b. (a -> b) -> a -> b
$ Rope -> Position
Rope.lengthAsPosition Rope
rope
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Word
l 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
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Rope
prefix

{- | Translate a code-point offset into a code-unit offset.
 Linear in the length of the rope.
-}
codePointOffsetToCodeUnitOffset :: URope.Rope -> Word -> Maybe Word
codePointOffsetToCodeUnitOffset :: Rope -> Word -> Maybe Word
codePointOffsetToCodeUnitOffset Rope
rope Word
offset = do
  -- Check for the position being out of bounds
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Word
offset forall a. Ord a => a -> a -> Bool
<= Rope -> Word
URope.length Rope
rope
  -- Split at the given position in *code points*
  let (Rope
prefix, Rope
_) = Word -> Rope -> (Rope, Rope)
URope.splitAt Word
offset Rope
rope
      -- Convert the prefix to a rope using *code units*
      utf16Prefix :: Rope
utf16Prefix = Text -> Rope
Rope.fromText forall a b. (a -> b) -> a -> b
$ Rope -> Text
URope.toText Rope
prefix
  -- Get the length of the prefix in *code units*
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Rope -> Word
Rope.length Rope
utf16Prefix

{- | Translate a UTF-16 code-unit offset into a code-point offset.
 Linear in the length of the rope.
-}
codeUnitOffsetToCodePointOffset :: Rope.Rope -> Word -> Maybe Word
codeUnitOffsetToCodePointOffset :: Rope -> Word -> Maybe Word
codeUnitOffsetToCodePointOffset Rope
rope Word
offset = do
  -- Check for the position being out of bounds
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Word
offset forall a. Ord a => a -> a -> Bool
<= Rope -> Word
Rope.length Rope
rope
  -- Split at the given position in *code units*
  (Rope
prefix, Rope
_) <- Word -> Rope -> Maybe (Rope, Rope)
Rope.splitAt Word
offset Rope
rope
  -- Convert the prefix to a rope using *code points*
  let utfPrefix :: Rope
utfPrefix = Text -> Rope
URope.fromText forall a b. (a -> b) -> a -> b
$ Rope -> Text
Rope.toText Rope
prefix
  -- Get the length of the prefix in *code points*
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Rope -> Word
URope.length Rope
utfPrefix

{- | Given a virtual file, translate a 'CodePointPosition' in that file into a 'J.Position' in that file.

 Will return 'Nothing' if the requested position is out of bounds of the document.

 Logarithmic in the number of lines in the document, and linear in the length of the line containing
 the position.
-}
codePointPositionToPosition :: VirtualFile -> CodePointPosition -> Maybe J.Position
codePointPositionToPosition :: VirtualFile -> CodePointPosition -> Maybe Position
codePointPositionToPosition VirtualFile
vFile (CodePointPosition UInt
l UInt
cpc) = do
  -- See Note [Converting between code points and code units]
  let text :: Rope
text = VirtualFile -> Rope
_file_text VirtualFile
vFile
  Rope
utf16Line <- Rope -> Word -> Maybe Rope
extractLine Rope
text (forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
l)
  -- Convert the line a rope using *code points*
  let utfLine :: Rope
utfLine = Text -> Rope
URope.fromText forall a b. (a -> b) -> a -> b
$ Rope -> Text
Rope.toText Rope
utf16Line

  Word
cuc <- Rope -> Word -> Maybe Word
codePointOffsetToCodeUnitOffset Rope
utfLine (forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
cpc)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ UInt -> UInt -> Position
J.Position UInt
l (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
cuc)

{- | Given a virtual file, translate a 'CodePointRange' in that file into a 'J.Range' in that file.

 Will return 'Nothing' if any of the positions are out of bounds of the document.

 Logarithmic in the number of lines in the document, and linear in the length of the lines containing
 the positions.
-}
codePointRangeToRange :: VirtualFile -> CodePointRange -> Maybe J.Range
codePointRangeToRange :: VirtualFile -> CodePointRange -> Maybe Range
codePointRangeToRange VirtualFile
vFile (CodePointRange CodePointPosition
b CodePointPosition
e) =
  Position -> Position -> Range
J.Range forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VirtualFile -> CodePointPosition -> Maybe Position
codePointPositionToPosition VirtualFile
vFile CodePointPosition
b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> VirtualFile -> CodePointPosition -> Maybe Position
codePointPositionToPosition VirtualFile
vFile CodePointPosition
e

{- | Given a virtual file, translate a 'J.Position' in that file into a 'CodePointPosition' in that file.

 Will return 'Nothing' if the requested position lies inside a code point, or if it is out of bounds of the document.

 Logarithmic in the number of lines in the document, and linear in the length of the line containing
 the position.
-}
positionToCodePointPosition :: VirtualFile -> J.Position -> Maybe CodePointPosition
positionToCodePointPosition :: VirtualFile -> Position -> Maybe CodePointPosition
positionToCodePointPosition VirtualFile
vFile (J.Position UInt
l UInt
cuc) = do
  -- See Note [Converting between code points and code units]
  let text :: Rope
text = VirtualFile -> Rope
_file_text VirtualFile
vFile
  Rope
utf16Line <- Rope -> Word -> Maybe Rope
extractLine Rope
text (forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
l)

  Word
cpc <- Rope -> Word -> Maybe Word
codeUnitOffsetToCodePointOffset Rope
utf16Line (forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
cuc)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ UInt -> UInt -> CodePointPosition
CodePointPosition UInt
l (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
cpc)

{- | Given a virtual file, translate a 'J.Range' in that file into a 'CodePointRange' in that file.

 Will return 'Nothing' if any of the positions are out of bounds of the document.

 Logarithmic in the number of lines in the document, and linear in the length of the lines containing
 the positions.
-}
rangeToCodePointRange :: VirtualFile -> J.Range -> Maybe CodePointRange
rangeToCodePointRange :: VirtualFile -> Range -> Maybe CodePointRange
rangeToCodePointRange VirtualFile
vFile (J.Range Position
b Position
e) =
  CodePointPosition -> CodePointPosition -> CodePointRange
CodePointRange forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VirtualFile -> Position -> Maybe CodePointPosition
positionToCodePointPosition VirtualFile
vFile Position
b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> VirtualFile -> Position -> Maybe CodePointPosition
positionToCodePointPosition VirtualFile
vFile Position
e

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

-- TODO:AZ:move this to somewhere sane

-- | Describes the line at the current cursor position
data PosPrefixInfo = PosPrefixInfo
  { PosPrefixInfo -> Text
fullLine :: !T.Text
  -- ^ The full contents of the line the cursor is at
  , PosPrefixInfo -> Text
prefixModule :: !T.Text
  -- ^ If any, the module name that was typed right before the cursor position.
  --  For example, if the user has typed "Data.Maybe.from", then this property
  --  will be "Data.Maybe"
  , PosPrefixInfo -> Text
prefixText :: !T.Text
  -- ^ The word right before the cursor position, after removing the module part.
  -- For example if the user has typed "Data.Maybe.from",
  -- then this property will be "from"
  , PosPrefixInfo -> Position
cursorPos :: !J.Position
  -- ^ The cursor position
  }
  deriving (Int -> PosPrefixInfo -> ShowS
[PosPrefixInfo] -> ShowS
PosPrefixInfo -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PosPrefixInfo] -> ShowS
$cshowList :: [PosPrefixInfo] -> ShowS
show :: PosPrefixInfo -> [Char]
$cshow :: PosPrefixInfo -> [Char]
showsPrec :: Int -> PosPrefixInfo -> ShowS
$cshowsPrec :: Int -> PosPrefixInfo -> ShowS
Show, PosPrefixInfo -> PosPrefixInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PosPrefixInfo -> PosPrefixInfo -> Bool
$c/= :: PosPrefixInfo -> PosPrefixInfo -> Bool
== :: PosPrefixInfo -> PosPrefixInfo -> Bool
$c== :: PosPrefixInfo -> PosPrefixInfo -> Bool
Eq)

getCompletionPrefix :: (Monad m) => J.Position -> VirtualFile -> m (Maybe PosPrefixInfo)
getCompletionPrefix :: forall (m :: * -> *).
Monad m =>
Position -> VirtualFile -> m (Maybe PosPrefixInfo)
getCompletionPrefix pos :: Position
pos@(J.Position UInt
l UInt
c) (VirtualFile Int32
_ Int
_ Rope
ropetext) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (Text -> Text -> Text -> Position -> PosPrefixInfo
PosPrefixInfo Text
"" Text
"" Text
"" Position
pos) forall a b. (a -> b) -> a -> b
$ do
    -- Maybe monad
    let lastMaybe :: [a] -> Maybe a
lastMaybe [] = forall a. Maybe a
Nothing
        lastMaybe [a]
xs = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [a]
xs

    let curRope :: Rope
curRope = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ Word -> Rope -> (Rope, Rope)
Rope.splitAtLine Word
1 forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ Word -> Rope -> (Rope, Rope)
Rope.splitAtLine (forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
l) Rope
ropetext
    Text
beforePos <- Rope -> Text
Rope.toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> Rope -> Maybe (Rope, Rope)
Rope.splitAt (forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
c) Rope
curRope
    Text
curWord <-
      if
          | Text -> Bool
T.null Text
beforePos -> forall a. a -> Maybe a
Just Text
""
          | Text -> Char
T.last Text
beforePos forall a. Eq a => a -> a -> Bool
== Char
' ' -> forall a. a -> Maybe a
Just Text
"" -- don't count abc as the curword in 'abc '
          | Bool
otherwise -> forall {a}. [a] -> Maybe a
lastMaybe (Text -> [Text]
T.words Text
beforePos)

    let parts :: [Text]
parts =
          (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
== Char
'.') forall a b. (a -> b) -> a -> b
$
            (Char -> Bool) -> Text -> Text
T.takeWhileEnd (\Char
x -> Char -> Bool
isAlphaNum Char
x Bool -> Bool -> Bool
|| Char
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Char]
"._'" :: String)) Text
curWord
    case forall a. [a] -> [a]
reverse [Text]
parts of
      [] -> forall a. Maybe a
Nothing
      (Text
x : [Text]
xs) -> do
        let modParts :: [Text]
modParts =
              forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isUpper forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Char
T.head) forall a b. (a -> b) -> a -> b
$
                forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$
                  forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) [Text]
xs
            modName :: Text
modName = Text -> [Text] -> Text
T.intercalate Text
"." [Text]
modParts
        -- curRope is already a single line, but it may include an enclosing '\n'
        let curLine :: Text
curLine = (Char -> Bool) -> Text -> Text
T.dropWhileEnd (forall a. Eq a => a -> a -> Bool
== Char
'\n') forall a b. (a -> b) -> a -> b
$ Rope -> Text
Rope.toText Rope
curRope
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Position -> PosPrefixInfo
PosPrefixInfo Text
curLine Text
modName Text
x Position
pos

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

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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
lf) Rope
ropetext
  (Rope
s2, Rope
_) = Word -> Rope -> (Rope, Rope)
Rope.splitAtLine (forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt
lt forall a. Num a => a -> a -> a
- UInt
lf)) Rope
s1
  r :: Text
r = Rope -> Text
Rope.toText Rope
s2

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