Commit 277be1fc authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'dev'

parents 38f940bf ff6e2e1e
......@@ -19,23 +19,20 @@ Import a corpus binary.
module Main where
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import System.Environment (getArgs)
import Gargantext.Prelude
import Gargantext.Database.Flow (FlowCmdM, flowCorpusFile, getOrMkRoot)
import Gargantext.Text.Corpus.Parsers (FileFormat(..))
import Gargantext.Database.Flow (getOrMkRoot, getOrMkRootWithCorpus)
import Gargantext.Database.Schema.Node (getOrMkList)
import Gargantext.Database.Utils (Cmd, )
import Gargantext.Database.Types.Node (CorpusId, toHyperdataDocument, RootId)
import Gargantext.Database.Types.Node (CorpusId, RootId, HyperdataCorpus, ListId)
import Gargantext.Database.Schema.User (insertUsersDemo, UserId)
import Gargantext.Text.Terms (TermType(..))
import Gargantext.Core (Lang(..))
import Gargantext.API.Types (GargError)
import Gargantext.API.Node () -- instances
import Gargantext.API.Settings (withDevEnv, runCmdDev, DevEnv)
--import Gargantext.Text.Corpus.Parsers.GrandDebat (readFile, GrandDebatReference(..))
import Data.Text (Text)
import qualified Data.Text as Text
import Control.Monad.IO.Class (liftIO)
import Gargantext.API.Settings (withDevEnv, runCmdDev)
import Gargantext.Database.Config (userMaster, corpusMasterName)
import Gargantext.Database.Init (initTriggers)
main :: IO ()
main = do
[iniPath] <- getArgs
......@@ -44,11 +41,21 @@ main = do
createUsers = insertUsersDemo
let
mkRoots :: Cmd GargError (UserId, RootId)
mkRoots = getOrMkRoot "user1"
mkRoots :: Cmd GargError [(UserId, RootId)]
mkRoots = mapM getOrMkRoot ["gargantua", "user1", "user2"]
-- TODO create all users roots
let
initMaster :: Cmd GargError (UserId, RootId, CorpusId, ListId)
initMaster = do
(masterUserId, masterRootId, masterCorpusId) <- getOrMkRootWithCorpus userMaster (Left corpusMasterName) (Nothing :: Maybe HyperdataCorpus)
masterListId <- getOrMkList masterCorpusId masterUserId
_ <- initTriggers masterListId
pure (masterUserId, masterRootId, masterCorpusId, masterListId)
withDevEnv iniPath $ \env -> do
_ <- runCmdDev env createUsers
_ <- runCmdDev env mkRoots
x <- runCmdDev env initMaster
putStrLn $ show x
pure ()
#!/bin/bash
if git --version;
then
echo "git installed, ok"
else
sudo apt update && sudo apt install git
fi
sudo apt update
sudo apt install liblzma-dev libpcre3-dev libblas-dev liblapack-dev pkg-config libgsl-dev libbz2-dev postgresql postgresql-server-dev-9.6 nginx libigraph-dev
#echo "Which user?"
#read USER
#sudo adduser --disabled-password --gecos "" $USER
#sudo su $USER
curl -sSL https://get.haskellstack.org/ | sh
stack update
stack upgrade
git clone https://gitlab.iscpif.fr/gargantext/haskell-gargantext.git
cd haskell-gargantext
git clone https://gitlab.iscpif.fr/gargantext/purescript-gargantext
mkdir deps
cd deps
git clone https://gitlab.iscpif.fr/gargantext/clustering-louvain.git
git clone https://github.com/np/servant-job.git
git clone https://github.com/np/patches-map
git clone https://gitlab.com/npouillard/patches-class.git
git clone https://github.com/delanoe/haskell-opaleye
git clone -b next --single-branch https://github.com/delanoe/hsparql
cd ..
stack setup
stack build
stack install
# Specific to our servers
### Configure timezone and locale ###################################
echo "########### LOCALES & TZ #################"
echo "Europe/Paris" > /etc/timezone
dpkg-reconfigure --frontend=noninteractive tzdata
#ENV TZ "Europe/Paris"
sed -i -e 's/# en_GB.UTF-8 UTF-8/en_GB.UTF-8 UTF-8/' /etc/locale.gen && \
sed -i -e 's/# fr_FR.UTF-8 UTF-8/fr_FR.UTF-8 UTF-8/' /etc/locale.gen && \
locale-gen && \
update-locale LANG=fr_FR.UTF-8 && \
update-locale LANGUAGE=fr_FR.UTF-8 && \
update-locale LC_ALL=fr_FR.UTF-8
################################################################
# Database configuration
# CREATE USER gargantua WITH PASSWORD $(grep DB_PASS gargantext.ini)
# GRANT ALL PRIVILEGES ON DATABASE gargandbV4 to gargantua
#######################################################################
## POSTGRESQL DATA (as ROOT)
#######################################################################
sed -iP "s%^data_directory.*%data_directory = \'\/srv\/gargandata\'%" /etc/postgresql/9.6/main/postgresql.conf
echo "host all all 0.0.0.0/0 md5" >> /etc/postgresql/9.6/main/pg_hba.conf
echo "listen_addresses='*'" >> /etc/postgresql/9.6/main/postgresql.conf
......@@ -14,5 +14,5 @@ sudo apt install liblzma-dev libpcre3-dev libblas-dev liblapack-dev pkg-config l
# Phylo management
sudo apt install graphviz
sudo apt install postgresql-server-dev-9.6
sudo apt install postgresql-server-dev-11
#!/bin/bash
git clone https://gitlab.iscpif.fr/gargantext/clustering-louvain-cplusplus.git
cd clustering-louvain-cplusplus
./install
cd ..
sudo apt install default-jdk
wget https://dl.gargantext.org/coreNLP.tar.bz2
tar xvjf coreNLP.tar.bz2
# ./startServer.sh
This diff is collapsed.
##
# You should look at the following URL's in order to grasp a solid understanding
# of Nginx configuration files in order to fully unleash the power of Nginx.
# http://wiki.nginx.org/Pitfalls
# http://wiki.nginx.org/QuickStart
# http://wiki.nginx.org/Configuration
#
# Generally, you will want to move this file somewhere, and start with a clean
# file but keep this around for reference. Or just disable in sites-enabled.
#
# Please see /usr/share/doc/nginx-doc/examples/ for more detailed examples.
##
server {
if ($host = dev.gargantext.org) {
return 301 https://$host$request_uri;
} # managed by Certbot
listen 80;
server_name dev.gargantext.org;
add_header Cache-Control "no-cache";
location '/.well-known/acme-challenge' {
root /var/www/gargantext;
}
# Always redirect to https
return 301 https://dev.gargantext.org$request_uri;
}
server {
listen 443;
listen [::]:443 ssl;
server_name dev.gargantext.org;
# Some options configurations:
# https://github.com/h5bp/server-configs-nginx/blob/master/h5bp/location/expires.conf
add_header Cache-Control "no-cache";
# SSL configuration
#
# listen 443 ssl default_server;
# listen [::]:443 ssl default_server;
ssl on;
ssl_certificate /etc/letsencrypt/live/dev.gargantext.org/fullchain.pem; # managed by Certbot
ssl_certificate_key /etc/letsencrypt/live/dev.gargantext.org/privkey.pem; # managed by Certbot
# Note: You should disable gzip for SSL traffic.
# See: https://bugs.debian.org/773332
#
# Read up on ssl_ciphers to ensure a secure configuration.
# See: https://bugs.debian.org/765782
#
# Self signed certs generated by the ssl-cert package
# Don't use them in a production server!
#
# include snippets/snakeoil.conf;
client_max_body_size 800M;
client_body_timeout 12;
client_header_timeout 12;
keepalive_timeout 15;
send_timeout 10;
root /var/www/html;
index index.html;
#add_header Access-Control-Allow-Origin $http_origin always;
# Add index.php to the list if you are using PHP
#index index.html index.htm index.nginx-debian.html;
# CORS config borrowed from: https://gist.github.com/pauloricardomg/7084524
# NP: not sure we need CORS yet
#
if ($http_origin ~* (^https?://(127.0.0.1|localhost|dev\.gargantext\.com))) {
set $cors "1";
}
#
# Cross-Origin Resource Sharing
if ($request_method = "OPTIONS") {
set $cors "${cors}o";
}
# SSL CERT renewal
location '/.well-known/acme-challenge' {
alias /var/www/gargantext/.well-known/acme-challenge ;
}
location /api {
# limit_except OPTIONS {
# auth_basic "Gargantext's Development Version";
# auth_basic_user_file /etc/nginx/haskell_gargantext.htpasswd;
# }
proxy_set_header X-Real-IP $remote_addr;
proxy_set_header X-Forwarded-For $proxy_add_x_forwarded_for;
proxy_set_header X-Forwarded-Proto $scheme;
proxy_set_header Host $http_host;
proxy_redirect off;
proxy_pass http://127.0.0.1:8008;
}
location / {
# https://stackoverflow.com/a/48708812
limit_except OPTIONS {
auth_basic "Gargantext's Development Version";
auth_basic_user_file /etc/nginx/haskell_gargantext.htpasswd;
}
proxy_set_header X-Real-IP $remote_addr;
proxy_set_header X-Forwarded-For $proxy_add_x_forwarded_for;
proxy_set_header X-Forwarded-Proto $scheme;
proxy_set_header Host $http_host;
proxy_redirect off;
proxy_pass http://127.0.0.1:8008;
}
#access_log off;
access_log /var/log/nginx/access.log;
error_log /var/log/nginx/error.log;
}
......@@ -4,12 +4,12 @@
# postgresql://$USER:$PW@localhost/$DB
PW="password"
PW="C8kdcUrAQy66U"
DB="gargandbV5"
USER="gargantua"
psql -c "CREATE USER \"${USER}\""
psql -c "ALTER USER \"${USER}\" with PASSWORD \"${PW}\""
psql -c "ALTER USER \"${USER}\" with PASSWORD '${PW}'"
psql -c "DROP DATABASE IF EXISTS \"${DB}\""
createdb "${DB}"
......
......@@ -93,13 +93,12 @@ ALTER TABLE public.nodes_nodes OWNER TO gargantua;
---------------------------------------------------------------
-- TODO should reference "id" of nodes_nodes (instead of node1_id, node2_id)
CREATE TABLE public.node_node_ngrams (
id SERIAL,
node1_id INTEGER NOT NULL REFERENCES public.nodes (id) ON DELETE CASCADE,
node2_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 (id)
PRIMARY KEY (node1_id, node2_id, ngrams_id, ngrams_type)
);
ALTER TABLE public.node_node_ngrams OWNER TO gargantua;
--------------------------------------------------------------
......
name: gargantext
version: '4.0.0.6'
version: '0.0.0.4'
synopsis: Search, map, share
description: Please see README.md
category: Data
......@@ -39,6 +39,8 @@ library:
- Gargantext.Core.Types.Main
- Gargantext.Core.Utils.Prefix
- Gargantext.Database
- Gargantext.Database.Init
- Gargantext.Database.Config
- Gargantext.Database.Flow
- Gargantext.Database.Schema.Node
- Gargantext.Database.Tree
......
......@@ -178,14 +178,18 @@ data MockEnv = MockEnv
makeLenses ''MockEnv
-- | TODO add this path in Settings
repoDir :: FilePath
repoDir = "repos"
repoSnapshot :: FilePath
repoSnapshot = "repo.json"
repoSnapshot = repoDir <> "/repo.json"
-- | TODO add hard coded file in Settings
-- This assumes we own the lock on repoSnapshot.
repoSaverAction :: ToJSON a => a -> IO ()
repoSaverAction a = do
withTempFile "." "tmp-repo.json" $ \fp h -> do
withTempFile "repos" "tmp-repo.json" $ \fp h -> do
-- printDebug "repoSaverAction" fp
L.hPut h $ encode a
hClose h
......@@ -210,6 +214,8 @@ mkRepoSaver repo_var = mkDebounce settings
readRepoEnv :: IO RepoEnv
readRepoEnv = do
-- Does file exist ? :: Bool
_repoDir <- doesDirectoryExist True repoDir
repoFile <- doesFileExist repoSnapshot
-- Is file not empty ? :: Bool
......@@ -230,7 +236,7 @@ readRepoEnv = do
pure repo
else
pure initRepo
-- TODO save in DB here
saver <- mkRepoSaver mvar
pure $ RepoEnv { _renv_var = mvar, _renv_saver = saver, _renv_lock = lock }
......
......@@ -96,7 +96,3 @@ fromNodeTypeId :: NodeTypeId -> NodeType
fromNodeTypeId tId = fromMaybe (panic $ pack $ "Type Id " <> show tId <> " does not exist")
(lookup tId nodeTypeInv)
......@@ -67,7 +67,6 @@ import Gargantext.Database.Schema.User (getUser, UserLight(..))
import Gargantext.Database.TextSearch (searchInDatabase)
import Gargantext.Database.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
import Gargantext.Database.Utils (Cmd, CmdM)
import Gargantext.Database.Triggers
import Gargantext.Ext.IMT (toSchoolName)
import Gargantext.Ext.IMTUser (deserialiseImtUsersFromFile)
import Gargantext.Prelude
......@@ -221,6 +220,7 @@ flowCorpusUser :: (FlowCmdM env err m, MkCorpus c)
flowCorpusUser l userName corpusName ctype ids = do
-- User Flow
(userId, _rootId, userCorpusId) <- getOrMkRootWithCorpus userName corpusName ctype
listId <- getOrMkList userCorpusId userId
-- TODO: check if present already, ignore
_ <- Doc.add userCorpusId ids
tId <- mkNode NodeTexts userCorpusId userId
......@@ -229,11 +229,11 @@ flowCorpusUser l userName corpusName ctype ids = do
-- User List Flow
--{-
(masterUserId, _masterRootId, masterCorpusId) <- getOrMkRootWithCorpus userMaster (Left "") ctype
(_masterUserId, _masterRootId, masterCorpusId) <- getOrMkRootWithCorpus userMaster (Left "") ctype
ngs <- buildNgramsLists l 2 3 (StopSize 3) userCorpusId masterCorpusId
userListId <- flowList userId userCorpusId ngs
mastListId <- getOrMkList masterCorpusId masterUserId
_ <- insertOccsUpdates userCorpusId mastListId
userListId <- flowList listId ngs
--mastListId <- getOrMkList masterCorpusId masterUserId
-- _ <- insertOccsUpdates userCorpusId mastListId
printDebug "userListId" userListId
-- User Graph Flow
_ <- mkDashboard userCorpusId userId
......@@ -475,12 +475,10 @@ listInsert lId ngs = mapM_ (\(typeList, ngElmts)
) $ toList ngs
flowList :: FlowCmdM env err m
=> UserId
-> CorpusId
=> ListId
-> Map NgramsType [NgramsElement]
-> m ListId
flowList uId cId ngs = do
lId <- getOrMkList cId uId
flowList lId ngs = do
printDebug "listId flowList" lId
listInsert lId ngs
--trace (show $ List.filter (\n -> _ne_ngrams n == "versatile") $ List.concat $ Map.elems ngs) $ listInsert lId ngs
......
......@@ -66,7 +66,7 @@ docNgrams2nodeNodeNgrams :: CorpusId
-> DocNgrams
-> NodeNodeNgrams
docNgrams2nodeNodeNgrams cId (DocNgrams d n nt w) =
NodeNodeNgrams Nothing cId d n nt w
NodeNodeNgrams cId d n nt w
data DocNgrams = DocNgrams { dn_doc_id :: DocId
, dn_ngrams_id :: Int
......
{-|
Module : Gargantext.Database.Init
Description : Triggers configuration
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
Ngrams by node enable contextual metrics.
-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Gargantext.Database.Init
where
import Database.PostgreSQL.Simple.SqlQQ (sql)
-- import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Gargantext.Database.Config (nodeTypeId)
import Gargantext.Database.Types.Node -- (ListId, CorpusId, NodeId)
import Gargantext.Database.Utils (Cmd, execPGSQuery)
import Gargantext.Prelude
import qualified Database.PostgreSQL.Simple as DPS
------------------------------------------------------------------------
type MasterListId = ListId
initTriggers :: MasterListId -> Cmd err [Int64]
initTriggers lId = do
t1 <- triggerCountInsert
t2 <- triggerDeleteCount lId
t3 <- triggerInsertCount lId
t4 <- triggerUpdateAdd lId
t5 <- triggerUpdateDel lId
pure [t1,t2,t3,t4,t5]
triggerCountInsert :: Cmd err Int64
triggerCountInsert = execPGSQuery query (nodeTypeId NodeDocument, nodeTypeId NodeList)
where
query :: DPS.Query
query = [sql|
CREATE OR REPLACE FUNCTION set_ngrams_global_count() RETURNS trigger AS $$
BEGIN
IF pg_trigger_depth() <> 1 THEN
RETURN NEW;
END IF;
IF TG_OP = 'INSERT' THEN
INSERT INTO node_node_ngrams (node1_id, node2_id, ngrams_id, ngrams_type, weight)
select n.parent_id, n.id, new1.ngrams_id, new1.ngrams_type, count(*) from NEW as new1
INNER JOIN nodes n ON n.id = new1.node1_id
INNER JOIN nodes n2 ON n2.id = new1.node2_id
WHERE n2.typename = ? -- not mandatory
AND n.typename = ? -- not mandatory
AND n.parent_id <> n2.id -- not mandatory
GROUP BY n.parent_id, n.id, new1.ngrams_id, new1.ngrams_type
ON CONFLICT (node1_id, node2_id, ngrams_id, ngrams_type)
DO UPDATE set weight = node_node_ngrams.weight + excluded.weight
;
END IF;
RETURN NULL;
END
$$ LANGUAGE plpgsql;
-- DROP trigger trigger_count_insert on node_node_ngrams;
CREATE TRIGGER trigger_count_insert AFTER INSERT on node_node_ngrams
REFERENCING NEW TABLE AS NEW
FOR EACH STATEMENT
EXECUTE PROCEDURE set_ngrams_global_count();
|]
-- Triggers NodesNodes
triggerDeleteCount :: MasterListId -> Cmd err Int64
triggerDeleteCount lId = execPGSQuery query (lId, nodeTypeId NodeList)
where
query :: DPS.Query
query = [sql|
CREATE OR REPLACE FUNCTION set_delete_count() RETURNS trigger AS $$
BEGIN
UPDATE node_node_ngrams SET weight = weight - d.delete_count
FROM (SELECT old1.node1_id as node1_id, lists.id as node2_id, nnn.ngrams_id as ngrams_id, nnn.ngrams_type as ngrams_type, count(*) as delete_count FROM OLD as old1
INNER JOIN nodes doc ON doc.id = old1.node2_id
INNER JOIN nodes lists ON lists.parent_id = old1.node1_id
INNER JOIN node_node_ngrams nnn ON nnn.node2_id = doc.id
WHERE nnn.node1_id in (?, lists.id)
AND lists.typename = ?
GROUP BY old1.node1_id, lists.id, nnn.ngrams_id, nnn.ngrams_type
) AS d
WHERE node_node_ngrams.node1_id = d.node1_id
AND node_node_ngrams.node2_id = d.node2_id
AND node_node_ngrams.ngrams_id = d.ngrams_id
AND node_node_ngrams.ngrams_type = d.ngrams_type
;
RETURN NULL;
END
$$ LANGUAGE plpgsql;
-- DROP trigger trigger_delete_count on nodes_nodes;
CREATE TRIGGER trigger_delete_count AFTER DELETE on nodes_nodes
REFERENCING OLD TABLE AS OLD
FOR EACH STATEMENT
EXECUTE PROCEDURE set_delete_count();
|]
triggerInsertCount :: MasterListId -> Cmd err Int64
triggerInsertCount lId = execPGSQuery query (lId, nodeTypeId NodeList)
where
query :: DPS.Query
query = [sql|
CREATE OR REPLACE FUNCTION set_insert_count() RETURNS trigger AS $$
BEGIN
INSERT INTO node_node_ngrams (node1_id, node2_id, ngrams_id, ngrams_type, weight)
SELECT new1.node1_id , lists.id, nnn.ngrams_id, nnn.ngrams_type, count(*) as weight from NEW as new1
INNER JOIN nodes doc ON doc.id = new1.node2_id
INNER JOIN nodes lists ON lists.parent_id = new1.node1_id
INNER JOIN node_node_ngrams nnn ON nnn.node2_id = doc.id
WHERE nnn.node1_id in (?, lists.id)
AND lists.typename = ?
GROUP BY new1.node1_id, lists.id, nnn.ngrams_id, nnn.ngrams_type
ON CONFLICT (node1_id, node2_id, ngrams_id, ngrams_type)
DO UPDATE set weight = node_node_ngrams.weight + excluded.weight
;
RETURN NULL;
END
$$ LANGUAGE plpgsql;
-- DROP trigger trigger_insert_count on nodes_nodes;
CREATE TRIGGER trigger_insert_count AFTER INSERT on nodes_nodes
REFERENCING NEW TABLE AS NEW
FOR EACH STATEMENT
EXECUTE PROCEDURE set_insert_count();
|]
triggerUpdateAdd :: MasterListId -> Cmd err Int64
triggerUpdateAdd lId = execPGSQuery query (lId, nodeTypeId NodeList)
where
query :: DPS.Query
query = [sql|
CREATE OR REPLACE FUNCTION set_update_ngrams_add() RETURNS trigger AS $$
BEGIN
UPDATE node_node_ngrams nnn0 SET weight = weight + d.fix_count
FROM (SELECT new1.node1_id as node1_id, lists.id as node2_id, nnn.ngrams_id as ngrams_id, nnn.ngrams_type as ngrams_type, count(*) as fix_count
FROM NEW as new1
INNER JOIN nodes lists ON new1.node1_id = lists.parent_id
INNER JOIN node_node_ngrams nnn ON new1.node2_id = nnn.node2_id
WHERE nnn.node1_id in (?, lists.id) -- (masterList_id, userLists)
AND lists.typename = ?
GROUP BY new1.node1_id, lists.id, nnn.ngrams_id, nnn.ngrams_type
) as d
WHERE nnn0.node1_id = d.node1_id
AND nnn0.node2_id = d.node2_id
AND nnn0.ngrams_id = d.ngrams_id
AND nnn0.ngrams_type = d.ngrams_type
;
RETURN NULL;
END
$$ LANGUAGE plpgsql;
-- DROP trigger trigger_count_update_add on nodes_nodes;
CREATE TRIGGER trigger_count_update_add AFTER UPDATE on nodes_nodes
REFERENCING OLD TABLE AS OLD NEW TABLE AS NEW
FOR EACH ROW
WHEN (OLD.category <= 0 AND NEW.category >= 1)
EXECUTE PROCEDURE set_update_ngrams_add();
|]
triggerUpdateDel :: MasterListId -> Cmd err Int64
triggerUpdateDel lId = execPGSQuery query (lId, nodeTypeId NodeList)
where
query :: DPS.Query
query = [sql|
CREATE OR REPLACE FUNCTION set_update_ngrams_count_del() RETURNS trigger AS $$
BEGIN
UPDATE node_node_ngrams nnn0 SET weight = weight - d.fix_count
FROM (SELECT new1.node1_id as node1_id, lists.id as node2_id, nnn.ngrams_id as ngrams_id, nnn.ngrams_type as ngrams_type, count(*) as fix_count
FROM NEW as new1
INNER JOIN nodes lists ON new1.node1_id = lists.parent_id
INNER JOIN node_node_ngrams nnn ON new1.node2_id = nnn.node2_id
WHERE nnn.node1_id in (?, lists.id) -- (masterList_id, userLists)
AND lists.typename = ?
GROUP BY new1.node1_id, lists.id, nnn.ngrams_id, nnn.ngrams_type
) as d
WHERE nnn0.node1_id = d.node1_id
AND nnn0.node2_id = d.node2_id
AND nnn0.ngrams_id = d.ngrams_id
AND nnn0.ngrams_type = d.ngrams_type
;
RETURN NULL;
END
$$ LANGUAGE plpgsql;
-- DROP trigger trigger_count_delete2 on nodes_nodes;
CREATE TRIGGER trigger_count_delete2 AFTER UPDATE on nodes_nodes
REFERENCING OLD TABLE AS OLD NEW TABLE AS NEW
FOR EACH ROW
WHEN (OLD.category >= 1 AND NEW.category <= 0)
EXECUTE PROCEDURE set_update_ngrams_count_del();
|]
......@@ -120,12 +120,12 @@ nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
where
fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
catQuery :: PGS.Query
catQuery = [sql| UPDATE nodes_nodes as old SET
category = new.category
from (?) as new(node1_id,node2_id,category)
WHERE old.node1_id = new.node1_id
AND old.node2_id = new.node2_id
RETURNING new.node2_id
catQuery = [sql| UPDATE nodes_nodes as nn0
SET category = nn1.category
FROM (?) as nn1(node1_id,node2_id,category)
WHERE nn0.node1_id = nn1.node1_id
AND nn0.node2_id = nn1.node2_id
RETURNING nn1.node2_id
|]
------------------------------------------------------------------------
......@@ -187,12 +187,12 @@ nodesToTrash input = map (\(PGS.Only a) -> a)
where
fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","bool"]
trashQuery :: PGS.Query
trashQuery = [sql| UPDATE nodes_nodes as old SET
delete = new.delete
from (?) as new(node1_id,node2_id,delete)
WHERE old.node1_id = new.node1_id
AND old.node2_id = new.node2_id
RETURNING new.node2_id
trashQuery = [sql| UPDATE nodes_nodes as nn0 SET
delete = nn1.delete
from (?) as nn1(node1_id,node2_id,delete)
WHERE nn0.node1_id = nn1.node1_id
AND nn0.node2_id = nn1.node2_id
RETURNING nn1.node2_id
|]
-- | /!\ Really remove nodes in the Corpus or Annuaire
......
......@@ -23,7 +23,6 @@ module Gargantext.Database.Schema.NodeNodeNgrams
where
import Prelude
import Data.Maybe (Maybe)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Control.Lens.TH (makeLenses)
import Gargantext.Database.Utils (Cmd, mkCmd)
......@@ -34,9 +33,8 @@ import Opaleye
data NodeNodeNgramsPoly id' n1 n2 ngrams_id ngt w
= NodeNodeNgrams { _nnng_id :: id'
, _nnng_node1_id :: n1
data NodeNodeNgramsPoly n1 n2 ngrams_id ngt w
= NodeNodeNgrams { _nnng_node1_id :: n1
, _nnng_node2_id :: n2
, _nnng_ngrams_id :: ngrams_id
, _nnng_ngramsType :: ngt
......@@ -45,8 +43,7 @@ data NodeNodeNgramsPoly id' n1 n2 ngrams_id ngt w
type NodeNodeNgramsWrite =
NodeNodeNgramsPoly (Maybe (Column PGInt4 ))
(Column PGInt4 )
NodeNodeNgramsPoly (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
......@@ -57,7 +54,6 @@ type NodeNodeNgramsRead =
(Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGFloat8)
type NodeNodeNgramsReadNull =
......@@ -65,11 +61,10 @@ type NodeNodeNgramsReadNull =
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGFloat8))
type NodeNodeNgrams =
NodeNodeNgramsPoly (Maybe Int) CorpusId DocId NgramsId NgramsTypeId Double
NodeNodeNgramsPoly CorpusId DocId NgramsId NgramsTypeId Double
$(makeAdaptorAndInstance "pNodeNodeNgrams" ''NodeNodeNgramsPoly)
makeLenses ''NodeNodeNgramsPoly
......@@ -78,8 +73,7 @@ makeLenses ''NodeNodeNgramsPoly
nodeNodeNgramsTable :: Table NodeNodeNgramsWrite NodeNodeNgramsRead
nodeNodeNgramsTable = Table "node_node_ngrams"
( pNodeNodeNgrams NodeNodeNgrams
{ _nnng_id = optional "id"
, _nnng_node1_id = required "node1_id"
{ _nnng_node1_id = required "node1_id"
, _nnng_node2_id = required "node2_id"
, _nnng_ngrams_id = required "ngrams_id"
, _nnng_ngramsType = required "ngrams_type"
......@@ -94,9 +88,8 @@ queryNodeNodeNgramsTable = queryTable nodeNodeNgramsTable
-- | Insert utils
insertNodeNodeNgrams :: [NodeNodeNgrams] -> Cmd err Int
insertNodeNodeNgrams = insertNodeNodeNgramsW
. map (\(NodeNodeNgrams id'' n1 n2 ng nt w) ->
NodeNodeNgrams (pgInt4 <$> id'')
(pgNodeId n1)
. map (\(NodeNodeNgrams n1 n2 ng nt w) ->
NodeNodeNgrams (pgNodeId n1)
(pgNodeId n2)
(pgInt4 ng)
(pgNgramsTypeId nt)
......
{-|
Module : Gargantext.Database.Triggers
Description : Triggers configuration
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
Ngrams by node enable contextual metrics.
-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Gargantext.Database.Triggers
where
import Database.PostgreSQL.Simple.SqlQQ (sql)
-- import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Gargantext.Database.Config (nodeTypeId)
import Gargantext.Database.Types.Node -- (ListId, CorpusId, NodeId)
import Gargantext.Database.Utils (Cmd, runPGSQuery)
import Gargantext.Prelude
import qualified Database.PostgreSQL.Simple as DPS
------------------------------------------------------------------------
type MasterListId = ListId
insertOccsUpdates :: UserCorpusId -> MasterListId -> Cmd err [DPS.Only Int]
insertOccsUpdates cId lId = runPGSQuery query (cId, lId, nodeTypeId NodeList, nodeTypeId NodeDocument)
where
query :: DPS.Query
query = [sql|
INSERT INTO node_node_ngrams (node1_id, node2_id, ngrams_id, ngrams_type, weight)
SELECT nn.node1_id, lists.id, nnn.ngrams_id, 1, count(*) as c -- type of score
FROM node_node_ngrams nnn
INNER JOIN nodes_nodes nn ON nn.node2_id = nnn.node2_id
INNER JOIN nodes docs ON docs.id = nnn.node2_id
INNER JOIN nodes lists ON lists.parent_id = nn.node1_id
-- WHERE nn.node1_id = NEW.node1_id -- .node1_id -- corpus_id
WHERE nn.node1_id = ? -- .node1_id -- corpus_id
AND nnn.node1_id in (?, lists.id) -- (masterList_id, userLists)
AND lists.typename = ?
AND docs.typename = ?
GROUP BY nn.node1_id, lists.id, nnn.ngrams_id
ON CONFLICT (node1_id, node2_id, ngrams_id, ngrams_type)
DO UPDATE SET weight = 3 -- c -- excluded.weight
RETURNING 1
-- TOCHECK
|]
triggerOccsUpdates :: CorpusId -> ListId -> Cmd err [DPS.Only Int]
triggerOccsUpdates cId lId = runPGSQuery query (cId, lId, nodeTypeId NodeList, nodeTypeId NodeDocument)
where
query :: DPS.Query
query = [sql|
drop trigger trigger_occs on nodes_nodes;
CREATE OR REPLACE FUNCTION occs_update() RETURNS trigger AS
$$
BEGIN
IF TG_OP = 'UPDATE' THEN
INSERT INTO node_node_ngrams (node1_id, node2_id, ngrams_id, ngrams_type, weight)
-- TODO edge_type instead of ngrams_type
SELECT nn.node1_id, lists.id, nnn.ngrams_id, count(*), 1 -- type of score
FROM node_node_ngrams nnn
INNER JOIN nodes_nodes nn ON nn.node2_id = nnn.node2_id
INNER JOIN nodes docs ON docs.id = nnn.node2_id
INNER JOIN nodes lists ON lists.parent_id = nn.node1_id
-- WHERE nn.node1_id = NEW.node1_id -- .node1_id -- corpus_id
WHERE nn.node1_id = ? -- .node1_id -- corpus_id
AND nnn.node1_id in (?, lists.id) -- (masterList_id, userLists)
AND lists.typename = ?
AND docs.typename = ?
GROUP BY nn.node1_id, lists.id, nnn.ngrams_id
ON CONFLICT (node1_id, node2_id, ngrams_id, ngrams_type)
DO UPDATE SET weight = excluded.weight;
END IF;
RETURN NULL;
END $$
LANGUAGE plpgsql;
CREATE TRIGGER trigger_occs
AFTER UPDATE ON nodes_nodes
REFERENCING NEW TABLE AS NEW
FOR EACH STATEMENT
EXECUTE PROCEDURE occs_update();
update nodes_nodes SET node1_id = node1_id;
|]
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment