{-|
Module      : Gargantext.Database.Root
Description : Main requests to get root of users
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX
-}

{-# LANGUAGE Arrows #-}

module Gargantext.Database.Query.Tree.Root
  where

import Control.Arrow (returnA)
import Data.Either (Either, fromLeft, fromRight)
import Gargantext.Core
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Core.Types.Main (CorpusName)
import Gargantext.Database.Action.Node
import Gargantext.Database.Action.User (getUserId, getUsername)
import Gargantext.Database.Admin.Config
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (Cmd, runOpaQuery)
import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.Node.Error
import Gargantext.Database.Query.Table.User (queryUserTable, UserPoly(..))
import Gargantext.Database.Schema.Node (NodePoly(..), NodeRead)
import Gargantext.Database.Schema.Node (queryNodeTable)
import Gargantext.Prelude
import Opaleye (restrict, (.==), Query)
import Opaleye.SqlTypes (sqlStrictText, sqlInt4)


getRootId :: (HasNodeError err) => User -> Cmd err NodeId
getRootId :: User -> Cmd err NodeId
getRootId User
u = do
  Maybe (Node HyperdataUser)
maybeRoot <- [Node HyperdataUser] -> Maybe (Node HyperdataUser)
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
head ([Node HyperdataUser] -> Maybe (Node HyperdataUser))
-> m [Node HyperdataUser] -> m (Maybe (Node HyperdataUser))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> User -> Cmd err [Node HyperdataUser]
forall err. User -> Cmd err [Node HyperdataUser]
getRoot User
u
  case Maybe (Node HyperdataUser)
maybeRoot of
    Maybe (Node HyperdataUser)
Nothing -> NodeError -> m NodeId
forall e (m :: * -> *) a.
(MonadError e m, HasNodeError e) =>
NodeError -> m a
nodeError (NodeError -> m NodeId) -> NodeError -> m NodeId
forall a b. (a -> b) -> a -> b
$ Text -> NodeError
NodeError Text
"[G.D.Q.T.R.getRootId] No root id"
    Just  Node HyperdataUser
r -> NodeId -> m NodeId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Node HyperdataUser -> NodeId
forall id hash_id typename user_id parent_id name date hyperdata.
NodePoly id hash_id typename user_id parent_id name date hyperdata
-> id
_node_id Node HyperdataUser
r)

getRoot :: User -> Cmd err [Node HyperdataUser]
getRoot :: User -> Cmd err [Node HyperdataUser]
getRoot = Select NodeRead -> m [Node HyperdataUser]
forall fields haskells err.
Default FromFields fields haskells =>
Select fields -> Cmd err [haskells]
runOpaQuery (Select NodeRead -> m [Node HyperdataUser])
-> (User -> Select NodeRead) -> User -> m [Node HyperdataUser]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. User -> Select NodeRead
selectRoot

getOrMkRoot :: (HasNodeError err)
            => User
            -> Cmd err (UserId, RootId)
getOrMkRoot :: User -> Cmd err (UserId, NodeId)
getOrMkRoot User
user = do
  UserId
userId <- User -> Cmd err UserId
forall err. HasNodeError err => User -> Cmd err UserId
getUserId User
user

  [NodeId]
