{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE LambdaCase               #-}
{-# LANGUAGE NamedFieldPuns           #-}
{-# LANGUAGE OverloadedLabels         #-}
{-# LANGUAGE OverloadedStrings        #-}
{-# LANGUAGE TypeOperators            #-}
{-# LANGUAGE ViewPatterns             #-}
module Main
  ( main
  ) where

import           Control.Lens                  ((^.))
import           Data.Either.Extra
import           Data.Foldable                 (find)
import           Data.Row                      ((.+), (.==))
import           Data.Text                     (Text)
import qualified Data.Text                     as T
import           Data.Traversable              (for)
import qualified Ide.Plugin.ExplicitImports    as ExplicitImports
import qualified Language.LSP.Protocol.Lens    as L
import           Language.LSP.Protocol.Message
import           System.FilePath               ((</>))
import           Test.Hls

explicitImportsPlugin :: PluginTestDescriptor ExplicitImports.Log
explicitImportsPlugin = mkPluginTestDescriptor ExplicitImports.descriptor "explicitImports"

main :: IO ()
main = defaultTestRunner $ testGroup "import-actions"
  [testGroup
    "Refine Imports"
    [ codeActionGoldenTest "RefineWithOverride" 3 1
    , codeLensGoldenTest isRefineImports "RefineUsualCase" 1
    , codeLensGoldenTest isRefineImports "RefineQualified" 0
    , codeLensGoldenTest isRefineImports "RefineQualifiedExplicit" 0
    ],
  testGroup
    "Make imports explicit"
    [ codeActionAllGoldenTest "ExplicitUsualCase" 3 0
    , codeActionAllResolveGoldenTest "ExplicitUsualCase" 3 0
    , codeActionOnlyGoldenTest "ExplicitOnlyThis" 3 0
    , codeActionOnlyResolveGoldenTest "ExplicitOnlyThis" 3 0
    , codeLensGoldenTest notRefineImports "ExplicitUsualCase" 0
    , codeActionBreakFile "ExplicitBreakFile" 4 0
    , codeActionStaleAction "ExplicitStaleAction" 4 0
    , testCase "No CodeAction when exported" $
      runSessionWithServer def explicitImportsPlugin testDataDir $ do
        doc <- openDoc "ExplicitExported.hs" "haskell"
        action <- getCodeActions doc (pointRange 3 0)
        liftIO $ action @?= []
    , testCase "No CodeLens when exported" $
      runSessionWithServer def explicitImportsPlugin testDataDir $ do
        doc <- openDoc "ExplicitExported.hs" "haskell"
        lenses <- getCodeLenses doc
        liftIO $ lenses @?= []
    , testGroup "Title abbreviation"
      [ testCase "not abbreviated" $
          let i = "import " <> T.replicate 70 "F" <> " (Athing, Bthing, Cthing)"
          in ExplicitImports.abbreviateImportTitle i @?= i
      , testCase "abbreviated in module name" $
          let i = "import " <> T.replicate 120 "F" <> " (Athing, Bthing, Cthing)"
              o = "import " <> T.replicate 97 "F" <> " ... (3 items)"
          in ExplicitImports.abbreviateImportTitle i @?= o
      , testCase "abbreviated in import list" $
          let i = "import " <> T.replicate 78 "F" <> " (Athing, Bthing, Cthing, Dthing, Ething)"
              o = "import " <> T.replicate 78 "F" <> " (Athing, Bthing, ... (3 items))"
          in ExplicitImports.abbreviateImportTitle i @?= o
      -- This one breaks earlier in the same import item, but still splits the list in the same place
      , testCase "abbreviated in import list (slightly shorter module)" $
          let i = "import " <> T.replicate 76 "F" <> " (Athing, Bthing, Cthing, Dthing, Ething)"
              o = "import " <> T.replicate 76 "F" <> " (Athing, Bthing, ... (3 items))"
          in ExplicitImports.abbreviateImportTitle i @?= o
      -- This one breaks later in the same import item, but still splits the list in the same place
      , testCase "abbreviated in import list (slightly longer module)" $
          let i = "import " <> T.replicate 80 "F" <> " (Athing, Bthing, Cthing, Dthing, Ething)"
              o = "import " <> T.replicate 80 "F" <> " (Athing, Bthing, ... (3 items))"
          in ExplicitImports.abbreviateImportTitle i @?= o
      ]
    ]]

-- code action tests

codeActionAllGoldenTest :: FilePath -> Int -> Int -> TestTree
codeActionAllGoldenTest fp l c = goldenWithImportActions " code action" fp codeActionNoResolveCaps $ \doc -> do
  actions <- getCodeActions doc (pointRange l c)
  case find ((== Just "Make all imports explicit") . caTitle) actions of
    Just (InR x) -> executeCodeAction x
    _            -> liftIO $ assertFailure "Unable to find CodeAction"

codeActionBreakFile :: FilePath -> Int -> Int -> TestTree
codeActionBreakFile fp l c = goldenWithImportActions " code action" fp codeActionNoResolveCaps $ \doc -> do
  _ <- getCodeLenses doc
  changeDoc doc [edit]
  actions <- getCodeActions doc (pointRange l c)
  case find ((== Just "Make all imports explicit") . caTitle) actions of
    Just (InR x) -> executeCodeAction x
    _            -> liftIO $ assertFailure "Unable to find CodeAction"
  where edit = TextDocumentContentChangeEvent $ InL $ #range .== pointRange 2 29
                                                   .+ #rangeLength .== Nothing
                                                   .+ #text .== "x"

codeActionStaleAction :: FilePath -> Int -> Int -> TestTree
codeActionStaleAction fp l c = goldenWithImportActions " code action" fp codeActionResolveCaps $ \doc -> do
  _ <- waitForDiagnostics
  actions <- getCodeActions doc (pointRange l c)
  changeDoc doc [edit]
  _ <- waitForDiagnostics
  case find ((== Just "Make this import explicit") . caTitle) actions of
    Just (InR x) ->
      maybeResolveCodeAction x >>=
        \case Just _  -> liftIO $ assertFailure "Code action still valid"
              Nothing -> pure ()
    _            -> liftIO $ assertFailure "Unable to find CodeAction"
  where edit = TextDocumentContentChangeEvent $ InL $ #range .== Range (Position 6 0) (Position 6 0)
                                                   .+ #rangeLength .== Nothing
                                                   .+ #text .== "\ntesting = undefined"

codeActionAllResolveGoldenTest :: FilePath -> Int -> Int -> TestTree
codeActionAllResolveGoldenTest fp l c = goldenWithImportActions " code action resolve" fp codeActionResolveCaps $ \doc -> do
  actions <- getCodeActions doc (pointRange l c)
  Just (InR x) <- pure $ find ((== Just "Make all imports explicit") . caTitle) actions
  resolved <- resolveCodeAction x
  executeCodeAction resolved

codeActionOnlyGoldenTest :: FilePath -> Int -> Int -> TestTree
codeActionOnlyGoldenTest fp l c = goldenWithImportActions " code action" fp codeActionNoResolveCaps $ \doc -> do
  actions <- getCodeActions doc (pointRange l c)
  case find ((== Just "Make this import explicit") . caTitle) actions of
    Just (InR x) -> executeCodeAction x
    _            -> liftIO $ assertFailure "Unable to find CodeAction"

codeActionOnlyResolveGoldenTest :: FilePath -> Int -> Int -> TestTree
codeActionOnlyResolveGoldenTest fp l c = goldenWithImportActions " code action resolve" fp codeActionResolveCaps $ \doc -> do
  actions <- getCodeActions doc (pointRange l c)
  Just (InR x) <- pure $ find ((== Just "Make this import explicit") . caTitle) actions
  resolved <- resolveCodeAction x
  executeCodeAction resolved

maybeResolveCodeAction :: CodeAction -> Session (Maybe CodeAction)
maybeResolveCodeAction ca = do
  resolveResponse <- request SMethod_CodeActionResolve ca
  let resolved = resolveResponse ^. L.result
  pure $ eitherToMaybe resolved

caTitle :: (Command |? CodeAction) -> Maybe Text
caTitle (InR CodeAction {_title}) = Just _title
caTitle _                         = Nothing

-- code lens tests

codeLensGoldenTest :: (CodeLens -> Bool) -> FilePath -> Int -> TestTree
codeLensGoldenTest predicate fp i = goldenWithImportActions " code lens" fp codeActionNoResolveCaps $ \doc -> do
  codeLenses <- getCodeLenses doc
  resolvedCodeLenses <- for codeLenses resolveCodeLens
  (CodeLens {_command = Just c}) <- pure (filter predicate resolvedCodeLenses !! i)
  executeCmd c

notRefineImports :: CodeLens -> Bool
notRefineImports (CodeLens _ (Just (Command text _ _)) _)
  | "Refine imports to" `T.isPrefixOf` text = False
notRefineImports _ = True

-- Execute command and wait for result
executeCmd :: Command -> Session ()
executeCmd cmd = do
    executeCommand cmd
    _resp <- skipManyTill anyMessage (message SMethod_WorkspaceApplyEdit)
    -- liftIO $ print _resp
    return ()

-- helpers

goldenWithImportActions :: String -> FilePath -> ClientCapabilities -> (TextDocumentIdentifier -> Session ()) -> TestTree
goldenWithImportActions title fp caps = goldenWithHaskellAndCaps def caps explicitImportsPlugin (fp <> title <> " (golden)") testDataDir fp "expected" "hs"

testDataDir :: String
testDataDir = "test" </> "testdata"

pointRange :: Int -> Int -> Range
pointRange
  (subtract 1 -> fromIntegral -> line)
  (subtract 1 -> fromIntegral -> col) =
    Range (Position line col) (Position line $ col + 1)

-------------------------------------------------------------------------------
-- code action tests

codeActionGoldenTest :: FilePath -> Int -> Int -> TestTree
codeActionGoldenTest fp l c = goldenWithImportActions "" fp codeActionNoResolveCaps $ \doc -> do
  actions <- getCodeActions doc (pointRange l c)
  case find ((== Just "Refine all imports") . caTitle) actions of
    Just (InR x) -> executeCodeAction x
    _            -> liftIO $ assertFailure "Unable to find CodeAction"

isRefineImports :: CodeLens -> Bool
isRefineImports (CodeLens _ (Just (Command txt _ _)) _)
  | "Refine imports to" `T.isInfixOf` txt = True
isRefineImports _ = False