{-|
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 #-}
{-# LANGUAGE QuasiQuotes #-}
module Main where
import Data.Either (Either(..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
import GHC.IO.Exception (IOException)
import Gargantext.API.Admin.EnvTypes (DevEnv)
import Gargantext.API.Dev (withDevEnv, runCmdDev)
import Gargantext.API.Node () -- instances only
import Gargantext.API.Prelude (GargError)
import Gargantext.Core (HasDBid(toDBid))
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Action.Flow (getOrMk_RootWithCorpus)
import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
import Gargantext.Database.Admin.Trigger.Init
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus)
import Gargantext.Database.Admin.Types.Node (NodeType(NodeDocument, NodeContact))
import Gargantext.Database.Prelude (Cmd'', Cmd, execPGSQuery)
import Gargantext.Database.Query.Table.Node (getOrMkList)
import Gargantext.Prelude
import Gargantext.Prelude.Config (GargConfig(..), readConfig)
import Prelude (getLine)
import System.Environment (getArgs)
import qualified Data.List as List (cycle, concat, take, unlines)
main :: IO ()
main = do
let ___ = putStrLn $ List.concat $ List.take 72 $ List.cycle ["_"]
___
putStrLn "GarganText upgrade to version 0.0.5"
___
params@[iniPath] <- getArgs
_ <- if length params /= 1
then panic "Usage: ./gargantext-upgrade gargantext.ini"
else pure ()
putStrLn $ List.unlines
[ "Your Database defined in gargantext.ini will be upgraded."
, "We stronlgy recommend you to make a backup using pg_dump."
, ""
, "If you encounter issues, please report your bugs here:"
, "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/101"
, ""
, "Press ENTER if you want to continue, CTRL+C if you want to stop."
]
_ok <- getLine
cfg <- readConfig iniPath
let secret = _gc_secretkey cfg
let
contextsTriggers :: Cmd GargError ()
contextsTriggers = do
(masterUserId, _masterRootId, masterCorpusId)
<- getOrMk_RootWithCorpus (UserName userMaster)
(Left corpusMasterName)
(Nothing :: Maybe HyperdataCorpus)
masterListId <- getOrMkList masterCorpusId masterUserId
_triggers <- initLastTriggers masterListId
pure ()
withDevEnv iniPath $ \env -> do
-- First upgrade the Database Schema
_ <- runCmdDev env sqlSchema
-- Then upgrade the triggers
_ <- runCmdDev env (initFirstTriggers secret :: Cmd GargError [Int64])
_ <- runCmdDev env (contextsTriggers :: Cmd GargError ())
-- Move nodes to contexts table
_ <- runCmdDev env sqlNodes2Contexts
-- Update the hashes
_ <- runCmdDev env sqlUpdateTriggerHash
___
putStrLn "Uprade done with success !"
___
pure ()
sqlUpdateTriggerHash :: Cmd'' DevEnv IOException Int64
sqlUpdateTriggerHash = do
execPGSQuery query ()
where
query = [sql|
UPDATE nodes SET typename = typename;
UPDATE contexts SET typename = typename;
|]
sqlNodes2Contexts :: Cmd'' DevEnv IOException Int64
sqlNodes2Contexts = do
execPGSQuery query (toDBid NodeDocument,toDBid NodeContact)
where
query = [sql|
-- WITH docs (id,hash_id,typename,user_id,parent_id,name,date,hyperdata, search)
WITH docs AS (SELECT * from nodes WHERE nodes.typename IN (?,?)),
inserted (id, hash_id) AS (
INSERT INTO contexts (hash_id,typename,user_id,parent_id,name,date,hyperdata, search)
SELECT d.hash_id,d.typename,d.user_id,NULL,d.name,d.date,d.hyperdata,search FROM docs AS d
RETURNING contexts.id, contexts.hash_id
),
indexed (node_id, context_id) AS (
SELECT docs.id, inserted.id from inserted
JOIN docs on docs.hash_id = inserted.hash_id
),
-- nodes_nodes -> nodes_contexts
nodes_contexts_query AS (
INSERT INTO nodes_contexts (node_id, context_id,score, category)
SELECT nn.node1_id,i.context_id,nn.score,nn.category FROM nodes_nodes nn
JOIN indexed i ON i.node_id = nn.node2_id
),
-- nodes_nodes_ngrams -> contexts_nodes_ngrams
contexts_nodes_ngrams_query AS (
INSERT INTO context_node_ngrams
SELECT i.context_id, nnn.node1_id, nnn.ngrams_id, nnn.ngrams_type, nnn.weight FROM node_node_ngrams nnn
JOIN indexed i ON i.node_id = nnn.node2_id
),
---- nodes_nodes_ngrams2 -> contexts_nodes_ngrams2
context_node_ngrams2_query AS (
INSERT INTO context_node_ngrams2
SELECT i.context_id, nnn2.nodengrams_id, nnn2.weight FROM node_node_ngrams2 nnn2
JOIN indexed i ON i.node_id = nnn2.node_id
)
-- WITH CASCADE it should update others tables
DELETE FROM nodes n
USING indexed i WHERE i.node_id = n.id
;
UPDATE contexts SET parent_id = id;
|]
sqlSchema :: Cmd'' DevEnv IOException Int64
sqlSchema = do
execPGSQuery query ()
where
query = [sql|
-- TODO typename -> type_id
CREATE TABLE public.contexts (
id SERIAL,
hash_id CHARACTER varying(66) DEFAULT ''::character varying NOT NULL,
typename INTEGER NOT NULL,
user_id INTEGER NOT NULL,
parent_id INTEGER REFERENCES public.contexts(id) ON DELETE CASCADE ,
name CHARACTER varying(255) DEFAULT ''::character varying NOT NULL,
date TIMESTAMP with time zone DEFAULT now() NOT NULL,
hyperdata jsonb DEFAULT '{}'::jsonb NOT NULL,
search tsvector,
PRIMARY KEY (id),
FOREIGN KEY (user_id) REFERENCES public.auth_user(id) ON DELETE CASCADE
);
ALTER TABLE public.contexts OWNER TO gargantua;
-- To attach contexts to a Corpus
CREATE TABLE public.nodes_contexts (
node_id INTEGER NOT NULL REFERENCES public.nodes(id) ON DELETE CASCADE,
context_id INTEGER NOT NULL REFERENCES public.contexts(id) ON DELETE CASCADE,
score REAL ,
category INTEGER ,
PRIMARY KEY (node_id, context_id)
);
ALTER TABLE public.nodes_contexts OWNER TO gargantua;
---------------------------------------------------------------
CREATE TABLE public.context_node_ngrams (
context_id INTEGER NOT NULL REFERENCES public.contexts (id) ON DELETE CASCADE,
node_id INTEGER NOT NULL REFERENCES public.nodes (id) ON DELETE CASCADE,
ngrams_id INTEGER NOT NULL REFERENCES public.ngrams (id) ON DELETE CASCADE,
ngrams_type INTEGER ,
weight double precision,
PRIMARY KEY (context_id, node_id, ngrams_id, ngrams_type)
);
ALTER TABLE public.context_node_ngrams OWNER TO gargantua;
CREATE TABLE public.context_node_ngrams2 (
context_id INTEGER NOT NULL REFERENCES public.contexts (id) ON DELETE CASCADE,
nodengrams_id INTEGER NOT NULL REFERENCES public.node_ngrams (id) ON DELETE CASCADE,
weight double precision,
PRIMARY KEY (context_id, nodengrams_id)
);
ALTER TABLE public.context_node_ngrams2 OWNER TO gargantua;
CREATE INDEX ON public.contexts USING gin (hyperdata);
CREATE INDEX ON public.contexts USING btree (user_id, typename, parent_id);
CREATE INDEX ON public.contexts USING btree (id, typename, date ASC);
CREATE INDEX ON public.contexts USING btree (id, typename, date DESC);
CREATE INDEX ON public.contexts USING btree (typename, id);
CREATE UNIQUE INDEX ON public.contexts USING btree (hash_id);
-- To make the links between Corpus Node and its contexts
CREATE UNIQUE INDEX ON public.nodes_contexts USING btree (node_id, context_id);
CREATE INDEX ON public.nodes_contexts USING btree (node_id, context_id, category);
------------------------------------------------------------------------
CREATE UNIQUE INDEX ON public.context_node_ngrams USING btree (context_id, node_id, ngrams_id, ngrams_type);
CREATE INDEX ON public.context_node_ngrams USING btree (context_id, node_id);
CREATE INDEX ON public.context_node_ngrams USING btree (ngrams_id, node_id);
CREATE INDEX ON public.context_node_ngrams USING btree (ngrams_type);
CREATE INDEX ON public.context_node_ngrams2 USING btree (context_id);
CREATE INDEX ON public.context_node_ngrams2 USING btree (nodengrams_id);
CREATE INDEX ON public.context_node_ngrams2 USING btree (context_id, nodengrams_id);
DROP TABLE if EXISTS public.node_nodengrams_nodengrams;
DROP TRIGGER if EXISTS trigger_count_delete2 ON nodes_nodes;
DROP TRIGGER if EXISTS trigger_count_update_add ON nodes_nodes;
DROP TRIGGER if EXISTS trigger_delete_count ON nodes_nodes;
DROP TRIGGER if EXISTS trigger_insert_count ON nodes_nodes;
|]