Completer.hs

{-# 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 ""