src/Gargantext/Database/Flow.hs

   1 {-|
   2 Module      : Gargantext.Database.Flow
   3 Description : Database Flow
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10
  11 Map (NgramsId, NodeId) -> insert
  12 data NgramsType = Sources | Authors | Terms
  13 nodes_ngrams : column type, column list
  14
  15 documents
  16 sources
  17 authors
  18
  19 -}
  20
  21 {-# LANGUAGE NoImplicitPrelude #-}
  22 {-# LANGUAGE OverloadedStrings #-}
  23
  24 module Gargantext.Database.Flow
  25     where
  26 import System.FilePath (FilePath)
  27 import GHC.Base ((>>))
  28 import Data.Maybe (Maybe(..))
  29 import Gargantext.Core.Types (NodePoly(..))
  30 import Gargantext.Prelude
  31 import Gargantext.Database.Bashql (runCmd', del)
  32 import Gargantext.Database.Node (Cmd(..), getRoot, mkRoot, mkCorpus)
  33 import Gargantext.Database.User (getUser, UserLight(..), Username)
  34 import Gargantext.Database.Node.Document.Insert (insertDocuments, ReturnId(reId))
  35 import Gargantext.Database.Node.Document.Add    (add)
  36 import Gargantext.Text.Parsers (parseDocs, FileFormat(WOS))
  37
  38 type UserId = Int
  39 type RootId = Int
  40 type CorpusId = Int
  41
  42 subFlow :: Username -> IO (UserId, RootId, CorpusId)
  43 subFlow username = do
  44   maybeUserId <- runCmd' (getUser username)
  45
  46   let userId = case maybeUserId of
  47         Nothing   -> panic "Error: User does not exist (yet)" -- mk NodeUser gargantua_id "Node Gargantua"
  48         Just user -> userLight_id user
  49
  50   rootId' <- map _node_id <$> runCmd' (getRoot userId)
  51
  52   rootId'' <- case rootId' of
  53         []  -> runCmd' (mkRoot userId)
  54         un  -> case length un >= 2 of
  55                  True  -> panic "Error: more than 1 userNode / user"
  56                  False -> pure rootId'
  57   let rootId = maybe (panic "error rootId") identity (head rootId'')
  58
  59   corpusId' <- runCmd' $ mkCorpus (Just "Corpus WOS") Nothing rootId userId
  60   let corpusId = maybe (panic "error corpusId") identity (head corpusId')
  61
  62   printDebug "(username, userId, rootId, corpusId"
  63               (username, userId, rootId, corpusId)
  64   pure (userId, rootId, corpusId)
  65
  66
  67 -- flow :: FilePath -> IO ()
  68 flow fp = do
  69
  70   (masterUserId, _, corpusId) <- subFlow "gargantua"
  71
  72   docs <- parseDocs WOS fp
  73   ids  <- runCmd' $ insertDocuments masterUserId corpusId docs
  74   printDebug "Docs IDs : " ids
  75
  76   idsRepeat  <- runCmd' $ insertDocuments masterUserId corpusId docs
  77   printDebug "Docs IDs : " idsRepeat
  78
  79   (userId, rootId, corpusId2) <- subFlow "alexandre"
  80
  81   inserted <- runCmd' $ add corpusId2 (map reId ids)
  82   printDebug "Inserted : " inserted
  83
  84   -- runCmd' (del [corpusId2, corpusId])
  85
  86 {-
  87   ids  <- add (Documents corpusId) docs
  88
  89   user_id <- runCmd' (get RootUser "alexandre")
  90   rootUser_id <- runCmd' (getRootUser $ userLight_id user_id
  91   corpusId <- mk Corpus
  92 -}
  93