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

-}

{-# LANGUAGE Arrows #-}
{-# LANGUAGE ConstraintKinds   #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Gargantext.Core.NodeStory.DB
  ( nodeExists
  , getNodesIdWithType
  , getNodesArchiveHistory
  , insertNodeArchiveHistory
  , nodeStoriesQuery
  , insertArchiveStateList
  , deleteArchiveStateList
  , updateArchiveStateList
  , updateNodeStoryVersion )
where

import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Data.Map.Strict qualified as Map
import Data.Map.Strict.Patch qualified as PM
import Database.PostgreSQL.Simple qualified as PGS
import Database.PostgreSQL.Simple.SqlQQ (sql)
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Gargantext.API.Ngrams.Types
import Gargantext.Core (toDBid)
import Gargantext.Core.NodeStory.Types ( a_state, a_version, ArchiveList, ArchiveStateList, NgramsStatePatch', ArchiveState )
import Gargantext.Core.Text.Ngrams (NgramsType)
import Gargantext.Database.Admin.Types.Node ( NodeId(..), NodeType )
import Gargantext.Database.Admin.Config ()
import Gargantext.Database.Schema.Ngrams ()
import Gargantext.Database.Prelude
import Gargantext.Prelude hiding (to)


nodeExists :: NodeId -> DBQuery err x Bool
nodeExists nId = (== [PGS.Only True])
  <$> mkPGQuery [sql| SELECT true FROM nodes WHERE id = ? LIMIT 1 |] (PGS.Only nId)

getNodesIdWithType :: NodeType -> DBQuery err x [NodeId]
getNodesIdWithType nt = do
  ns <- mkPGQuery query (PGS.Only $ toDBid nt)
  pure $ map (\(PGS.Only nId) -> UnsafeMkNodeId nId) ns
  where
    query :: PGS.Query
    query = [sql| SELECT id FROM nodes WHERE typename = ? |]


-- /!\ This function is using an hard coded parameter
-- which depends on the Ngrams List Flow
-- Version > 5 is hard coded because by default
-- first version of history of manual change is 6
getNodesArchiveHistory :: [NodeId]
                       -> DBQuery err x [(NodeId, (Map NgramsType [HashMap NgramsTerm NgramsPatch]))]
getNodesArchiveHistory nodesId = do
  as <- mkPGQuery query (PGS.Only $ Values fields nodesId)
                          :: DBQuery err x [(Int, NgramsType, NgramsTerm, NgramsPatch)]

  pure $ map (\(nId, ngramsType, terms, patch)
               -> ( UnsafeMkNodeId nId
                  , Map.singleton ngramsType [HashMap.singleton terms patch]
                  )
             ) as
  where

    fields = [QualifiedIdentifier Nothing "int4"]
    query :: PGS.Query
    query = [sql| WITH nodes_id(nid) as (?)
                    SELECT node_id, ngrams_type_id, terms, patch
                    FROM node_story_archive_history
                    JOIN ngrams ON ngrams.id = ngrams_id
                    JOIN nodes_id n ON node_id = n.nid
                    WHERE version > 5
                    ORDER BY (version, node_story_archive_history.id) DESC
            |]


insertNodeArchiveHistory :: NodeId -> Version -> [NgramsStatePatch'] -> DBUpdate err ()
insertNodeArchiveHistory _ _ [] = pure ()
insertNodeArchiveHistory nodeId version (h:hs) = do
  let tuples = mconcat $ (\(nType, NgramsTablePatch patch) ->
                           (\(term, p) ->
                              (nodeId, nType, term, p)) <$> PM.toList patch) <$> PM.toList h :: [(NodeId, NgramsType, NgramsTerm, NgramsPatch)]

  forM_ tuples $ \(nId, nType, term, patch) -> do
    (ngramsId :: Int) <- PGS.fromOnly <$> mkPGUpdateReturningOne qInsert (PGS.Only term)
    mkPGUpdate query (nId, nType, ngramsId, patch, version)

  void $ insertNodeArchiveHistory nodeId version hs
  where
    qInsert :: PGS.Query
    qInsert = [sql|INSERT INTO ngrams (terms) VALUES (?)
                  ON CONFLICT (terms) DO UPDATE SET terms = excluded.terms
                  RETURNING id|]

    -- https://stackoverflow.com/questions/39224438/postgresql-insert-if-foreign-key-exists
    query :: PGS.Query
    query = [sql| INSERT INTO node_story_archive_history(node_id, ngrams_type_id, ngrams_id, patch, version)
                VALUES (?, ?, ?, ?, ?)
                |]


nodeStoriesQuery :: PGS.Query
nodeStoriesQuery = [sql| SELECT version, ngrams_type_id, terms, ngrams_repo_element
                           FROM node_stories
                           JOIN ngrams ON ngrams.id = ngrams_id
                           WHERE node_id = ?
                           |]


-- Archive


insertArchiveStateList :: NodeId -> Version -> ArchiveStateList -> DBUpdate err ()
insertArchiveStateList nodeId version = mapM_ performInsert
  where
    performInsert :: ArchiveState -> DBUpdate err ()
    performInsert (ngramsType, ngrams, ngramsRepoElement) = do
      ngramsId <- tryInsertTerms ngrams
      _ <- case ngramsRepoElement ^. nre_root of
        Nothing -> pure []
        Just r  -> (:[]) <$> tryInsertTerms r
      mapM_ tryInsertTerms $ ngramsRepoElement ^. nre_children
      void $ mkPGUpdate query (nodeId, ngramsId, version, ngramsType, ngramsRepoElement)

    tryInsertTerms :: NgramsTerm -> DBUpdate err Int
    tryInsertTerms t = PGS.fromOnly <$> mkPGUpdateReturningOne qInsert (PGS.Only t)

    qInsert :: PGS.Query
    qInsert = [sql|INSERT INTO ngrams (terms) VALUES (?)
                  ON CONFLICT (terms) DO UPDATE SET terms = excluded.terms
                  RETURNING id|]

    query :: PGS.Query
    query = [sql|INSERT INTO node_stories(node_id, ngrams_id, version, ngrams_type_id, ngrams_repo_element)
                VALUES (?, ?, ?, ?, ? :: jsonb)
                |]

deleteArchiveStateList :: NodeId -> ArchiveStateList -> DBUpdate err ()
deleteArchiveStateList nodeId as = do
  mapM_ (\(nt, n, _) -> mkPGUpdate query (nodeId, nt, n)) as
  where
    query :: PGS.Query
    query = [sql| DELETE FROM node_stories
                WHERE node_id = ? AND ngrams_type_id = ?
                  AND ngrams_id IN (SELECT id FROM ngrams WHERE terms = ?)
                  |]

updateArchiveStateList :: NodeId -> Version -> ArchiveStateList -> DBUpdate err ()
updateArchiveStateList nodeId version as = do
  let params = (\(nt, n, nre) -> (nre, version, nodeId, nt, n)) <$> as
  mapM_ (mkPGUpdate query) params
  where
    query :: PGS.Query
    query = [sql| UPDATE node_stories
                SET ngrams_repo_element = ?, version = ?
                WHERE node_id = ? AND ngrams_type_id = ?
                  AND ngrams_id IN (SELECT id FROM ngrams WHERE terms = ?)
                  |]


updateNodeStoryVersion :: NodeId -> ArchiveList -> DBUpdate err ()
updateNodeStoryVersion nodeId newArchive = do
  let ngramsTypes = Map.keys $ newArchive ^. a_state
  mapM_ (\nt -> mkPGUpdate query (newArchive ^. a_version, nodeId, nt)) ngramsTypes
  where
    query :: PGS.Query
    query = [sql|UPDATE node_stories
                SET version = ?
                WHERE node_id = ?
                AND ngrams_type_id = ?|]
