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

-}

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

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TemplateHaskell  #-}
{-# LANGUAGE TypeApplications #-}

module Gargantext.Core.Viz.Phylo.API.Tools
  where

import Control.Lens (to, view)
import Data.Aeson (Value, decodeFileStrict, encode, eitherDecodeFileStrict')
import Data.ByteString.Lazy qualified as Lazy
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Text (pack)
import Data.Time (diffUTCTime)
import Data.Time.Calendar (fromGregorian, diffGregorianDurationClip, cdMonths, diffDays, showGregorian)
import Data.Time.Clock.POSIX(posixSecondsToUTCTime)
import Gargantext.API.Ngrams.Prelude (getTermList)
import Gargantext.API.Ngrams.Types (NgramsTerm(..))
import Gargantext.Core (withDefaultLanguage, Lang)
import Gargantext.Core.NodeStory.Types (HasNodeStory, NodeStoryEnv, HasNodeStoryEnv (..))
import Gargantext.Core.Text.Ngrams (NgramsType(..))
import Gargantext.Core.Text.Terms.WithList (Patterns, buildPatterns, termsInText)
import Gargantext.Core.Types.Main (ListType(MapTerm))
import Gargantext.Core.Utils.DateUtils (UTCTimeR(..), defUTCTimeR, toUTCTime)
import Gargantext.Core.Viz.Phylo (TimeUnit(..), Date, Document(..), PhyloConfig(..), Phylo (_phylo_computeTime), trackComputeTime, ComputeTimeHistory)
import Gargantext.Core.Viz.Phylo.PhyloExport (toPhyloExport, dotToFile)
import Gargantext.Core.Viz.Phylo.PhyloMaker  (toPhylo, toPhyloWithoutLink)
import Gargantext.Core.Viz.Phylo.PhyloTools  ({-printIOMsg, printIOComment,-} setConfig)
import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataCorpus(..) )
import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument(..), unwrapHyperdataDateTime)
import Gargantext.Database.Admin.Types.Hyperdata.Phylo ( HyperdataPhylo(..) )
import Gargantext.Database.Admin.Types.Node (Context, CorpusId, ContextId, PhyloId, nodeId2ContextId)
import Gargantext.Database.Prelude
import Gargantext.Database.Query.Table.Node (defaultList, getNodeWith)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Table.NodeContext (selectDocNodes)
import Gargantext.Database.Schema.Context ( ContextPoly(_context_hyperdata, _context_id) )
import Gargantext.Database.Schema.Node ( NodePoly(_node_hyperdata), node_hyperdata )
import Gargantext.Prelude hiding (to)
import Gargantext.System.Logging ( MonadLogger, LogLevel(DEBUG), logLocM )
import Gargantext.Utils.Jobs.Monad (JobHandle, MonadJobStatus(markProgress, addMoreSteps))
import Gargantext.Utils.UTCTime (timeMeasured, timeMeasured'')
import Prelude qualified
import System.FilePath ((</>))
import System.IO.Temp (withTempDirectory)
import System.Process qualified as Shell

--------------------------------------------------------------------
getPhyloData :: HasNodeError err
             => PhyloId -> DBQuery err x (Maybe Phylo)
getPhyloData phyloId = do
  nodePhylo <- getNodeWith phyloId (Proxy :: Proxy HyperdataPhylo)
  pure $ _hp_data $ _node_hyperdata nodePhylo

putPhylo :: PhyloId -> DBCmd err Phylo
putPhylo = undefined

savePhylo :: PhyloId -> DBCmd err ()
savePhylo = undefined

--------------------------------------------------------------------
maybePhylo2dot2json :: Maybe Phylo -> IO (Maybe Value)
maybePhylo2dot2json Nothing = pure Nothing
maybePhylo2dot2json (Just phylo) = Just <$> phylo2dot2json phylo

