[DBFLOW] parsing + insertion + insertion duplicatas + delete corpus.

src/Gargantext/Database/Flow.hs

@@ -31,40 +31,57 @@ authors
 
 module Gargantext.Database.Flow
     where
+import System.FilePath (FilePath)
 import GHC.Base ((>>))
 import Data.Maybe (Maybe(..))
 import Gargantext.Core.Types (NodePoly(..))
 import Gargantext.Prelude
-import Gargantext.Database.Bashql (runCmd')
-import Gargantext.Database.Node (Cmd(..), getRoot, mkRoot)
+import Gargantext.Database.Bashql (runCmd', del)
+import Gargantext.Database.Node (Cmd(..), getRoot, mkRoot, mkCorpus, defaultCorpus)
 import Gargantext.Database.User (getUser, UserLight(..))
 import Gargantext.Database.Node.Document.Import (insertDocuments)
+import Gargantext.Text.Parsers (parseDocs, FileFormat(WOS))
 
---flow :: IO ()
-flow = do
+--flow :: FilePath -> IO ()
+flow fp = do
   masterUser <- runCmd' (getUser "gargantua")
   
   let masterUserId = case masterUser of
         Nothing   -> panic "Error: User does not exist (yet)" -- mk NodeUser gargantua_id "Node Gargantua"
         Just user -> userLight_id user
         
-  root <- map _node_id <$> runCmd' (getRoot masterUserId)
+  rootId' <- map _node_id <$> runCmd' (getRoot masterUserId)
   
-  root' <- case root of
+  rootId'' <- case rootId' of
         []  -> runCmd' (mkRoot masterUserId)
         un  -> case length un >= 2 of
                  True  -> panic "Error: more than 1 userNode / user"
-                 False -> pure root
+                 False -> pure rootId'
+  let rootId = maybe (panic "error rootId") identity (head rootId'')
+  printDebug "Root ID : " rootId
+  
+  corpusId' <- runCmd' $ mkCorpus (Just "Corpus WOS") Nothing rootId masterUserId
+  let corpusId = maybe (panic "error corpusId") identity (head corpusId')
+  printDebug "Corpus ID : " corpusId
+
+  docs <- parseDocs WOS fp
+  ids  <- runCmd' $ insertDocuments masterUserId corpusId docs
+  printDebug "Docs IDs : " ids
 
-  printDebug "User Node : " root'
+  idsRepeat  <- runCmd' $ insertDocuments masterUserId corpusId docs
+  printDebug "Docs IDs : " idsRepeat
   
-  pure ()
-{-
+  runCmd' (del [corpusId])
 
+{-
   --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  <- add (Documents corpusId) docs
 

src/Gargantext/Database/Node.hs

@@ -373,6 +373,9 @@ node2row (Node id tn ud pid nm dt hp) = ((pgInt4    <$> id)
                                         ,(pgStrictJSONB hp)
                                         )
 ------------------------------------------------------------------------
+insertNodesR' :: [NodeWrite'] -> Cmd [Int]
+insertNodesR' ns = mkCmd $ \c -> insertNodesR ns c
+
 insertNodes :: [NodeWrite'] -> Connection -> IO Int64
 insertNodes ns conn = runInsertMany conn nodeTable' (map node2row ns)
 
@@ -486,3 +489,8 @@ mkRoot :: UserId -> Cmd [Int]
 mkRoot uId = case uId > 0 of
                False -> panic "UserId <= 0"
                True  -> mk'' NodeUser Nothing uId ("User Node : " <> (pack . show) uId)
+
+mkCorpus :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> Cmd [Int]
+mkCorpus n h p u = insertNodesR' [nodeCorpusW n h p u]
+
+

src/Gargantext/Database/Node/Document/Import.hs

@@ -77,6 +77,7 @@ import qualified Data.Digest.Pure.SHA        as SHA (sha256, showDigest)
 import qualified Data.ByteString.Lazy.Char8  as DC (pack)
 
 import Gargantext.Database.Config (nodeTypeId)
+import Gargantext.Database.Node (mkCmd, Cmd(..))
 import Gargantext.Database.Types.Node
 -- TODO : the import of Document constructor below does not work
 -- import Gargantext.Database.Types.Node (Document)
@@ -103,8 +104,8 @@ import GHC.Generics (Generic)
 -- | Insert Document main function
 -- UserId : user who is inserting the documents
 -- ParentId : folder ID which is parent of the inserted documents
-insertDocuments :: Connection -> UserId -> ParentId -> [HyperdataDocument] -> IO [ReturnId]
-insertDocuments conn uId pId hs = query conn queryInsert (Only $ Values fields inputData)
+insertDocuments :: UserId -> ParentId -> [HyperdataDocument] -> Cmd [ReturnId]
+insertDocuments uId pId hs = mkCmd $ \c -> query c queryInsert (Only $ Values fields inputData)
   where
     fields    = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
     inputData = prepare uId pId hs