{-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} module Completer where import Control.Lens ((^.), (^?)) import Control.Lens.Prism import qualified Data.ByteString as ByteString import Data.Maybe (mapMaybe) import qualified Data.Text as T import qualified Development.IDE.Plugin.Completions.Types as Ghcide import Distribution.PackageDescription.Parsec (parseGenericPackageDescriptionMaybe) import Ide.Plugin.Cabal.Completion.Completer.FilePath import Ide.Plugin.Cabal.Completion.Completer.Module import Ide.Plugin.Cabal.Completion.Completer.Paths import Ide.Plugin.Cabal.Completion.Completer.Types (CompleterData (..)) import Ide.Plugin.Cabal.Completion.Completions import Ide.Plugin.Cabal.Completion.Types (CabalPrefixInfo (..), StanzaName) import Ide.Plugin.Cabal.Parse (GenericPackageDescription) import qualified Language.LSP.Protocol.Lens as L import System.FilePath import Test.Hls import Utils completerTests :: TestTree completerTests = testGroup "Completer Tests" [ basicCompleterTests, fileCompleterTests, filePathCompletionContextTests, directoryCompleterTests, completionHelperTests, filePathExposedModulesTests, exposedModuleCompleterTests ] basicCompleterTests :: TestTree basicCompleterTests = testGroup "Basic Completer Tests" [ runCabalTestCaseSession "In stanza context - stanza should not be suggested" "" $ do doc <- openDoc "completer.cabal" "cabal" compls <- getCompletions doc (Position 11 7) let complTexts = getTextEditTexts compls liftIO $ assertBool "does not suggest library" $ "library" `notElem` complTexts liftIO $ assertBool "suggests library keyword" $ "extra-libraries:" `elem` complTexts , runCabalTestCaseSession "In top level context - stanza should be suggested" "" $ do doc <- openDoc "completer.cabal" "cabal" compls <- getCompletions doc (Position 8 2) let complTexts = getTextEditTexts compls liftIO $ assertBool "suggests benchmark" $ "benchmark" `elem` complTexts , runCabalTestCaseSession "Main-is completions should be relative to hs-source-dirs of same stanza" "filepath-completions" $ do doc <- openDoc "main-is.cabal" "cabal" compls <- getCompletions doc (Position 10 12) let complTexts = getTextEditTexts compls liftIO $ assertBool "suggests f2" $ "./f2.hs" `elem` complTexts liftIO $ assertBool "does not suggest" $ "./Content.hs" `notElem` complTexts ] where getTextEditTexts :: [CompletionItem] -> [T.Text] getTextEditTexts compls = mapMaybe (^? L.textEdit . _Just . _L . L.newText) compls fileCompleterTests :: TestTree fileCompleterTests = testGroup "File Completer Tests" [ testCase "Current Directory" $ do completions <- completeFilePath "" filePathComplTestDir completions @?== ["./.hidden", "./Content.hs", "./dir1/", "./dir2/", "./textfile.txt", "./main-is.cabal"], testCase "Current Directory - alternative writing" $ do completions <- completeFilePath "./" filePathComplTestDir completions @?== ["./.hidden", "./Content.hs", "./dir1/", "./dir2/", "./textfile.txt", "./main-is.cabal"], testCase "Current Directory - hidden file start" $ do completions <- completeFilePath "." filePathComplTestDir completions @?== ["./Content.hs", "./.hidden", "./textfile.txt", "./main-is.cabal"], testCase "Current Directory - incomplete directory path written" $ do completions <- completeFilePath "di" filePathComplTestDir completions @?== ["./dir1/", "./dir2/"], testCase "Current Directory - incomplete filepath written" $ do completions <- completeFilePath "te" filePathComplTestDir completions @?== ["./Content.hs", "./textfile.txt"], testCase "Subdirectory" $ do completions <- completeFilePath "dir1/" filePathComplTestDir completions @?== ["dir1/f1.txt", "dir1/f2.hs"], testCase "Subdirectory - incomplete filepath written" $ do completions <- completeFilePath "dir2/dir3/MA" filePathComplTestDir completions @?== ["dir2/dir3/MARKDOWN.md"], testCase "Nonexistent directory" $ do completions <- completeFilePath "dir2/dir4/" filePathComplTestDir completions @?== [] ] where completeFilePath :: T.Text -> TestName -> IO [T.Text] completeFilePath written dirName = do completer <- filePathCompleter mempty $ mkCompleterData $ simpleCabalPrefixInfoFromFp written dirName pure $ fmap extract completer filePathCompletionContextTests :: TestTree filePathCompletionContextTests = testGroup "File Path Completion Context Tests" [ testCase "empty file - start" $ do let complContext = getCabalPrefixInfo "" (simplePosPrefixInfo "" 0 0) completionPrefix complContext @?= "", testCase "only whitespaces" $ do let complContext = getCabalPrefixInfo "" (simplePosPrefixInfo " " 0 3) completionPrefix complContext @?= "", testCase "simple filepath" $ do let complContext = getCabalPrefixInfo "" (simplePosPrefixInfo " src/" 0 7) completionPrefix complContext @?= "src/", testCase "simple filepath - starting apostrophe" $ do let complContext = getCabalPrefixInfo "" (simplePosPrefixInfo " \"src/" 0 8) completionPrefix complContext @?= "src/", testCase "simple filepath - starting apostrophe, already closed" $ do let complContext = getCabalPrefixInfo "" (simplePosPrefixInfo " \"src/\"" 0 8) completionPrefix complContext @?= "src/", testCase "second filepath - starting apostrophe" $ do let complContext = getCabalPrefixInfo "" (simplePosPrefixInfo "fp.txt \"src/" 0 12) completionPrefix complContext @?= "src/", testCase "middle filepath - starting apostrophe" $ do let complContext = getCabalPrefixInfo "" (simplePosPrefixInfo "fp.txt \"src/ fp2.txt" 0 12) completionPrefix complContext @?= "src/", testCase "middle filepath - starting apostrophe, already closed" $ do let complContext = getCabalPrefixInfo "" (simplePosPrefixInfo "fp.t xt \"src\" fp2.txt" 0 12) completionPrefix complContext @?= "src", testCase "middle filepath - starting apostrophe, already closed" $ do let complContext = getCabalPrefixInfo "" (simplePosPrefixInfo "\"fp.txt\" \"src fp2.txt" 0 13) completionPrefix complContext @?= "src", testCase "Current Directory" $ do compls <- listFileCompletions mempty PathCompletionInfo { isStringNotationPath = Nothing, pathSegment = "", queryDirectory = "", workingDirectory = filePathComplTestDir } compls @?== [".hidden", "Content.hs", "dir1/", "dir2/", "textfile.txt", "main-is.cabal"], testCase "In directory" $ do compls <- listFileCompletions mempty PathCompletionInfo { isStringNotationPath = Nothing, pathSegment = "", queryDirectory = "dir1/", workingDirectory = filePathComplTestDir } compls @?== ["f1.txt", "f2.hs"] ] where simplePosPrefixInfo :: T.Text -> UInt -> UInt -> Ghcide.PosPrefixInfo simplePosPrefixInfo lineString linePos charPos = Ghcide.PosPrefixInfo { Ghcide.fullLine = lineString, Ghcide.prefixScope = "", Ghcide.prefixText = "", Ghcide.cursorPos = Position linePos charPos } directoryCompleterTests :: TestTree directoryCompleterTests = testGroup "Directory Completer Tests" [ testCase "Current Directory" $ do completions <- completeDirectory "" filePathComplTestDir completions @?== ["./dir1/", "./dir2/"], testCase "Current Directory - alternative writing" $ do completions <- completeDirectory "./" filePathComplTestDir completions @?== ["./dir1/", "./dir2/"], testCase "Current Directory - incomplete directory path written" $ do completions <- completeDirectory "di" filePathComplTestDir completions @?== ["./dir1/", "./dir2/"], testCase "Current Directory - incomplete filepath written" $ do completions <- completeDirectory "te" filePathComplTestDir completions @?== [], testCase "Subdirectory - no more directories found" $ do completions <- completeDirectory "dir1/" filePathComplTestDir completions @?== [], testCase "Subdirectory - available subdirectory" $ do completions <- completeDirectory "dir2/" filePathComplTestDir completions @?== ["dir2/dir3/"], testCase "Nonexistent directory" $ do completions <- completeDirectory "dir2/dir4/" filePathComplTestDir completions @?== [] ] where completeDirectory :: T.Text -> TestName -> IO [T.Text] completeDirectory written dirName = do completer <- directoryCompleter mempty $ mkCompleterData $ simpleCabalPrefixInfoFromFp written dirName pure $ fmap extract completer completionHelperTests :: TestTree completionHelperTests = testGroup "Completion Helper Tests" [ testCase "get FilePath - partly written file path" $ do getFilePathCursorPrefix "src/a" 0 5 @?= "src/a", testCase "get FilePath - ignores spaces" $ do getFilePathCursorPrefix " src/a" 0 7 @?= "src/a", testCase "get FilePath - ignores spaces and keyword" $ do getFilePathCursorPrefix "license-file: src/a" 0 19 @?= "src/a", testCase "get FilePath - with apostrophe, ignores spaces and keyword" $ do getFilePathCursorPrefix "license-file: \"src/a" 0 20 @?= "src/a", testCase "get FilePath - ignores list of filepaths beforehand, space separated" $ do getFilePathCursorPrefix " ./text.txt file.h" 0 19 @?= "file.h", testCase "get FilePath - ignores list of filepaths after, space separated" $ do getFilePathCursorPrefix " ./text.t file.h" 0 10 @?= "./text.t", testCase "get FilePath - ignores list of filepaths and rest of filepath after, space separated" $ do getFilePathCursorPrefix " ./text.t file.h" 0 6 @?= "./te", testCase "get FilePath - ignores list of filepaths beforehand, multiple space separated" $ do getFilePathCursorPrefix " ./text.txt file.h" 0 21 @?= "file.h", testCase "get FilePath - ignores list of filepaths beforehand, comma separated" $ do getFilePathCursorPrefix " ./text.txt, file.h" 0 20 @?= "file.h", testCase "get FilePath - ignores list of filepaths beforehand, comma separated, many whitespaces" $ do getFilePathCursorPrefix " ./text.txt, file.h" 0 22 @?= "file.h", testCase "get FilePath - ignores list of filepaths beforehand, comma separated, no whitespace" $ do getFilePathCursorPrefix " ./text.txt,file.h" 0 19 @?= "file.h", testCase "get FilePath - with apostrophes, ignores list of filepaths beforehand" $ do getFilePathCursorPrefix " \"./text.txt\" \"file.h" 0 23 @?= "file.h", testCase "get FilePath - ignores list of filepaths with apostrophe beforehand" $ do getFilePathCursorPrefix " \"./text.txt\" file.h" 0 22 @?= "file.h" ] where getFilePathCursorPrefix :: T.Text -> UInt -> UInt -> T.Text getFilePathCursorPrefix lineString linePos charPos = completionPrefix . getCabalPrefixInfo "" $ Ghcide.PosPrefixInfo { Ghcide.fullLine = lineString, Ghcide.prefixScope = "", Ghcide.prefixText = "", Ghcide.cursorPos = Position linePos charPos } filePathExposedModulesTests :: TestTree filePathExposedModulesTests = testGroup "Filepaths for Exposed Modules Tests" [ testCase "Root dir" $ do exposed <- callFilePathsForExposedModules ["./"] exposed @?== ["Dir1.", "File1"], testCase "Nested path" $ do exposed <- callFilePathsForExposedModules ["./Dir1/Dir2/"] exposed @?== ["File2"], testCase "Nested empty dir" $ do exposed <- callFilePathsForExposedModules ["./Dir1/Dir2/Dir4"] exposed @?== [], testCase "Two dirs" $ do exposed <- callFilePathsForExposedModules ["./Dir1/", "Dir1/Dir3/Dir4/"] exposed @?== ["Dir2.", "Dir3.", "File3"] ] where callFilePathsForExposedModules :: [FilePath] -> IO [T.Text] callFilePathsForExposedModules srcDirs = do let prefInfo = simpleCabalPrefixInfoFromFp "" exposedTestDir filePathsForExposedModules mempty srcDirs prefInfo exposedModuleCompleterTests :: TestTree exposedModuleCompleterTests = testGroup "Exposed Modules Completer Tests" [ testCase "Top level single source dir, library" $ do completions <- callModulesCompleter Nothing sourceDirsExtractionLibrary "" completions @?== ["Dir2.", "Dir3."], testCase "Top level single source dir, benchmark, with prefix" $ do completions <- callModulesCompleter (Just "benchie") sourceDirsExtractionBenchmark "Fi" completions @?== ["File1"], testCase "Top level single source dir, named executable" $ do completions <- callModulesCompleter (Just "executie") sourceDirsExtractionExecutable "" completions @?== ["File1", "Dir1.", "Dir2.", "Dir3."], testCase "Top level single source dir, named executable" $ do completions <- callModulesCompleter (Just "exe-not-so-cutie") sourceDirsExtractionExecutable "" completions @?== ["File2", "Dir4."], testCase "Top level single source dir, nonexistent name" $ do completions <- callModulesCompleter (Just "exe-the-beste") sourceDirsExtractionExecutable "" completions @?== [], testCase "Top level single source dir, testsuite, with prefix" $ do completions <- callModulesCompleter (Just "suitor") sourceDirsExtractionTestSuite "3" completions @?== ["File3"], testCase "Name nothing but not library" $ do completions <- callModulesCompleter Nothing sourceDirsExtractionTestSuite "3" completions @?== [] ] where simpleCompleterData :: Maybe StanzaName -> FilePath -> T.Text -> CompleterData simpleCompleterData sName dir pref = do CompleterData { cabalPrefixInfo = simpleExposedCabalPrefixInfo pref dir, getLatestGPD = do cabalContents <- ByteString.readFile $ testDataDir "exposed.cabal" pure $ parseGenericPackageDescriptionMaybe cabalContents, stanzaName = sName } callModulesCompleter :: Maybe StanzaName -> (Maybe StanzaName -> GenericPackageDescription -> [FilePath]) -> T.Text -> IO [T.Text] callModulesCompleter sName func prefix = do let cData = simpleCompleterData sName testDataDir prefix completer <- modulesCompleter func mempty cData pure $ fmap extract completer mkCompleterData :: CabalPrefixInfo -> CompleterData mkCompleterData prefInfo = CompleterData {getLatestGPD = undefined, cabalPrefixInfo = prefInfo, stanzaName = Nothing} exposedTestDir :: FilePath exposedTestDir = addTrailingPathSeparator $ testDataDir "src-modules" simpleExposedCabalPrefixInfo :: T.Text -> FilePath -> CabalPrefixInfo simpleExposedCabalPrefixInfo prefix fp = CabalPrefixInfo { completionPrefix = prefix, isStringNotation = Nothing, completionCursorPosition = Position 0 0, completionRange = Range (Position 0 0) (Position 0 0), completionWorkingDir = fp, completionFileName = "exposed.cabal" } extract :: CompletionItem -> T.Text extract item = case item ^. L.textEdit of Just (InL v) -> v ^. L.newText _ -> error ""