rootId' <- (Node HyperdataUser -> NodeId) -> [Node HyperdataUser] -> [NodeId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Node HyperdataUser -> NodeId
forall id hash_id typename user_id parent_id name date hyperdata.
NodePoly id hash_id typename user_id parent_id name date hyperdata
-> id
_node_id ([Node HyperdataUser] -> [NodeId])
-> m [Node HyperdataUser] -> m [NodeId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> User -> Cmd err [Node HyperdataUser]
forall err. User -> Cmd err [Node HyperdataUser]
getRoot User
user

  [NodeId]
rootId'' <- case [NodeId]
rootId' of
        []  -> User -> Cmd err [NodeId]
forall err. HasNodeError err => User -> Cmd err [NodeId]
mkRoot User
user
        [NodeId]
n   -> case [NodeId] -> UserId
forall (t :: * -> *) a. Foldable t => t a -> UserId
length [NodeId]
n UserId -> UserId -> Bool
forall a. Ord a => a -> a -> Bool
>= UserId
2 of
            Bool
True  -> NodeError -> m [NodeId]
forall e (m :: * -> *) a.
(MonadError e m, HasNodeError e) =>
NodeError -> m a
nodeError NodeError
ManyNodeUsers
            Bool
False -> [NodeId] -> m [NodeId]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [NodeId]
rootId'

  NodeId
rootId <- m NodeId -> (NodeId -> m NodeId) -> Maybe NodeId -> m NodeId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (NodeError -> m NodeId
forall e (m :: * -> *) a.
(MonadError e m, HasNodeError e) =>
NodeError -> m a
nodeError NodeError
NoRootFound) NodeId -> m NodeId
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([NodeId] -> Maybe NodeId
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
head [NodeId]
rootId'')
  (UserId, NodeId) -> m (UserId, NodeId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserId
userId, NodeId
rootId)


getOrMk_RootWithCorpus :: (HasNodeError err, MkCorpus a)
                      => User
                      -> Either CorpusName [CorpusId]
                      -> Maybe a
                      -> Cmd err (UserId, RootId, CorpusId)
getOrMk_RootWithCorpus :: User
-> Either Text [NodeId]
-> Maybe a
-> Cmd err (UserId, NodeId, NodeId)
getOrMk_RootWithCorpus User
user Either Text [NodeId]
cName Maybe a
c = do
  (UserId
userId, NodeId
rootId) <- User -> Cmd err (UserId, NodeId)
forall err. HasNodeError err => User -> Cmd err (UserId, NodeId)
getOrMkRoot User
user
  [NodeId]
corpusId'' <- if User
user User -> User -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> User
UserName Text
userMaster
                  then do
                    [Node HyperdataCorpus]
ns <- NodeId -> Cmd err [Node HyperdataCorpus]
forall err.
HasDBid NodeType =>
NodeId -> Cmd err [Node HyperdataCorpus]
getCorporaWithParentId NodeId
rootId
                    [NodeId] -> m [NodeId]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([NodeId] -> m [NodeId]) -> [NodeId] -> m [NodeId]
forall a b. (a -> b) -> a -> b
$ (Node HyperdataCorpus -> NodeId)
-> [Node HyperdataCorpus] -> [NodeId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Node HyperdataCorpus -> NodeId
forall id hash_id typename user_id parent_id name date hyperdata.
NodePoly id hash_id typename user_id parent_id name date hyperdata
-> id
_node_id [Node HyperdataCorpus]
ns
                  else
                    [NodeId] -> m [NodeId]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([NodeId] -> m [NodeId]) -> [NodeId] -> m [NodeId]
forall a b. (a -> b) -> a -> b
$ [NodeId] -> Either Text [NodeId] -> [NodeId]
forall b a. b -> Either a b -> b
fromRight [] Either Text [NodeId]
cName

  [NodeId]
corpusId' <- if [NodeId]
corpusId'' [NodeId] -> [NodeId] -> Bool
forall a. Eq a => a -> a -> Bool
/= []
                  then [NodeId] -> m [NodeId]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [NodeId]
corpusId''
                  else do
                    [NodeId]
c' <- Maybe Text -> Maybe a -> NodeId -> UserId -> Cmd err [NodeId]
forall a err.
(MkCorpus a, HasDBid NodeType) =>
Maybe Text -> Maybe a -> NodeId -> UserId -> Cmd err [NodeId]
mk (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Either Text [NodeId] -> Text
forall a b. a -> Either a b -> a
fromLeft Text
"Default" Either Text [NodeId]
cName) Maybe a
c NodeId
rootId UserId
userId
                    [NodeId]
_tId <- case [NodeId] -> Maybe NodeId
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
head [NodeId]
c' of
                              Maybe NodeId
Nothing  -> NodeError -> m [NodeId]
forall e (m :: * -> *) a.
(MonadError e m, HasNodeError e) =>
NodeError -> m a
nodeError (NodeError -> m [NodeId]) -> NodeError -> m [NodeId]
forall a b. (a -> b) -> a -> b
$ Text -> NodeError
NodeError Text
"[G.D.Q.T.Root.getOrMk...] mk Corpus failed"
                              Just NodeId
c'' -> NodeType -> NodeId -> UserId -> Cmd err [NodeId]
forall err.
HasDBid NodeType =>
NodeType -> NodeId -> UserId -> Cmd err [NodeId]
insertDefaultNode NodeType
NodeTexts NodeId
c'' UserId
userId
                    [NodeId] -> m [NodeId]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [NodeId]
c'

  NodeId
corpusId <- m NodeId -> (NodeId -> m NodeId) -> Maybe NodeId -> m NodeId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (NodeError -> m NodeId
forall e (m :: * -> *) a.
(MonadError e m, HasNodeError e) =>
NodeError -> m a
nodeError NodeError
NoCorpusFound) NodeId -> m NodeId
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([NodeId] -> Maybe NodeId
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
head [NodeId]
corpusId')
  (UserId, NodeId, NodeId) -> m (UserId, NodeId, NodeId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UserId
userId, NodeId
rootId, NodeId
corpusId)


mkRoot :: HasNodeError err
       => User
       -> Cmd err [RootId]
mkRoot :: User -> Cmd err [NodeId]
mkRoot User
user = do

  -- TODO
  -- udb <- getUserDb user
  -- let uid = user_id udb
  UserId
uid <- User -> Cmd err UserId
forall err. HasNodeError err => User -> Cmd err UserId
getUserId User
user

  -- TODO ? Which name for user Node ?
  Text
una <- User -> Cmd err Text
forall err. HasNodeError err => User -> Cmd err Text
getUsername User
user

  case UserId
uid UserId -> UserId -> Bool
forall a. Ord a => a -> a -> Bool
> UserId
0 of
     Bool
False -> NodeError -> m [NodeId]
forall e (m :: * -> *) a.
(MonadError e m, HasNodeError e) =>
NodeError -> m a
nodeError NodeError
NegativeId
     Bool
True  -> do
       [NodeId]
rs <- NodeType -> Maybe NodeId -> UserId -> Text -> Cmd err [NodeId]
forall err.
(HasNodeError err, HasDBid NodeType) =>
NodeType -> Maybe NodeId -> UserId -> Text -> Cmd err [NodeId]
mkNodeWithParent NodeType
NodeUser Maybe NodeId
forall a. Maybe a
Nothing UserId
uid Text
una
       [NodeId]
_ <- case [NodeId]
rs of
         [NodeId
r] -> do
           [NodeId]
_ <- NodeType
-> Maybe Text
-> Maybe DefaultHyperdata
-> NodeId
-> UserId
-> Cmd err [NodeId]
forall err.
HasDBid NodeType =>
NodeType
-> Maybe Text
-> Maybe DefaultHyperdata
-> NodeId
-> UserId
-> Cmd err [NodeId]
insertNode NodeType
NodeFolderPrivate Maybe Text
forall a. Maybe a
Nothing Maybe DefaultHyperdata
forall a. Maybe a
Nothing NodeId
r UserId
uid
           [NodeId]
_ <- NodeType
-> Maybe Text
-> Maybe DefaultHyperdata
-> NodeId
-> UserId
-> Cmd err [NodeId]
forall err.
HasDBid NodeType =>
NodeType
-> Maybe Text
-> Maybe DefaultHyperdata
-> NodeId
-> UserId
-> Cmd err [NodeId]
insertNode NodeType
NodeFolderShared Maybe Text
forall a. Maybe a
Nothing Maybe DefaultHyperdata
forall a. Maybe a
Nothing NodeId
r UserId
uid
           [NodeId]
_ <- NodeType
-> Maybe Text
-> Maybe DefaultHyperdata
-> NodeId
-> UserId
-> Cmd err [NodeId]
forall err.
HasDBid NodeType =>
NodeType
-> Maybe Text
-> Maybe DefaultHyperdata
-> NodeId
-> UserId
-> Cmd err [NodeId]
insertNode NodeType
NodeFolderPublic Maybe Text
forall a. Maybe a
Nothing Maybe DefaultHyperdata
forall a. Maybe a
Nothing NodeId
r UserId
uid
           [NodeId] -> m [NodeId]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [NodeId]
rs
         [NodeId]
_   -> [NodeId] -> m [NodeId]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [NodeId]
rs
       [NodeId] -> m [NodeId]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [NodeId]
rs

selectRoot :: User -> Query NodeRead
selectRoot :: User -> Select NodeRead
selectRoot (UserName Text
username) = proc () -> do
    NodeRead
row   <- Select NodeRead
queryNodeTable -< ()
    UserRead
users <- Query UserRead
queryUserTable -< ()
    SelectArr (Field SqlBool) ()
SelectArr (Column SqlBool) ()
restrict -< NodeRead -> Column PGInt4
forall id hash_id typename user_id parent_id name date hyperdata.
NodePoly id hash_id typename user_id parent_id name date hyperdata
-> typename
_node_typename NodeRead
row   Column PGInt4 -> Column PGInt4 -> Field SqlBool
forall a. Column a -> Column a -> Field SqlBool
.== (UserId -> Field PGInt4
sqlInt4 (UserId -> Field PGInt4) -> UserId -> Field PGInt4
forall a b. (a -> b) -> a -> b
$ NodeType -> UserId
forall a. HasDBid a => a -> UserId
toDBid NodeType
NodeUser)
    SelectArr (Field SqlBool) ()
SelectArr (Column SqlBool) ()
restrict -< UserRead -> Column PGText
forall id pass llogin suser uname fname lname mail staff active
       djoined.
UserPoly
  id pass llogin suser uname fname lname mail staff active djoined
-> uname
user_username  UserRead
users Column PGText -> Column PGText -> Field SqlBool
forall a. Column a -> Column a -> Field SqlBool
.== (Text -> Field PGText
sqlStrictText Text
username)
    SelectArr (Field SqlBool) ()
SelectArr (Column SqlBool) ()
restrict -< NodeRead -> Column PGInt4
forall id hash_id typename user_id parent_id name date hyperdata.
NodePoly id hash_id typename user_id parent_id name date hyperdata
-> user_id
_node_user_id   NodeRead
row   Column PGInt4 -> Column PGInt4 -> Field SqlBool
forall a. Column a -> Column a -> Field SqlBool
.== (UserRead -> Column PGInt4
forall id pass llogin suser uname fname lname mail staff active
       djoined.
UserPoly
  id pass llogin suser uname fname lname mail staff active djoined
-> id
user_id UserRead
users)
    SelectArr NodeRead NodeRead
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA  -< NodeRead
row

selectRoot (UserDBId UserId
uid) = proc () -> do
    NodeRead
row   <- Select NodeRead
queryNodeTable -< ()
    SelectArr (Field SqlBool) ()
SelectArr (Column SqlBool) ()
restrict -< NodeRead -> Column PGInt4
forall id hash_id typename user_id parent_id name date hyperdata.
NodePoly id hash_id typename user_id parent_id name date hyperdata
-> typename
_node_typename NodeRead
row   Column PGInt4 -> Column PGInt4 -> Field SqlBool
forall a. Column a -> Column a -> Field SqlBool
.== (UserId -> Field PGInt4
sqlInt4 (UserId -> Field PGInt4) -> UserId -> Field PGInt4
forall a b. (a -> b) -> a -> b
$ NodeType -> UserId
forall a. HasDBid a => a -> UserId
toDBid NodeType
NodeUser)
    SelectArr (Field SqlBool) ()
SelectArr (Column SqlBool) ()
restrict -< NodeRead -> Column PGInt4
forall id hash_id typename user_id parent_id name date hyperdata.
NodePoly id hash_id typename user_id parent_id name date hyperdata
-> user_id
_node_user_id   NodeRead
row   Column PGInt4 -> Column PGInt4 -> Field SqlBool
forall a. Column a -> Column a -> Field SqlBool
.== (UserId -> Field PGInt4
sqlInt4 UserId
uid)
    SelectArr NodeRead NodeRead
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA  -< NodeRead
row

selectRoot (RootId NodeId
nid) =
 proc () -> do
    NodeRead
row   <- Select NodeRead
queryNodeTable -< ()
    SelectArr (Field SqlBool) ()
SelectArr (Column SqlBool) ()
restrict -< NodeRead -> Column PGInt4
forall id hash_id typename user_id parent_id name date hyperdata.
NodePoly id hash_id typename user_id parent_id name date hyperdata
-> typename
_node_typename NodeRead
row   Column PGInt4 -> Column PGInt4 -> Field SqlBool
forall a. Column a -> Column a -> Field SqlBool
.== (UserId -> Field PGInt4
sqlInt4 (UserId -> Field PGInt4) -> UserId -> Field PGInt4
forall a b. (a -> b) -> a -> b
$ NodeType -> UserId
forall a. HasDBid a => a -> UserId
toDBid NodeType
NodeUser)
    SelectArr (Field SqlBool) ()
SelectArr (Column SqlBool) ()
restrict -< NodeRead -> Column PGInt4
forall id hash_id typename user_id parent_id name date hyperdata.
NodePoly id hash_id typename user_id parent_id name date hyperdata
-> id
_node_id   NodeRead
row   Column PGInt4 -> Column PGInt4 -> Field SqlBool
forall a. Column a -> Column a -> Field SqlBool
.== (NodeId -> Column PGInt4
pgNodeId NodeId
nid)
    SelectArr NodeRead NodeRead
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA  -< NodeRead
row
selectRoot User
UserPublic = Text -> Select NodeRead
forall a. HasCallStack => Text -> a
panic {-nodeError $ NodeError-}  Text
"[G.D.Q.T.Root.selectRoot] No root for Public"