@@ -42,37 +42,48 @@ module Test.Hls.Util
4242 , withCurrentDirectoryInTmp
4343 , withCurrentDirectoryInTmp'
4444 , withCanonicalTempDir
45+ -- * Extract positions from input file.
46+ , extractCursorPositions
47+ , mkParameterisedLabel
48+ , trimming
4549 )
4650where
4751
48- import Control.Applicative.Combinators (skipManyTill , (<|>) )
49- import Control.Exception (catch , throwIO )
50- import Control.Lens (_Just , (&) , (.~) , (?~) , (^.) )
52+ import Control.Applicative.Combinators (skipManyTill , (<|>) )
53+ import Control.Exception (catch , throwIO )
54+ import Control.Lens (_Just , (&) , (.~) ,
55+ (?~) , (^.) )
5156import Control.Monad
5257import Control.Monad.IO.Class
53- import qualified Data.Aeson as A
54- import Data.Bool (bool )
58+ import qualified Data.Aeson as A
59+ import Data.Bool (bool )
5560import Data.Default
56- import Data.List.Extra (find )
61+ import Data.List.Extra (find )
5762import Data.Proxy
58- import qualified Data.Set as Set
59- import qualified Data.Text as T
60- import Development.IDE ( GhcVersion ( .. ), ghcVersion )
61- import qualified Language.LSP.Protocol.Lens as L
63+ import qualified Data.Text as T
64+ import Development.IDE ( GhcVersion ( .. ),
65+ ghcVersion )
66+ import qualified Language.LSP.Protocol.Lens as L
6267import Language.LSP.Protocol.Message
6368import Language.LSP.Protocol.Types
64- import qualified Language.LSP.Test as Test
69+ import qualified Language.LSP.Test as Test
6570import System.Directory
6671import System.FilePath
67- import System.Info.Extra (isMac , isWindows )
72+ import System.Info.Extra (isMac , isWindows )
6873import qualified System.IO.Extra
6974import System.IO.Temp
70- import System.Time.Extra (Seconds , sleep )
71- import Test.Tasty (TestTree )
72- import Test.Tasty.ExpectedFailure (expectFailBecause ,
73- ignoreTestBecause )
74- import Test.Tasty.HUnit (Assertion , assertFailure ,
75- (@?=) )
75+ import System.Time.Extra (Seconds , sleep )
76+ import Test.Tasty (TestTree )
77+ import Test.Tasty.ExpectedFailure (expectFailBecause ,
78+ ignoreTestBecause )
79+ import Test.Tasty.HUnit (assertFailure )
80+
81+ import qualified Data.List as List
82+ import qualified Data.Text.Internal.Search as T
83+ import qualified Data.Text.Utf16.Rope.Mixed as Rope
84+ import Development.IDE.Plugin.Completions.Logic (getCompletionPrefixFromRope )
85+ import Development.IDE.Plugin.Completions.Types (PosPrefixInfo (.. ))
86+ import NeatInterpolation (trimming )
7687
7788noLiteralCaps :: ClientCapabilities
7889noLiteralCaps = def & L. textDocument ?~ textDocumentCaps
@@ -327,3 +338,119 @@ withCanonicalTempDir :: (FilePath -> IO a) -> IO a
327338withCanonicalTempDir f = System.IO.Extra. withTempDir $ \ dir -> do
328339 dir' <- canonicalizePath dir
329340 f dir'
341+
342+ -- ----------------------------------------------------------------------------
343+ -- Extract Position data from the source file itself.
344+ -- ----------------------------------------------------------------------------
345+
346+ -- | Pretty labelling for tests that use the parameterised test helpers.
347+ mkParameterisedLabel :: PosPrefixInfo -> String
348+ mkParameterisedLabel posPrefixInfo = unlines
349+ [ " Full Line: \" " <> T. unpack (fullLine posPrefixInfo) <> " \" "
350+ , " Cursor Column: \" " <> replicate (fromIntegral $ cursorPos posPrefixInfo ^. L. character) ' ' ++ " ^" <> " \" "
351+ , " Prefix Text: \" " <> T. unpack (prefixText posPrefixInfo) <> " \" "
352+ ]
353+
354+ -- | Given a in-memory representation of a file, where a user can specify the
355+ -- current cursor position using a '^' in the next line.
356+ --
357+ -- This function allows to generate multiple tests for a single input file, without
358+ -- the hassle of calculating by hand where there cursor is supposed to be.
359+ --
360+ -- Example (line number has been added for readability):
361+ --
362+ -- @
363+ -- 0: foo = 2
364+ -- 1: ^
365+ -- 2: bar =
366+ -- 3: ^
367+ -- @
368+ --
369+ -- This example input file contains two cursor positions (y, x), at
370+ --
371+ -- * (1, 1), and
372+ -- * (3, 5).
373+ --
374+ -- 'extractCursorPositions' will search for '^' characters, and determine there are
375+ -- two cursor positions in the text.
376+ -- First, it will normalise the text to:
377+ --
378+ -- @
379+ -- 0: foo = 2
380+ -- 1: bar =
381+ -- @
382+ --
383+ -- stripping away the '^' characters. Then, the actual cursor positions are:
384+ --
385+ -- * (0, 1) and
386+ -- * (2, 5).
387+ --
388+ extractCursorPositions :: T. Text-> (T. TextPosPrefixInfo ])
389+ extractCursorPositions t =
390+ let
391+ textLines = T. lines t
392+ foldState = List. foldl' go emptyFoldState textLines
393+ finalText = foldStateToText foldState
394+ reconstructCompletionPrefix pos = getCompletionPrefixFromRope pos (Rope. fromText finalText)
395+ cursorPositions = reverse . fmap reconstructCompletionPrefix $ foldStatePositions foldState
396+ in
397+ (finalText, cursorPositions)
398+
399+ where
400+ go foldState l = case T. indices " ^" of
401+ [] -> addTextLine foldState l
402+ xs -> List. foldl' addTextCursor foldState xs
403+
404+ -- | 'FoldState' is an implementation detail used to parse some file contents,
405+ -- extracting the cursor positions identified by '^' and producing a cleaned
406+ -- representation of the file contents.
407+ data FoldState = FoldState
408+ { foldStateRows :: ! Int
409+ -- ^ The row index of the cleaned file contents.
410+ --
411+ -- For example, the file contents
412+ --
413+ -- @
414+ -- 0: foo
415+ -- 1: ^
416+ -- 2: bar
417+ -- @
418+ -- will report that 'bar' is actually occurring in line '1', as '^' is
419+ -- a cursor position.
420+ -- Lines containing cursor positions are removed.
421+ , foldStatePositions :: ! [Position ]
422+ -- ^ List of cursors positions found in the file contents.
423+ --
424+ -- List is stored in reverse for efficient 'cons'ing
425+ , foldStateFinalText :: ! [T. Text
426+ -- ^ Final file contents with all lines containing cursor positions removed.
427+ --
428+ -- List is stored in reverse for efficient 'cons'ing
429+ }
430+
431+ emptyFoldState :: FoldState
432+ emptyFoldState = FoldState
433+ { foldStateRows = 0
434+ , foldStatePositions = []
435+ , foldStateFinalText = []
436+ }
437+
438+ -- | Produce the final file contents, without any lines containing cursor positions.
439+ foldStateToText :: FoldState -> T. Text
440+ foldStateToText state = T. unlines $ reverse $ foldStateFinalText state
441+
442+ -- | We found a '^' at some location! Add it to the list of known cursor positions.
443+ --
444+ -- If the row index is '0', we throw an error, as there can't be a cursor position above the first line.
445+ addTextCursor :: FoldState -> Int -> FoldState
446+ addTextCursor state col
447+ | foldStateRows state <= 0 = error $ " addTextCursor: Invalid '^' found at: " <> show (col, foldStateRows state)
448+ | otherwise = state
449+ { foldStatePositions = Position (fromIntegral (foldStateRows state) - 1 ) (fromIntegral col) : foldStatePositions state
450+ }
451+
452+ addTextLine :: FoldState -> T. Text-> FoldState
453+ addTextLine state l = state
454+ { foldStateFinalText = l : foldStateFinalText state
455+ , foldStateRows = foldStateRows state + 1
456+ }
0 commit comments