]> Git — Sourcephile - gargantext.git/blob - bin/gargantext-init/Main.hs
Merge branch 'master' into stable
[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, getOrMkRootWithCorpus)
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) <- getOrMkRootWithCorpus userMaster (Left corpusMasterName) (Nothing :: Maybe HyperdataCorpus)
52 masterListId <- getOrMkList masterCorpusId masterUserId
53 _ <- 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 ()