phylo2dot2json :: Phylo -> IO Value
phylo2dot2json phylo = do
  withTempDirectory "/tmp" "phylo" $ \dirPath -> do
    let fileFrom = dirPath </> "phyloFrom.dot"
        fileDot  = dirPath </> "phylo.dot"
        fileToJson = dirPath </> "output.json"

    phyloContent <- phylo2dot phylo
    writeFile fileFrom phyloContent

    -- parsing a file can be done with:
    -- runParser' (Data.GraphViz.Parsing.parse :: Parse (Data.GraphViz.DotGraph Text)) $ TL.fromStrict f
    Shell.callProcess "dot" ["-Tdot", "-o", fileDot, fileFrom]
    Shell.callProcess "dot" ["-Txdot_json", "-o", fileToJson, fileDot]

    maybeValue <- decodeFileStrict fileToJson
    -- print maybeValue

    case maybeValue of
      Nothing -> panic "[G.C.V.Phylo.API.phylo2dot2json] Error no file"
      Just v  -> pure v


phylo2dot :: Phylo -> IO Text
phylo2dot phylo = do
  withTempDirectory "/tmp" "phylo" $ \dirPath -> do
    let fileFrom = dirPath </> "phyloFrom.dot"

    dotToFile fileFrom (toPhyloExport phylo)

    value <- readFile fileFrom

    case value of
      ""  -> panic "[G.C.V.Phylo.API.phylo2dot] Error no file"
      _   -> pure value


flowPhyloAPI :: (HasNodeStory env err m, HasNodeError err, MonadLogger m, MonadJobStatus m)
             => PhyloConfig
             -> Maybe ComputeTimeHistory
             -- ^ Previous compute time historical data, if any.
             -> CorpusId
             -> JobHandle m
             -> m Phylo
flowPhyloAPI config mbOldComputeHistory cId jobHandle = do
  env <- view hasNodeStory
  addMoreSteps 5 jobHandle
  corpus <- timeMeasured "flowPhyloAPI.corpusIdtoDocuments" $ runDBQuery $ corpusIdtoDocuments env (timeUnit config) cId
  markProgress 1 jobHandle
  -- writePhylo phyloWithCliquesFile phyloWithCliques
  $(logLocM) DEBUG $ "PhyloConfig old: " <> show config

  (t1, phyloWithCliques) <- timeMeasured'' DEBUG "flowPhyloAPI.phyloWithCliques" (pure $! toPhyloWithoutLink corpus config)
  markProgress 1 jobHandle
  (t2, phyloConfigured)  <- timeMeasured'' DEBUG "flowPhyloAPI.phyloConfigured" (pure $! setConfig config phyloWithCliques)
  markProgress 1 jobHandle
  (t3, finalPhylo)       <- timeMeasured'' DEBUG "flowPhyloAPI.toPhylo" (pure $! toPhylo phyloConfigured)
  markProgress 1 jobHandle

  -- As the phylo is computed fresh every time, without looking at the one stored (if any), we
  -- have to manually propagate computing time across.
  let ret = trackComputeTime (t1 + t2 + t3) (finalPhylo { _phylo_computeTime = mbOldComputeHistory })

  markProgress 1 jobHandle
  
  pure ret

--------------------------------------------------------------------
corpusIdtoDocuments :: HasNodeError err
                    => NodeStoryEnv err
                    -> TimeUnit
                    -> CorpusId
                    -> DBQuery err x [Document]
corpusIdtoDocuments env timeUnit corpusId = do
  docs <- selectDocNodes corpusId
  lId  <- defaultList corpusId
  termList <- getTermList env lId MapTerm NgramsTerms
  corpus_node <- getNodeWith corpusId (Proxy @HyperdataCorpus)
  let corpusLang = view (node_hyperdata . to _hc_lang) corpus_node

  let patterns = case termList of
        Nothing        -> panic "[G.C.V.Phylo.API] no termList found"
        Just termList' -> buildPatterns termList'
  pure $ map (toPhyloDocs (withDefaultLanguage corpusLang) patterns timeUnit) (map _context_hyperdata docs)

termsInText' :: Lang -> Patterns -> Text -> [Text]
termsInText' lang p t = (map fst) $ termsInText lang p t

