{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeInType #-}

{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleInstances #-}

-- 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
  , vfsTempDir
  , VirtualFile(..)
  , lsp_version
  , file_version
  , file_text
  , virtualFileText
  , virtualFileVersion
  , VfsLog (..)
  -- * Managing the VFS
  , initVFS
  , 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           Control.Lens hiding ( (<.>), parts )
import           Control.Monad
import           Colog.Core (LogAction (..), WithSeverity (..), Severity (..), (<&))
import           Control.Monad.State
import           Data.Char (isUpper, isAlphaNum)
import           Data.Text ( Text )
import qualified Data.Text as T
import qualified Data.Text.IO as T
import           Data.Int (Int32)
import           Data.List
import           Data.Ord
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Map.Strict as Map
import           Data.Maybe
import qualified Data.Text.Rope as URope
import           Data.Text.Utf16.Rope ( Rope )
import qualified Data.Text.Utf16.Rope as Rope
import           Data.Text.Prettyprint.Doc hiding (line)
import qualified Language.LSP.Types           as J
import qualified Language.LSP.Types.Lens      as J
import           System.FilePath
import           Data.Hashable
import           System.Directory
import           System.IO
import           System.IO.Temp
import Data.Foldable (traverse_)

-- ---------------------------------------------------------------------
{-# 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 -> String
(Int -> VirtualFile -> ShowS)
-> (VirtualFile -> String)
-> ([VirtualFile] -> ShowS)
-> Show VirtualFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VirtualFile] -> ShowS
$cshowList :: [VirtualFile] -> ShowS
show :: VirtualFile -> String
$cshow :: VirtualFile -> String
showsPrec :: Int -> VirtualFile -> ShowS
$cshowsPrec :: Int -> VirtualFile -> ShowS
Show)

data VFS = VFS { VFS -> Map NormalizedUri VirtualFile
_vfsMap :: !(Map.Map J.NormalizedUri VirtualFile)
               , VFS -> String
_vfsTempDir :: !FilePath -- ^ This is where all the temporary files will be written to
               } deriving Int -> VFS -> ShowS
[VFS] -> ShowS
VFS -> String
(Int -> VFS -> ShowS)
-> (VFS -> String) -> ([VFS] -> ShowS) -> Show VFS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VFS] -> ShowS
$cshowList :: [VFS] -> ShowS
show :: VFS -> String
$cshow :: VFS -> String
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 -> String
(Int -> VfsLog -> ShowS)
-> (VfsLog -> String) -> ([VfsLog] -> ShowS) -> Show VfsLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VfsLog] -> ShowS
$cshowList :: [VfsLog] -> ShowS
show :: VfsLog -> String
$cshow :: VfsLog -> String
showsPrec :: Int -> VfsLog -> ShowS
$cshowsPrec :: Int -> VfsLog -> ShowS
Show)

instance Pretty VfsLog where
  pretty :: 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. Show a => a -> Doc ann
