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 Data.Maybe (Maybe(..))
  28 import Gargantext.Core.Types (NodePoly(..))
  29 import Gargantext.Prelude
  30 import Gargantext.Database.Bashql (runCmd', del)
  31 import Gargantext.Database.Node (getRoot, mkRoot, mkCorpus)
  32 import Gargantext.Database.User (getUser, UserLight(..), Username)
  33 import Gargantext.Database.Node.Document.Insert (insertDocuments, ReturnId(reId))
  34 import Gargantext.Database.Node.Document.Add    (add)
  35 import Gargantext.Text.Parsers (parseDocs, FileFormat(WOS))
  36
  37 type UserId = Int
  38 type RootId = Int
  39 type CorpusId = Int
  40
  41 subFlow :: Username -> IO (UserId, RootId, CorpusId)
  42 subFlow username = do
  43   maybeUserId <- runCmd' (getUser username)
  44
  45   let userId = case maybeUserId of
  46         Nothing   -> panic "Error: User does not exist (yet)" -- mk NodeUser gargantua_id "Node Gargantua"
  47         Just user -> userLight_id user
  48
  49   rootId' <- map _node_id <$> runCmd' (getRoot userId)
  50
  51   rootId'' <- case rootId' of
  52         []  -> runCmd' (mkRoot userId)
  53         un  -> case length un >= 2 of
  54                  True  -> panic "Error: more than 1 userNode / user"
  55                  False -> pure rootId'
  56   let rootId = maybe (panic "error rootId") identity (head rootId'')
  57
  58   corpusId' <- runCmd' $ mkCorpus (Just "Corpus WOS") Nothing rootId userId
  59   let corpusId = maybe (panic "error corpusId") identity (head corpusId')
  60
  61   printDebug "(username, userId, rootId, corpusId"
  62               (username, userId, rootId, corpusId)
  63   pure (userId, rootId, corpusId)
  64
  65
  66 flow :: FilePath -> IO Int
  67 flow fp = do
  68
  69   (masterUserId, _, corpusId) <- subFlow "gargantua"
  70
  71   docs <- parseDocs WOS fp
  72   ids  <- runCmd' $ insertDocuments masterUserId corpusId docs
  73   printDebug "Docs IDs : " ids
  74
  75   idsRepeat  <- runCmd' $ insertDocuments masterUserId corpusId docs
  76   printDebug "Docs IDs : " idsRepeat
  77
  78   (_, _, corpusId2) <- subFlow "alexandre"
  79
  80   inserted <- runCmd' $ add corpusId2 (map reId ids)
  81   printDebug "Inserted : " inserted
  82
  83   runCmd' (del [corpusId2, corpusId])
  84