{-|
Module      : Gargantext.Database.Query.Table.Node
Description : Main Tools of Node to the database
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX
-}

{-# LANGUAGE Arrows                 #-}
{-# LANGUAGE ConstraintKinds        #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE QuasiQuotes            #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE ViewPatterns           #-}

module Gargantext.Database.Query.Table.Node
  ( -- * Smart constructors, classes, defaults and helper functions
    defaultList
  , MkCorpus(..)
  , CorpusType(..)
  , node
  , queryNodeSearchTable

  -- * Queries that returns a single node
  , getClosestParentIdByType
  , getClosestParentIdByType'
  , getCorporaWithParentId
  , getNode
  , getNodes
  , getParent
  , getNodeWith
  , getNodeWithType
  , getOrMkList
  , getParentId
  , getUserRootPublicNode
  , getUserRootPrivateNode
  , getUserRootShareNode
  , selectNode

  -- * Boolean queries
  , isUserNode

  -- * Queries that returns multiple nodes
  , getChildrenByType
  , getClosestChildrenByType
  , getListsWithParentId
  , getNodesIdWithType
  , getNodesWith
  , getNodesWithParentId
  , getNodesWithType
  , selectNodesWith

  -- * Creating one or more nodes
  , insertDefaultNode
  , insertDefaultNodeIfNotExists
  , insertNode
  , insertNodesWithParentR
  , insertNodeWithHyperdata

  -- * Deleting one or more nodes
  , deleteNode
  , deleteNodes

  -- * Copying data
  , copyNode
  , copyNodeStories

  ) where

import Control.Arrow (returnA)
import Control.Lens (set, view)
import Data.Aeson ( encode, Value )
import Data.Bimap ((!>))
import Data.List.NonEmpty qualified as NE
import Database.PostgreSQL.Simple qualified as PGS
import Database.PostgreSQL.Simple.SqlQQ (sql)
import Gargantext.API.Errors.Types (BackendInternalError (..))
import Gargantext.Core ( HasDBid(toDBid) )
import Gargantext.Core.Types
import Gargantext.Core.Types.Query (Limit, Offset)
import Gargantext.Database.Admin.Config ( nodeTypes )
import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataAnnuaire, HyperdataCorpus )
import Gargantext.Database.Admin.Types.Hyperdata.Default ( defaultHyperdata, DefaultHyperdata(..) )
import Gargantext.Database.Admin.Types.Hyperdata.Folder (HyperdataFolder)
import Gargantext.Database.Admin.Types.Hyperdata.List ( HyperdataList )
import Gargantext.Database.Admin.Types.Hyperdata.Prelude ( Hyperdata )
import Gargantext.Database.Prelude
import Gargantext.Database.Query.Filter (limit', offset')
import Gargantext.Database.Query.Table.Node.Children (getChildrenByParentId)
import Gargantext.Database.Query.Table.Node.Error
import Gargantext.Database.Schema.Node
import Gargantext.Prelude hiding (sum, head)
import Opaleye hiding (FromField)
import Prelude hiding (null, id, map, sum)


queryNodeSearchTable :: Select NodeSearchRead
queryNodeSearchTable = selectTable nodeTableSearch

selectNode :: Column SqlInt4 -> Select NodeRead
selectNode id' = proc () -> do
    row      <- queryNodeTable -< ()
    restrict -< _node_id row .== id'
    returnA  -< row

------------------------------------------------------------------------
-- | order by publication date
-- Favorites (Bool), node_ngrams
selectNodesWith :: HasDBid NodeType
                => ParentId     -> Maybe NodeType
                -> Maybe Offset -> Maybe Limit   -> Select NodeRead
selectNodesWith parentId maybeNodeType maybeOffset maybeLimit =
        --offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId
  limit' maybeLimit $ offset' maybeOffset
                    $ orderBy (asc _node_id)
                    $ selectNodesWith' parentId maybeNodeType

selectNodesWith' :: HasDBid NodeType
                 => ParentId -> Maybe NodeType -> Select NodeRead
selectNodesWith' parentId maybeNodeType = proc () -> do
    node' <- (proc () -> do
      row@(Node _ _ typeId _ parentId' _ _ _) <- queryNodeTable -< ()
      restrict -< parentId' .== (pgNodeId parentId)

      let typeId' = maybe 0 toDBid maybeNodeType

      restrict -< if typeId' > 0
                     then typeId   .== (sqlInt4 (typeId' :: Int))
                     else (sqlBool True)
      returnA  -< row ) -< ()
    returnA -< node'

deleteNode :: NodeId -> DBUpdate err Int
deleteNode n =
  fromIntegral <$> mkOpaDelete
                 (Delete nodeTable
                         (\(Node n_id _ _ _ _ _ _ _) -> n_id .== pgNodeId n)
                         rCount
                 )

deleteNodes :: [NodeId] -> DBUpdate err Int
deleteNodes ns =
  fromIntegral <$> mkOpaDelete
                   (Delete nodeTable
                           (\(Node n_id _ _ _ _ _ _ _) -> in_ ((map pgNodeId ns)) n_id)
                           rCount
                   )

-- TODO: NodeType should match with `a'
getNodesWith :: (JSONB a, HasDBid NodeType) => NodeId -> proxy a -> Maybe NodeType
             -> Maybe Offset -> Maybe Limit -> DBQuery err x [Node a]
getNodesWith parentId _ nodeType maybeOffset maybeLimit =
    mkOpaQuery $ selectNodesWith parentId nodeType maybeOffset maybeLimit

-- TODO: Why is the second parameter ignored?
-- TODO: Why not use getNodesWith?
getNodesWithParentId :: (Hyperdata a, JSONB a)
                     => Maybe NodeId
                     -> DBQuery err x [Node a]
getNodesWithParentId n = mkOpaQuery $ selectNodesWithParentID n'
  where
    n' = case n of
      Just n'' -> n''
      Nothing  -> 0

-- | Given a node id, find it's parent node id (if exists)
getParentId :: NodeId -> DBQuery err x (Maybe NodeId)
getParentId nId = do
  result <- mkPGQuery query (PGS.Only nId)
  case result of
    [PGS.Only parentId] -> pure $ Just $ UnsafeMkNodeId parentId
    _ -> pure Nothing
  where
    query :: PGS.Query
    query = [sql|
      SELECT parent_id
      FROM nodes
        WHERE id = ?;
    |]

-- | Given a node id, find it's closest parent of given type
-- NOTE: This isn't too optimal: can make successive queries depending on how
-- deeply nested the child is.
getClosestParentIdByType :: HasDBid NodeType
                         => NodeId
                         -> NodeType
                         -> DBQuery err x (Maybe NodeId)
getClosestParentIdByType nId nType = do
  result <- mkPGQuery query (PGS.Only nId)
  case result of
    [(_NodeId -> parentId, pTypename)] -> do
      if toDBid nType == pTypename then
        pure $ Just $ UnsafeMkNodeId parentId
      else
        getClosestParentIdByType (UnsafeMkNodeId parentId) nType
    _ -> pure Nothing
  where
    query :: PGS.Query
    query = [sql|
      SELECT n2.id, n2.typename
      FROM nodes n1
        JOIN nodes n2 ON n1.parent_id = n2.id
        WHERE n1.id = ?;
    |]

-- | Similar to `getClosestParentIdByType` but includes current node
-- in search too
getClosestParentIdByType' :: HasDBid NodeType
                          => NodeId
                          -> NodeType
                          -> DBQuery err x (Maybe NodeId)
getClosestParentIdByType' nId nType = do
  result <- mkPGQuery query (PGS.Only nId)
  case result of
    [(_NodeId -> id, pTypename)] -> do
      if toDBid nType == pTypename then
        pure $ Just $ UnsafeMkNodeId id
      else
        getClosestParentIdByType nId nType
    _ -> pure Nothing
  where
    query :: PGS.Query
    query = [sql|
      SELECT n.id, n.typename
      FROM nodes n
      WHERE n.id = ?;
    |]

-- | Given a node id, find all it's children (no matter how deep) of
-- given node type.
getChildrenByType :: HasDBid NodeType
                  => NodeId
                  -> NodeType
                  -> DBQuery err x [NodeId]
getChildrenByType nId nType = do
  childrenFirstLevel <- getClosestChildrenByType nId nType
  childrenLst <- mapM (\id -> getChildrenByType id nType) childrenFirstLevel
  pure $ childrenFirstLevel ++ concat childrenLst

-- | Given a node id, find all it's children (only first level) of
-- given node type.
getClosestChildrenByType :: HasDBid NodeType
                         => NodeId
                         -> NodeType
                         -> DBQuery err x [NodeId]
getClosestChildrenByType nId nType = do
  results <- mkPGQuery query (nId, toDBid nType)
  pure $ (\(PGS.Only nodeId) -> nodeId) <$> results
  where
    query :: PGS.Query
    query = [sql|
      SELECT n.id
      FROM nodes n
      WHERE n.parent_id = ?
      AND n.typename = ?;
    |]

------------------------------------------------------------------------
getCorporaWithParentId :: HasDBid NodeType => NodeId -> DBQuery err x [Node HyperdataCorpus]
getCorporaWithParentId n = mkOpaQuery $ selectNodesWith' n (Just NodeCorpus)

------------------------------------------------------------------------
selectNodesWithParentID :: NodeId -> Select NodeRead
selectNodesWithParentID n = proc () -> do
    row@(Node _ _ _ _ parent_id _ _ _) <- queryNodeTable -< ()
    restrict -< parent_id .== pgNodeId n
    returnA -< row


------------------------------------------------------------------------
-- | Example of use:
-- runCmdReplEasy  (getNodesWithType NodeList (Proxy :: Proxy HyperdataList))
getNodesWithType :: (HasNodeError err, JSONB a, HasDBid NodeType) => NodeType -> proxy a -> DBQuery err x [Node a]
getNodesWithType nt _ = mkOpaQuery $ selectNodesWithType nt
  where
    selectNodesWithType ::  HasDBid NodeType
                         => NodeType -> Select NodeRead
    selectNodesWithType nt' = proc () -> do
        row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< ()
        restrict -< tn .== sqlInt4 (toDBid nt')
        returnA -< row

getNodeWithType :: (JSONB a, HasDBid NodeType)
                => NodeId
                -> NodeType
                -> proxy a
                -> DBQuery err x [Node a]
getNodeWithType nId nt _ = mkOpaQuery $ selectNodeWithType nId nt
  where
    selectNodeWithType ::  HasDBid NodeType
                        => NodeId -> NodeType -> Select NodeRead
    selectNodeWithType (_NodeId -> nId') nt' = proc () -> do
        row@(Node ti _ tn _ _ _ _ _) <- queryNodeTable -< ()
        restrict -< ti .== sqlInt4 nId'
        restrict -< tn .== sqlInt4 (toDBid nt')
        returnA -< row

getNodesIdWithType :: (HasNodeError err, HasDBid NodeType) => NodeType -> DBQuery err x [NodeId]
getNodesIdWithType nt = do
  ns <- mkOpaQuery $ selectNodesIdWithType nt
  pure (map UnsafeMkNodeId ns)

selectNodesIdWithType :: HasDBid NodeType
                      => NodeType -> Select (Column SqlInt4)
selectNodesIdWithType nt = proc () -> do
    row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< ()
    restrict -< tn .== (sqlInt4 $ toDBid nt)
    returnA -< _node_id row

-- | Get node, Hyperdata is 'Aeson.Value'
getNode :: HasNodeError err => NodeId -> DBQuery err x (Node Value)
getNode nId = do
  maybeNode <- headMay <$> mkOpaQuery (selectNode (pgNodeId nId))
  case maybeNode of
    Nothing -> nodeError (DoesNotExist nId)
    Just  r -> pure r

-- | Get the nodes recursively, as a hierarchical tree.
getNodes :: HasNodeError err => NodeId -> DBQuery err x (Tree (Node Value))
getNodes nId = do
  root     <- getNode nId
  children <- getChildrenByParentId nId
  case children of
    [] -> pure $ TreeN root []
    xs -> TreeN root <$> forM xs getNodes

-- | Get the parent of a given 'Node', failing if this was called
-- on a root node.
getParent :: HasNodeError err => Node a -> DBQuery err x (Node Value)
getParent n = do
  case n ^. node_parent_id of
    Nothing  -> nodeError NoRootFound
    Just nId -> getNode nId

getNodeWith :: (HasNodeError err, JSONB a)
            => NodeId -> proxy a -> DBQuery err x (Node a)
getNodeWith nId _ = do
  maybeNode <- headMay <$> mkOpaQuery (selectNode (pgNodeId nId))
  case maybeNode of
    Nothing -> nodeError (DoesNotExist nId)
    Just  r -> pure r


------------------------------------------------------------------------
-- | Sugar to insert Node with NodeType in Database
insertDefaultNode :: (HasDBid NodeType, HasNodeError err)
                  => NodeType -> ParentId -> UserId -> DBUpdate err NodeId
insertDefaultNode nt p u = insertNode nt Nothing Nothing p u

insertDefaultNodeIfNotExists :: (HasDBid NodeType, HasNodeError err)
                             => NodeType -> ParentId -> UserId -> DBUpdate err [NodeId]
insertDefaultNodeIfNotExists nt p u = do
  children <- getChildrenByType p nt
  case children of
    [] -> (:[]) <$> insertDefaultNode nt p u
    xs -> pure xs

insertNode :: (HasDBid NodeType, HasNodeError err)
           => NodeType -> Maybe Name -> Maybe DefaultHyperdata -> ParentId -> UserId -> DBUpdate err NodeId
insertNode nt n h p u = insertNodeWithHyperdata nt n' h' (Just p) u
  where
    n' = fromMaybe (defaultName nt) n
    h' = maybe     (defaultHyperdata nt) identity h

insertNodeWithHyperdata :: (ToJSON h, Hyperdata h, HasDBid NodeType, HasNodeError err)
                        => NodeType
                        -> Name
                        -> h
                        -> Maybe ParentId
                        -> UserId
                        -> DBUpdate err NodeId
insertNodeWithHyperdata nt n h p u = do
  res <- insertNodesR [node nt n h p u]
  case res of
    [x] -> pure x
    _   -> nodeError $ NodeCreationFailed $ InsertNodeFailed u p

------------------------------------------------------------------------
node :: (ToJSON a, Hyperdata a, HasDBid NodeType)
     => NodeType
     -> Name
     -> a
     -> Maybe ParentId
     -> UserId
     -> NodeWrite
node nodeType name hyperData parentId userId =
  Node Nothing Nothing
       (sqlInt4 typeId)
       (sqlInt4 $ _UserId userId)
       (pgNodeId <$> parentId)
       (sqlStrictText name)
       Nothing
       (sqlJSONB $ cs $ encode hyperData)
    where
      typeId = toDBid nodeType

                  -------------------------------
insertNodesR :: [NodeWrite] -> DBUpdate err [NodeId]
insertNodesR ns = mkOpaInsert (Insert nodeTable ns (rReturning (\(Node i _ _ _ _ _ _ _) -> i)) Nothing)

insertNodesWithParentR :: Maybe ParentId -> [NodeWrite] -> DBUpdate err [NodeId]
insertNodesWithParentR pid ns = insertNodesR (set node_parent_id (pgNodeId <$> pid) <$> ns)

------------------------------------------------------------------------
-- TODO
-- currently this function removes the child relation
-- needs a Temporary type between Node' and NodeWriteT

data Node' = Node' { _n_type :: NodeType
                   , _n_name :: Text
                   , _n_data :: Value
                   , _n_children :: [Node']
                   } deriving (Show)

-- =================================================================== --
-- |
-- CorpusDocument is a corpus made from a set of documents
-- CorpusContact  is a corpus made from a set of contacts (syn of Annuaire)
data CorpusType = CorpusDocument | CorpusContact

class MkCorpus a
  where
    mk :: (HasDBid NodeType, HasNodeError err)
       => Maybe Name
       -> Maybe a
       -> ParentId
       -> UserId
       -> DBUpdate err [NodeId]

instance MkCorpus HyperdataCorpus
  where
    mk n Nothing  p u = (:[]) <$> insertNode NodeCorpus n Nothing p u
    mk n (Just h) p u = (:[]) <$> insertNode NodeCorpus n (Just $ DefaultCorpus h) p u


instance MkCorpus HyperdataAnnuaire
  where
    mk n Nothing  p u = (:[]) <$> insertNode NodeCorpus   n Nothing p u
    mk n (Just h) p u = (:[]) <$> insertNode NodeAnnuaire n (Just $ DefaultAnnuaire h) p u


getOrMkList :: (HasNodeError err, HasDBid NodeType)
            => ParentId
            -> UserId
            -> DBUpdate err ListId
getOrMkList pId uId =
  maybe (mkList' pId uId) (pure . view node_id) . headMay =<< getListsWithParentId pId
    where
      mkList' pId' uId' = insertDefaultNode NodeList pId' uId'

-- | TODO remove defaultList
defaultList :: (HasNodeError err, HasDBid NodeType) => CorpusId -> DBQuery err x ListId
defaultList cId =
  maybe (nodeError (NoListFound cId)) (pure . view node_id) . headMay =<< getListsWithParentId cId

getListsWithParentId :: HasDBid NodeType => NodeId -> DBQuery err x [Node HyperdataList]
getListsWithParentId n = mkOpaQuery $ selectNodesWith' n (Just NodeList)

-- | Returns the /root/ public node for the input user. By root we mean that
-- if we were to traverse all the parents of the result, we wouldn't find any
-- other parent which 'NodeType' was 'NodeFolderPublic'.
getUserRootPublicNode :: (HasNodeError err, HasDBid NodeType)
                      => UserId
                      -> DBQuery err x (Node HyperdataFolder)
getUserRootPublicNode = get_user_root_node_folder NodeFolderPublic

getUserRootPrivateNode :: (HasNodeError err, HasDBid NodeType)
                       => UserId
                       -> DBQuery err x (Node HyperdataFolder)
getUserRootPrivateNode = get_user_root_node_folder NodeFolderPrivate

getUserRootShareNode :: (HasNodeError err, HasDBid NodeType)
                     => UserId
                     -> DBQuery err x (Node HyperdataFolder)
getUserRootShareNode = get_user_root_node_folder NodeFolderShared

get_user_root_node_folder :: (HasNodeError err, HasDBid NodeType)
                          => NodeType
                          -> UserId
                          -> DBQuery err x (Node HyperdataFolder)
get_user_root_node_folder nty userId = do
  result <- mkOpaQuery $ do
    n <- queryNodeTable
    where_ $ (n ^. node_typename .== sqlInt4 (toDBid nty)) .&&
             (n ^. node_user_id  .== sqlInt4 (_UserId userId))
    pure n
  case NE.nonEmpty result of
    Nothing
      -> nodeError $ NodeLookupFailed $ UserFolderDoesNotExist userId
    -- See https://gitlab.iscpif.fr/gargantext/haskell-gargantext/merge_requests/350#note_12732
    -- User might have more than one public folder, in which case we need to take the one with the
    -- smallest id.
    Just folders
      -> pure $ NE.head (NE.sortWith _node_id folders)

-- | An input 'NodeId' identifies a user node if its typename is 'NodeUser' and it has no parent_id.
isUserNode :: HasDBid NodeType => NodeId -> DBQuery err x Bool
isUserNode userNodeId = (== [PGS.Only True])
  <$> mkPGQuery [sql|
    SELECT EXISTS (
        SELECT 1
        FROM nodes
        WHERE n.id = ? AND n.typename = ? AND n.parent_id = NULL
    )
|] (userNodeId, toDBid NodeUser)

-- | Copy a node somewhere else in the tree
copyNode :: Bool   -- ^ Whether to copy whole subtree (`True`) or just the node (`False`)
         -> Bool   -- ^ Whether to deal with ngrams and contexts (`True`) or just the data in the `nodes` table (`False`)
         -> NodeId -- ^ ID of the node to be copied
         -> NodeId -- ^ ID of the node which will become the parent of the copied node
         -> DBUpdate BackendInternalError NodeId -- ^ ID of the copied node
copyNode copySubtree smart idToCopy newParentId = if copySubtree
  -- Recursive copy:
  then do
    -- Non-recursively copy the node itself, then recursively copy its children:
    copiedNode <- copyNode False smart idToCopy newParentId
    children   <- getChildrenByParentId idToCopy
    for_ children $ \child -> copyNode True smart child copiedNode
    return copiedNode
  -- Single-node (non-recursive) copy:
  else do
    copiedNode <- mkPGUpdateReturningOne
      -- Copy node. Should return exactly one ID, that of the new node:
      [sql|
        INSERT INTO public.nodes (typename, user_id, parent_id, name, date, hyperdata)
        SELECT typename, user_id, ?, name, date, hyperdata FROM public.nodes WHERE id = ?
        RETURNING id;
      |] (newParentId, idToCopy)
    -- Copy node stories/contexts if applicable
    when smart $ do
      nodeToCopy <- getNode idToCopy
      case nodeTypes !> view node_typename nodeToCopy of
        NodeList   -> copyNodeStories  idToCopy copiedNode
        -- Contexts are attached to a corpus node, not to the docs node:
        NodeCorpus -> copyNodeContexts idToCopy copiedNode
        _ -> return ()
    return copiedNode


-- | Given two IDs of terms nodes, copies the node stories of the first into
-- node stories of the second. This effectively copies the terms from one terms
-- node to another.
-- TODO add a check that we are looking at the right type of node?
copyNodeStories :: NodeId -- ^ The ID of the node whose stories are to be copied
                -> NodeId -- ^ The ID of the node under which to copy the stories
                -> DBUpdate BackendInternalError ()
copyNodeStories oldNodeId newNodeId = void $ mkPGUpdate
  [sql|
    INSERT INTO node_stories
      (node_id, version, ngrams_type_id, ngrams_id, ngrams_repo_element)
    SELECT ?, version, ngrams_type_id, ngrams_id, ngrams_repo_element
    FROM node_stories
    WHERE node_id = ?;
  |] (newNodeId, oldNodeId)

-- | Given two IDs of Docs nodes, add to the second the contexts associated to
-- the first. Functionally, this copies the contexts from the first node to the
-- second, although the contexts are not technically duplicated in the database.
copyNodeContexts :: NodeId -- ^ The ID of the node whose contexts are to be "copied"
                 -> NodeId -- ^ The ID of the node under which to "copy" the contexts
                 -> DBUpdate BackendInternalError ()
copyNodeContexts oldNodeId newNodeId = void $ mkPGUpdate
  [sql|
    INSERT INTO node_contexts (node_id, context_id, score, category)
    SELECT ?, context_id, score, category FROM node_stories WHERE node_id = ?
  |] (newNodeId, oldNodeId)
