Main.hs 3.65 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14
{-|
Module      : Main.hs
Description : Gargantext Import Corpus
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

Import a corpus binary.

 -}

{-# LANGUAGE Strict            #-}
15
{-# LANGUAGE QuasiQuotes       #-}
16 17 18

module Main where

19 20 21
import Data.Either (Either(..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
import GHC.IO.Exception (IOException)
22
import Gargantext.API.Admin.EnvTypes (DevEnv)
23
import Gargantext.API.Dev (withDevEnv, runCmdDev)
24
import Gargantext.API.Ngrams.Tools (migrateFromDirToDb)
25
import Gargantext.API.Node () -- instances only
26 27 28 29
import Gargantext.API.Prelude (GargError)
import Gargantext.Core (HasDBid(toDBid))
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Action.Flow (getOrMk_RootWithCorpus)
30 31
import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
import Gargantext.Database.Admin.Trigger.Init
32 33 34
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus)
import Gargantext.Database.Admin.Types.Node (NodeType(NodeDocument, NodeContact))
import Gargantext.Database.Prelude (Cmd'', Cmd, execPGSQuery)
35 36
import Gargantext.Prelude
import Gargantext.Prelude.Config (GargConfig(..), readConfig)
37 38 39
import Prelude (getLine)
import System.Environment (getArgs)
import qualified Data.List as List (cycle, concat, take, unlines)
40

41 42 43
main :: IO ()
main = do

44 45 46 47
  let ___ = putStrLn
          $ List.concat
          $ List.take 72
          $ List.cycle ["_"]
48

49
  ___
50
  putStrLn "GarganText upgrade to version 0.0.6.9.9.4.4"
51
  ___
52

53 54 55 56
  params@[iniPath] <- getArgs
  _ <- if length params /= 1
         then panic "Usage: ./gargantext-upgrade gargantext.ini"
         else pure ()
57

58 59 60 61 62 63
  putStrLn $ List.unlines
           [ "Your Database defined in gargantext.ini will be upgraded."
           , "We stronlgy recommend you to make a backup using pg_dump."
           , ""
           , "Press ENTER if you want to continue, CTRL+C if you want to stop."
           ]
64

65
  _ok  <- getLine
66

67
  cfg       <- readConfig         iniPath
68
  let _secret = _gc_secretkey cfg
69

70
  withDevEnv iniPath $ \env -> do
71 72
    -- _ <- runCmdDev env addIndex
    -- _ <- runCmdDev env refreshIndex
73

74 75 76 77

    ___
    putStrLn "Uprade done with success !"
    ___
78
    pure ()
79

80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110
-- refreshIndex :: Cmd'' DevEnv IOException ()
-- refreshIndex = do
--   _ <- execPGSQuery [sql| REFRESH MATERIALIZED VIEW CONCURRENTLY context_node_ngrams_view; |] ()
--   pure ()

-- addIndex :: Cmd'' DevEnv IOException Int64
-- addIndex = do
--   execPGSQuery query ()
--     where
--       query = [sql|
--         CREATE MATERIALIZED VIEW IF NOT EXISTS context_node_ngrams_view AS
--           SELECT DISTINCT context_node_ngrams.context_id, ngrams_id, nodes_contexts.node_id
--           FROM nodes_contexts
--           JOIN context_node_ngrams
--           ON context_node_ngrams.context_id = nodes_contexts.context_id;

--         CREATE INDEX IF NOT EXISTS context_node_ngrams_context_id_ngrams_id_idx
--           ON context_node_ngrams(context_id, ngrams_id);

--         CREATE INDEX IF NOT EXISTS context_node_ngrams_view_context_id_idx
--           ON context_node_ngrams_view(context_id);
--         CREATE INDEX IF NOT EXISTS context_node_ngrams_view_ngrams_id_idx
--           ON context_node_ngrams_view(ngrams_id);
--         CREATE INDEX IF NOT EXISTS context_node_ngrams_view_node_id_idx
--           ON context_node_ngrams_view(node_id);
--         CREATE UNIQUE INDEX IF NOT EXISTS context_node_ngrams_view_context_ngrams_node_uniq_idx
--           ON context_node_ngrams_view (context_id, ngrams_id, node_id);

--         CREATE INDEX IF NOT EXISTS node_stories_ngrams_id_idx
--           ON node_stories(ngrams_id);
--   |]