{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE OverloadedStrings #-}


module ReferenceTests (tests) where

import           Control.Applicative.Combinators
import qualified Control.Lens                    as Lens
import           Control.Monad
import           Control.Monad.IO.Class          (liftIO)
import           Data.List.Extra
import qualified Data.Set                        as Set
import           Development.IDE.Types.Location
import qualified Language.LSP.Protocol.Lens      as L
import           Language.LSP.Protocol.Types     hiding
                                                 (SemanticTokenAbsolute (..),
                                                  SemanticTokenRelative (..),
                                                  SemanticTokensEdit (..),
                                                  mkRange)
import           Language.LSP.Test
import           System.Directory
-- import Test.QuickCheck.Instances ()
import           Config
import           Control.Lens                    ((^.))
import qualified Data.Aeson                      as A
import           Data.Default                    (def)
import           Data.Tuple.Extra
import           GHC.TypeLits                    (symbolVal)
import           Ide.PluginUtils                 (toAbsolute)
import           Ide.Types
import           System.FilePath                 (addTrailingPathSeparator,
                                                  (</>))
import           Test.Hls                        (BrokenBehavior (..),
                                                  ExpectBroken (..),
                                                  FromServerMessage' (..),
                                                  SMethod (..),
                                                  TCustomMessage (..),
                                                  TNotificationMessage (..),
                                                  unCurrent)
import           Test.Hls.FileSystem             (copyDir)
import           Test.Tasty
import           Test.Tasty.HUnit


tests :: TestTree
tests = testGroup "references"
    [ testGroup "can get references to FOIs"
          [ referenceTest "can get references to symbols"
                          ("References.hs", 4, 7)
                          YesIncludeDeclaration
                          [ ("References.hs", 4, 6)
                          , ("References.hs", 6, 0)
                          , ("References.hs", 6, 14)
                          , ("References.hs", 9, 7)
                          , ("References.hs", 10, 11)
                          ]

          , referenceTest "can get references to data constructor"
                          ("References.hs", 13, 2)
                          YesIncludeDeclaration
                          [ ("References.hs", 13, 2)
                          , ("References.hs", 16, 14)
                          , ("References.hs", 19, 21)
                          ]

          , referenceTest "getting references works in the other module"
                          ("OtherModule.hs", 6, 0)
                          YesIncludeDeclaration
                          [ ("OtherModule.hs", 6, 0)
                          , ("OtherModule.hs", 8, 16)
                          ]

          , referenceTest "getting references works in the Main module"
                          ("Main.hs", 9, 0)
                          YesIncludeDeclaration
                          [ ("Main.hs", 9, 0)
                          , ("Main.hs", 10, 4)
                          ]

          , referenceTest "getting references to main works"
                          ("Main.hs", 5, 0)
                          YesIncludeDeclaration
                          [ ("Main.hs", 4, 0)
                          , ("Main.hs", 5, 0)
                          ]

          , referenceTest "can get type references"
                          ("Main.hs", 9, 9)
                          YesIncludeDeclaration
                          [ ("Main.hs", 9, 0)
                          , ("Main.hs", 9, 9)
                          , ("Main.hs", 10, 0)
                          ]

          -- TODO: references provider does not respect includeDeclaration parameter
          , referenceTestExpectFail "works when we ask to exclude declarations"
                          ("References.hs", 4, 7)
                          NoExcludeDeclaration
                          (BrokenIdeal
                            [ ("References.hs", 6, 0)
                            , ("References.hs", 6, 14)
                            , ("References.hs", 9, 7)
                            , ("References.hs", 10, 11)
                            ]
                          )
                          (BrokenCurrent
                            [ ("References.hs", 4, 6)
                            , ("References.hs", 6, 0)
                            , ("References.hs", 6, 14)
                            , ("References.hs", 9, 7)
                            , ("References.hs", 10, 11)
                            ]
                          )
          ]

    , testGroup "can get references to non FOIs"
          [ referenceTest "references to symbol defined in a module we import"
                          ("References.hs", 22, 4)
                          YesIncludeDeclaration
                          [ ("References.hs", 22, 4)
                          , ("OtherModule.hs", 0, 20)
                          , ("OtherModule.hs", 4, 0)
                          ]

          , referenceTest "references in modules that import us to symbols we define"
                          ("OtherModule.hs", 4, 0)
                          YesIncludeDeclaration
                          [ ("References.hs", 22, 4)
                          , ("OtherModule.hs", 0, 20)
                          , ("OtherModule.hs", 4, 0)
                          ]

          , referenceTest "references to symbol defined in a module we import transitively"
                          ("References.hs", 24, 4)
                          YesIncludeDeclaration
                          [ ("References.hs", 24, 4)
                          , ("OtherModule.hs", 0, 48)
                          , ("OtherOtherModule.hs", 2, 0)
                          ]

          , referenceTest "references in modules that transitively use symbols we define"
                          ("OtherOtherModule.hs", 2, 0)
                          YesIncludeDeclaration
                          [ ("References.hs", 24, 4)
                          , ("OtherModule.hs", 0, 48)
                          , ("OtherOtherModule.hs", 2, 0)
                          ]

          , referenceTest "type references to other modules"
                          ("Main.hs", 12, 10)
                          YesIncludeDeclaration
                          [ ("Main.hs", 12, 7)
                          , ("Main.hs", 13, 0)
                          , ("References.hs", 12, 5)
                          , ("References.hs", 16, 0)
                          ]
          ]
        -- Fields.hs does not depend on Main.hs
        -- so we can only find references in Fields.hs
        , testGroup "references to record fields"
          [ referenceTest "references record fields in the same file"
                          ("Fields.hs", 5, 4)
                          YesIncludeDeclaration
                          [ ("Fields.hs", 5, 4)
                          , ("Fields.hs", 10, 14)
                          , ("Fields.hs", 13, 14)
                          ]

          -- Main.hs depends on Fields.hs, so we can find references
          -- from Main.hs to Fields.hs
          , referenceTest "references record fields cross modules"
                          ("Main.hs", 16, 24)
                          YesIncludeDeclaration
                          [ ("Fields.hs", 5, 4)
                          , ("Fields.hs", 10, 14)
                          , ("Fields.hs", 13, 14)
                          , ("Main.hs", 16, 24)
                          ]
          ]
    ]

-- | When we ask for all references to symbol "foo", should the declaration "foo
-- = 2" be among the references returned?
data IncludeDeclaration =
    YesIncludeDeclaration
    | NoExcludeDeclaration

getReferences' :: SymbolLocation -> IncludeDeclaration -> Session [Location]
getReferences' (file, l, c) includeDeclaration = do
    doc <- openDoc file "haskell"
    getReferences doc (Position l c) $ toBool includeDeclaration
    where toBool YesIncludeDeclaration = True
          toBool NoExcludeDeclaration  = False



referenceTestSession :: String -> FilePath -> [FilePath] -> (FilePath -> Session ()) -> TestTree
referenceTestSession name thisDoc docs' f = do
  testWithDummyPlugin' name (mkIdeTestFs [copyDir "references"]) $ \fs -> do
    let rootDir = addTrailingPathSeparator fs
    -- needed to build whole project indexing
    configureCheckProject True
    -- need to get the real paths through links
    docs <- mapM (liftIO . canonicalizePath . (fs </>)) $ delete thisDoc $ nubOrd docs'
    -- Initial Index
    docid <- openDoc thisDoc "haskell"

    liftIO $ putStrLn $ "docs:" <> show docs
    let
        -- todo wait for docs
        loop :: [FilePath] -> Session ()
        loop [] = pure ()
        loop docs = do

            doc <- skipManyTill anyMessage $ referenceReady (`elem` docs)
            loop (delete doc docs)
    loop docs
    f rootDir
    closeDoc docid

-- | Given a location, lookup the symbol and all references to it. Make sure
-- they are the ones we expect.
referenceTest :: (HasCallStack) => String -> SymbolLocation -> IncludeDeclaration -> [SymbolLocation] -> TestTree
referenceTest name loc includeDeclaration expected =
    referenceTestSession name (fst3 loc) docs $ \rootDir -> do
        actual <- getReferences' loc includeDeclaration
        liftIO $ expectSameLocations rootDir actual expected
  where
    docs = map fst3 expected

referenceTestExpectFail
  :: (HasCallStack)
  => String
  -> SymbolLocation
  -> IncludeDeclaration
  -> ExpectBroken 'Ideal [SymbolLocation]
  -> ExpectBroken 'Current [SymbolLocation]
  -> TestTree
referenceTestExpectFail name loc includeDeclaration _ =
  referenceTest name loc includeDeclaration . unCurrent

type SymbolLocation = (FilePath, UInt, UInt)

expectSameLocations :: (HasCallStack) => FilePath -> [Location] -> [SymbolLocation] -> Assertion
expectSameLocations rootDir actual expected = do
    let actual' =
            Set.map (\location -> (location ^. L.uri
                                   , location ^. L.range . L.start . L.line . Lens.to fromIntegral
                                   , location ^. L.range . L.start . L.character . Lens.to fromIntegral))
            $ Set.fromList actual
    expected' <- Set.fromList <$>
        (forM expected $ \(file, l, c) -> do
                              fp <- canonicalizePath $ toAbsolute rootDir file
                              return (filePathToUri fp, l, c))
    actual' @?= expected'


-- todo find where to put this in hls
configureCheckProject :: Bool -> Session ()
configureCheckProject overrideCheckProject = setConfigSection "haskell" (A.toJSON $ def{checkProject = overrideCheckProject})
referenceReady :: (FilePath -> Bool) -> Session FilePath
referenceReady pred = satisfyMaybe $ \case
  FromServerMess (SMethod_CustomMethod p) (NotMess TNotificationMessage{_params})
    | A.Success fp <- A.fromJSON _params
    , pred fp
    , symbolVal p == "ghcide/reference/ready"
    -> Just fp
  _ -> Nothing
