content: {-# language NoImplicitPrelude, DoAndIfThenElse, OverloadedStrings, ExtendedDefaultRules #-}
  {-# LANGUAGE CPP #-}
  
  -- Shelly's types are kinda borked.
  {-# OPTIONS_GHC -Wno-type-defaults #-}
  
  module IHaskell.Test.Completion (testCompletions) where
  
  import           Prelude
  
  import           Data.List (elemIndex)
  import qualified Data.Text as T
  import           Control.Monad.IO.Class (liftIO)
  import           System.Environment (setEnv)
  import           System.Directory (setCurrentDirectory, getCurrentDirectory)
  
  #if MIN_VERSION_ghc(9,6,0)
  import           GHC (getSessionDynFlags, setSessionDynFlags, DynFlags(..), GhcLink(..), setContext,
                        parseImportDecl, interpreterBackend, Backend(..), InteractiveImport(..))
  #elif MIN_VERSION_ghc(9,2,0)
  import           GHC (getSessionDynFlags, setSessionDynFlags, DynFlags(..), GhcLink(..), setContext,
                        parseImportDecl, Backend(..), InteractiveImport(..))
  #else
  import           GHC (getSessionDynFlags, setSessionDynFlags, DynFlags(..), GhcLink(..), setContext,
                        parseImportDecl, HscTarget(..), InteractiveImport(..))
  #endif
  
  import           Test.Hspec
  
  import           Shelly (toTextIgnore, (</>), shelly, fromText, get_env_text, FilePath, cd, mkdir_p,
                           touchfile, withTmpDir)
  
  import           IHaskell.Eval.Evaluate (Interpreter, liftIO)
  import           IHaskell.Eval.Completion (complete, CompletionType(..), completionType,
                                             completionTarget)
  import           IHaskell.Eval.Util (setWayDynFlag)
  import           IHaskell.Test.Util (replace, shouldBeAmong, ghc)
  
  -- | @readCompletePrompt "xs*ys"@ return @(xs, i)@ where i is the location of
  -- @'*'@ in the input string.
  readCompletePrompt :: String -> (String, Int)
  readCompletePrompt string =
    case elemIndex '*' string of
      Nothing  -> error "Expected cursor written as '*'."
      Just idx -> (replace "*" "" string, idx)
  
  completionEvent :: String -> Interpreter (String, [String])
  completionEvent string = complete newString cursorloc
    where
      (newString, cursorloc) =
        case elemIndex '*' string of
          Nothing  -> error "Expected cursor written as '*'."
          Just idx -> (replace "*" "" string, idx)
  
  completionEventInDirectory :: String -> IO (String, [String])
  completionEventInDirectory string = withHsDirectory $ const $ completionEvent string
  
  shouldHaveCompletionsInDirectory :: String -> [String] -> IO ()
  shouldHaveCompletionsInDirectory string expected = do
    (_, completions) <- completionEventInDirectory string
    expected `shouldBeAmong` completions
  
  completionHas :: String -> [String] -> IO ()
  completionHas string expected = do
    (_, completions) <- ghc $ do
                                initCompleter
                                completionEvent string
    expected `shouldBeAmong` completions
  
  initCompleter :: Interpreter ()
  initCompleter = do
    flags <- getSessionDynFlags
  #if MIN_VERSION_ghc(9,6,0)
    _ <- setSessionDynFlags $ setWayDynFlag flags { backend = interpreterBackend, ghcLink = LinkInMemory }
  #elif MIN_VERSION_ghc(9,2,0)
    _ <- setSessionDynFlags $ setWayDynFlag flags { backend = Interpreter, ghcLink = LinkInMemory }
  #else
    _ <- setSessionDynFlags $ setWayDynFlag flags { hscTarget = HscInterpreted, ghcLink = LinkInMemory }
  #endif
  
    -- Import modules.
    imports <- mapM parseImportDecl
                 [ "import Prelude"
                 , "import qualified Control.Monad"
                 , "import qualified Data.List as List"
                 , "import IHaskell.Display"
                 , "import Data.Maybe as Maybe"
                 ]
    setContext $ map IIDecl imports
  
  completes :: String -> [String] -> IO ()
  completes string expected = completionTarget newString cursorloc `shouldBe` expected
    where
      (newString, cursorloc) = readCompletePrompt string
  
  testCompletions :: Spec
  testCompletions = do
    testIdentifierCompletion
    testCommandCompletion
  
  testIdentifierCompletion :: Spec
  testIdentifierCompletion = describe "Completion" $ do
      it "correctly gets the completion identifier without dots" $ do
        "hello*" `completes` ["hello"]
        "hello aa*bb goodbye" `completes` ["aa"]
        "hello aabb* goodbye" `completes` ["aabb"]
        "aacc* goodbye" `completes` ["aacc"]
        "hello *aabb goodbye" `completes` []
        "*aabb goodbye" `completes` []
  
      it "correctly gets the completion identifier with dots" $ do
        "hello test.aa*bb goodbye" `completes` ["test", "aa"]
        "Test.*" `completes` ["Test", ""]
        "Test.Thing*" `completes` ["Test", "Thing"]
        "Test.Thing.*" `completes` ["Test", "Thing", ""]
        "Test.Thing.*nope" `completes` ["Test", "Thing", ""]
  
      it "correctly gets the completion type" $ do
        completionType "import Data." 12 ["Data", ""] `shouldBe` ModuleName "Data" ""
        completionType "import Prel" 11 ["Prel"] `shouldBe` ModuleName "" "Prel"
        completionType "import D.B.M" 12 ["D", "B", "M"] `shouldBe` ModuleName "D.B" "M"
        completionType " import A." 10 ["A", ""] `shouldBe` ModuleName "A" ""
        completionType "import a.x" 10 ["a", "x"] `shouldBe` Identifier "x"
        completionType "A.x" 3 ["A", "x"] `shouldBe` Qualified "A" "x"
        completionType "a.x" 3 ["a", "x"] `shouldBe` Identifier "x"
        completionType "pri" 3 ["pri"] `shouldBe` Identifier "pri"
        completionType ":load A" 7 ["A"] `shouldBe` HsFilePath ":load A" "A"
        completionType ":! cd " 6 [""] `shouldBe` FilePath ":! cd " ""
  
  
  
      it "properly completes identifiers" $ do
        "pri*" `completionHas` ["print"]
        "ma*" `completionHas` ["map"]
        "hello ma*" `completionHas` ["map"]
        "print $ catMa*" `completionHas` ["catMaybes"]
  
      it "properly completes qualified identifiers" $ do
        "Control.Monad.liftM*" `completionHas` [ "Control.Monad.liftM"
                                               , "Control.Monad.liftM2"
                                               , "Control.Monad.liftM5"
                                               ]
        "print $ List.intercal*" `completionHas` ["List.intercalate"]
        "print $ Data.Maybe.cat*" `completionHas` []
        "print $ Maybe.catM*" `completionHas` ["Maybe.catMaybes"]
  
      it "properly completes imports" $ do
        "import Data.*" `completionHas` ["Data.Maybe", "Data.List"]
        "import Data.M*" `completionHas` ["Data.Maybe"]
        "import Prel*" `completionHas` ["Prelude"]
  
  
  testCommandCompletion :: Spec
  testCommandCompletion = describe "Completes commands" $ do
    it "properly completes haskell file paths on :load directive" $ do
      let loading xs = ":load " ++ T.unpack (toTextIgnore xs)
          paths = map (T.unpack . toTextIgnore)
          testInDirectory start comps = loading start `shouldHaveCompletionsInDirectory` paths comps
      testInDirectory ("dir" </> "file*") ["dir" </> "file2.hs", "dir" </> "file2.lhs"]
      testInDirectory ("" </> "file1*") ["" </> "file1.hs", "" </> "file1.lhs"]
      testInDirectory ("" </> "file1*") ["" </> "file1.hs", "" </> "file1.lhs"]
      testInDirectory ("" </> "./*") ["./" </> "dir/", "./" </> "file1.hs", "./" </> "file1.lhs"]
      testInDirectory ("" </> "./*") ["./" </> "dir/", "./" </> "file1.hs", "./" </> "file1.lhs"]
  
    it "provides path completions on empty shell cmds " $
      ":! cd *" `shouldHaveCompletionsInDirectory` map (T.unpack . toTextIgnore)
                                                     [ "" </> "dir/"
                                                     , "" </> "file1.hs"
                                                     , "" </> "file1.lhs"
                                                     ]
  
    let withHsHome action = withHsDirectory $ \dirPath -> do
          home <- shelly $ Shelly.get_env_text "HOME"
          setHomeEvent dirPath
          result <- action
          setHomeEvent $ Shelly.fromText home
          return result
        setHomeEvent path = liftIO $ setEnv "HOME" (T.unpack $ toTextIgnore path)
  
    it "correctly interprets ~ as the environment HOME variable" $ do
      let shouldHaveCompletions :: String -> [String] -> IO ()
          shouldHaveCompletions string expected = do
            (_, completions) <- withHsHome $ completionEvent string
  
            expected `shouldBeAmong` completions
      ":! cd ~/*" `shouldHaveCompletions` ["~/dir/"]
      ":! ~/*" `shouldHaveCompletions` ["~/dir/"]
      ":load ~/*" `shouldHaveCompletions` ["~/dir/"]
      ":l ~/*" `shouldHaveCompletions` ["~/dir/"]
  
    let shouldHaveMatchingText :: String -> String -> IO ()
        shouldHaveMatchingText string expected = do
          matchText <- withHsHome $ fst <$> uncurry complete (readCompletePrompt string)
          matchText `shouldBe` expected
  
    it "generates the correct matchingText on `:! cd ~/*` " $
      ":! cd ~/*" `shouldHaveMatchingText` ("~/" :: String)
  
    it "generates the correct matchingText on `:load ~/*` " $
      ":load ~/*" `shouldHaveMatchingText` ("~/" :: String)
  
    it "generates the correct matchingText on `:l ~/*` " $
      ":l ~/*" `shouldHaveMatchingText` ("~/" :: String)
  
  inDirectory :: [Shelly.FilePath] -- ^ directories relative to temporary directory
              -> [Shelly.FilePath] -- ^ files relative to temporary directory
              -> (Shelly.FilePath -> Interpreter a)
              -> IO a
  -- | Run an Interpreter action, but first make a temporary directory
  --   with some files and folder and cd to it.
  inDirectory dirs files action = shelly $ withTmpDir $ \dirPath -> do
    cd dirPath
    mapM_ mkdir_p dirs
    mapM_ touchfile files
    liftIO $ ghc $ wrap (T.unpack $ toTextIgnore dirPath) (action dirPath)
    where
      cdEvent path = liftIO $ setCurrentDirectory path
      wrap :: String -> Interpreter a -> Interpreter a
      wrap path actn = do
        initCompleter
        pwd <- IHaskell.Eval.Evaluate.liftIO getCurrentDirectory
        cdEvent path   -- change to the temporary directory
        out <- actn  -- run action
        cdEvent pwd    -- change back to the original directory
        return out
  
  withHsDirectory :: (Shelly.FilePath -> Interpreter a) -> IO a
  withHsDirectory = inDirectory [p "" </> p "dir", p "dir" </> p "dir1"]
                      [ p "" </> p "file1.hs"
                      , p "dir" </> p "file2.hs"
                      , p "" </> p "file1.lhs"
                      , p "dir" </> p "file2.lhs"
                      ]
    where
      p :: T.Text -> T.Text
      p = id
  