{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}

module Test.Offline.Phylo (tests) where

import CLI.Phylo.Common ( fileToList, fileToDocsDefault )
import Control.Monad (when)
import Data.Aeson as JSON
import Data.Aeson.Encode.Pretty qualified as JSON
import Data.Aeson.Types qualified as JSON
import Data.ByteString.Char8 qualified as C8
import Data.ByteString.Lazy qualified as BIO
import Data.ByteString.Lazy qualified as BL
import Data.GraphViz.Attributes.Complete qualified as Graphviz
import Data.Text.Lazy as TL
import Data.TreeDiff ( ansiWlEditExprCompact, ediff )
import Data.Vector qualified as V
import Gargantext.Core.Text.List.Formats.TSV ( tsvMapTermList )
import Gargantext.Core.Types.Phylo hiding (Phylo(..))
import Gargantext.Core.Viz.Phylo.API.Tools (readPhylo, phylo2dot2json)
import Gargantext.Core.Viz.Phylo.Example qualified as Cleopatre
import Gargantext.Core.Viz.Phylo hiding (EdgeType(..))
import Gargantext.Core.Viz.Phylo.PhyloExport ( toAttr )
import Gargantext.Core.Viz.Phylo.PhyloMaker (toPhylo, toPhyloWithoutLink)
import Gargantext.Core.Viz.Phylo.PhyloTools ( setConfig, ngramsToLabel, relatedComponents )
import Paths_gargantext ( getDataFileName )
import Prelude
import Test.HUnit
import Test.Hspec
import Test.Hspec.Golden


-- | Switch to 'True' if you want to update golden tests
doUpdateGolden :: Bool
doUpdateGolden = False


phyloTestConfig :: PhyloConfig
phyloTestConfig = PhyloConfig {
    corpusPath = "corpus.csv"
  , listPath = "list.csv"
  , outputPath = "data/"
  , corpusParser = Tsv {_tsv_limit = 150000}
  , listParser = V4
  , phyloName = "Phylo Name"
  , phyloScale = 2
  , similarity = WeightedLogJaccard {_wlj_sensibility = 0.5, _wlj_minSharedNgrams = 2}
  , seaElevation = Constante {_cons_start = 0.1, _cons_gap = 0.1}
  , defaultMode = True
  , findAncestors = False
  , phyloSynchrony = ByProximityThreshold {_bpt_threshold = 0.5, _bpt_sensibility = 0.0, _bpt_scope = AllBranches, _bpt_strategy = MergeAllGroups}
  , phyloQuality = Quality {_qua_granularity = 0.8, _qua_minBranch = 3}
  , timeUnit = Year {_year_period = 3, _year_step = 1, _year_matchingFrame = 5}
  , clique = MaxClique {_mcl_size = 5, _mcl_threshold = 1.0e-4, _mcl_filter = ByThreshold}
  , exportLabel = [ BranchLabel {_branch_labelTagger = MostEmergentTfIdf, _branch_labelSize = 2}
                  , GroupLabel {_group_labelTagger = MostEmergentInclusive, _group_labelSize = 2}
                  ]
  , exportSort = ByHierarchy {_sort_order = Desc}
  , exportFilter = [ByBranchSize {_branch_size = 3.0}]
  }

phyloGolden :: (FilePath, BL.ByteString) -> Golden BL.ByteString
phyloGolden (fp, actualOutput) =
  Golden {
    output = actualOutput
  , encodePretty = C8.unpack . BIO.toStrict
  , writeToFile = if doUpdateGolden then \_ new' -> BL.writeFile fp new' else (\_ _ -> pure ())
  , readFromFile = BIO.readFile
  , goldenFile = fp
  , actualFile = Nothing
  , failFirstTime = True
  }

newtype GraphDataFuzzy =
  GraphDataFuzzy { _GraphDataFuzzy :: GraphData }

instance Eq GraphDataFuzzy where
  (GraphDataFuzzy a) == (GraphDataFuzzy b) = a `compareGraphDataFuzzy` b

