{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-deprecations #-}
module Test.Ngrams.Query (
    tests
  , mkMapTerm
  , hierarchicalTableMap
  ) where

import Control.Lens
import Control.Monad
import Data.Coerce
import Data.Map.Strict qualified as Map
import Data.Monoid
import Data.Patch.Class qualified as Patch
import Data.String
import Data.Text qualified as T
import Data.Validity qualified as Validity
import Gargantext.API.Ngrams
import Gargantext.API.Ngrams.Types
import Gargantext.Core.Types.Main
import Gargantext.Core.Types.Query
import Gargantext.Prelude
import Test.HUnit
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.Ngrams.Query.PaginationCorpus
import Test.QuickCheck
import Test.Utils ((@??=))
import Text.Collate qualified as Unicode
import Test.Instances

hierarchicalTableMap :: Map NgramsTerm NgramsElement
hierarchicalTableMap = Map.fromList [
    ("vehicle", mkMapTerm "vehicle" & ne_children .~ mSetFromList ["car"])
  , ("car", mkMapTerm "car" & ne_root .~ Just "vehicle"
                            & ne_parent .~ Just "vehicle"
                            & ne_children .~ mSetFromList ["ford"])
  , ("ford", mkMapTerm "ford" & ne_root .~ Just "vehicle"
                              & ne_parent .~ Just "car")
  ]


tests :: Spec
tests = describe "Ngrams" $ unitTests

curryElem :: NgramsElement
curryElem = mkMapTerm "curry"

elbaElem :: NgramsElement
elbaElem = mkMapTerm "elba"

mkMapTerm :: T.Text -> NgramsElement
mkMapTerm e = mkNgramsElement (fromString . T.unpack $ e) MapTerm Nothing mempty

mockFlatCorpus :: Versioned (Map NgramsTerm NgramsElement)
mockFlatCorpus = Versioned 0 $ Map.fromList [
    ( "haskell", curryElem)
  , ( "idris", elbaElem)
  ]

mockQueryFn :: Maybe T.Text -> NgramsTerm -> Bool
mockQueryFn searchQuery (NgramsTerm nt) =
  maybe (const True) (T.isInfixOf . T.toLower) searchQuery (T.toLower nt)

unitTests :: Spec
unitTests = describe "Query tests" $ do
  -- Sorting
  it "Simple query mockFlatCorpus" testFlat01
  it "Simple query (desc sorting)" testFlat02
  it "[#331] sorting via DUCET works" testSortDiacriticsDucet
  it "[#331] Natural sort ascending works"  testNaturalSortAsceding
  it "[#331] Natural sort descending works" testNaturalSortDescending
  --  -- Filtering
  it "Simple query (listType = MapTerm)" testFlat03
  it "Simple query (listType = StopTerm)" testFlat04
  --  -- Full text search
  it "Simple query (search with match)" testFlat05
  prop "Searching something that is there should always succeed" testForestSearchProp
  it "Searching for nested terms should succeed" testSearchNestedTerms
  --  -- Pagination
  it "Simple pagination on all terms" test_pagination_allTerms
  it "Simple pagination on MapTerm" test_pagination01
  it "Simple pagination on MapTerm  (limit < total terms)" test_pagination02
  it "Simple pagination on MapTerm  (offset works)" test_pagination02_offset
  it "Simple pagination on ListTerm (limit < total terms)" test_pagination03
  it "Simple pagination on ListTerm  (offset works)" test_pagination03_offset
  it "Simple pagination on CandidateTerm (limit < total terms)" test_pagination04
  it "paginating QuantumComputing corpus works (MapTerms)" test_paginationQuantum
  it "paginating QuantumComputing corpus works (CandidateTerm)" test_paginationQuantum_02
  --  -- Patching
  it "I can apply a patch to term mapTerms to stopTerms (issue #217)" test_217

-- Let's test that if we request elements sorted in
-- /ascending/ order, we get them.
testFlat01 :: Assertion
testFlat01 = do
  let res = searchTableNgrams mockFlatCorpus searchQuery
  res @?= Right (VersionedWithCount 0 2 ( NgramsTable [curryElem, elbaElem] ))
  where
   searchQuery = NgramsSearchQuery {
                 _nsq_limit       = Limit 5
               , _nsq_offset      = Nothing
               , _nsq_listType    = Nothing
               , _nsq_minSize     = Nothing
               , _nsq_maxSize     = Nothing
               , _nsq_orderBy     = Just TermAsc
               , _nsq_searchQuery = mockQueryFn Nothing
               }

-- Let's test that if we request elements sorted in
-- /descending/ order, we get them.
testFlat02 :: Assertion
testFlat02 = do
  let res = searchTableNgrams mockFlatCorpus searchQuery
  res @?= Right (VersionedWithCount 0 2 ( NgramsTable [elbaElem, curryElem] ))
  where
   searchQuery = NgramsSearchQuery {
                 _nsq_limit       = Limit 5
               , _nsq_offset      = Nothing
               , _nsq_listType    = Nothing
               , _nsq_minSize     = Nothing
               , _nsq_maxSize     = Nothing
               , _nsq_orderBy     = Just TermDesc
               , _nsq_searchQuery = mockQueryFn Nothing
               }

testSortDiacriticsDucet :: Assertion
testSortDiacriticsDucet = do
  let inputData = [ "étude", "âge", "vue", "période" ]
  let expected  = [ "âge", "étude", "période", "vue" ]
  expected @??= sortBy (Unicode.collate Unicode.rootCollator) inputData

testNaturalSortAsceding :: Assertion
testNaturalSortAsceding = do
  let res = searchTableNgrams frenchCorpus searchQuery
  res @?= Right (VersionedWithCount 0 4 ( NgramsTable $ map mkMapTerm [ "âge", "étude", "période", "vue" ]))
  where

   frenchCorpus :: Versioned (Map NgramsTerm NgramsElement)
   frenchCorpus = Versioned 0 $ Map.fromList [
       ( "doc_01", mkMapTerm "période")
     , ( "doc_02", mkMapTerm "vue")
     , ( "doc_03", mkMapTerm "âge")
     , ( "doc_04", mkMapTerm "étude")
     ]

   searchQuery = NgramsSearchQuery {
                 _nsq_limit       = Limit 10
               , _nsq_offset      = Nothing
               , _nsq_listType    = Nothing
               , _nsq_minSize     = Nothing
               , _nsq_maxSize     = Nothing
               , _nsq_orderBy     = Just TermAsc
               , _nsq_searchQuery = mockQueryFn Nothing
               }

testNaturalSortDescending :: Assertion
testNaturalSortDescending = do
  let res = searchTableNgrams frenchCorpus searchQuery
  res @?= Right (VersionedWithCount 0 4 ( NgramsTable $ map mkMapTerm [ "vue", "période", "étude", "âge" ]))
  where

   frenchCorpus :: Versioned (Map NgramsTerm NgramsElement)
   frenchCorpus = Versioned 0 $ Map.fromList [
       ( "doc_01", mkMapTerm "période")
     , ( "doc_02", mkMapTerm "vue")
     , ( "doc_03", mkMapTerm "âge")
     , ( "doc_04", mkMapTerm "étude")
     ]

   searchQuery = NgramsSearchQuery {
                 _nsq_limit       = Limit 10
               , _nsq_offset      = Nothing
               , _nsq_listType    = Nothing
               , _nsq_minSize     = Nothing
               , _nsq_maxSize     = Nothing
               , _nsq_orderBy     = Just TermDesc
               , _nsq_searchQuery = mockQueryFn Nothing
               }


testFlat03 :: Assertion
testFlat03 = do
  let res = searchTableNgrams mockFlatCorpus searchQuery
  res @?= Right (VersionedWithCount 0 2 ( NgramsTable [elbaElem, curryElem] ))
  where
   searchQuery = NgramsSearchQuery {
                 _nsq_limit       = Limit 5
               , _nsq_offset      = Nothing
               , _nsq_listType    = Just MapTerm
               , _nsq_minSize     = Nothing
               , _nsq_maxSize     = Nothing
               , _nsq_orderBy     = Just TermDesc
               , _nsq_searchQuery = mockQueryFn Nothing
               }

-- Here we are searching for all the stop terms, but
-- due to the fact we don't have any inside 'mockFlatCorpus',
-- we should get no results.
testFlat04 :: Assertion
testFlat04 = do
  let res = searchTableNgrams mockFlatCorpus searchQuery
  res @?= Right (VersionedWithCount 0 0 ( NgramsTable [] ))
  where
   searchQuery = NgramsSearchQuery {
                 _nsq_limit       = Limit 5
               , _nsq_offset      = Nothing
               , _nsq_listType    = Just StopTerm
               , _nsq_minSize     = Nothing
               , _nsq_maxSize     = Nothing
               , _nsq_orderBy     = Just TermDesc
               , _nsq_searchQuery = mockQueryFn Nothing
               }

-- For this test, we run a full text search on the word
-- \"curry\", and we expect back a result.
testFlat05 :: Assertion
testFlat05 = do
  let res = searchTableNgrams mockFlatCorpus searchQuery
  res @?= Right (VersionedWithCount 0 1 ( NgramsTable [curryElem] ))
  where
   searchQuery = NgramsSearchQuery {
                 _nsq_limit       = Limit 5
               , _nsq_offset      = Nothing
               , _nsq_listType    = Nothing
               , _nsq_minSize     = Nothing
               , _nsq_maxSize     = Nothing
               , _nsq_orderBy     = Just TermDesc
               , _nsq_searchQuery = mockQueryFn (Just "curry")
               }

-- | Property that tests that if we make a search for a given term that we know it's
-- present in the list, we need to get it back, either directly (i.e. a single match) or
-- indirectly (i.e. present in the list of results, because it's included in a hierarchy of nodes).
testForestSearchProp :: Property
testForestSearchProp = forAll arbitrary $ \(AcyclicTableMap ngramsTable el) -> do
  case searchTableNgrams (Versioned 0 ngramsTable) (searchQuery el) of
    Left (BFE_loop_detected err)    -> fail (T.unpack $ renderLoop err)
    Right res -> res ^. vc_data `shouldSatisfy` (any (containsTerm (_ne_ngrams el)) . getNgramsTable)
  where
   searchQuery term = NgramsSearchQuery {
                 _nsq_limit       = Limit 5
               , _nsq_offset      = Nothing
               , _nsq_listType    = Just $ _ne_list term -- search using the list of the candidate
               , _nsq_minSize     = Nothing
               , _nsq_maxSize     = Nothing
               , _nsq_orderBy     = Just TermDesc
               , _nsq_searchQuery = mockQueryFn (Just $ unNgramsTerm $ _ne_ngrams term)
               }

-- | In this test we check that if we have nested terms, they will still show up in search.
-- In this test we have a nested hierarchy of a level-2 tree, and we search for the children,
-- and it still shows up.
testSearchNestedTerms :: Assertion
testSearchNestedTerms = do
  case searchTableNgrams (Versioned 0 hierarchicalTableMap) searchQuery of
    Left (BFE_loop_detected err) -> fail (T.unpack $ renderLoop err)
    Right res ->
      -- it should appear at the top level or as one of the children.
      res ^. vc_data `shouldSatisfy` (any (containsTerm "ford") . getNgramsTable)
  where
   searchQuery = NgramsSearchQuery {
                 _nsq_limit       = Limit 5
               , _nsq_offset      = Nothing
               , _nsq_listType    = Nothing
               , _nsq_minSize     = Nothing
               , _nsq_maxSize     = Nothing
               , _nsq_orderBy     = Just TermDesc
               , _nsq_searchQuery = mockQueryFn (Just "ford")
               }

-- | Returns True if the input 'NgramsElement' contains (either in the root or in the children)
-- the input term.
containsTerm :: NgramsTerm -> NgramsElement -> Bool
containsTerm t (NgramsElement{..}) = _ne_ngrams == t || any ((==) t) (mSetToList _ne_children)

-- Pagination tests

test_pagination_allTerms :: Assertion
test_pagination_allTerms = do
  let res = searchTableNgrams paginationCorpus searchQuery
  res @?= Right (VersionedWithCount 0 10 ( NgramsTable [ haskellElem
                                                , sideEffectsElem
                                                , concHaskellElem
                                                , implementationElem
                                                , ooElem
                                                , languagesElem
                                                , javaElem
                                                , termsElem
                                                ] ))
  where
   searchQuery = NgramsSearchQuery {
                 _nsq_limit       = Limit 8
               , _nsq_offset      = Nothing
               , _nsq_listType    = Nothing
               , _nsq_minSize     = Nothing
               , _nsq_maxSize     = Nothing
               , _nsq_orderBy     = Nothing
               , _nsq_searchQuery = mockQueryFn Nothing
               }

-- In this test, I'm asking for 5 /map terms/, and as the
-- corpus has only 2, that's what I should get back.
test_pagination01 :: Assertion
test_pagination01 = do
  let res = searchTableNgrams paginationCorpus searchQuery
  res @?= Right (VersionedWithCount 0 4 ( NgramsTable [implementationElem, languagesElem, termsElem, proofElem] ))
  where
   searchQuery = NgramsSearchQuery {
                 _nsq_limit       = Limit 5
               , _nsq_offset      = Nothing
               , _nsq_listType    = Just MapTerm
               , _nsq_minSize     = Nothing
               , _nsq_maxSize     = Nothing
               , _nsq_orderBy     = Just ScoreDesc
               , _nsq_searchQuery = mockQueryFn Nothing
               }

test_pagination02 :: Assertion
test_pagination02 = do
  let res = searchTableNgrams paginationCorpus searchQuery
  res @?= Right (VersionedWithCount 0 4 ( NgramsTable [implementationElem, languagesElem, termsElem] ))
  where
   searchQuery = NgramsSearchQuery {
                 _nsq_limit       = Limit 3
               , _nsq_offset      = Nothing
               , _nsq_listType    = Just MapTerm
               , _nsq_minSize     = Nothing
               , _nsq_maxSize     = Nothing
               , _nsq_orderBy     = Just ScoreDesc
               , _nsq_searchQuery = mockQueryFn Nothing
               }

test_pagination02_offset :: Assertion
test_pagination02_offset = do
  let res = searchTableNgrams paginationCorpus searchQuery
  res @?= Right (VersionedWithCount 0 4 ( NgramsTable [termsElem, proofElem] ))
  where
   searchQuery = NgramsSearchQuery {
                 _nsq_limit       = Limit 2
               , _nsq_offset      = Just (Offset 2)
               , _nsq_listType    = Just MapTerm
               , _nsq_minSize     = Nothing
               , _nsq_maxSize     = Nothing
               , _nsq_orderBy     = Just ScoreDesc
               , _nsq_searchQuery = mockQueryFn Nothing
               }

test_pagination03 :: Assertion
test_pagination03 = do
  let res = searchTableNgrams paginationCorpus searchQuery
  res @?= Right (VersionedWithCount 0 4 ( NgramsTable [sideEffectsElem, ooElem, javaElem] ))
  where
   searchQuery = NgramsSearchQuery {
                 _nsq_limit       = Limit 3
               , _nsq_offset      = Nothing
               , _nsq_listType    = Just StopTerm
               , _nsq_minSize     = Nothing
               , _nsq_maxSize     = Nothing
               , _nsq_orderBy     = Just ScoreDesc
               , _nsq_searchQuery = mockQueryFn Nothing
               }

test_pagination03_offset :: Assertion
test_pagination03_offset = do
  let res = searchTableNgrams paginationCorpus searchQuery
  res @?= Right (VersionedWithCount 0 4 ( NgramsTable [javaElem, pascalElem] ))
  where
   searchQuery = NgramsSearchQuery {
                 _nsq_limit       = Limit 2
               , _nsq_offset      = Just (Offset 2)
               , _nsq_listType    = Just StopTerm
               , _nsq_minSize     = Nothing
               , _nsq_maxSize     = Nothing
               , _nsq_orderBy     = Just ScoreDesc
               , _nsq_searchQuery = mockQueryFn Nothing
               }

test_pagination04 :: Assertion
test_pagination04 = do
  let res = searchTableNgrams paginationCorpus searchQuery
  res @?= Right (VersionedWithCount 0 2 ( NgramsTable [haskellElem] ))
  where
   searchQuery = NgramsSearchQuery {
                 _nsq_limit       = Limit 1
               , _nsq_offset      = Nothing
               , _nsq_listType    = Just CandidateTerm
               , _nsq_minSize     = Nothing
               , _nsq_maxSize     = Nothing
               , _nsq_orderBy     = Just ScoreDesc
               , _nsq_searchQuery = mockQueryFn Nothing
               }

test_paginationQuantum :: Assertion
test_paginationQuantum = do
  case searchTableNgrams quantumComputingCorpus searchQuery of
    Left err -> fail (show err)
    Right res -> do
      let elems = coerce @NgramsTable @[NgramsElement] $ _vc_data res
      countRoots elems @?= 10
      forM_ elems $ \term ->
        assertBool ("found " <> show (_ne_list term) <> " in: " <> show elems) (_ne_list term == MapTerm)
  where
   searchQuery = NgramsSearchQuery {
                 _nsq_limit       = Limit 10
               , _nsq_offset      = Nothing
               , _nsq_listType    = Just MapTerm
               , _nsq_minSize     = Nothing
               , _nsq_maxSize     = Nothing
               , _nsq_orderBy     = Nothing
               , _nsq_searchQuery = mockQueryFn Nothing
               }

countRoots :: [NgramsElement] -> Int
countRoots [] = 0
countRoots (x:xs) =
  if isNothing (_ne_root x) || isNothing (_ne_parent x)
     then 1 + countRoots xs
     else countRoots xs

test_paginationQuantum_02 :: Assertion
test_paginationQuantum_02 = do
  case searchTableNgrams quantumComputingCorpus searchQuery of
    Left err -> fail (show err)
    Right res -> do
      let elems = coerce @NgramsTable @[NgramsElement] $ _vc_data res
      assertBool ("found only " <> show (length elems) <> " in: " <> show elems) (countRoots elems == 10)
  where
   searchQuery = NgramsSearchQuery {
                 _nsq_limit       = Limit 10
               , _nsq_offset      = Nothing
               , _nsq_listType    = Just CandidateTerm
               , _nsq_minSize     = Nothing
               , _nsq_maxSize     = Nothing
               , _nsq_orderBy     = Nothing
               , _nsq_searchQuery = mockQueryFn Nothing
               }

issue217Corpus :: NgramsTableMap
issue217Corpus = Map.fromList [
    ( "advantages", NgramsRepoElement 1 MapTerm Nothing Nothing (mSetFromList ["advantage"]))
  , ( "advantage" , NgramsRepoElement 1 MapTerm (Just "advantages") (Just "advantages") mempty)
  ]

patched217Corpus :: NgramsTableMap
patched217Corpus = Map.fromList [
    ( "advantages", NgramsRepoElement 1 StopTerm Nothing Nothing (mSetFromList ["advantage"]))
  , ( "advantage" , NgramsRepoElement 1 StopTerm (Just "advantages") (Just "advantages") mempty)
  ]

-- In this patch we simulate turning the subtree composed by 'advantages' and 'advantage'
-- from map terms to stop terms.
patch217 :: NgramsTablePatch
patch217 = mkNgramsTablePatch $ Map.fromList [
                                 (NgramsTerm "advantages", NgramsPatch
                                    { _patch_children = mempty
                                    , _patch_list     = Patch.Replace MapTerm StopTerm
                                    }
                                 )
                              ]

test_217 :: Assertion
test_217 = do
  -- Check the patch is applicable
  Validity.validationIsValid (Patch.applicable patch217 (Just issue217Corpus)) @?= True
  Patch.act patch217 (Just issue217Corpus) @?= Just patched217Corpus
