]> Git — Sourcephile - gargantext.git/blob - bin/gargantext-init/Main.hs
Merge branch 'dev-list-charts' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell...
[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 Strict #-}
15
16 module Main where
17
18 import Data.Either (Either(..))
19 import Data.Maybe (Maybe(..))
20 import Gargantext.API.Admin.Settings (withDevEnv, runCmdDev)
21 import Gargantext.API.Prelude (GargError)
22 import Gargantext.API.Node () -- instances
23 import Gargantext.Core.Types.Individu (User(..))
24 import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMk_RootWithCorpus)
25 import Gargantext.Database.Query.Table.Node (getOrMkList)
26 import Gargantext.Database.Query.Table.User (insertUsersDemo)
27 import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
28 import Gargantext.Database.Admin.Types.Node
29 import Gargantext.Database.Admin.Trigger.Init (initTriggers)
30 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus)
31 import Gargantext.Database.Admin.Types.Node (CorpusId, RootId, ListId)
32 import Gargantext.Database.Prelude (Cmd, )
33 import Gargantext.Prelude
34 import System.Environment (getArgs)
35
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 $ map UserName ["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 (UserName 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 ()