-- | Use this variant for those tests which requires a more sophisticated way of
-- comparing outputs directly on the GraphData
phyloGoldenGraphData :: (FilePath, GraphDataFuzzy) -> Golden GraphDataFuzzy
phyloGoldenGraphData (goldenPath, new) =
  Golden {
    output = new
  , encodePretty = differ
  , writeToFile = \_ new' -> updateGolden new'
  , readFromFile = const getGolden
  , goldenFile = goldenPath
  , actualFile = Nothing
  , failFirstTime = True
  }
  where
    differ :: GraphDataFuzzy -> String
    differ (GraphDataFuzzy ref) = show (ansiWlEditExprCompact $ ediff ref (_GraphDataFuzzy new))

    updateGolden :: GraphDataFuzzy -> IO ()
    updateGolden (GraphDataFuzzy gd) = BL.writeFile goldenPath (JSON.encodePretty gd)

    getGolden :: IO GraphDataFuzzy
    getGolden = GraphDataFuzzy <$> do
      expected_e <- JSON.eitherDecodeFileStrict' =<< getDataFileName goldenPath
      case expected_e of
        Left err -> fail err
        Right (expected :: GraphData) -> pure expected

tests :: Spec
tests = describe "Phylo" $ do
  describe "Export" $ do
    it "ngramsToLabel respects encoding" test_ngramsToLabel_01
    it "ngramsToLabel is rendered correctly in CustomAttribute" test_ngramsToLabel_02
  describe "toPhyloWithoutLink" $ do
    it "returns expected data" testSmallPhyloWithoutLinkExpectedOutput
    it "phyloCleopatre returns expected data" $ phyloGolden testCleopatreWithoutLinkExpectedOutput
    beforeAll testNadalWithoutLinkExpectedOutput $
      it "Nadal canned corpus returns expected data" $ phyloGolden
  describe "phylo2dot2json" $ do
    beforeAll testPhylo2dot2json $
      it "is deterministic" phyloGoldenGraphData
  describe "toPhylo" $ do
    beforeAll testToPhyloDeterminism $
      it "is deterministic" $ phyloGolden
  describe "relatedComponents" $ do
    it "finds simple connection" testRelComp_Connected
    it "parses csv phylo" testCsvPhylo

testCleopatreWithoutLinkExpectedOutput :: (FilePath, BL.ByteString)
testCleopatreWithoutLinkExpectedOutput =
  let actual = toPhyloWithoutLink Cleopatre.docs Cleopatre.config
  in ("test-data/phylo/cleopatre.golden.json", JSON.encodePretty actual)

testNadalWithoutLinkExpectedOutput :: IO (FilePath, BL.ByteString)
testNadalWithoutLinkExpectedOutput = do

  corpusPath'    <- getDataFileName "test-data/phylo/nadal_docslist.golden.tsv"
  listPath'      <- getDataFileName "test-data/phylo/nadal_ngramslist.golden.tsv"
  let config  = phyloTestConfig { corpusPath = corpusPath'
                                , listPath   = listPath'
                                , listParser = V3
                                }
  mapList <- fileToList (listParser config) (listPath config)
  corpus <- fileToDocsDefault (corpusParser config)
                        (corpusPath config)
                        [Year 3 1 5,Month 3 1 5,Week 4 2 5]
                        mapList
  pure ( "test-data/phylo/nadal.golden.json"
       , JSON.encodePretty $ setConfig phyloTestConfig $ toPhyloWithoutLink corpus config
       )

testSmallPhyloWithoutLinkExpectedOutput :: Assertion
testSmallPhyloWithoutLinkExpectedOutput = do
  bpaConfig      <- getDataFileName "bench-data/phylo/bpa-config.json"
  corpusPath'    <- getDataFileName "test-data/phylo/small_phylo_docslist.tsv"
  listPath'      <- getDataFileName "test-data/phylo/small_phylo_ngramslist.tsv"
  (Right config) <- fmap (\pcfg -> pcfg { corpusPath = corpusPath'
                                        , listPath   = listPath'
                                        }) <$> JSON.eitherDecodeFileStrict' bpaConfig
  mapList <- fileToList (listParser config) (listPath config)
  corpus <- fileToDocsDefault (corpusParser config)
                        (corpusPath config)
                        [Year 3 1 5,Month 3 1 5,Week 4 2 5]
                        mapList
  let actual = setConfig phyloTestConfig $ toPhyloWithoutLink corpus config
  expected   <- setConfig phyloTestConfig <$> (readPhylo =<< getDataFileName "test-data/phylo/small-phylo.golden.json")
  when doUpdateGolden $ BL.writeFile "test-data/phylo/small-phylo.golden.json" (JSON.encodePretty actual)
  assertBool (show $ ansiWlEditExprCompact $ ediff expected actual) (expected == actual)

