Unverified Commit 8230bdee authored by Nicolas Pouillard's avatar Nicolas Pouillard

Merge branch 'dbflow' of https://gitlab.iscpif.fr/gargantext/haskell-gargantext into dbflow

parents 10f9f394 670baca2
...@@ -30,39 +30,52 @@ authors ...@@ -30,39 +30,52 @@ authors
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Gargantext.Database.Flow module Gargantext.Database.Flow
(flow)
where where
import System.FilePath (FilePath) import System.FilePath (FilePath)
import GHC.Base ((>>))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Gargantext.Core.Types (NodePoly(..)) import Gargantext.Core.Types (NodePoly(..))
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Database.Bashql (runCmd', del) import Gargantext.Database.Bashql (runCmd', del)
import Gargantext.Database.Node (getRoot, mkRoot, mkCorpus) import Gargantext.Database.Node (Cmd(..), getRoot, mkRoot, mkCorpus, defaultCorpus)
import Gargantext.Database.User (getUser, UserLight(..)) import Gargantext.Database.User (getUser, UserLight(..), Username)
import Gargantext.Database.Node.Document.Import (insertDocuments) import Gargantext.Database.Node.Document.Import (insertDocuments)
import Gargantext.Text.Parsers (parseDocs, FileFormat(WOS)) import Gargantext.Text.Parsers (parseDocs, FileFormat(WOS))
flow :: FilePath -> IO () type UserId = Int
flow fp = do type RootId = Int
masterUser <- runCmd' (getUser "gargantua") type CorpusId = Int
subFlow :: Username -> IO (UserId, RootId, CorpusId)
subFlow username = do
maybeUserId <- runCmd' (getUser username)
let masterUserId = case masterUser of let userId = case maybeUserId of
Nothing -> panic "Error: User does not exist (yet)" -- mk NodeUser gargantua_id "Node Gargantua" Nothing -> panic "Error: User does not exist (yet)" -- mk NodeUser gargantua_id "Node Gargantua"
Just user -> userLight_id user Just user -> userLight_id user
rootId' <- map _node_id <$> runCmd' (getRoot masterUserId) rootId' <- map _node_id <$> runCmd' (getRoot userId)
rootId'' <- case rootId' of rootId'' <- case rootId' of
[] -> runCmd' (mkRoot masterUserId) [] -> runCmd' (mkRoot userId)
un -> case length un >= 2 of un -> case length un >= 2 of
True -> panic "Error: more than 1 userNode / user" True -> panic "Error: more than 1 userNode / user"
False -> pure rootId' False -> pure rootId'
let rootId = maybe (panic "error rootId") identity (head rootId'') let rootId = maybe (panic "error rootId") identity (head rootId'')
printDebug "Root ID : " rootId
corpusId' <- runCmd' $ mkCorpus (Just "Corpus WOS") Nothing rootId userId
corpusId' <- runCmd' $ mkCorpus (Just "Corpus WOS") Nothing rootId masterUserId
let corpusId = maybe (panic "error corpusId") identity (head corpusId') let corpusId = maybe (panic "error corpusId") identity (head corpusId')
printDebug "Corpus ID : " corpusId
printDebug "(username, userId, rootId, corpusId"
(username, userId, rootId, corpusId)
pure (userId, rootId, corpusId)
-- flow :: FilePath -> IO ()
flow fp = do
(masterUserId, _, corpusId) <- subFlow "gargantua"
docs <- parseDocs WOS fp docs <- parseDocs WOS fp
ids <- runCmd' $ insertDocuments masterUserId corpusId docs ids <- runCmd' $ insertDocuments masterUserId corpusId docs
...@@ -71,8 +84,12 @@ flow fp = do ...@@ -71,8 +84,12 @@ flow fp = do
idsRepeat <- runCmd' $ insertDocuments masterUserId corpusId docs idsRepeat <- runCmd' $ insertDocuments masterUserId corpusId docs
printDebug "Docs IDs : " idsRepeat printDebug "Docs IDs : " idsRepeat
_ <- runCmd' (del [corpusId]) (userId, rootId, corpusId2) <- subFlow "alexandre"
pure ()
runCmd' (del [corpusId])
{- {-
--folderId <- mk Folder parentId (Name "Data") (Descr "All corpora DATA here") --folderId <- mk Folder parentId (Name "Data") (Descr "All corpora DATA here")
......
...@@ -142,3 +142,5 @@ type Username = Text ...@@ -142,3 +142,5 @@ type Username = Text
getUser :: Username -> Cmd (Maybe UserLight) getUser :: Username -> Cmd (Maybe UserLight)
getUser u = mkCmd $ \c -> userLightWithUsername u <$> runCmd c usersLight getUser u = mkCmd $ \c -> userLightWithUsername u <$> runCmd c usersLight
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment