[DB] getRootUser function.

src/Gargantext/API/Node.hs

@@ -187,7 +187,7 @@ nodesAPI :: Connection -> [NodeId] -> Server NodesAPI
 nodesAPI conn ids = deleteNodes' conn ids
 
 postNode :: Connection -> NodeId -> PostNode -> Handler Int
-postNode c pId (PostNode name nt) = liftIO $ mk c pId nt name
+postNode c pId (PostNode name nt) = liftIO $ mk c nt pId name
 
 putNode :: Connection -> NodeId -> Handler Int
 putNode = undefined -- TODO

src/Gargantext/Database/Bashql.hs

@@ -69,7 +69,7 @@ module Gargantext.Database.Bashql ( get
                                   , put
                                   , rename
                                   , tree
-                                  , mkCorpus, postAnnuaire
+                                  , mkCorpus, mkAnnuaire
                                   , runCmd'
                                  )
     where
@@ -162,8 +162,8 @@ mkCorpus name title ns = do
 -- |
 -- import IMTClient as C
 -- postAnnuaire "Annuaire IMT" (\n -> (maybe "" identity (C.prenom n)) <> " " <> (maybe "" identity (C.nom n))) (take 30 annuaire)
-postAnnuaire :: ToJSON a => Name -> (a -> Text) -> [a] -> Cmd NewNode
-postAnnuaire name title ns = do
+mkAnnuaire :: ToJSON a => Name -> (a -> Text) -> [a] -> Cmd NewNode
+mkAnnuaire name title ns = do
   pid <- last <$> home
   let uid = 1
   postNode uid pid ( Node' Annuaire  name emptyObject

src/Gargantext/Database/Flow.hs

+{-|
+Module      : Gargantext.Database.Flow
+Description : Database Flow
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+
+
+add :: Corpus -> [Documents] -> IO Int
+if new id -> extractNgrams + extract Authors + extract Sources
+Map (Ngrams, NodeId)
+insert Ngrams -> NgramsId
+Map (NgramsId, NodeId) -> insert
+
+data NgramsType = Sources | Authors | Terms
+
+nodes_ngrams : column type, column list
+
+
+documents
+sources
+authors
+
+-}
+
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Gargantext.Database.Flow
+    where
+
+import Data.Maybe (Maybe(..))
+import Gargantext.Prelude
+import Gargantext.Database.Bashql (runCmd')
+import Gargantext.Database.Node (Cmd(..), getRootUser)
+import Gargantext.Database.User (getUser, UserLight(..))
+import Gargantext.Database.Node.Document.Import (insertDocuments)
+
+flow = do
+  gargantua_id <- runCmd' (getUser "gargantua")
+  -- createUser
+  userNode <- case gargantua_id of
+        Nothing     -> panic "no user"
+        Just userId -> runCmd' (getRootUser $ userLight_id userId)
+  
+  case userNode of
+        [] -> pure ()
+        _  -> pure ()
+  
+  -- getOrMk
+  --rootId       <- runCmd' (getNodeWith userId nodeType)
+{-
+  rootId       <- mk NodeUser gargantua_id "Node Gargantua"
+
+  --folderId <- mk Folder parentId (Name "Data") (Descr "All corpora DATA here")
+  folderId <- mk Folder rootId "Data"
+  corpusId <- mk Corpus folderId (Name "WOS")  (Descr "WOS database description")
+  
+  docs <- parseDocuments WOS "doc/.."
+  ids <- addDocuments corpusId docs
+
+  user_id <- runCmd' (get RootUser "alexandre")
+-}
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

src/Gargantext/Database/Node.hs

@@ -62,19 +62,10 @@ import Database.PostgreSQL.Simple (Connection)
 import Opaleye hiding (FromField)
 import Opaleye.Internal.QueryArr (Query)
 import qualified Data.Profunctor.Product as PP
--- | Types for Node Database Management
-data PGTSVector
 
-newtype Cmd a = Cmd (ReaderT Connection IO a)
-  deriving (Functor, Applicative, Monad, MonadReader Connection, MonadIO)
-
-runCmd :: Connection -> Cmd a -> IO a
-runCmd c (Cmd f) = runReaderT f c
-
-mkCmd :: (Connection -> IO a) -> Cmd a
-mkCmd = Cmd . ReaderT
+------------------------------------------------------------------------
+{- | Reader Monad reinvented here:
 
-{-
 newtype Cmd a = Cmd { unCmd :: Connection -> IO a }
 
 instance Monad Cmd where
@@ -84,9 +75,19 @@ instance Monad Cmd where
     a <- unCmd m c
     unCmd (f a) c
 -}
+newtype Cmd a = Cmd (ReaderT Connection IO a)
+  deriving (Functor, Applicative, Monad, MonadReader Connection, MonadIO)
+
+runCmd :: Connection -> Cmd a -> IO a
+runCmd c (Cmd f) = runReaderT f c
+
+mkCmd :: (Connection -> IO a) -> Cmd a
+mkCmd = Cmd . ReaderT
 
 ------------------------------------------------------------------------
 type CorpusId = Int
+type UserId = NodeId
+type TypeId = Int
 ------------------------------------------------------------------------
 
 instance FromField HyperdataCorpus where
@@ -107,6 +108,7 @@ instance FromField HyperdataUser where
 
 instance QueryRunnerColumnDefault PGJsonb HyperdataDocument where
   queryRunnerColumnDefault = fieldQueryRunnerColumn
+
 instance QueryRunnerColumnDefault PGJsonb HyperdataDocumentV3 where
   queryRunnerColumnDefault = fieldQueryRunnerColumn
 
@@ -179,7 +181,6 @@ nodeTable' = Table "nodes" (PP.p7 ( optional "id"
 queryNodeTable :: Query NodeRead
 queryNodeTable = queryTable nodeTable
 
-
 selectNode :: Column PGInt4 -> Query NodeRead
 selectNode id = proc () -> do
     row <- queryNodeTable -< ()
@@ -189,6 +190,18 @@ selectNode id = proc () -> do
 runGetNodes :: Query NodeRead -> Cmd [Node Value]
 runGetNodes q = mkCmd $ \conn -> runQuery conn q
 
+------------------------------------------------------------------------
+selectRootUser :: UserId -> Query NodeRead
+selectRootUser userId = proc () -> do
+    row <- queryNodeTable -< ()
+    restrict -< node_userId   row .== (pgInt4 userId)
+    restrict -< node_typename row .== (pgInt4 $ nodeTypeId NodeUser)
+    returnA -< row
+
+getRootUser :: UserId -> Cmd [Node HyperdataUser]
+getRootUser userId = mkCmd $ \conn -> runQuery conn (selectRootUser userId)
+------------------------------------------------------------------------
+
 -- | order by publication date
 -- Favorites (Bool), node_ngrams
 selectNodesWith :: ParentId     -> Maybe NodeType
@@ -283,9 +296,6 @@ getNodesWithType :: Connection -> Column PGInt4 -> IO [Node HyperdataDocument]
 getNodesWithType conn type_id = do
     runQuery conn $ selectNodesWithType type_id
 
-type UserId = NodeId
-type TypeId = Int
-
 
 ------------------------------------------------------------------------
 -- Quick and dirty
@@ -302,8 +312,7 @@ node userId parentId nodeType name nodeData = Node Nothing typeId userId parentI
 
 
 node2write :: (Functor f2, Functor f1) =>
-              Int
-              -> NodePoly (f1 Int) Int Int parentId Text (f2 UTCTime) ByteString
+              Int -> NodePoly (f1 Int) Int Int parentId Text (f2 UTCTime) ByteString
               -> (f1 (Column PGInt4), Column PGInt4, Column PGInt4,
                   Column PGInt4, Column PGText, f2 (Column PGTimestamptz),
                   Column PGJsonb)
@@ -397,8 +406,7 @@ childWith uId pId (Node' UserPage txt v []) = node2table uId pId (Node' UserPage
 childWith _   _   (Node' _        _   _ _) = panic "This NodeType can not be a child"
 
 
-mk :: Connection -> ParentId -> NodeType -> Text -> IO Int
-mk c pId nt name  = fromIntegral <$> mkNode pId [node 1 pId nt name ""] c
-
+mk :: Connection -> NodeType -> ParentId -> Text -> IO Int
+mk c nt pId name  = fromIntegral <$> mkNode pId [node 1 pId nt name ""] c
 
 

src/Gargantext/Database/User.hs

@@ -13,7 +13,6 @@ Functions to deal with users, database side.
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 {-# OPTIONS_GHC -fno-warn-orphans        #-}
 
-
 {-# LANGUAGE TemplateHaskell             #-}
 {-# LANGUAGE FlexibleInstances           #-}
 {-# LANGUAGE MultiParamTypeClasses       #-}
@@ -23,22 +22,20 @@ Functions to deal with users, database side.
 
 module Gargantext.Database.User where
 
-import GHC.Show(Show(..))
+import Control.Arrow (returnA)
+import Control.Lens.TH (makeLensesWith, abbreviatedFields)
 import Data.Eq(Eq(..))
-import Data.Time (UTCTime)
-import Data.Text (Text)
+import Data.List (find)
 import Data.Maybe (Maybe)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
-import Control.Lens.TH (makeLensesWith, abbreviatedFields)
-import Control.Arrow (returnA)
-import qualified Database.PostgreSQL.Simple as PGS
-
+import Data.Text (Text)
+import Data.Time (UTCTime)
+import GHC.Show(Show(..))
 import Opaleye
-
--- Functions only
-import Data.List (find)
+import qualified Database.PostgreSQL.Simple as PGS
 
 import Gargantext.Prelude
+import Gargantext.Database.Node (Cmd(..), mkCmd, runCmd)
 
 
 data UserLight = UserLight { userLight_id   :: Int
@@ -135,14 +132,14 @@ instance QueryRunnerColumnDefault PGTimestamptz (Maybe UTCTime) where
   queryRunnerColumnDefault = fieldQueryRunnerColumn
 
 
-users :: PGS.Connection -> IO [User]
-users conn = runQuery conn queryUserTable
+users :: Cmd [User]
+users = mkCmd $ \conn -> runQuery conn queryUserTable
 
-usersLight :: PGS.Connection -> IO [UserLight]
-usersLight conn = map toUserLight <$> runQuery conn queryUserTable
+usersLight :: Cmd [UserLight]
+usersLight = mkCmd $ \conn -> map toUserLight <$> runQuery conn queryUserTable
 
 type Username = Text
 
-user :: PGS.Connection -> Username -> IO (Maybe UserLight)
-user c u = userLightWithUsername u <$> usersLight c
+getUser :: Username -> Cmd (Maybe UserLight)
+getUser u = mkCmd $ \c -> userLightWithUsername u <$> runCmd c usersLight