{-|
Module      : Gargantext.Core.Viz.Phylo.Main
Description : Phylomemy Main
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

-}

{-# OPTIONS_GHC -fno-warn-deprecations #-}

{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE TypeApplications  #-}

module Gargantext.Core.Viz.Phylo.Legacy.LegacyMain
  where

import Control.Lens (to, view)
import Data.HashMap.Strict qualified as HashMap
import Data.List qualified as List
import Data.Set qualified as Set
import Data.Text qualified as Text
import Gargantext.API.Ngrams.Tools (getTermsWith)
import Gargantext.API.Ngrams.Types (NgramsTerm(..))
import Gargantext.Core (HasDBid, withDefaultLanguage)
import Gargantext.Core.NodeStory.Types (HasNodeStory, HasNodeStoryEnv (..))
import Gargantext.Core.Text.Context (TermList)
import Gargantext.Core.Text.Ngrams (NgramsType(..))
import Gargantext.Core.Text.Terms.WithList ( buildPatterns, termsInText, Patterns )
import Gargantext.Core.Types.Main ( ListType(MapTerm) )
import Gargantext.Database.Admin.Types.Node ( NodeType, CorpusId )
import Gargantext.Core.Viz.LegacyPhylo hiding (Svg, Dot)
import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataCorpus(_hc_lang) )
import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument(_hd_abstract, _hd_publication_year) )
import Gargantext.Database.Query.Table.Node(defaultList, getNodeWith)
import Gargantext.Database.Query.Table.NodeContext (selectDocs)
import Gargantext.Database.Schema.Node ( node_hyperdata )
import Gargantext.Database.Prelude
import Gargantext.Prelude hiding (to)

type MinSizeBranch = Int

flowPhylo :: (HasNodeStory env err m, HasDBid NodeType, IsDBCmd env err m)
          => CorpusId
          -> m Phylo
flowPhylo cId = do
  env <- view hasNodeStory
  runDBQuery $ do
    corpus_node <- getNodeWith cId (Proxy @HyperdataCorpus)
    let lang = withDefaultLanguage $ view (node_hyperdata . to _hc_lang) corpus_node
    list'    <- defaultList cId
    termList <- HashMap.toList <$> getTermsWith env (Text.words . unNgramsTerm) [list'] NgramsTerms (Set.singleton MapTerm)

    docs' <- catMaybes
          <$> map (\h -> (,) <$> _hd_publication_year h
                             <*> _hd_abstract h
                  )
          <$> selectDocs cId

    let
      patterns = buildPatterns termList
      -- | To filter the Ngrams of a document based on the termList
      filterTerms :: Patterns -> (Date, Text) -> (Date, [Text])
      filterTerms patterns' (y,d) = (y, fst <$> termsInText lang patterns' d)

      docs = map ((\(y,t) -> Document y t) . filterTerms patterns) docs'

    --liftBase $ flowPhylo' (List.sortOn date docs) termList l m fp
    pure $ buildPhylo (List.sortOn date docs) termList


-- TODO SortedList Document
flowPhylo' :: [Document] -> TermList      -- ^Build
           -> Level       -> MinSizeBranch -- ^View
           -> FilePath
           -> IO FilePath
flowPhylo' corpus terms l m fp = do
  let
    phylo = buildPhylo corpus terms
    phVie = viewPhylo  l m phylo

  writePhylo fp phVie


defaultQuery :: PhyloQueryBuild
defaultQuery = undefined
-- defaultQuery = defaultQueryBuild'
--   "Default Title"
--   "Default Description"

buildPhylo :: [Document] -> TermList -> Phylo
buildPhylo = trace (show defaultQuery :: Text) $ buildPhylo' defaultQuery

buildPhylo' :: PhyloQueryBuild -> [Document] -> TermList -> Phylo
buildPhylo' _ _ _ = undefined
-- buildPhylo' q corpus termList = toPhylo q corpus termList Map.empty

-- refactor 2021
-- queryView :: Level -> MinSizeBranch -> PhyloQueryView
-- queryView level _minSizeBranch = PhyloQueryView level Merge False 2
--            [BranchAge]
--            []
--            -- [SizeBranch $ SBParams minSizeBranch]
--            [BranchPeakFreq,GroupLabelCooc]
--            (Just (ByBranchAge,Asc))
--            Json Flat True

queryView :: Level -> MinSizeBranch -> PhyloQueryView
queryView _level _minSizeBranch = undefined

viewPhylo :: Level -> MinSizeBranch -> Phylo -> PhyloView
viewPhylo _l _b _phylo = undefined
-- viewPhylo l b phylo = toPhyloView (queryView l b) phylo

writePhylo :: FilePath -> PhyloView -> IO FilePath
writePhylo _fp _phview = undefined
-- writePhylo fp phview = runGraphviz (viewToDot phview) Svg fp

-- refactor 2021
-- viewPhylo2Svg :: PhyloView -> IO DB.ByteString
-- viewPhylo2Svg p = graphvizWithHandle Dot (viewToDot p) Svg DB.hGetContents
