{-|
Module      : Gargantext.Database.Tree
Description : Tree of Resource Nodes built from Database
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

Let a Root Node, return the Tree of the Node as a directed acyclic graph
(Tree).

-- TODO delete node, if not owned, then suppress the link only
-- see Action/Delete.hs
-}

{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE TemplateHaskell   #-}

module Gargantext.Database.Query.Tree
  ( module Gargantext.Database.Query.Tree.Error
  , isDescendantOf
  , isOwnedBy
  , isSharedWith
  , isIn
  , tree
  , tree_flat
  , TreeMode(..)
  , findNodesId
  , DbTreeNode(..)
  , dt_name
  , dt_nodeId
  , dt_typeId
  , dt_publish_policy
  , findShared
  , findNodes
  , findNodesWithType
  , NodeMode(..)

  , sharedTreeUpdate
  , dbTree
  , updateTree
  , recursiveParents

  , lookupPublishPolicy
  )
  where

import Control.Lens qualified as L
import Control.Lens (view, toListOf, at, each, _Just, to, set, over)
import Database.PostgreSQL.Simple ( Only(Only), In(In) )
import Database.PostgreSQL.Simple.SqlQQ ( sql )
import Data.List.NonEmpty qualified as NE
import Data.List qualified as List
import Data.List (tail, nub)
import Data.Map.Strict (fromListWith, lookup)
import Data.Text qualified as Text
import Gargantext.Core ( fromDBid, HasDBid(toDBid) )
import Gargantext.Core.Types.Main (NodeTree(..), Tree(..))
import Gargantext.Database.Admin.Config ()
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Table.Node (getNode)
import Gargantext.Database.Query.Table.Node (getUserRootPublicNode)
import Gargantext.Database.Query.Table.NodeNode
import Gargantext.Database.Query.Tree.Error
import Gargantext.Database.Schema.Node
import Gargantext.Prelude hiding (to)

------------------------------------------------------------------------
data DbTreeNode = DbTreeNode { _dt_nodeId         :: NodeId
                             , _dt_typeId         :: Int
                             , _dt_parentId       :: Maybe NodeId
                             , _dt_name           :: Text
                             , _dt_publish_policy :: Maybe NodePublishPolicy
                             } deriving (Show)

makeLenses ''DbTreeNode

instance Eq DbTreeNode where
  (==) d1 d2 = (==) (_dt_nodeId d1) (_dt_nodeId d2)

------------------------------------------------------------------------

data TreeMode = TreeBasic | TreeAdvanced | TreeFirstLevel

-- | Returns the Tree of Nodes in Database
tree :: (HasTreeError err, HasNodeError err)
     => UserId
     -> TreeMode
     -> RootId
     -> [NodeType]
     -> DBQuery err x (Tree NodeTree)
tree _ TreeBasic                   = tree_basic
tree loggedInUserId TreeAdvanced   = tree_advanced loggedInUserId
tree loggedInUserId TreeFirstLevel = tree_first_level loggedInUserId

-- | Tree basic returns the Tree of Nodes in Database
-- (without shared folders)
-- keeping this for teaching purpose only
tree_basic :: (HasTreeError err, HasNodeError err)
           => RootId
           -> [NodeType]
           -> DBQuery err x (Tree NodeTree)
tree_basic r nodeTypes = do
  trees <- toTree . toTreeParent . map db_tree_to_node_tree <$> dbTree r nodeTypes
  either treeError pure trees

-- | Advanced mode of the Tree enables shared nodes
tree_advanced :: (HasTreeError err, HasNodeError err)
              => UserId
              -> RootId
              -> [NodeType]
              -> DBQuery err x (Tree NodeTree)
tree_advanced loggedInUserId r types = do
  trees <- tree_find_modes loggedInUserId [ Private, Public, Shared, Published ] r types
  either treeError pure (toTree . toSubtreeParent r $ trees)

-- | Fetch only first level of tree
tree_first_level :: (HasTreeError err, HasNodeError err)
                 => UserId
                 -> RootId
                 -> [NodeType]
                 -> DBQuery err x (Tree NodeTree)
tree_first_level loggedInUserId r types = do
  trees <- tree_find_modes loggedInUserId [ Private, PublicDirect, SharedDirect, Published ] r types
  either treeError pure (toTree . toSubtreeParent r $ trees)

-- | Fetch tree in a flattened form
tree_flat :: (HasTreeError err, HasNodeError err)
          => UserId
          -> RootId
          -> [NodeType]
          -> Maybe Text
          -> DBQuery err x [NodeTree]
tree_flat loggedInUserId r nodeTypes q = do
  trees <- map snd <$> tree_find_modes loggedInUserId [Private, Public, Shared] r nodeTypes
  pure $ case q of
    Just v  -> filter (\(NodeTree {_nt_name}) -> Text.isInfixOf (Text.toLower v) (Text.toLower _nt_name)) trees
    Nothing -> trees

-- | Collect all the subtrees given for the input 'NodeMode' list.
tree_find_modes :: (HasTreeError err, HasNodeError err)
                => UserId
                -> [NodeMode]
                -> RootId
                -> [NodeType]
                -> DBQuery err x [(Maybe ParentId, NodeTree)]
tree_find_modes loggedInUserId nodeModes r nodeTypes = do
  foldM (\ !acc mode -> findNodes loggedInUserId r mode nodeTypes <&> \dbTrees -> acc <> map db_tree_to_node_tree dbTrees) [] nodeModes

db_tree_to_node_tree :: DbTreeNode -> (Maybe ParentId, NodeTree)
db_tree_to_node_tree t = (_dt_parentId t, toNodeTree t)

------------------------------------------------------------------------
data NodeMode =
  -- | A node is /private/, i.e. only visible to the logged-in user.
  Private
  -- | A node is /shared/, i.e. only visible to the logged-in user /and/
  -- the members of the team.
  | Shared
  -- | A node is /public/, i.e. visible to /all/ logged-in users.
  | Public
  -- | A node is /published/ when it's public and it's visible in all other
  -- user trees. The semantic between 'Public' and 'Published' is subtle:
  -- 'Public' refers to published nodes _of the current user_ which are visible
  -- in his/her \"Public\" folder. 'Published' refers to published nodes
  -- _from other users_, which will be listed in the final tree we build.
  | Published
  | SharedDirect
  | PublicDirect

findNodes :: (HasTreeError err, HasNodeError err)
          => UserId
          -> RootId
          -> NodeMode
          -> [NodeType]
          -> DBQuery err x [DbTreeNode]
findNodes _ r Private nt
  = dbTree r nt
findNodes _ r Shared  nt
  = findShared r NodeFolderShared nt sharedTreeUpdate
findNodes loggedInUserId r SharedDirect  nt
  = findSharedDirect loggedInUserId r NodeFolderShared nt sharedTreeUpdate
findNodes _ r Public  nt
  = findShared r NodeFolderPublic nt publicTreeUpdate
findNodes loggedInUserId r PublicDirect  nt
  = findSharedDirect loggedInUserId r NodeFolderPublic nt publicTreeUpdate
findNodes loggedInUserId r Published nt
  = findPublished loggedInUserId r nt

-- | Finds the /published/ nodes. Refer to the documentation for the 'NodeMode' to
-- understand the difference between publish and published (which are the same thing,
-- but seen from different perspectives).
findPublished :: (HasTreeError err, HasNodeError err)
              => UserId
              -> RootId
              -> [NodeType]
              -> DBQuery err x [DbTreeNode]
findPublished loggedInUserId _r nt = do
  -- Get the public folder for the /currently logged in user/. This will be the node where we
  -- want to attach all the /public nodes/ of the users that are publishing something.
  loggedInUserPublicFolder <- getUserRootPublicNode loggedInUserId
  -- Get all the published nodes, but filter out those owned by the currently logged in user, because
  -- those will be listed /only for the owner/ as part of the 'Public' 'find_nodes' query.
  allPublishedRootFolders  <- filter (notOwnedByMe loggedInUserPublicFolder) <$> selectPublishedNodes
  trees <- forM allPublishedRootFolders $ \PublishedNodeInfo{pni_target_id, pni_owner_id, pni_policy} -> do
    let (TargetId publicFolderId) = pni_target_id
    let (OwnerId  publicFolderOwnerId) = pni_owner_id
    publicNode     <- getNode publicFolderId
    let publicNodeId = publicNode ^. node_id
    -- Fetch the user node which is sharing this folder.
    sharerUserNode <- getNode publicFolderOwnerId
    -- Get the full subtree reacheable from the source id
    sharedSubTree <- findNodes (sharerUserNode ^. node_user_id) publicFolderOwnerId Public nt
    -- Now we need to artificially attach this subtree to a node which will show up in
    -- the final tree as being owned by the logged-in user, but clearly showing as provenance
    -- the public folder id.

    let sharerDbTreeNode       = DbTreeNode {
            _dt_nodeId         = publicNodeId
          , _dt_typeId         = publicNode ^. node_typename
          , _dt_parentId       = Just (loggedInUserPublicFolder ^. node_id)
          , _dt_name           = sharerUserNode ^. node_name
          -- It's the published node, not this artificial root that has to display the
          -- policy.
          , _dt_publish_policy = Nothing
          }

    let detachedTree = sharerDbTreeNode : (sharedSubTree & over L._head (\dt -> dt { _dt_parentId = Just publicNodeId
                                                                                   , _dt_publish_policy = Just pni_policy
                                                                                   }))
    pure $ detachedTree
  pure $ mconcat trees
  where
    notOwnedByMe :: Node a -> PublishedNodeInfo -> Bool
    notOwnedByMe myPublicFolder PublishedNodeInfo{pni_target_id} = myPublicFolder ^. node_id /= (_TargetId pni_target_id)

------------------------------------------------------------------------
-- | Collaborative Nodes in the Tree
--   Queries the `nodes_nodes` table.
findShared :: HasTreeError err
           => RootId -> NodeType -> [NodeType] -> UpdateTree err x
           -> DBQuery err x [DbTreeNode]
findShared r nt nts fun = do
  foldersSharedId     <- findNodesId r [nt]
  trees               <- mapM (updateTree nts fun) foldersSharedId
  pure $ concat trees

-- | Find shared folders with "direct" access, i.e. when fetching only
-- first-level subcomponents. This works in a simplified manner: fetch the node
-- and get the tree for its parent.
findSharedDirect :: (HasTreeError err, HasNodeError err)
                 => UserId
                 -> RootId
                 -> NodeType
                 -> [NodeType]
                 -> UpdateTree err x
                 -> DBQuery err x [DbTreeNode]
findSharedDirect _loggedInUserId r nt nts fun = do
  rootNode <- getNode r
  let mParent = _node_parent_id rootNode
  case mParent of
    Nothing -> pure []
    Just parentId -> do
      foldersSharedId <- findNodesId parentId [nt]
      concat <$> mapM (updateTree nts fun) foldersSharedId


-- | An action to update the nodes /AFTER/ they have been fetched from the database,
-- so it's not an update in database terms, but it's actually a transformation on
-- notes fetched from the DB as in a pure /Query/.
type UpdateTree err x = ParentId -> [NodeType] -> NodeId -> DBQuery err x [DbTreeNode]

updateTree :: HasTreeError err
           => [NodeType] -> UpdateTree err x -> RootId
           -> DBQuery err x [DbTreeNode]
updateTree nts fun r = do
  folders       <- getNodeNode r
  nodesSharedId <- mapM (fun r nts)
                 $ map _nn_node2_id folders
  pure $ concat nodesSharedId


sharedTreeUpdate :: HasTreeError err => UpdateTree err x
sharedTreeUpdate p nt n = dbTree n nt
               <&> map (\n' -> if (view dt_nodeId n') == n
                                  -- && elem (fromDBid $ _dt_typeId n') [NodeGraph]
                                  -- && not (elem (fromDBid $ _dt_typeId n') [NodeFile])
                                  then set dt_parentId (Just p) n'
                                  else n')

publicTreeUpdate :: HasTreeError err => UpdateTree err x
publicTreeUpdate p nt n = dbTree n nt
               <&> map (\n' -> if _dt_nodeId n' == n
                                  -- && (fromDBid $ _dt_typeId n') /= NodeGraph
                                  -- && not (elem (fromDBid $ _dt_typeId n') [NodeFile])
                                  then set dt_parentId (Just p) n'
                                  else n')



-- | findNodesId returns all nodes matching nodeType but the root (Nodeuser)
findNodesId :: RootId -> [NodeType] -> DBQuery err x [NodeId]
findNodesId r nt = tail
                <$> map _dt_nodeId
                <$> dbTree r nt

findNodesWithType :: HasCallStack => RootId -> [NodeType] -> [NodeType] -> DBQuery err x [DbTreeNode]
findNodesWithType root target through =
  filter isInTarget <$> dbTree root through
    where
      isInTarget n = List.elem (fromDBid $ view dt_typeId n)
                   $ List.nub $ target <> through

------------------------------------------------------------------------
toTree :: Map (Maybe ParentId) [NodeTree] -> Either TreeError (Tree NodeTree)
toTree m =
    case lookup Nothing m of
        Just [root] -> pure $ toTree' m root
        Nothing     -> Left $ NoRoot
        Just []     -> Left $ EmptyRoot
        Just r      -> Left $ TooManyRoots (NE.fromList $ map _nt_id r)

      where
        toTree' :: Map (Maybe ParentId) [NodeTree]
                -> NodeTree
                -> Tree NodeTree
        toTree' m' root =
          TreeN root $
            -- Lines below are equivalent computationally but not semantically
            -- m' ^.. at (Just $ _dt_nodeId root) . _Just . each . to (toTree' m')
            toListOf (at (Just $ _nt_id root) . _Just . each . to (toTree' m')) m'

-- FIXME(adn) We need to propagate the 'PublishPolicy' into a 'DbTreeNode' and a 'NodeTree'
-- so that we can display them properly in the frontend.
toNodeTree :: HasCallStack => DbTreeNode -> NodeTree
toNodeTree (DbTreeNode nId tId _ n pp) = NodeTree n (fromDBid tId) nId pp

------------------------------------------------------------------------
toTreeParent :: [(Maybe ParentId, NodeTree)]
             -> Map (Maybe ParentId) [NodeTree]
toTreeParent = fromListWith (\a b -> nub $ a <> b) . map (\(mb_parent, n) -> (mb_parent, [n]))

------------------------------------------------------------------------
-- toSubtreeParent' :: [DbTreeNode]
--                 -> Map (Maybe ParentId) [DbTreeNode]
-- toSubtreeParent' ns = fromListWith (\a b -> nub $ a <> b) . map (\n -> (_dt_parentId n, [n])) $ nullifiedParents
--   where
--     nodeIds = Set.fromList $ map (\n -> unNodeId $ _dt_nodeId n) ns
--     nullifiedParents = map nullifyParent ns
--     nullifyParent dt@(DbTreeNode { _dt_parentId = Nothing }) = dt
--     nullifyParent dt@(DbTreeNode { _dt_nodeId = nId
--                                  , _dt_parentId = Just pId
--                                  , _dt_typeId = tId
--                                  , _dt_name = name }) =
--       if Set.member (unNodeId pId) nodeIds then
--         dt
--       else
--         DbTreeNode { _dt_nodeId = nId
--                    , _dt_typeId = tId
--                    , _dt_parentId = Nothing
--                    , _dt_name = name }
------------------------------------------------------------------------
toSubtreeParent :: RootId
                -> [(Maybe ParentId, NodeTree)]
                -> Map (Maybe ParentId) [NodeTree]
toSubtreeParent r = toTreeParent . map (nullifyParent r)

nullifyParent :: RootId -> (Maybe ParentId, NodeTree) -> (Maybe ParentId, NodeTree)
nullifyParent _ (Nothing, t)
  = (Nothing, t)
nullifyParent r (Just parent, t@(NodeTree{..}))
  = if r == _nt_id then (Nothing, t) else (Just parent, t)

------------------------------------------------------------------------
-- | Main DB Tree function
dbTree :: RootId
       -> [NodeType]
       -> DBQuery err x [DbTreeNode]
dbTree rootId nodeTypes = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n Nothing)
  <$> mkPGQuery [sql|
    WITH RECURSIVE
        tree (id, typename, parent_id, name) AS
        (
          SELECT p.id, p.typename, p.parent_id, p.name
          FROM nodes AS p
          WHERE p.id = ?

          UNION

          SELECT c.id, c.typename, c.parent_id, c.name
          FROM nodes AS c

          INNER JOIN tree AS s ON c.parent_id = s.id
           WHERE c.typename IN ?
        )
    SELECT * from tree;
    |] (rootId, In typename)
  where
    typename = map toDBid ns
    ns = case nodeTypes of
      [] -> allNodeTypes
      _  -> nodeTypes

isDescendantOf :: NodeId -> RootId -> DBQuery err x Bool
isDescendantOf childId rootId = (== [Only True])
  <$> mkPGQuery [sql|
                  WITH RECURSIVE
      tree (id, parent_id) AS
      (
        SELECT c.id, c.parent_id
        FROM nodes AS c
        WHERE c.id = ?

        UNION

        SELECT p.id, p.parent_id
        FROM nodes AS p
        INNER JOIN tree AS t ON t.parent_id = p.id

      )
  SELECT COUNT(*) = 1 from tree AS t
  WHERE t.id = ?;
  |] (childId, rootId)

isOwnedBy :: NodeId -> UserId -> DBQuery err x Bool
isOwnedBy nodeId userId = (== [Only True])
  <$> mkPGQuery [sql| SELECT COUNT(*) = 1 from nodes AS c where c.id = ? AND c.user_id = ? |] (nodeId, userId)

isSharedWith :: NodeId -> NodeId -> DBQuery err x Bool
isSharedWith targetNode targetUserNode = (== [Only True])
  <$> mkPGQuery [sql|
      WITH RECURSIVE SharePath AS (
        SELECT nn.node1_id, nn.node2_id AS shared_node_id
        FROM nodes_nodes nn
        WHERE nn.node1_id IN (SELECT id FROM nodes WHERE parent_id = ?)
        UNION ALL
        SELECT nn.node1_id, nn.node2_id
        FROM nodes_nodes nn
        JOIN SharePath sp ON nn.node1_id = sp.shared_node_id
      ),
      UpwardPath AS (
        SELECT ? AS current_node_id, parent_id
        FROM nodes
        WHERE id = ?
        UNION ALL
        SELECT up.parent_id, n.parent_id
        FROM UpwardPath up
        JOIN nodes n ON up.parent_id = n.id
      )
      SELECT
        EXISTS (
          SELECT 1
          FROM UpwardPath up
          JOIN SharePath sp ON up.current_node_id = sp.shared_node_id
        ) AS share_exists;
  |] (targetUserNode, targetNode, targetNode)

-- TODO should we check the category?
isIn :: NodeId -> DocId -> DBQuery err x Bool
isIn cId docId = ( == [Only True])
  <$> mkPGQuery [sql| SELECT COUNT(*) = 1
    FROM nodes_nodes nn
      WHERE nn.node1_id = ?
        AND nn.node2_id = ?;
  |] (cId, docId)

-- Recursive parents function to construct a breadcrumb
recursiveParents :: NodeId
                 -> [NodeType]
                 -> DBQuery err x [DbTreeNode]
recursiveParents nodeId nodeTypes = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n Nothing)
  <$> mkPGQuery [sql|
    WITH RECURSIVE recursiveParents AS
    (
      SELECT id, typename, parent_id, name, 1 as original_order
        FROM public.nodes WHERE id = ?
      UNION ALL
        SELECT n.id, n.typename, n.parent_id, n.name, rp.original_order+1
          FROM public.nodes n 
          INNER JOIN recursiveParents rp ON n.id = rp.parent_id
            WHERE n.typename IN ?
    ) SELECT id, typename, parent_id, name FROM recursiveParents ORDER BY original_order DESC;
    |] (nodeId, In typename)
  where
    typename = map toDBid ns
    ns = case nodeTypes of
      [] -> allNodeTypes
      _  -> nodeTypes
-----------------------------------------------------

-- | Given an input 'NodeId', figures out if the node itself or
-- a parent is published and, if yes, returns the original publish policy.
-- NOTE(adn) This query is not very optimised, and once it starts to become slow,
-- we need to rewrite it as a plain PG query to make it fast.
lookupPublishPolicy :: HasNodeError err => NodeId -> DBQuery err x (Maybe NodePublishPolicy)
lookupPublishPolicy targetId = do
  -- Optimisation: if the 'targetId' ends up being one of the published \"root\" node_node,
  -- short-circuit.
  mb_nn <- getNodeNode2 targetId
  case lookupPublish mb_nn of
    Just pol -> pure $ Just pol
    Nothing -> do
      isRO <- isNodeReadOnly targetId
      case isRO of
        False -> pure Nothing
        True  -> do
          -- General case: find all the recursive parents for the target id, and for each of them
          -- check if they are read only; if yes, grab their 'NodePublishPolicy'
          allParents <- recursiveParents targetId []
          go Nothing allParents
  where

    lookupPublish mb_nn = mb_nn >>= \nn -> nn L.^? (nn_category . _Just . _NNC_publish)

    go !acc [] = pure acc
    go !acc (x:xs) = do
      isRO <- isNodeReadOnly (_dt_nodeId x)
      case isRO of
        True  -> do
          mb_nn <- getNodeNode2 (_dt_nodeId x)
          case lookupPublish mb_nn of
            Just pol -> pure $ Just pol
            Nothing  -> go acc xs
        False -> go acc xs