toPhyloDocs :: Lang -> Patterns -> TimeUnit -> HyperdataDocument -> Document
toPhyloDocs lang patterns time d =
  let title = fromMaybe "" (_hd_title d)
      abstr = fromMaybe "" (_hd_abstract d)
                  in Document (toPhyloDate (unwrapHyperdataDateTime d) time)
                                    (toPhyloDate' (unwrapHyperdataDateTime d) time)
                                    (termsInText' lang patterns $ title <> " " <> abstr) Nothing [] time



context2phyloDocument :: TimeUnit
                      -> Context HyperdataDocument
                      -> (Map ContextId (Set NgramsTerm), Map ContextId (Set NgramsTerm))
                      -> Maybe Document
context2phyloDocument timeUnit context (ngs_terms, ngs_sources) = do
  let contextId = _context_id context
  (date, date') <- context2date context timeUnit

  let
    toText x = Set.toList $ Set.map unNgramsTerm x

    text'    = maybe [] toText $ Map.lookup (nodeId2ContextId contextId) ngs_terms
    sources' = maybe [] toText $ Map.lookup (nodeId2ContextId contextId) ngs_sources

  pure $ Document date date' text' Nothing sources' (Year 3 1 5)


-- TODO better default date and log the errors to improve data quality
context2date :: Context HyperdataDocument -> TimeUnit -> Maybe (Date, Text)
context2date context timeUnit = do
  let hyperdata =  _context_hyperdata context
  let
    utcTimeR = unwrapHyperdataDateTime hyperdata
  pure (toPhyloDate utcTimeR timeUnit, toPhyloDate' utcTimeR timeUnit)


---------------
-- | Dates | --
---------------
toMonths :: Integer -> Int -> Int -> Date
toMonths y m d = fromIntegral $ cdMonths
               $ diffGregorianDurationClip (fromGregorian y    m d)
                                           (fromGregorian 0001 1 1)

toDays :: Integer -> Int -> Int -> Date
toDays y m d = fromIntegral
             $ diffDays (fromGregorian y m d) (fromGregorian 0001 1 1)

toHours :: UTCTimeR -> Date
toHours utcTimeR = toMinutes utcTimeR `div` 60

toMinutes :: UTCTimeR -> Date
toMinutes utcTimeR = toSeconds utcTimeR `div` 60

toSeconds :: UTCTimeR -> Date
toSeconds utcTimeR = floor diffSeconds
  where
    diffSeconds = diffUTCTime (toUTCTime utcTimeR) (toUTCTime defUTCTimeR)

-- | This must be in accordance with frontend's 'G.C.PE.Types' -> 'parseNodeDate'
toPhyloDate :: UTCTimeR -> TimeUnit -> Date
toPhyloDate utcTimeR@(UTCTimeR { .. }) tu = case tu of
  Year   {} -> year
  Month  {} -> toMonths (Prelude.toInteger year) month day
  Week   {} -> div (toDays (Prelude.toInteger year) month day) 7
  Day    {} -> toDays (Prelude.toInteger year) month day
  Hour   {} -> toHours utcTimeR
  Minute {} -> toMinutes utcTimeR
  Second {} -> toSeconds utcTimeR
  _         -> panic "[G.C.V.P.API.Tools] toPhyloDate"

toPhyloDate' :: UTCTimeR -> TimeUnit -> Text
toPhyloDate' (UTCTimeR { .. }) (Epoch {}) = pack $ show $ posixSecondsToUTCTime $ fromIntegral year
toPhyloDate' (UTCTimeR { .. }) _          = pack $ showGregorian $ fromGregorian (toInteger year) month day

-- Utils

writePhylo :: HasCallStack => [Char] -> Phylo -> IO ()
writePhylo path phylo = Lazy.writeFile path $ encode phylo


readPhylo :: [Char] -> IO Phylo
readPhylo path = do
  phyloJson <- eitherDecodeFileStrict' @Phylo path
  either errorTrace pure phyloJson

-- | To read and decode a Json file
readJson :: FilePath -> IO Lazy.ByteString
readJson = Lazy.readFile