viaShow 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. Show a => a -> Doc ann
viaShow 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. Show a => a -> Doc ann
viaShow NormalizedUri
uri
  pretty (PersistingFile NormalizedUri
uri String
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. Show a => a -> Doc ann
viaShow 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
<+> String -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow String
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. Show a => a -> Doc ann
viaShow 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. Show a => a -> Doc ann
viaShow 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

---

initVFS :: (VFS -> IO r) -> IO r
initVFS :: (VFS -> IO r) -> IO r
initVFS VFS -> IO r
k = String -> (String -> IO r) -> IO r
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> m a) -> m a
withSystemTempDirectory String
"haskell-lsp" ((String -> IO r) -> IO r) -> (String -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \String
temp_dir -> VFS -> IO r
k (Map NormalizedUri VirtualFile -> String -> VFS
VFS Map NormalizedUri VirtualFile
forall a. Monoid a => a
mempty String
temp_dir)

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

-- | Applies the changes from a 'J.DidOpenTextDocument' to the 'VFS'
openVFS :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.Message 'J.TextDocumentDidOpen -> m ()
openVFS :: LogAction m (WithSeverity VfsLog)
-> Message @'FromClient @'Notification 'TextDocumentDidOpen -> m ()
openVFS LogAction m (WithSeverity VfsLog)
logger Message @'FromClient @'Notification 'TextDocumentDidOpen
msg = do
  let J.TextDocumentItem (Uri -> NormalizedUri
J.toNormalizedUri -> NormalizedUri
uri) Text
_ Int32
version Text
text = Message @'FromClient @'Notification 'TextDocumentDidOpen
NotificationMessage @'FromClient 'TextDocumentDidOpen
msg NotificationMessage @'FromClient 'TextDocumentDidOpen
-> Getting
     TextDocumentItem
     (NotificationMessage @'FromClient 'TextDocumentDidOpen)
     TextDocumentItem
-> TextDocumentItem
forall s a. s -> Getting a s a -> a
^. (DidOpenTextDocumentParams
 -> Const @* TextDocumentItem DidOpenTextDocumentParams)
-> NotificationMessage @'FromClient 'TextDocumentDidOpen
-> Const
     @*
     TextDocumentItem
     (NotificationMessage @'FromClient 'TextDocumentDidOpen)
forall s a. HasParams s a => Lens' s a
J.params ((DidOpenTextDocumentParams
  -> Const @* TextDocumentItem DidOpenTextDocumentParams)
 -> NotificationMessage @'FromClient 'TextDocumentDidOpen
 -> Const
      @*
      TextDocumentItem
      (NotificationMessage @'FromClient 'TextDocumentDidOpen))
-> ((TextDocumentItem
     -> Const @* TextDocumentItem TextDocumentItem)
    -> DidOpenTextDocumentParams
    -> Const @* TextDocumentItem DidOpenTextDocumentParams)
-> Getting
     TextDocumentItem
     (NotificationMessage @'FromClient '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
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
vfsMap ((Map NormalizedUri VirtualFile
  -> Identity (Map NormalizedUri VirtualFile))
 -> VFS -> Identity VFS)
-> ((Maybe VirtualFile -> Identity (Maybe VirtualFile))
    -> Map NormalizedUri VirtualFile
    -> Identity (Map NormalizedUri VirtualFile))
-> (Maybe 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 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

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

-- | Applies a 'DidChangeTextDocumentNotification' to the 'VFS'
changeFromClientVFS :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.Message 'J.TextDocumentDidChange -> m ()
changeFromClientVFS :: LogAction m (WithSeverity VfsLog)
-> Message @'FromClient @'Notification 'TextDocumentDidChange
-> m ()
changeFromClientVFS LogAction m (WithSeverity VfsLog)
logger Message @'FromClient @'Notification 'TextDocumentDidChange
msg = do
  let
    J.DidChangeTextDocumentParams VersionedTextDocumentIdentifier
vid (J.List [TextDocumentContentChangeEvent]
changes) = Message @'FromClient @'Notification 'TextDocumentDidChange
NotificationMessage @'FromClient 'TextDocumentDidChange
msg NotificationMessage @'FromClient 'TextDocumentDidChange
-> Getting
     DidChangeTextDocumentParams
     (NotificationMessage @'FromClient 'TextDocumentDidChange)
     DidChangeTextDocumentParams
-> DidChangeTextDocumentParams
forall s a. s -> Getting a s a -> a
^. Getting
  DidChangeTextDocumentParams
  (NotificationMessage @'FromClient 'TextDocumentDidChange)
  DidChangeTextDocumentParams
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 -> TextDocumentVersion -> Int32
forall a. a -> Maybe a -> a
fromMaybe Int32
0 -> 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
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
vfsMap ((Map NormalizedUri VirtualFile
  -> Identity (Map NormalizedUri VirtualFile))
 -> VFS -> Identity VFS)
-> ((Maybe VirtualFile -> Identity (Maybe VirtualFile))
    -> Map NormalizedUri VirtualFile
    -> Identity (Map NormalizedUri VirtualFile))
-> (Maybe 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 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 :: CreateFile -> m ()
applyCreateFile (J.CreateFile (Uri -> NormalizedUri
J.toNormalizedUri -> NormalizedUri
uri) Maybe CreateFileOptions
options Maybe ChangeAnnotationIdentifier
_ann) =
  (Map NormalizedUri VirtualFile
 -> Identity (Map NormalizedUri VirtualFile))
-> VFS -> Identity VFS
forall s a. HasVfsMap s a => Lens' s a
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  -- 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 :: RenameFile -> m ()
applyRenameFile (J.RenameFile (Uri -> NormalizedUri
J.toNormalizedUri -> NormalizedUri
oldUri) (Uri -> NormalizedUri
J.toNormalizedUri -> NormalizedUri
newUri) Maybe RenameFileOptions
options Maybe ChangeAnnotationIdentifier
_ann) = do
  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
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
oldUri of
      -- nothing to rename
      Maybe VirtualFile
Nothing -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just VirtualFile
file -> 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
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
newUri of
        -- the target does not exist, just move over
        Maybe VirtualFile
Nothing -> do
          (Map NormalizedUri VirtualFile
 -> Identity (Map NormalizedUri VirtualFile))
-> VFS -> Identity VFS
forall s a. HasVfsMap s a => Lens' s a
vfsMap ((Map NormalizedUri VirtualFile
  -> Identity (Map NormalizedUri VirtualFile))
 -> VFS -> Identity VFS)
-> ((Maybe VirtualFile -> Identity (Maybe VirtualFile))
    -> Map NormalizedUri VirtualFile
    -> Identity (Map NormalizedUri VirtualFile))
-> (Maybe 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
oldUri ((Maybe 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 ()
.= Maybe 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
vfsMap ((Map NormalizedUri VirtualFile
  -> Identity (Map NormalizedUri VirtualFile))
 -> VFS -> Identity VFS)
-> ((Maybe VirtualFile -> Identity (Maybe VirtualFile))
    -> Map NormalizedUri VirtualFile
    -> Identity (Map NormalizedUri VirtualFile))
-> (Maybe 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
newUri ((Maybe 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
file
        Just 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
vfsMap ((Map NormalizedUri VirtualFile
  -> Identity (Map NormalizedUri VirtualFile))
 -> VFS -> Identity VFS)
-> ((Maybe VirtualFile -> Identity (Maybe VirtualFile))
    -> Map NormalizedUri VirtualFile
    -> Identity (Map NormalizedUri VirtualFile))
-> (Maybe 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
oldUri ((Maybe 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 ()
.= Maybe 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
vfsMap ((Map NormalizedUri VirtualFile
  -> Identity (Map NormalizedUri VirtualFile))
 -> VFS -> Identity VFS)
-> ((Maybe VirtualFile -> Identity (Maybe VirtualFile))
    -> Map NormalizedUri VirtualFile
    -> Identity (Map NormalizedUri VirtualFile))
-> (Maybe 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
newUri ((Maybe 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
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 :: LogAction m (WithSeverity VfsLog) -> DeleteFile -> m ()
applyDeleteFile LogAction m (WithSeverity VfsLog)
logger (J.DeleteFile (Uri -> NormalizedUri
J.toNormalizedUri -> NormalizedUri
uri) Maybe DeleteFileOptions
options Maybe ChangeAnnotationIdentifier
_ann) = do
  -- NOTE: we are ignoring the `recursive` option here because we don't know which file is a directory
  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. Prism (Maybe a) (Maybe b) a 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
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. Prism (Maybe a) (Maybe b) a 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
  -- Remove and get the old value so we can check if it was missing
  Maybe VirtualFile
old <- (Map NormalizedUri VirtualFile
 -> Identity (Map NormalizedUri VirtualFile))
-> VFS -> Identity VFS
forall s a. HasVfsMap s a => Lens' s a
vfsMap ((Map NormalizedUri VirtualFile
  -> Identity (Map NormalizedUri VirtualFile))
 -> VFS -> Identity VFS)
-> ((Maybe VirtualFile -> Identity (Maybe VirtualFile))
    -> Map NormalizedUri VirtualFile
    -> Identity (Map NormalizedUri VirtualFile))
-> (Maybe 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 VirtualFile -> Identity (Maybe VirtualFile))
 -> VFS -> Identity VFS)
-> Maybe VirtualFile -> m (Maybe VirtualFile)
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m b
<.= Maybe VirtualFile
forall a. Maybe a
Nothing
  case Maybe 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 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. Prism (Maybe a) (Maybe b) a 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
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. Prism (Maybe a) (Maybe b) a 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 VirtualFile
_ -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

applyTextDocumentEdit :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.TextDocumentEdit -> m ()
applyTextDocumentEdit :: LogAction m (WithSeverity VfsLog) -> TextDocumentEdit -> m ()
applyTextDocumentEdit LogAction m (WithSeverity VfsLog)
logger (J.TextDocumentEdit VersionedTextDocumentIdentifier
vid (J.List [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 = ((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
      ps :: DidChangeTextDocumentParams
ps = VersionedTextDocumentIdentifier
-> List TextDocumentContentChangeEvent
-> DidChangeTextDocumentParams
J.DidChangeTextDocumentParams VersionedTextDocumentIdentifier
vid ([TextDocumentContentChangeEvent]
-> List TextDocumentContentChangeEvent
forall a. [a] -> List a
J.List [TextDocumentContentChangeEvent]
changeEvents)
      notif :: NotificationMessage @'FromClient 'TextDocumentDidChange
notif = Text
-> SMethod @'FromClient @'Notification 'TextDocumentDidChange
-> MessageParams @'FromClient @'Notification 'TextDocumentDidChange
-> NotificationMessage @'FromClient 'TextDocumentDidChange
forall (f :: From) (m :: Method f 'Notification).
Text
-> SMethod @f @'Notification m
-> MessageParams @f @'Notification m
-> NotificationMessage @f m
J.NotificationMessage Text
"" SMethod @'FromClient @'Notification 'TextDocumentDidChange
J.STextDocumentDidChange MessageParams @'FromClient @'Notification 'TextDocumentDidChange
DidChangeTextDocumentParams
ps
  LogAction m (WithSeverity VfsLog)
-> Message @'FromClient @'Notification 'TextDocumentDidChange
-> m ()
forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> Message @'FromClient @'Notification 'TextDocumentDidChange
-> m ()
changeFromClientVFS LogAction m (WithSeverity VfsLog)
logger Message @'FromClient @'Notification 'TextDocumentDidChange
NotificationMessage @'FromClient '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
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
J.range

    editToChangeEvent :: J.TextEdit J.|? J.AnnotatedTextEdit -> J.TextDocumentContentChangeEvent
    editToChangeEvent :: (TextEdit |? AnnotatedTextEdit) -> TextDocumentContentChangeEvent
editToChangeEvent (J.InR AnnotatedTextEdit
e) = Maybe Range -> Maybe UInt -> Text -> TextDocumentContentChangeEvent
J.TextDocumentContentChangeEvent (Range -> Maybe Range
forall a. a -> Maybe a
Just (Range -> Maybe Range) -> Range -> Maybe Range
forall a b. (a -> b) -> a -> b
$ 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
J.range) Maybe UInt
forall a. Maybe a
Nothing (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
J.newText)
    editToChangeEvent (J.InL TextEdit
e) = Maybe Range -> Maybe UInt -> Text -> TextDocumentContentChangeEvent
J.TextDocumentContentChangeEvent (Range -> Maybe Range
forall a. a -> Maybe a
Just (Range -> Maybe Range) -> Range -> Maybe Range
forall a b. (a -> b) -> a -> b
$ 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
J.range) Maybe UInt
forall a. Maybe a
Nothing (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
J.newText)

applyDocumentChange :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.DocumentChange -> m ()
applyDocumentChange :: 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

-- | Applies the changes from a 'ApplyWorkspaceEditRequest' to the 'VFS'
changeFromServerVFS :: forall m . MonadState VFS m => LogAction m (WithSeverity VfsLog) -> J.Message 'J.WorkspaceApplyEdit -> m ()
changeFromServerVFS :: LogAction m (WithSeverity VfsLog)
-> Message @'FromServer @'Request 'WorkspaceApplyEdit -> m ()
changeFromServerVFS LogAction m (WithSeverity VfsLog)
logger Message @'FromServer @'Request 'WorkspaceApplyEdit
msg = do
  let J.ApplyWorkspaceEditParams Maybe Text
_label WorkspaceEdit
edit = Message @'FromServer @'Request 'WorkspaceApplyEdit
RequestMessage @'FromServer 'WorkspaceApplyEdit
msg RequestMessage @'FromServer 'WorkspaceApplyEdit
-> Getting
     ApplyWorkspaceEditParams
     (RequestMessage @'FromServer 'WorkspaceApplyEdit)
     ApplyWorkspaceEditParams
-> ApplyWorkspaceEditParams
forall s a. s -> Getting a s a -> a
^. Getting
  ApplyWorkspaceEditParams
  (RequestMessage @'FromServer 'WorkspaceApplyEdit)
  ApplyWorkspaceEditParams
forall s a. HasParams s a => Lens' s a
J.params
      J.WorkspaceEdit Maybe WorkspaceEditMap
mChanges Maybe (List DocumentChange)
mDocChanges Maybe ChangeAnnotationMap
_anns = WorkspaceEdit
edit
  case Maybe (List DocumentChange)
mDocChanges of
    Just (J.List [DocumentChange]
docChanges) -> [DocumentChange] -> m ()
applyDocumentChanges [DocumentChange]
docChanges
    Maybe (List DocumentChange)
Nothing -> case Maybe WorkspaceEditMap
mChanges of
      Just WorkspaceEditMap
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 -> List TextEdit -> [TextDocumentEdit])
-> [TextDocumentEdit] -> WorkspaceEditMap -> [TextDocumentEdit]
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
HashMap.foldlWithKey' [TextDocumentEdit] -> Uri -> List TextEdit -> [TextDocumentEdit]
changeToTextDocumentEdit [] WorkspaceEditMap
cs
      Maybe WorkspaceEditMap
Nothing -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  where
    changeToTextDocumentEdit :: [TextDocumentEdit] -> Uri -> List TextEdit -> [TextDocumentEdit]
changeToTextDocumentEdit [TextDocumentEdit]
acc Uri
uri List TextEdit
edits =
      [TextDocumentEdit]
acc [TextDocumentEdit] -> [TextDocumentEdit] -> [TextDocumentEdit]
forall a. [a] -> [a] -> [a]
++ [VersionedTextDocumentIdentifier
-> List (TextEdit |? AnnotatedTextEdit) -> TextDocumentEdit
J.TextDocumentEdit (Uri -> TextDocumentVersion -> VersionedTextDocumentIdentifier
J.VersionedTextDocumentIdentifier Uri
uri (Int32 -> TextDocumentVersion
forall a. a -> Maybe a
Just Int32
0)) ((TextEdit -> TextEdit |? AnnotatedTextEdit)
-> List TextEdit -> List (TextEdit |? AnnotatedTextEdit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextEdit -> TextEdit |? AnnotatedTextEdit
forall a b. a -> a |? b
J.InL List 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 -> TextDocumentVersion)
-> [DocumentChange] -> [DocumentChange]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn DocumentChange -> TextDocumentVersion
project

    -- for sorting [DocumentChange]
    project :: J.DocumentChange -> J.TextDocumentVersion -- type TextDocumentVersion = Maybe Int
    project :: DocumentChange -> TextDocumentVersion
project (J.InL TextDocumentEdit
textDocumentEdit) = TextDocumentEdit
textDocumentEdit TextDocumentEdit
-> Getting TextDocumentVersion TextDocumentEdit TextDocumentVersion
-> TextDocumentVersion
forall s a. s -> Getting a s a -> a
^. (VersionedTextDocumentIdentifier
 -> Const @* TextDocumentVersion VersionedTextDocumentIdentifier)
-> TextDocumentEdit
-> Const @* TextDocumentVersion TextDocumentEdit
forall s a. HasTextDocument s a => Lens' s a
J.textDocument ((VersionedTextDocumentIdentifier
  -> Const @* TextDocumentVersion VersionedTextDocumentIdentifier)
 -> TextDocumentEdit
 -> Const @* TextDocumentVersion TextDocumentEdit)
-> ((TextDocumentVersion
     -> Const @* TextDocumentVersion TextDocumentVersion)
    -> VersionedTextDocumentIdentifier
    -> Const @* TextDocumentVersion VersionedTextDocumentIdentifier)
-> Getting TextDocumentVersion TextDocumentEdit TextDocumentVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentVersion
 -> Const @* TextDocumentVersion TextDocumentVersion)
-> VersionedTextDocumentIdentifier
-> Const @* TextDocumentVersion VersionedTextDocumentIdentifier
forall s a. HasVersion s a => Lens' s a
J.version
    project DocumentChange
_ = TextDocumentVersion
forall a. Maybe a
Nothing

-- ---------------------------------------------------------------------
virtualFileName :: FilePath -> J.NormalizedUri -> VirtualFile -> FilePath
virtualFileName :: String -> NormalizedUri -> VirtualFile -> String
virtualFileName String
prefix NormalizedUri
uri (VirtualFile Int32
_ Int
file_ver Rope
_) =
  let uri_raw :: Uri
uri_raw = NormalizedUri -> Uri
J.fromNormalizedUri NormalizedUri
uri
      basename :: String
basename = String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ShowS
takeFileName (Uri -> Maybe String
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 -> String
padLeft Int
n Int
num =
        let numString :: String
numString = Int -> String
forall a. Show a => a -> String
show Int
num
        in Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
numString) Char
'0' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
numString
  in String
prefix String -> ShowS
</> String
basename String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Int -> String
padLeft Int
5 Int
file_ver String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Uri -> Int
forall a. Hashable a => a -> Int
hash Uri
uri_raw) String -> ShowS
<.> ShowS
takeExtensions String
basename

-- | Write a virtual file to a temporary file if it exists in the VFS.
persistFileVFS :: (MonadIO m) => LogAction m (WithSeverity VfsLog) -> VFS -> J.NormalizedUri -> Maybe (FilePath, m ())
persistFileVFS :: LogAction m (WithSeverity VfsLog)
-> VFS -> NormalizedUri -> Maybe (String, m ())
persistFileVFS LogAction m (WithSeverity VfsLog)
logger 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
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 (String, m ())
forall a. Maybe a
Nothing
    Just VirtualFile
vf ->
      let tfn :: String
tfn = String -> NormalizedUri -> VirtualFile -> String
virtualFileName (VFS
vfs VFS -> Getting String VFS String -> String
forall s a. s -> Getting a s a -> a
^. Getting String VFS String
forall s a. HasVfsTempDir s a => Lens' s a
vfsTempDir) NormalizedUri
uri VirtualFile
vf
          action :: m ()
action = do
            Bool
exists <- IO Bool -> m Bool
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
$ String -> IO Bool
doesFileExist String
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
                    -- 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 LogAction m (WithSeverity VfsLog) -> WithSeverity VfsLog -> m ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& NormalizedUri -> String -> VfsLog
PersistingFile NormalizedUri
uri String
tfn VfsLog -> Severity -> WithSeverity VfsLog
forall msg. msg -> Severity -> WithSeverity msg
`WithSeverity` Severity
Debug
               IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
tfn IOMode
WriteMode Handle -> IO ()
writeRaw
      in (String, m ()) -> Maybe (String, m ())
forall a. a -> Maybe a
Just (String
tfn, m ()
action)

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

closeVFS :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.Message 'J.TextDocumentDidClose -> m ()
closeVFS :: LogAction m (WithSeverity VfsLog)
-> Message @'FromClient @'Notification 'TextDocumentDidClose
-> m ()
closeVFS LogAction m (WithSeverity VfsLog)
logger Message @'FromClient @'Notification 'TextDocumentDidClose
msg = do
  let J.DidCloseTextDocumentParams (J.TextDocumentIdentifier (Uri -> NormalizedUri
J.toNormalizedUri -> NormalizedUri
uri)) = Message @'FromClient @'Notification 'TextDocumentDidClose
NotificationMessage @'FromClient 'TextDocumentDidClose
msg NotificationMessage @'FromClient 'TextDocumentDidClose
-> Getting
     DidCloseTextDocumentParams
     (NotificationMessage @'FromClient 'TextDocumentDidClose)
     DidCloseTextDocumentParams
-> DidCloseTextDocumentParams
forall s a. s -> Getting a s a -> a
^. Getting
  DidCloseTextDocumentParams
  (NotificationMessage @'FromClient 'TextDocumentDidClose)
  DidCloseTextDocumentParams
forall s a. HasParams s a => Lens' s a
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
vfsMap ((Map NormalizedUri VirtualFile
  -> Identity (Map NormalizedUri VirtualFile))
 -> VFS -> Identity VFS)
-> ((Maybe VirtualFile -> Identity (Maybe VirtualFile))
    -> Map NormalizedUri VirtualFile
    -> Identity (Map NormalizedUri VirtualFile))
-> (Maybe 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 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 ()
.= Maybe VirtualFile
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 :: 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 :: LogAction m (WithSeverity VfsLog)
-> Rope -> TextDocumentContentChangeEvent -> m Rope
applyChange LogAction m (WithSeverity VfsLog)
_ Rope
_ (J.TextDocumentContentChangeEvent Maybe Range
Nothing Maybe UInt
_ Text
str)
  = Rope -> m Rope
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
str
applyChange LogAction m (WithSeverity VfsLog)
logger Rope
str (J.TextDocumentContentChangeEvent (Just (J.Range (J.Position UInt
sl UInt
sc) (J.Position UInt
fl UInt
fc))) Maybe UInt
_ Text
txt)
  = 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
Rope.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
Rope.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

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

-- | 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 :: 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 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Rope -> m Rope
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 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Rope -> m Rope
forall (f :: * -> *) a. Applicative f => a -> f a
pure Rope
str
     Just (Rope
before', Rope
_) -> Rope -> m Rope
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]

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

-- | 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
    { -- | Line position in a document (zero-based).
      CodePointPosition -> UInt
_line      :: J.UInt
      -- | Character offset on a line in a document in *code points* (zero-based).
    , CodePointPosition -> UInt
_character :: J.UInt
    } deriving (Int -> CodePointPosition -> ShowS
[CodePointPosition] -> ShowS
CodePointPosition -> String
(Int -> CodePointPosition -> ShowS)
-> (CodePointPosition -> String)
-> ([CodePointPosition] -> ShowS)
-> Show CodePointPosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodePointPosition] -> ShowS
$cshowList :: [CodePointPosition] -> ShowS
show :: CodePointPosition -> String
$cshow :: CodePointPosition -> String
showsPrec :: Int -> CodePointPosition -> ShowS
$cshowsPrec :: Int -> 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
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
(CodePointPosition -> CodePointPosition -> Bool)
-> (CodePointPosition -> CodePointPosition -> Bool)
-> Eq CodePointPosition
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
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
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
$cp1Ord :: Eq CodePointPosition
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 -> String
(Int -> CodePointRange -> ShowS)
-> (CodePointRange -> String)
-> ([CodePointRange] -> ShowS)
-> Show CodePointRange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodePointRange] -> ShowS
$cshowList :: [CodePointRange] -> ShowS
show :: CodePointRange -> String
$cshow :: CodePointRange -> String
showsPrec :: Int -> CodePointRange -> ShowS
$cshowsPrec :: Int -> 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
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
(CodePointRange -> CodePointRange -> Bool)
-> (CodePointRange -> CodePointRange -> Bool) -> Eq CodePointRange
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
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
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
$cp1Ord :: Eq CodePointRange
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 (Position -> Word) -> Position -> Word
forall a b. (a -> b) -> a -> b
$ Rope -> Position
Rope.lengthAsPosition 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 (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
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Word
offset Word -> Word -> Bool
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 (Text -> Rope) -> Text -> Rope
forall a b. (a -> b) -> a -> b
$ Rope -> Text
URope.toText Rope
prefix
      -- Get the length of the prefix in *code units*
  Word -> Maybe Word
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word -> Maybe Word) -> Word -> Maybe Word
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
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Word
offset Word -> Word -> Bool
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 (Text -> Rope) -> Text -> Rope
forall a b. (a -> b) -> a -> b
$ Rope -> Text
Rope.toText Rope
prefix
      -- Get the length of the prefix in *code points*
  Word -> Maybe Word
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word -> Maybe Word) -> Word -> Maybe Word
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 (UInt -> Word
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 (Text -> Rope) -> Text -> Rope
forall a b. (a -> b) -> a -> b
$ Rope -> Text
Rope.toText Rope
utf16Line

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

  Word
cpc <- Rope -> Word -> Maybe Word
codeUnitOffsetToCodePointOffset Rope
utf16Line (UInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
cuc)
  CodePointPosition -> Maybe CodePointPosition
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CodePointPosition -> Maybe CodePointPosition)
-> CodePointPosition -> Maybe CodePointPosition
forall a b. (a -> b) -> a -> b
$ UInt -> UInt -> CodePointPosition
CodePointPosition UInt
l (Word -> UInt
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 (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 (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 -> String
(Int -> PosPrefixInfo -> ShowS)
-> (PosPrefixInfo -> String)
-> ([PosPrefixInfo] -> ShowS)
-> Show PosPrefixInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PosPrefixInfo] -> ShowS
$cshowList :: [PosPrefixInfo] -> ShowS
show :: PosPrefixInfo -> String
$cshow :: PosPrefixInfo -> String
showsPrec :: Int -> PosPrefixInfo -> ShowS
$cshowsPrec :: Int -> PosPrefixInfo -> ShowS
Show,PosPrefixInfo -> PosPrefixInfo -> Bool
(PosPrefixInfo -> PosPrefixInfo -> Bool)
-> (PosPrefixInfo -> PosPrefixInfo -> Bool) -> Eq PosPrefixInfo
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 :: Position -> VirtualFile -> m (Maybe PosPrefixInfo)
getCompletionPrefix pos :: Position
pos@(J.Position UInt
l UInt
c) (VirtualFile Int32
_ Int
_ Rope
ropetext) =
      Maybe PosPrefixInfo -> m (Maybe PosPrefixInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PosPrefixInfo -> m (Maybe PosPrefixInfo))
-> Maybe PosPrefixInfo -> m (Maybe PosPrefixInfo)
forall a b. (a -> b) -> a -> b
$ PosPrefixInfo -> Maybe PosPrefixInfo
forall a. a -> Maybe a
Just (PosPrefixInfo -> Maybe PosPrefixInfo)
-> PosPrefixInfo -> Maybe PosPrefixInfo
forall a b. (a -> b) -> a -> b
$ PosPrefixInfo -> Maybe PosPrefixInfo -> PosPrefixInfo
forall a. a -> Maybe a -> a
fromMaybe (Text -> Text -> Text -> Position -> PosPrefixInfo
PosPrefixInfo Text
"" Text
"" Text
"" Position
pos) (Maybe PosPrefixInfo -> PosPrefixInfo)
-> Maybe PosPrefixInfo -> PosPrefixInfo
forall a b. (a -> b) -> a -> b
$ do -- Maybe monad
        let lastMaybe :: [a] -> Maybe a
lastMaybe [] = Maybe a
forall a. Maybe a
Nothing
            lastMaybe [a]
xs = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall a. [a] -> a
last [a]
xs

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

        let parts :: [Text]
parts = (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.')
                      (Text -> [Text]) -> Text -> [Text]
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 Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"._'"::String)) Text
curWord
        case [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
parts of
          [] -> Maybe PosPrefixInfo
forall a. Maybe a
Nothing
          (Text
x:[Text]
xs) -> do
            let modParts :: [Text]
modParts = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isUpper (Char -> Bool) -> (Text -> Char) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Char
T.head)
                                ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
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 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Rope -> Text
Rope.toText Rope
curRope
            PosPrefixInfo -> Maybe PosPrefixInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (PosPrefixInfo -> Maybe PosPrefixInfo)
-> PosPrefixInfo -> Maybe PosPrefixInfo
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 (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
-- ---------------------------------------------------------------------