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

{-|
Handles the "Language.Haskell.LSP.Types.TextDocumentDidChange" \/
"Language.Haskell.LSP.Types.TextDocumentDidOpen" \/
"Language.Haskell.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.Haskell.LSP.VFS
  (
    VFS(..)
  , VirtualFile(..)
  , virtualFileText
  , virtualFileVersion
  -- * Managing the VFS
  , initVFS
  , openVFS
  , changeFromClientVFS
  , changeFromServerVFS
  , persistFileVFS
  , closeVFS
  , updateVFS

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

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

import           Control.Lens hiding ( parts )
import           Control.Monad
import           Data.Char (isUpper, isAlphaNum)
import           Data.Text ( Text )
import qualified Data.Text as T
import           Data.List
import           Data.Ord
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Map as Map
import           Data.Maybe
import           Data.Rope.UTF16 ( Rope )
import qualified Data.Rope.UTF16 as Rope
import qualified Language.Haskell.LSP.Types           as J
import qualified Language.Haskell.LSP.Types.Lens      as J
import           Language.Haskell.LSP.Utility
import           System.FilePath
import           Data.Hashable
import           System.Directory
import           System.IO 
import           System.IO.Temp

-- ---------------------------------------------------------------------
{-# ANN module ("hlint: ignore Eta reduce" :: String) #-}
{-# ANN module ("hlint: ignore Redundant do" :: String) #-}
-- ---------------------------------------------------------------------

data VirtualFile =
  VirtualFile {
      VirtualFile -> Int
_lsp_version :: !Int  -- ^ 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
_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)


type VFSMap = Map.Map J.NormalizedUri VirtualFile

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

---

virtualFileText :: VirtualFile -> Text
virtualFileText :: VirtualFile -> Text
virtualFileText VirtualFile
vf = Rope -> Text
Rope.toText (VirtualFile -> Rope
_text  VirtualFile
vf)

virtualFileVersion :: VirtualFile -> Int
virtualFileVersion :: VirtualFile -> Int
virtualFileVersion VirtualFile
vf = VirtualFile -> Int
_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 'DidOpenTextDocumentNotification' to the 'VFS'
openVFS :: VFS -> J.DidOpenTextDocumentNotification -> (VFS, [String])
openVFS :: VFS -> DidOpenTextDocumentNotification -> (VFS, [String])
openVFS VFS
vfs (J.NotificationMessage Text
_ ClientMethod
_ DidOpenTextDocumentParams
params) =
  let J.DidOpenTextDocumentParams
         (J.TextDocumentItem Uri
uri Text
_ Int
version Text
text) = DidOpenTextDocumentParams
params
  in ((Map NormalizedUri VirtualFile -> Map NormalizedUri VirtualFile)
-> VFS -> VFS
updateVFS (NormalizedUri
-> VirtualFile
-> Map NormalizedUri VirtualFile
-> Map NormalizedUri VirtualFile
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Uri -> NormalizedUri
J.toNormalizedUri Uri
uri) (Int -> Int -> Rope -> VirtualFile
VirtualFile Int
version Int
0 (Text -> Rope
Rope.fromText Text
text))) VFS
vfs
     , [])


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

-- ^ Applies a 'DidChangeTextDocumentNotification' to the 'VFS'
changeFromClientVFS :: VFS -> J.DidChangeTextDocumentNotification -> (VFS,[String])
changeFromClientVFS :: VFS -> DidChangeTextDocumentNotification -> (VFS, [String])
changeFromClientVFS VFS
vfs (J.NotificationMessage Text
_ ClientMethod
_ DidChangeTextDocumentParams
params) =
  let
    J.DidChangeTextDocumentParams VersionedTextDocumentIdentifier
vid (J.List [TextDocumentContentChangeEvent]
changes) = DidChangeTextDocumentParams
params
    J.VersionedTextDocumentIdentifier (Uri -> NormalizedUri
J.toNormalizedUri -> NormalizedUri
uri) TextDocumentVersion
version = VersionedTextDocumentIdentifier
vid
  in
    case NormalizedUri -> Map NormalizedUri VirtualFile -> Maybe VirtualFile
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NormalizedUri
uri (VFS -> Map NormalizedUri VirtualFile
vfsMap VFS
vfs) of
      Just (VirtualFile Int
_ Int
file_ver Rope
str) ->
        let str' :: Rope
str' = Rope -> [TextDocumentContentChangeEvent] -> Rope
applyChanges Rope
str [TextDocumentContentChangeEvent]
changes
        -- the client shouldn't be sending over a null version, only the server.
        in ((Map NormalizedUri VirtualFile -> Map NormalizedUri VirtualFile)
-> VFS -> VFS
updateVFS (NormalizedUri
-> VirtualFile
-> Map NormalizedUri VirtualFile
-> Map NormalizedUri VirtualFile
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert NormalizedUri
uri (Int -> Int -> Rope -> VirtualFile
VirtualFile (Int -> TextDocumentVersion -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 TextDocumentVersion
version) (Int
file_ver Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Rope
str')) VFS
vfs, [])
      Maybe VirtualFile
Nothing ->
        -- logs $ "haskell-lsp:changeVfs:can't find uri:" ++ show uri
        -- return vfs
        (VFS
vfs, [String
"haskell-lsp:changeVfs:can't find uri:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ NormalizedUri -> String
forall a. Show a => a -> String
show NormalizedUri
uri])

updateVFS :: (VFSMap -> VFSMap) -> VFS -> VFS
updateVFS :: (Map NormalizedUri VirtualFile -> Map NormalizedUri VirtualFile)
-> VFS -> VFS
updateVFS Map NormalizedUri VirtualFile -> Map NormalizedUri VirtualFile
f vfs :: VFS
vfs@VFS{Map NormalizedUri VirtualFile
vfsMap :: Map NormalizedUri VirtualFile
$sel:vfsMap:VFS :: VFS -> Map NormalizedUri VirtualFile
vfsMap} = VFS
vfs { $sel:vfsMap:VFS :: Map NormalizedUri VirtualFile
vfsMap = Map NormalizedUri VirtualFile -> Map NormalizedUri VirtualFile
f Map NormalizedUri VirtualFile
vfsMap }

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

-- ^ Applies the changes from a 'ApplyWorkspaceEditRequest' to the 'VFS'
changeFromServerVFS :: VFS -> J.ApplyWorkspaceEditRequest -> IO VFS
changeFromServerVFS :: VFS -> ApplyWorkspaceEditRequest -> IO VFS
changeFromServerVFS VFS
initVfs (J.RequestMessage Text
_ LspId
_ ServerMethod
_ ApplyWorkspaceEditParams
params) = do
  let J.ApplyWorkspaceEditParams WorkspaceEdit
edit = ApplyWorkspaceEditParams
params
      J.WorkspaceEdit Maybe WorkspaceEditMap
mChanges Maybe (List TextDocumentEdit)
mDocChanges = WorkspaceEdit
edit
  case Maybe (List TextDocumentEdit)
mDocChanges of
    Just (J.List [TextDocumentEdit]
textDocEdits) -> [TextDocumentEdit] -> IO VFS
applyEdits [TextDocumentEdit]
textDocEdits
    Maybe (List TextDocumentEdit)
Nothing -> case Maybe WorkspaceEditMap
mChanges of
      Just WorkspaceEditMap
cs -> [TextDocumentEdit] -> IO VFS
applyEdits ([TextDocumentEdit] -> IO VFS) -> [TextDocumentEdit] -> IO VFS
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 -> do
        String -> IO ()
logs String
"haskell-lsp:changeVfs:no changes"
        VFS -> IO VFS
forall (m :: * -> *) a. Monad m => a -> m a
return VFS
initVfs

  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 -> TextDocumentEdit
J.TextDocumentEdit (Uri -> TextDocumentVersion -> VersionedTextDocumentIdentifier
J.VersionedTextDocumentIdentifier Uri
uri (Int -> TextDocumentVersion
forall a. a -> Maybe a
Just Int
0)) List TextEdit
edits]

    -- applyEdits :: [J.TextDocumentEdit] -> VFS
    applyEdits :: [J.TextDocumentEdit] -> IO VFS
    applyEdits :: [TextDocumentEdit] -> IO VFS
applyEdits = (VFS -> TextDocumentEdit -> IO VFS)
-> VFS -> [TextDocumentEdit] -> IO VFS
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM VFS -> TextDocumentEdit -> IO VFS
f VFS
initVfs ([TextDocumentEdit] -> IO VFS)
-> ([TextDocumentEdit] -> [TextDocumentEdit])
-> [TextDocumentEdit]
-> IO VFS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentEdit -> TextDocumentVersion)
-> [TextDocumentEdit] -> [TextDocumentEdit]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (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)

    f :: VFS -> J.TextDocumentEdit -> IO VFS
    f :: VFS -> TextDocumentEdit -> IO VFS
f VFS
vfs (J.TextDocumentEdit VersionedTextDocumentIdentifier
vid (J.List [TextEdit]
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]
sortedEdits = (TextEdit -> Down Range) -> [TextEdit] -> [TextEdit]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Range -> Down Range
forall a. a -> Down a
Down (Range -> Down Range)
-> (TextEdit -> Range) -> TextEdit -> Down Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)) [TextEdit]
edits
          changeEvents :: [TextDocumentContentChangeEvent]
changeEvents = (TextEdit -> TextDocumentContentChangeEvent)
-> [TextEdit] -> [TextDocumentContentChangeEvent]
forall a b. (a -> b) -> [a] -> [b]
map TextEdit -> TextDocumentContentChangeEvent
editToChangeEvent [TextEdit]
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 :: DidChangeTextDocumentNotification
notif = Text
-> ClientMethod
-> DidChangeTextDocumentParams
-> DidChangeTextDocumentNotification
forall m a. Text -> m -> a -> NotificationMessage m a
J.NotificationMessage Text
"" ClientMethod
J.TextDocumentDidChange DidChangeTextDocumentParams
ps
      let (VFS
vfs',[String]
ls) = VFS -> DidChangeTextDocumentNotification -> (VFS, [String])
changeFromClientVFS VFS
vfs DidChangeTextDocumentNotification
notif
      (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
logs [String]
ls
      VFS -> IO VFS
forall (m :: * -> *) a. Monad m => a -> m a
return VFS
vfs'

    editToChangeEvent :: TextEdit -> TextDocumentContentChangeEvent
editToChangeEvent (J.TextEdit Range
range Text
text) = Maybe Range
-> TextDocumentVersion -> Text -> TextDocumentContentChangeEvent
J.TextDocumentContentChangeEvent (Range -> Maybe Range
forall a. a -> Maybe a
Just Range
range) TextDocumentVersion
forall a. Maybe a
Nothing Text
text

-- ---------------------------------------------------------------------
virtualFileName :: FilePath -> J.NormalizedUri -> VirtualFile -> FilePath
virtualFileName :: String -> NormalizedUri -> VirtualFile -> String
virtualFileName String
prefix NormalizedUri
uri (VirtualFile Int
_ 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
forall a. [a] -> [a] -> [a]
++ String
".hs"

-- | Write a virtual file to a temporary file if it exists in the VFS.
persistFileVFS :: VFS -> J.NormalizedUri -> Maybe (FilePath, IO ())
persistFileVFS :: VFS -> NormalizedUri -> Maybe (String, IO ())
persistFileVFS VFS
vfs NormalizedUri
uri =
  case NormalizedUri -> Map NormalizedUri VirtualFile -> Maybe VirtualFile
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NormalizedUri
uri (VFS -> Map NormalizedUri VirtualFile
vfsMap VFS
vfs) of
    Maybe VirtualFile
Nothing -> Maybe (String, IO ())
forall a. Maybe a
Nothing
    Just VirtualFile
vf ->
      let tfn :: String
tfn = String -> NormalizedUri -> VirtualFile -> String
virtualFileName (VFS -> String
vfsTempDir VFS
vfs) NormalizedUri
uri VirtualFile
vf
          action :: IO ()
action = do
            Bool
exists <- String -> IO Bool
doesFileExist String
tfn
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
               let contents :: String
contents = Rope -> String
Rope.toString (VirtualFile -> Rope
_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 -> String -> IO ()
hPutStr Handle
h String
contents
               String -> IO ()
logs  (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"haskell-lsp:persistFileVFS: Writing virtual file: " 
                    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"uri = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ NormalizedUri -> String
forall a. Show a => a -> String
show NormalizedUri
uri String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", virtual file = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
tfn
               String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
tfn IOMode
WriteMode Handle -> IO ()
writeRaw
      in (String, IO ()) -> Maybe (String, IO ())
forall a. a -> Maybe a
Just (String
tfn, IO ()
action)

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

closeVFS :: VFS -> J.DidCloseTextDocumentNotification -> (VFS, [String])
closeVFS :: VFS -> DidCloseTextDocumentNotification -> (VFS, [String])
closeVFS VFS
vfs (J.NotificationMessage Text
_ ClientMethod
_ DidCloseTextDocumentParams
params) =
  let J.DidCloseTextDocumentParams (J.TextDocumentIdentifier Uri
uri) = DidCloseTextDocumentParams
params
  in ((Map NormalizedUri VirtualFile -> Map NormalizedUri VirtualFile)
-> VFS -> VFS
updateVFS (NormalizedUri
-> Map NormalizedUri VirtualFile -> Map NormalizedUri VirtualFile
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (Uri -> NormalizedUri
J.toNormalizedUri Uri
uri)) VFS
vfs,[String
"Closed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Uri -> String
forall a. Show a => a -> String
show Uri
uri])

-- ---------------------------------------------------------------------
{-

data TextDocumentContentChangeEvent =
  TextDocumentContentChangeEvent
    { _range       :: Maybe Range
    , _rangeLength :: Maybe Int
    , _text        :: String
    } deriving (Read,Show,Eq)
-}

-- | Apply the list of changes.
-- Changes should be applied in the order that they are
-- received from the client.
applyChanges :: Rope -> [J.TextDocumentContentChangeEvent] -> Rope
applyChanges :: Rope -> [TextDocumentContentChangeEvent] -> Rope
applyChanges = (Rope -> TextDocumentContentChangeEvent -> Rope)
-> Rope -> [TextDocumentContentChangeEvent] -> Rope
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Rope -> TextDocumentContentChangeEvent -> Rope
applyChange

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

applyChange :: Rope -> J.TextDocumentContentChangeEvent -> Rope
applyChange :: Rope -> TextDocumentContentChangeEvent -> Rope
applyChange Rope
_ (J.TextDocumentContentChangeEvent Maybe Range
Nothing TextDocumentVersion
Nothing Text
str)
  = Text -> Rope
Rope.fromText Text
str
applyChange Rope
str (J.TextDocumentContentChangeEvent (Just (J.Range (J.Position Int
sl Int
sc) Position
_to)) (Just Int
len) Text
txt)
  = Rope -> Int -> Int -> Text -> Rope
changeChars Rope
str Int
start Int
len Text
txt
  where
    start :: Int
start = RowColumn -> Rope -> Int
Rope.rowColumnCodeUnits (Int -> Int -> RowColumn
Rope.RowColumn Int
sl Int
sc) Rope
str
applyChange Rope
str (J.TextDocumentContentChangeEvent (Just (J.Range (J.Position Int
sl Int
sc) (J.Position Int
el Int
ec))) TextDocumentVersion
Nothing Text
txt)
  = Rope -> Int -> Int -> Text -> Rope
changeChars Rope
str Int
start Int
len Text
txt
  where
    start :: Int
start = RowColumn -> Rope -> Int
Rope.rowColumnCodeUnits (Int -> Int -> RowColumn
Rope.RowColumn Int
sl Int
sc) Rope
str
    end :: Int
end = RowColumn -> Rope -> Int
Rope.rowColumnCodeUnits (Int -> Int -> RowColumn
Rope.RowColumn Int
el Int
ec) Rope
str
    len :: Int
len = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start
applyChange Rope
str (J.TextDocumentContentChangeEvent Maybe Range
Nothing (Just Int
_) Text
_txt)
  = Rope
str

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

changeChars :: Rope -> Int -> Int -> Text -> Rope
changeChars :: Rope -> Int -> Int -> Text -> Rope
changeChars Rope
str Int
start Int
len Text
new = [Rope] -> Rope
forall a. Monoid a => [a] -> a
mconcat [Rope
before, Text -> Rope
Rope.fromText Text
new, Rope
after']
  where
    (Rope
before, Rope
after) = Int -> Rope -> (Rope, Rope)
Rope.splitAt Int
start Rope
str
    after' :: Rope
after' = Int -> Rope -> Rope
Rope.drop Int
len Rope
after

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

-- 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 Int
l Int
c) (VirtualFile Int
_ 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 headMaybe :: [a] -> Maybe a
headMaybe [] = Maybe a
forall a. Maybe a
Nothing
            headMaybe (a
x:[a]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
            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

        Text
curLine <- [Text] -> Maybe Text
forall a. [a] -> Maybe a
headMaybe ([Text] -> Maybe Text) -> [Text] -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Rope -> Text
Rope.toText
                             (Rope -> Text) -> Rope -> Text
forall a b. (a -> b) -> a -> b
$ (Rope, Rope) -> Rope
forall a b. (a, b) -> a
fst ((Rope, Rope) -> Rope) -> (Rope, Rope) -> Rope
forall a b. (a -> b) -> a -> b
$ Int -> Rope -> (Rope, Rope)
Rope.splitAtLine Int
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
$ Int -> Rope -> (Rope, Rope)
Rope.splitAtLine Int
l Rope
ropetext
        let beforePos :: Text
beforePos = Int -> Text -> Text
T.take Int
c Text
curLine
        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
            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 Int
_ Int
_ Rope
ropetext) (J.Range (J.Position Int
lf Int
_cf) (J.Position Int
lt Int
_ct)) = Text
r
  where
    (Rope
_ ,Rope
s1) = Int -> Rope -> (Rope, Rope)
Rope.splitAtLine Int
lf Rope
ropetext
    (Rope
s2, Rope
_) = Int -> Rope -> (Rope, Rope)
Rope.splitAtLine (Int
lt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lf) Rope
s1
    r :: Text
r = Rope -> Text
Rope.toText Rope
s2
-- ---------------------------------------------------------------------