Portability : POSIX
-}
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-{-# LANGUAGE Arrows #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE Arrows #-}
module Gargantext.Database.Query.Tree.Root
where
-import Data.Either (Either, fromLeft, fromRight)
import Control.Arrow (returnA)
-import Gargantext.Core.Types.Main (CorpusName)
+import Data.Either (Either, fromLeft, fromRight)
+import Gargantext.Core
import Gargantext.Core.Types.Individu (User(..))
-import Gargantext.Database.Admin.Config (nodeTypeId, userMaster)
-import Gargantext.Database.Admin.Types.Errors
+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.User (HyperdataUser)
-import Gargantext.Database.Action.Flow.Utils (getUserId)
+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.Database.Query
-import Gargantext.Database.Query.Table.User (queryUserTable, UserPoly(..))
-import Gargantext.Database.Admin.Types.Node (Node, NodeType(NodeUser), pgNodeId)
-import Gargantext.Database.Admin.Utils (Cmd, runOpaQuery)
import Gargantext.Prelude
import Opaleye (restrict, (.==), Query)
-import Opaleye.PGTypes (pgStrictText, pgInt4)
+import Opaleye.SqlTypes (sqlStrictText, sqlInt4)
+
+getRootId :: (HasNodeError err) => User -> Cmd err NodeId
+getRootId u = do
+ maybeRoot <- head <$> getRoot u
+ case maybeRoot of
+ Nothing -> nodeError $ NodeError "[G.D.Q.T.R.getRootId] No root id"
+ Just r -> pure (_node_id r)
+getRoot :: User -> Cmd err [Node HyperdataUser]
+getRoot = runOpaQuery . selectRoot
getOrMkRoot :: (HasNodeError err)
=> User
else do
c' <- mk (Just $ fromLeft "Default" cName) c rootId userId
_tId <- case head c' of
- Nothing -> pure [0]
- Just c'' -> mkNode NodeTexts c'' userId
+ Nothing -> nodeError $ NodeError "[G.D.Q.T.Root.getOrMk...] mk Corpus failed"
+ Just c'' -> insertDefaultNode NodeTexts c'' userId
pure c'
corpusId <- maybe (nodeError NoCorpusFound) pure (head corpusId')
pure (userId, rootId, corpusId)
-
-
-
-
mkRoot :: HasNodeError err
=> User
-> Cmd err [RootId]
uid <- getUserId user
-- TODO ? Which name for user Node ?
- let una = "username"
+ una <- getUsername user
case uid > 0 of
False -> nodeError NegativeId
rs <- mkNodeWithParent NodeUser Nothing uid una
_ <- case rs of
[r] -> do
- _ <- mkNodeWithParent NodeFolderPrivate (Just r) uid una
- _ <- mkNodeWithParent NodeFolderShared (Just r) uid una
- _ <- mkNodeWithParent NodeFolderPublic (Just r) uid una
+ _ <- insertNode NodeFolderPrivate Nothing Nothing r uid
+ _ <- insertNode NodeFolderShared Nothing Nothing r uid
+ _ <- insertNode NodeFolderPublic Nothing Nothing r uid
pure rs
_ -> pure rs
pure rs
-getRoot :: User -> Cmd err [Node HyperdataUser]
-getRoot = runOpaQuery . selectRoot
-
selectRoot :: User -> Query NodeRead
selectRoot (UserName username) = proc () -> do
row <- queryNodeTable -< ()
users <- queryUserTable -< ()
- restrict -< _node_typename row .== (pgInt4 $ nodeTypeId NodeUser)
- restrict -< user_username users .== (pgStrictText username)
- restrict -< _node_userId row .== (user_id users)
+ restrict -< _node_typename row .== (sqlInt4 $ toDBid NodeUser)
+ restrict -< user_username users .== (sqlStrictText username)
+ restrict -< _node_user_id row .== (user_id users)
returnA -< row
selectRoot (UserDBId uid) = proc () -> do
row <- queryNodeTable -< ()
- restrict -< _node_typename row .== (pgInt4 $ nodeTypeId NodeUser)
- restrict -< _node_userId row .== (pgInt4 uid)
+ restrict -< _node_typename row .== (sqlInt4 $ toDBid NodeUser)
+ restrict -< _node_user_id row .== (sqlInt4 uid)
returnA -< row
selectRoot (RootId nid) =
proc () -> do
row <- queryNodeTable -< ()
- restrict -< _node_typename row .== (pgInt4 $ nodeTypeId NodeUser)
+ restrict -< _node_typename row .== (sqlInt4 $ toDBid NodeUser)
restrict -< _node_id row .== (pgNodeId nid)
returnA -< row
-
+selectRoot UserPublic = panic {-nodeError $ NodeError-} "[G.D.Q.T.Root.selectRoot] No root for Public"