{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {- Manage the J.TextDocumentDidChange messages to keep a local copy of the files in the client workspace, so that tools at the server can operate on them. -} module Language.Haskell.LSP.VFS ( VFS , VirtualFile(..) , openVFS , changeVFS , closeVFS -- * for tests , applyChange , sortChanges , deleteChars , addChars , changeChars , yiSplitAt ) where import Data.Text ( Text ) import Data.List import Data.Monoid import qualified Data.Map as Map import qualified Language.Haskell.LSP.TH.DataTypesJSON as J import Language.Haskell.LSP.Utility import qualified Yi.Rope as Yi -- --------------------------------------------------------------------- {-# ANN module ("hlint: ignore Eta reduce" :: String) #-} {-# ANN module ("hlint: ignore Redundant do" :: String) #-} -- --------------------------------------------------------------------- data VirtualFile = VirtualFile { _version :: Int , _text :: Yi.YiString } deriving (Show) type VFS = Map.Map J.Uri VirtualFile -- --------------------------------------------------------------------- openVFS :: VFS -> J.DidOpenTextDocumentNotification -> IO VFS openVFS vfs (J.NotificationMessage _ _ params) = do let J.DidOpenTextDocumentParams (J.TextDocumentItem uri _ version text) = params return $ Map.insert uri (VirtualFile version (Yi.fromText text)) vfs -- --------------------------------------------------------------------- changeVFS :: VFS -> J.DidChangeTextDocumentNotification -> IO VFS changeVFS vfs (J.NotificationMessage _ _ params) = do let J.DidChangeTextDocumentParams vid (J.List changes) = params J.VersionedTextDocumentIdentifier uri version = vid case Map.lookup uri vfs of Just (VirtualFile _ str) -> do let str' = applyChanges str changes return $ Map.insert uri (VirtualFile version str') vfs Nothing -> do logs $ "haskell-lsp:changeVfs:can't find uri:" ++ show uri return vfs -- --------------------------------------------------------------------- closeVFS :: VFS -> J.DidCloseTextDocumentNotification -> IO VFS closeVFS vfs (J.NotificationMessage _ _ params) = do let J.DidCloseTextDocumentParams (J.TextDocumentIdentifier uri) = params return $ Map.delete uri vfs -- --------------------------------------------------------------------- {- data TextDocumentContentChangeEvent = TextDocumentContentChangeEvent { _range :: Maybe Range , _rangeLength :: Maybe Int , _text :: String } deriving (Read,Show,Eq) -} -- | Apply the list of changes, in descending order of range. Assuming no overlaps. applyChanges :: Yi.YiString -> [J.TextDocumentContentChangeEvent] -> Yi.YiString applyChanges str changes' = r where changes = sortChanges changes' r = foldl' applyChange str changes -- --------------------------------------------------------------------- applyChange :: Yi.YiString -> J.TextDocumentContentChangeEvent -> Yi.YiString applyChange _ (J.TextDocumentContentChangeEvent Nothing Nothing str) = Yi.fromText str applyChange str (J.TextDocumentContentChangeEvent (Just (J.Range fm _to)) (Just len) txt) = if txt == "" then -- delete len chars from fm deleteChars str fm len else -- add or change, based on length if len == 0 then addChars str fm txt -- Note: changeChars comes from applyEdit, emacs will split it into a -- delete and an add else changeChars str fm len txt applyChange str (J.TextDocumentContentChangeEvent (Just r@(J.Range (J.Position sl sc) (J.Position el ec))) Nothing txt) = applyChange str (J.TextDocumentContentChangeEvent (Just r) (Just len) txt) where len = Yi.length region (beforeEnd, afterEnd) = Yi.splitAtLine el str lastLine = Yi.take ec afterEnd lastLine' | sl == el = Yi.drop sc lastLine | otherwise = lastLine (_beforeStart, afterStartBeforeEnd) = Yi.splitAtLine sl beforeEnd region = Yi.drop sc afterStartBeforeEnd <> lastLine' applyChange str (J.TextDocumentContentChangeEvent Nothing (Just _) _txt) = str -- --------------------------------------------------------------------- deleteChars :: Yi.YiString -> J.Position -> Int -> Yi.YiString deleteChars str (J.Position l c) len = str' where (before,after) = Yi.splitAtLine l str -- after contains the area we care about, starting with the selected line. -- Due to LSP zero-based coordinates beforeOnLine = Yi.take c after after' = Yi.drop (c + len) after str' = Yi.append before (Yi.append beforeOnLine after') -- --------------------------------------------------------------------- addChars :: Yi.YiString -> J.Position -> Text -> Yi.YiString addChars str (J.Position l c) new = str' where (before,after) = Yi.splitAtLine l str -- after contains the area we care about, starting with the selected line. -- Due to LSP zero-based coordinates beforeOnLine = Yi.take c after after' = Yi.drop c after str' = Yi.concat [before, beforeOnLine, (Yi.fromText new), after'] -- --------------------------------------------------------------------- changeChars :: Yi.YiString -> J.Position -> Int -> Text -> Yi.YiString changeChars str (J.Position ls cs) len new = str' where (before,after) = yiSplitAt ls cs str after' = Yi.drop len after str' = Yi.concat [before, (Yi.fromText new), after'] -- changeChars :: Yi.YiString -> J.Position -> J.Position -> String -> Yi.YiString -- changeChars str (J.Position ls cs) (J.Position le ce) new = str' -- where -- (before,_after) = yiSplitAt ls cs str -- (_before,after) = yiSplitAt le ce str -- str' = Yi.concat [before, (Yi.fromString new), after] -- -- str' = Yi.concat [before] -- -- str' = Yi.concat [_before] -- --------------------------------------------------------------------- yiSplitAt :: Int -> Int -> Yi.YiString -> (Yi.YiString, Yi.YiString) yiSplitAt l c str = (before,after) where (b,a) = Yi.splitAtLine l str before = Yi.concat [b,Yi.take c a] after = Yi.drop c a -- --------------------------------------------------------------------- sortChanges :: [J.TextDocumentContentChangeEvent] -> [J.TextDocumentContentChangeEvent] sortChanges changes = changes' where myComp (J.TextDocumentContentChangeEvent (Just r1) _ _) (J.TextDocumentContentChangeEvent (Just r2) _ _) = compare r2 r1 -- want descending order myComp _ _ = EQ changes' = sortBy myComp changes -- ---------------------------------------------------------------------