]> Git — Sourcephile - gargantext.git/blob - bin/gargantext-init/Main.hs
[GRAPH] Async Route
[gargantext.git] / bin / gargantext-init / Main.hs
1 {-|
2 Module : Main.hs
3 Description : Gargantext Import Corpus
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
8 Portability : POSIX
9
10 Import a corpus binary.
11
12 -}
13
14 {-# LANGUAGE NoImplicitPrelude #-}
15 {-# LANGUAGE OverloadedStrings #-}
16 {-# LANGUAGE FlexibleContexts #-}
17 {-# LANGUAGE RankNTypes #-}
18 {-# LANGUAGE Strict #-}
19
20 module Main where
21
22 import Data.Either (Either(..))
23 import Data.Maybe (Maybe(..))
24 import System.Environment (getArgs)
25 import Gargantext.Prelude
26 import Gargantext.Database.Flow (getOrMkRoot, getOrMk_RootWithCorpus)
27 import Gargantext.Database.Schema.Node (getOrMkList)
28 import Gargantext.Database.Utils (Cmd, )
29 import Gargantext.Database.Types.Node (CorpusId, RootId, HyperdataCorpus, ListId)
30 import Gargantext.Database.Schema.User (insertUsersDemo, UserId)
31 import Gargantext.API.Types (GargError)
32 import Gargantext.API.Node () -- instances
33 import Gargantext.API.Settings (withDevEnv, runCmdDev)
34 import Gargantext.Database.Config (userMaster, corpusMasterName)
35 import Gargantext.Database.Init (initTriggers)
36 main :: IO ()
37 main = do
38 [iniPath] <- getArgs
39
40 let createUsers :: Cmd GargError Int64
41 createUsers = insertUsersDemo
42
43 let
44 mkRoots :: Cmd GargError [(UserId, RootId)]
45 mkRoots = mapM getOrMkRoot ["gargantua", "user1", "user2"]
46 -- TODO create all users roots
47
48 let
49 initMaster :: Cmd GargError (UserId, RootId, CorpusId, ListId)
50 initMaster = do
51 (masterUserId, masterRootId, masterCorpusId) <- getOrMk_RootWithCorpus userMaster (Left corpusMasterName) (Nothing :: Maybe HyperdataCorpus)
52 masterListId <- getOrMkList masterCorpusId masterUserId
53 _triggers <- initTriggers masterListId
54 pure (masterUserId, masterRootId, masterCorpusId, masterListId)
55
56 withDevEnv iniPath $ \env -> do
57 _ <- runCmdDev env createUsers
58 _ <- runCmdDev env mkRoots
59 x <- runCmdDev env initMaster
60 putStrLn $ show x
61 pure ()