{-|
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 (runPGSQuery, DBCmd)
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]
     -> DBCmd err (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]
           -> DBCmd err (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]
              -> DBCmd err (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]
                 -> DBCmd err (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
          -> DBCmd err [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]
                -> DBCmd err [(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]
          -> DBCmd err [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]
              -> DBCmd err [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
           -> DBCmd err [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
                 -> DBCmd err [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


type UpdateTree err = ParentId -> [NodeType] -> NodeId -> DBCmd err [DbTreeNode]

updateTree :: HasTreeError err
           => [NodeType] -> UpdateTree err -> RootId
           -> DBCmd err [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
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
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] -> DBCmd err [NodeId]
findNodesId r nt = tail
                <$> map _dt_nodeId
                <$> dbTree r nt

findNodesWithType :: HasCallStack => RootId -> [NodeType] -> [NodeType] -> DBCmd err [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]
       -> DBCmd err [DbTreeNode]
dbTree rootId nodeTypes = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n Nothing)
  <$> runPGSQuery [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 -> DBCmd err Bool
isDescendantOf childId rootId = (== [Only True])
  <$> runPGSQuery [sql|
                  BEGIN ;
                  SET TRANSACTION READ ONLY;
                  COMMIT;

                  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 -> DBCmd err Bool
isOwnedBy nodeId userId = (== [Only True])
  <$> runPGSQuery [sql| SELECT COUNT(*) = 1 from nodes AS c where c.id = ? AND c.user_id = ? |] (nodeId, userId)

isSharedWith :: NodeId -> NodeId -> DBCmd err Bool
isSharedWith targetNode targetUserNode = (== [Only True])
  <$> runPGSQuery [sql|
      BEGIN;
      SET TRANSACTION READ ONLY;
      COMMIT;

      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 -> DBCmd err Bool
isIn cId docId = ( == [Only True])
  <$> runPGSQuery [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]
                 -> DBCmd err [DbTreeNode]
recursiveParents nodeId nodeTypes = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n Nothing)
  <$> runPGSQuery [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 -> DBCmd err (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