testPhylo2dot2json :: IO (FilePath, GraphDataFuzzy)
testPhylo2dot2json = do
  actual_e <- JSON.parseEither JSON.parseJSON <$> phylo2dot2json Cleopatre.phyloCleopatre
  case actual_e of
    Left err -> fail err
    Right (actual :: GraphData) -> pure ("test-data/phylo/phylo2dot2json.golden.json", GraphDataFuzzy actual)

compareGraphDataFuzzy :: GraphData -> GraphData -> Bool
compareGraphDataFuzzy gd1 gd2 =
  and [ _gd__subgraph_cnt gd1 == _gd__subgraph_cnt gd2
      , _gd_directed gd1      == _gd_directed gd2
      , Prelude.all (uncurry compareEdgeDataFuzzy) (Prelude.zip (_gd_edges gd1) (_gd_edges gd2))
      , Prelude.all (uncurry compareObjectDataFuzzy) $ Prelude.zip (_gd_objects gd1) (_gd_objects gd2)
      , _gd_strict gd1        == _gd_strict gd2
      , _gd_data gd1 `compareGraphDataDataFuzzy` _gd_data gd2
      ]
  where
    gdd1 `compareEdgeDataFuzzy` ggd2 = case (gdd1, ggd2) of
      (GroupToAncestor gvId1 ecd1 gad1, GroupToAncestor gvId2 ecd2 gad2)
        -> (gvId1 == gvId2) && (ecd1 `compareEdgeCommonDataFuzzy` ecd2) && (gad1 == gad2)
      (GroupToAncestor{}, _)
        -> False
      (GroupToGroup gvId1 ecd1 gd1', GroupToGroup gvId2 ecd2 gd2')
        -> (gvId1 == gvId2) && (ecd1 `compareEdgeCommonDataFuzzy` ecd2) && (gd1' == gd2')
      (GroupToGroup{}, _)
        -> False
      (BranchToGroup gvId1 ecd1 bgd1, BranchToGroup gvId2 ecd2 bgd2)
        -> (gvId1 == gvId2) && (ecd1 `compareEdgeCommonDataFuzzy` ecd2) && (bgd1 == bgd2)
      (BranchToGroup{}, _)
        -> False
      (PeriodToPeriod gvId1 ecd1, PeriodToPeriod gvId2 ecd2)
        -> (gvId1 == gvId2) && (ecd1 `compareEdgeCommonDataFuzzy` ecd2)
      (PeriodToPeriod{}, _)
        -> False

    gdd1 `compareObjectDataFuzzy` ggd2 = case (gdd1, ggd2) of
      (GroupToNode  gvId1 ncd1 gnd1, GroupToNode  gvId2 ncd2 gnd2)
        -> (gvId1 == gvId2) && (ncd1 `compareNodeCommonDataFuzzy` ncd2) && (gnd1 == gnd2)
      (GroupToNode{}, _)
        -> False
      (BranchToNode gvId1 ncd1 bnd1, BranchToNode gvId2 ncd2 bnd2)
        -> (gvId1 == gvId2) && (ncd1 `compareNodeCommonDataFuzzy` ncd2) && (bnd1 == bnd2)
      (BranchToNode{}, _)
        -> False
      (PeriodToNode gvId1 ncd1 pnd1, PeriodToNode gvId2 ncd2 pnd2)
        -> (gvId1 == gvId2) && (ncd1 `compareNodeCommonDataFuzzy` ncd2) && (pnd1 == pnd2)
      (PeriodToNode{}, _)
        -> False
      (Layer gvId1 gdd1' ld1, Layer gvId2 gdd2 ld2)
        -> (gvId1 == gvId2) && (gdd1' `compareGraphDataDataFuzzy` gdd2) && (ld1 == ld2)
      (Layer{}, _)
        -> False

    gdd1 `compareNodeCommonDataFuzzy` ggd2 =
      -- Excluded fields: pos, width, height.
      and [ _nd_label    gdd1 == _nd_label ggd2
          , _nd_name     gdd1 == _nd_name ggd2
          , _nd_nodeType gdd1 == _nd_nodeType ggd2
          , _nd_shape    gdd1 == _nd_shape ggd2
          ]

    gdd1 `compareEdgeCommonDataFuzzy` gdd2 =
      -- Excluded fields: pos, width.
      (_ed_color gdd1 == _ed_color gdd2) &&
      (_ed_head  gdd1 == _ed_head gdd2) &&
      (_ed_tail  gdd1 == _ed_tail gdd2)

    gdd1 `compareGraphDataDataFuzzy` ggd2 =
      -- Excluded fields: bb, lp, lheight, lwidth.
      and [ _gdd_color             gdd1 == _gdd_color ggd2
          , _gdd_fontsize          gdd1 == _gdd_fontsize ggd2
          , _gdd_label             gdd1 == _gdd_label ggd2
          , _gdd_labelloc          gdd1 == _gdd_labelloc ggd2
          , _gdd_name              gdd1 == _gdd_name ggd2
          , _gdd_nodesep           gdd1 == _gdd_nodesep ggd2
          , _gdd_overlap           gdd1 == _gdd_overlap ggd2
          , _gdd_phyloBranches     gdd1 == _gdd_phyloBranches ggd2
          , _gdd_phyloDocs         gdd1 == _gdd_phyloDocs ggd2
          , _gdd_phyloFoundations  gdd1 == _gdd_phyloFoundations ggd2
          , _gdd_phyloGroups       gdd1 == _gdd_phyloGroups ggd2
          , _gdd_phyloPeriods      gdd1 == _gdd_phyloPeriods ggd2
          , _gdd_phyloSources      gdd1 == _gdd_phyloSources ggd2
          , _gdd_phyloTerms        gdd1 == _gdd_phyloTerms ggd2
          , _gdd_phyloTimeScale    gdd1 == _gdd_phyloTimeScale ggd2
          , _gdd_rank              gdd1 == _gdd_rank ggd2
          , _gdd_ranksep           gdd1 == _gdd_ranksep ggd2
          , _gdd_ratio             gdd1 == _gdd_ratio ggd2
          , _gdd_splines           gdd1 == _gdd_splines ggd2
          , _gdd_style             gdd1 == _gdd_style ggd2
          ]

test_ngramsToLabel_01 :: Assertion
test_ngramsToLabel_01 =
  let ngrams = V.fromList [ "évaluation", "méthodologique" ]
  in ngramsToLabel ngrams [0,1] @?= "évaluation | méthodologique"

test_ngramsToLabel_02 :: Assertion
test_ngramsToLabel_02 =
  let ngrams = V.fromList [ "钱", "狗" ]
  in (Graphviz.customValue $ toAttr "lbl" $ TL.fromStrict $ ngramsToLabel ngrams [0,1]) @?= "钱 | 狗"

testRelComp_Connected :: Assertion
testRelComp_Connected = do
  (relatedComponents @Int) []                                @?= []
  (relatedComponents @Int) [[]]                              @?= [[]]
  (relatedComponents @Int) [[],[1,2]]                        @?= [[],[1,2]]
  (relatedComponents @Int) [[1,2],[]]                        @?= [[1,2],[]]
  (relatedComponents @Int) [[1,2], [2]]                      @?= [[1,2]]
  (relatedComponents @Int) [[1,2], [2],[2]]                  @?= [[1,2]]
  (relatedComponents @Int) [[1,2], [2],[2,1]]                @?= [[1,2]]
  (relatedComponents @Int) [[1,2], [2,4]]                    @?= [[1,2,4]]
  (relatedComponents @Int) [[1,2], [3,5], [2,4]]             @?= [[3,5], [1,2,4]]
  (relatedComponents @Int) [[1,2], [3,5], [2,4],[9,5],[5,4]] @?= [[1,2,4,3,5,9]]
  (relatedComponents @Int) [[1,2,5], [4,5,9]]                @?= [[1,2,5,4,9]]

testToPhyloDeterminism :: IO (FilePath, BL.ByteString)
testToPhyloDeterminism = do
  corpusPath' <- getDataFileName "test-data/phylo/GarganText_DocsList-nodeId-187481.tsv"
  listPath'   <- getDataFileName "test-data/phylo/GarganText_NgramsList-187482.tsv"
  let config  = phyloTestConfig { corpusPath = corpusPath'
                                , listPath   = listPath'
                                , listParser = V3
                                }
  mapList <- tsvMapTermList (listPath config)
  corpus <- fileToDocsDefault (corpusParser config)
                              (corpusPath config)
                              [Year 3 1 5,Month 3 1 5,Week 4 2 5]
                              mapList
  let actual = setConfig phyloTestConfig $ toPhylo $ toPhyloWithoutLink corpus config
  pure ( "test-data/phylo/187481.json"
       , JSON.encodePretty actual
       )

testCsvPhylo :: Assertion
testCsvPhylo = do
  pth <- getDataFileName "test-data/phylo/cleopatre.golden.csv.json"
  phyloJson <- eitherDecodeFileStrict' @Phylo pth
  case phyloJson of
    Left err -> error err
    Right _  -> pure ()
