{-|
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 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)
import qualified Data.List.NonEmpty as NE


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)
