Skip to content

haskell-gargantext
haskell-gargantext
Commit 156790ff authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[WIP] backup during the vacations

parent 2d69d20f
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 1153 additions and 289 deletions
bin/gargantext-init/Main.hs
View file @ 156790ff
......@@ -39,7 +39,11 @@ secret = "Database secret to change"
main :: IO ()
main = do
[iniPath] <- getArgs
params@[iniPath] <- getArgs
_ <- if length params /= 1
then panic "USAGE: ./gargantext-init gargantext.ini"
else pure ()
putStrLn "Enter master user (gargantua) _password_ :"
password <- getLine
......
devops/postgres/create
View file @ 156790ff
......@@ -5,11 +5,11 @@
# postgresql://$USER:$PW@localhost/$DB
PW="C8kdcUrAQy66U"
DB="gargandbV5"
DB="gargandb1"
USER="gargantua"
psql -c "CREATE USER \"${USER}\""
psql -c "ALTER USER \"${USER}\" with PASSWORD '${PW}'"
#psql -c "CREATE USER \"${USER}\""
#psql -c "ALTER USER \"${USER}\" with PASSWORD '${PW}'"
psql -c "DROP DATABASE IF EXISTS \"${DB}\""
createdb "${DB}"
......
devops/postgres/schema.sql
View file @ 156790ff
This diff is collapsed.
src/Gargantext/Database/Action/Flow.hs
View file @ 156790ff
......@@ -94,7 +94,7 @@ import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.Node.Document.Insert -- (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..))
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Database.Query.Table.NodeNgrams (listInsertDb , getCgramsId)
import Gargantext.Database.Query.Table.NodeNodeNgrams2
import Gargantext.Database.Query.Table.ContextNodeNgrams2
import Gargantext.Database.Query.Tree.Root (getOrMkRoot, getOrMk_RootWithCorpus)
import Gargantext.Database.Schema.Node (NodePoly(..), node_id)
import Gargantext.Database.Types
......@@ -231,6 +231,9 @@ flow c u cn la mfslw docs logStatus = do
) (zip [1..] docs)
flowCorpusUser (la ^. tt_lang) u cn c (concat ids) mfslw
------------------------------------------------------------------------
flowCorpusUser :: ( FlowCmdM env err m
, MkCorpus c
......@@ -325,10 +328,10 @@ saveDocNgramsWith lId mapNgramsDocs' = do
$ HashMap.toList mapNgramsDocs
-- insertDocNgrams
_return <- insertNodeNodeNgrams2
$ catMaybes [ NodeNodeNgrams2 <$> Just nId
<*> getCgramsId mapCgramsId ngrams_type (_ngramsTerms terms'')
<*> Just (fromIntegral w :: Double)
_return <- insertContextNodeNgrams2
$ catMaybes [ ContextNodeNgrams2 <$> Just nId
<*> getCgramsId mapCgramsId ngrams_type (_ngramsTerms terms'')
<*> Just (fromIntegral w :: Double)
| (terms'', mapNgramsTypes) <- HashMap.toList mapNgramsDocs
, (ngrams_type, mapNodeIdWeight) <- Map.toList mapNgramsTypes
, (nId, w) <- Map.toList mapNodeIdWeight
......
src/Gargantext/Database/Action/Flow/Utils.hs
View file @ 156790ff
......@@ -17,7 +17,7 @@ import Data.Map (Map)
import Data.HashMap.Strict (HashMap)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (Cmd)
import Gargantext.Database.Query.Table.NodeNodeNgrams
import Gargantext.Database.Query.Table.ContextNodeNgrams
import Gargantext.Database.Schema.Ngrams
import Gargantext.Database.Types
import Gargantext.Prelude
......@@ -31,11 +31,11 @@ data DocumentIdWithNgrams a b =
, documentNgrams :: HashMap b (Map NgramsType Int)
} deriving (Show)
docNgrams2nodeNodeNgrams :: CorpusId
docNgrams2contextNodeNgrams :: CorpusId
-> DocNgrams
-> NodeNodeNgrams
docNgrams2nodeNodeNgrams cId (DocNgrams d n nt w) =
NodeNodeNgrams cId d n nt w
-> ContextNodeNgrams
docNgrams2contextNodeNgrams cId (DocNgrams d n nt w) =
ContextNodeNgrams cId d n nt w
data DocNgrams = DocNgrams { dn_doc_id :: DocId
, dn_ngrams_id :: Int
......@@ -47,8 +47,8 @@ insertDocNgramsOn :: CorpusId
-> [DocNgrams]
-> Cmd err Int
insertDocNgramsOn cId dn =
insertNodeNodeNgrams
$ (map (docNgrams2nodeNodeNgrams cId) dn)
insertContextNodeNgrams
$ (map (docNgrams2contextNodeNgrams cId) dn)
insertDocNgrams :: CorpusId
-> HashMap (Indexed Int Ngrams) (Map NgramsType (Map NodeId Int))
......
src/Gargantext/Database/Action/Metrics/NgramsByNode.hs
View file @ 156790ff
......@@ -81,16 +81,16 @@ getNodesByNgramsUser cId nt =
queryNgramsByNodeUser :: DPS.Query
queryNgramsByNodeUser = [sql|
SELECT nng.node2_id, ng.terms FROM node_node_ngrams nng
JOIN ngrams ng ON nng.ngrams_id = ng.id
JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id
SELECT cng.node_id, ng.terms FROM context_node_ngrams cng
JOIN ngrams ng ON cng.ngrams_id = ng.id
JOIN nodes_nodes nn ON nn.node2_id = cng.node_id
JOIN nodes n ON nn.node2_id = n.id
WHERE nn.node1_id = ? -- CorpusId
AND n.typename = ? -- toDBid
AND nng.ngrams_type = ? -- NgramsTypeId
AND cng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0
GROUP BY nng.node2_id, ng.terms
ORDER BY (nng.node2_id, ng.terms) DESC
GROUP BY cng.node_id, ng.terms
ORDER BY (cng.node_id, ng.terms) DESC
-- LIMIT ?
-- OFFSET ?
|]
......@@ -143,14 +143,14 @@ getOccByNgramsOnlyFast' cId lId nt tms = trace (show (cId, lId)) $
query :: DPS.Query
query = [sql|
WITH input_rows(terms) AS (?)
SELECT ng.terms, nng.weight FROM node_node_ngrams nng
JOIN ngrams ng ON nng.ngrams_id = ng.id
SELECT ng.terms, cng.weight FROM context_node_ngrams cng
JOIN ngrams ng ON cng.ngrams_id = ng.id
JOIN input_rows ir ON ir.terms = ng.terms
WHERE nng.node1_id = ? -- CorpusId
AND nng.node2_id = ? -- ListId
AND nng.ngrams_type = ? -- NgramsTypeId
WHERE cng.context_id = ? -- CorpusId
AND cng.node_id = ? -- ListId
AND cng.ngrams_type = ? -- NgramsTypeId
-- AND nn.category > 0 -- TODO
GROUP BY ng.terms, nng.weight
GROUP BY ng.terms, cng.weight
|]
......@@ -210,16 +210,16 @@ selectNgramsOccurrencesOnlyByNodeUser cId nt tms =
queryNgramsOccurrencesOnlyByNodeUser :: DPS.Query
queryNgramsOccurrencesOnlyByNodeUser = [sql|
WITH input_rows(terms) AS (?)
SELECT ng.terms, COUNT(nng.node2_id) FROM node_node_ngrams nng
JOIN ngrams ng ON nng.ngrams_id = ng.id
SELECT ng.terms, COUNT(cng.node_id) FROM context_node_ngrams cng
JOIN ngrams ng ON cng.ngrams_id = ng.id
JOIN input_rows ir ON ir.terms = ng.terms
JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id
JOIN nodes n ON nn.node2_id = n.id
JOIN nodes_nodes nn ON nn.node_id = cng.node_id
JOIN nodes n ON nn.node_id = n.id
WHERE nn.node1_id = ? -- CorpusId
AND n.typename = ? -- toDBid
AND nng.ngrams_type = ? -- NgramsTypeId
AND cng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0
GROUP BY nng.node2_id, ng.terms
GROUP BY cng.node_id, ng.terms
|]
......@@ -249,15 +249,15 @@ queryNgramsOccurrencesOnlyByNodeUser_withSample = [sql|
WHERE n.typename = ?
AND nn.node1_id = ?),
input_rows(terms) AS (?)
SELECT ng.terms, COUNT(nng.node2_id) FROM node_node_ngrams nng
JOIN ngrams ng ON nng.ngrams_id = ng.id
SELECT ng.terms, COUNT(cng.node_id) FROM context_node_ngrams cng
JOIN ngrams ng ON cng.ngrams_id = ng.id
JOIN input_rows ir ON ir.terms = ng.terms
JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id
JOIN nodes_nodes nn ON nn.node2_id = cng.node_id
JOIN nodes_sample n ON nn.node2_id = n.id
WHERE nn.node1_id = ? -- CorpusId
AND nng.ngrams_type = ? -- NgramsTypeId
AND cng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0
GROUP BY nng.node2_id, ng.terms
GROUP BY cng.node_id, ng.terms
|]
......@@ -265,16 +265,16 @@ queryNgramsOccurrencesOnlyByNodeUser_withSample = [sql|
queryNgramsOccurrencesOnlyByNodeUser' :: DPS.Query
queryNgramsOccurrencesOnlyByNodeUser' = [sql|
WITH input_rows(terms) AS (?)
SELECT ng.terms, COUNT(nng.node2_id) FROM node_node_ngrams nng
JOIN ngrams ng ON nng.ngrams_id = ng.id
SELECT ng.terms, COUNT(cng.node_id) FROM context_node_ngrams cng
JOIN ngrams ng ON cng.ngrams_id = ng.id
JOIN input_rows ir ON ir.terms = ng.terms
JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id
JOIN nodes_nodes nn ON nn.node2_id = cng.node_id
JOIN nodes n ON nn.node2_id = n.id
WHERE nn.node1_id = ? -- CorpusId
AND n.typename = ? -- toDBid
AND nng.ngrams_type = ? -- NgramsTypeId
AND cng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0
GROUP BY nng.node2_id, ng.terms
GROUP BY cng.node_id, ng.terms
|]
------------------------------------------------------------------------
......@@ -331,17 +331,17 @@ queryNgramsOnlyByNodeUser :: DPS.Query
queryNgramsOnlyByNodeUser = [sql|
WITH input_rows(terms) AS (?),
input_list(id) AS (?)
SELECT ng.terms, nng.node2_id FROM node_node_ngrams nng
JOIN ngrams ng ON nng.ngrams_id = ng.id
SELECT ng.terms, cng.node_id FROM context_node_ngrams cng
JOIN ngrams ng ON cng.ngrams_id = ng.id
JOIN input_rows ir ON ir.terms = ng.terms
JOIN input_list il ON il.id = nng.node1_id
JOIN nodes_nodes nn ON nn.node2_id = nng.node2_id
JOIN input_list il ON il.id = cng.context_id
JOIN nodes_nodes nn ON nn.node2_id = cng.node_id
JOIN nodes n ON nn.node2_id = n.id
WHERE nn.node1_id = ? -- CorpusId
AND n.typename = ? -- toDBid
AND nng.ngrams_type = ? -- NgramsTypeId
AND cng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0
GROUP BY ng.terms, nng.node2_id
GROUP BY ng.terms, cng.node_id
|]
......@@ -367,14 +367,14 @@ queryNgramsOnlyByNodeUser' :: DPS.Query
queryNgramsOnlyByNodeUser' = [sql|
WITH input_rows(terms) AS (?),
input_list(id) AS (?)
SELECT ng.terms, nng.weight FROM node_node_ngrams nng
JOIN ngrams ng ON nng.ngrams_id = ng.id
SELECT ng.terms, cng.weight FROM context_node_ngrams cng
JOIN ngrams ng ON cng.ngrams_id = ng.id
JOIN input_rows ir ON ir.terms = ng.terms
JOIN input_list il ON il.id = nng.node2_id
WHERE nng.node1_id = ? -- CorpusId
AND nng.ngrams_type = ? -- NgramsTypeId
JOIN input_list il ON il.id = cng.node_id
WHERE cng.context_id = ? -- CorpusId
AND cng.ngrams_type = ? -- NgramsTypeId
-- AND nn.category > 0
GROUP BY ng.terms, nng.weight
GROUP BY ng.terms, cng.weight
|]
......@@ -411,13 +411,13 @@ queryNgramsOnlyByDocUser :: DPS.Query
queryNgramsOnlyByDocUser = [sql|
WITH input_rows(terms) AS (?),
input_list(id) AS (?)
SELECT ng.terms, nng.node2_id FROM node_node_ngrams nng
JOIN ngrams ng ON nng.ngrams_id = ng.id
SELECT ng.terms, cng.node_id FROM context_node_ngrams cng
JOIN ngrams ng ON cng.ngrams_id = ng.id
JOIN input_rows ir ON ir.terms = ng.terms
JOIN input_list il ON il.id = nng.node1_id
WHERE nng.node2_id = ? -- DocId
AND nng.ngrams_type = ? -- NgramsTypeId
GROUP BY ng.terms, nng.node2_id
JOIN input_list il ON il.id = cng.context_id
WHERE cng.node_id = ? -- DocId
AND cng.ngrams_type = ? -- NgramsTypeId
GROUP BY ng.terms, cng.node_id
|]
------------------------------------------------------------------------
......@@ -450,18 +450,18 @@ selectNgramsByNodeMaster n ucId mcId p = runPGSQuery
, ngramsTypeId NgramsTerms
)
-- | TODO fix node_node_ngrams relation
-- | TODO fix context_node_ngrams relation
queryNgramsByNodeMaster' :: DPS.Query
queryNgramsByNodeMaster' = [sql|
WITH nodesByNgramsUser AS (
SELECT n.id, ng.terms FROM nodes n
JOIN nodes_nodes nn ON n.id = nn.node2_id
JOIN node_node_ngrams nng ON nng.node2_id = n.id
JOIN ngrams ng ON nng.ngrams_id = ng.id
JOIN context_node_ngrams cng ON cng.node_id = n.id
JOIN ngrams ng ON cng.ngrams_id = ng.id
WHERE nn.node1_id = ? -- UserCorpusId
-- AND n.typename = ? -- toDBid
AND nng.ngrams_type = ? -- NgramsTypeId
AND cng.ngrams_type = ? -- NgramsTypeId
AND nn.category > 0
AND node_pos(n.id,?) >= ?
AND node_pos(n.id,?) < ?
......@@ -472,12 +472,12 @@ queryNgramsByNodeMaster' = [sql|
nodesByNgramsMaster AS (
SELECT n.id, ng.terms FROM nodes n TABLESAMPLE SYSTEM_ROWS(?)
JOIN node_node_ngrams nng ON n.id = nng.node2_id
JOIN ngrams ng ON ng.id = nng.ngrams_id
JOIN context_node_ngrams cng ON n.id = cng.node_id
JOIN ngrams ng ON ng.id = cng.ngrams_id
WHERE n.parent_id = ? -- Master Corpus toDBid
AND n.typename = ? -- toDBid
AND nng.ngrams_type = ? -- NgramsTypeId
AND cng.ngrams_type = ? -- NgramsTypeId
GROUP BY n.id, ng.terms
)
......
src/Gargantext/Database/Admin/Trigger/NodeNodeNgrams.hs → src/Gargantext/Database/Admin/Trigger/ContextNodeNgrams.hs
View file @ 156790ff
......@@ -13,7 +13,7 @@ Triggers on NodeNodeNgrams table.
{-# LANGUAGE QuasiQuotes #-}
module Gargantext.Database.Admin.Trigger.NodeNodeNgrams
module Gargantext.Database.Admin.Trigger.ContextNodeNgrams
where
import Database.PostgreSQL.Simple.SqlQQ (sql)
......@@ -35,16 +35,16 @@ triggerCountInsert = execPGSQuery query (toDBid NodeDocument, toDBid NodeList)
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
INSERT INTO context_node_ngrams (context_id, node_id, ngrams_id, ngrams_type, weight)
select n.parent_id, n.id, new0.ngrams_id, new0.ngrams_type, count(*) from NEW as new0
INNER JOIN contexts n ON n.id = new0.context_id
INNER JOIN nodes n2 ON n2.id = new0.node_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
GROUP BY n.parent_id, n.id, new0.ngrams_id, new0.ngrams_type
ON CONFLICT (context_id, node_id, ngrams_id, ngrams_type)
DO UPDATE set weight = context_node_ngrams.weight + excluded.weight
;
END IF;
......@@ -52,9 +52,9 @@ triggerCountInsert = execPGSQuery query (toDBid NodeDocument, toDBid NodeList)
END
$$ LANGUAGE plpgsql;
-- DROP trigger trigger_count_insert on node_node_ngrams;
-- DROP trigger trigger_count_insert on context_node_ngrams;
CREATE TRIGGER trigger_count_insert AFTER INSERT on node_node_ngrams
CREATE TRIGGER trigger_count_insert AFTER INSERT on context_node_ngrams
REFERENCING NEW TABLE AS NEW
FOR EACH STATEMENT
EXECUTE PROCEDURE set_ngrams_global_count();
......@@ -74,11 +74,11 @@ triggerCountInsert2 = execPGSQuery query ( toDBid NodeCorpus
RETURN NEW;
END IF;
IF TG_OP = 'INSERT' THEN
INSERT INTO node_node_ngrams2 (node_id, nodengrams_id, weight)
SELECT corpus.id, nng.id, count(*) from NEW as new1
INNER JOIN node_ngrams nng ON nng.id = new1.nodengrams_id
INNER JOIN nodes list ON list.id = nng.node_id
INNER JOIN nodes_nodes nn ON nn.node2_id = new1.node_id
INSERT INTO context_node_ngrams2 (context_id, nodengrams_id, weight)
SELECT corpus.id, nng.id, count(*) from NEW as new3
INNER JOIN node_ngrams nng ON nng.id = new3.nodengrams_id
INNER JOIN nodes list ON list.id = nng.node_id
INNER JOIN nodes_nodes nn ON nn.node2_id = new3.context_id
INNER JOIN nodes corpus ON corpus.id = nn.node1_id
INNER JOIN nodes doc ON doc.id = nn.node2_id
WHERE corpus.typename = ? -- 30 -- corpus
......@@ -86,8 +86,8 @@ triggerCountInsert2 = execPGSQuery query ( toDBid NodeCorpus
AND list.typename = ? -- 5 -- list
GROUP BY corpus.id, nng.id
ON CONFLICT (node_id, nodengrams_id)
DO UPDATE set weight = node_node_ngrams2.weight + excluded.weight
ON CONFLICT (context_id, nodengrams_id)
DO UPDATE set weight = context_node_ngrams2.weight + excluded.weight
;
END IF;
......@@ -95,15 +95,16 @@ triggerCountInsert2 = execPGSQuery query ( toDBid NodeCorpus
END
$$ LANGUAGE plpgsql;
-- DROP trigger trigger_count_insert2 on node_node_ngrams2;
-- DROP trigger trigger_count_insert2 on context_node_ngrams2;
CREATE TRIGGER trigger_count_insert2 AFTER INSERT on node_node_ngrams2
CREATE TRIGGER trigger_count_insert2 AFTER INSERT on context_node_ngrams2
REFERENCING NEW TABLE AS NEW
FOR EACH STATEMENT
EXECUTE PROCEDURE set_ngrams_global_count2();
|]
-- TODO add the groups
-- TODO use context instead of nodes of type doc
triggerCoocInsert :: HasDBid NodeType => Cmd err Int64
triggerCoocInsert = execPGSQuery query ( toDBid NodeCorpus
, toDBid NodeDocument
......@@ -122,10 +123,10 @@ triggerCoocInsert = execPGSQuery query ( toDBid NodeCorpus
IF TG_OP = 'INSERT' THEN
INSERT INTO node_nodengrams_nodengrams (node_id, node_ngrams1_id, node_ngrams2_id, weight)
WITH input(corpus_id, nn1, nn2, weight) AS (
SELECT corpus.id, nng1.id, nng2.id, count(*) from NEW as new1
INNER JOIN node_ngrams nng1 ON nng1.id = new1.nodengrams_id
SELECT corpus.id, nng1.id, nng2.id, count(*) from NEW as new2
INNER JOIN node_ngrams nng1 ON nng1.id = new2.nodengrams_id
INNER JOIN nodes list ON list.id = nng1.node_id
INNER JOIN nodes_nodes nn ON nn.node2_id = new1.node_id
INNER JOIN nodes_nodes nn ON nn.node2_id = new2.node_id
INNER JOIN nodes corpus ON corpus.id = nn.node1_id
INNER JOIN nodes doc ON doc.id = nn.node2_id
......@@ -159,4 +160,3 @@ triggerCoocInsert = execPGSQuery query ( toDBid NodeCorpus
FOR EACH STATEMENT
EXECUTE PROCEDURE set_cooc();
|]
src/Gargantext/Database/Admin/Trigger/Init.hs
View file @ 156790ff
......@@ -17,7 +17,7 @@ module Gargantext.Database.Admin.Trigger.Init
where
import Data.Text (Text)
import Gargantext.Database.Admin.Trigger.NodeNodeNgrams (triggerCountInsert, triggerCountInsert2)
import Gargantext.Database.Admin.Trigger.ContextNodeNgrams (triggerCountInsert, triggerCountInsert2)
import Gargantext.Database.Admin.Trigger.Nodes (triggerSearchUpdate, triggerUpdateHash)
import Gargantext.Database.Admin.Trigger.NodesNodes (triggerDeleteCount, triggerInsertCount, triggerUpdateAdd, triggerUpdateDel, MasterListId) -- , triggerCoocInsert)
import Gargantext.Database.Prelude (Cmd)
......@@ -34,7 +34,7 @@ initLastTriggers lId = do
t0 <- triggerSearchUpdate
t1 <- triggerCountInsert
t1' <- triggerCountInsert2
-- t1'' <- triggerCoocInsert lId
-- t1'' <- triggerCoocInsert lId
t2 <- triggerDeleteCount lId
t3 <- triggerInsertCount lId
t4 <- triggerUpdateAdd lId
......
src/Gargantext/Database/Admin/Trigger/Nodes.hs
View file @ 156790ff
......@@ -33,7 +33,7 @@ triggerSearchUpdate = execPGSQuery query ( toDBid NodeDocument
where
query :: DPS.Query
query = [sql|
-- DROP TRIGGER search_update_trigger on nodes;
-- DROP TRIGGER search_update_trigger on contexts;
CREATE OR REPLACE FUNCTION public.search_update()
RETURNS trigger AS $$
begin
......@@ -59,11 +59,11 @@ triggerSearchUpdate = execPGSQuery query ( toDBid NodeDocument
CREATE TRIGGER search_update_trigger
BEFORE INSERT OR UPDATE
ON nodes FOR EACH ROW
ON contexts FOR EACH ROW
EXECUTE PROCEDURE search_update();
-- Initialize index with already existing data
UPDATE nodes SET hyperdata = hyperdata;
UPDATE contexts SET hyperdata = hyperdata;
|]
......@@ -113,6 +113,9 @@ triggerUpdateHash secret = execPGSQuery query ( toDBid NodeDocument
CREATE TRIGGER nodes_hash_insert BEFORE INSERT ON nodes FOR EACH ROW EXECUTE PROCEDURE hash_insert_nodes();
CREATE TRIGGER nodes_hash_update BEFORE UPDATE ON nodes FOR EACH ROW EXECUTE PROCEDURE hash_update_nodes();
CREATE TRIGGER contexts_hash_insert BEFORE INSERT ON contexts FOR EACH ROW EXECUTE PROCEDURE hash_insert_nodes();
CREATE TRIGGER contexts_hash_update BEFORE UPDATE ON nodes FOR EACH ROW EXECUTE PROCEDURE hash_update_nodes();
|]
src/Gargantext/Database/Admin/Types/Node.hs
View file @ 156790ff
......@@ -46,13 +46,24 @@ import Text.Read (read)
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
-- import Gargantext.Database.Prelude (fromField')
import Gargantext.Database.Schema.Node
import Gargantext.Database.Schema.Context
import Gargantext.Prelude
type UserId = Int
type MasterUserId = UserId
type NodeTypeId = Int
type NodeName = Text
type ContextName = Text
type TSVector = Text
type ContextTitle = Text
------------------------------------------------------------------------
-- | NodePoly indicates that Node has a Polymorphism Type
type Node json = NodePoly NodeId (Maybe Hash) NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
type Node json = NodePoly NodeId (Maybe Hash) NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
type Context json = ContextPoly NodeId (Maybe Hash) NodeTypeId UserId (Maybe ParentId) ContextTitle UTCTime json
-- | NodeSearch (queries)
-- type NodeSearch json = NodePolySearch NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json (Maybe TSVector)
......@@ -120,6 +131,8 @@ instance (Arbitrary nodeId
<*> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary
instance (Arbitrary hyperdata
,Arbitrary nodeId
,Arbitrary toDBid
......@@ -144,6 +157,47 @@ instance (Arbitrary hyperdata
<*> arbitrary
<*> arbitrary
instance (Arbitrary contextId
,Arbitrary hashId
,Arbitrary toDBid
,Arbitrary userId
,Arbitrary contextParentId
, Arbitrary hyperdata
) => Arbitrary (ContextPoly contextId hashId toDBid userId contextParentId
ContextName UTCTime hyperdata) where
--arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
arbitrary = Context <$> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary
instance (Arbitrary hyperdata
,Arbitrary contextId
,Arbitrary toDBid
,Arbitrary userId
,Arbitrary contextParentId
) => Arbitrary (ContextPolySearch contextId
toDBid
userId
contextParentId
ContextName
UTCTime
hyperdata
(Maybe TSVector)
) where
--arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
arbitrary = ContextSearch <$> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
------------------------------------------------------------------------
pgNodeId :: NodeId -> O.Column O.SqlInt4
pgNodeId = O.sqlInt4 . id2int
......@@ -151,9 +205,16 @@ pgNodeId = O.sqlInt4 . id2int
id2int :: NodeId -> Int
id2int (NodeId n) = n
pgContextId :: ContextId -> O.Column O.SqlInt4
pgContextId = pgNodeId
------------------------------------------------------------------------
newtype NodeId = NodeId Int
deriving (Read, Generic, Num, Eq, Ord, Enum, ToJSONKey, FromJSONKey, ToJSON, FromJSON, Hashable, Csv.ToField)
-- TODO make another type?
type ContextId = NodeId
instance GQLType NodeId
instance Show NodeId where
show (NodeId n) = "nodeId-" <> show n
......@@ -173,10 +234,6 @@ instance ToSchema NodeId
unNodeId :: NodeId -> Int
unNodeId (NodeId n) = n
type NodeTypeId = Int
type NodeName = Text
type TSVector = Text
------------------------------------------------------------------------
------------------------------------------------------------------------
instance FromHttpApiData NodeId where
......
src/Gargantext/Database/Query/Facet.hs
View file @ 156790ff
This diff is collapsed.
src/Gargantext/Database/Query/Join.hs
View file @ 156790ff
......@@ -77,10 +77,9 @@ leftJoin3 :: ( Default Unpackspec b2 b2
-> ((b3, fieldsR) -> Column SqlBool)
-> ((fieldsL, (b3, b2)) -> Column SqlBool)
-> Select (fieldsL, (b4, b5))
leftJoin3 q1 q2 q3
cond12 cond23 =
leftJoin q3 ( leftJoin q2 q1 cond12) cond23
leftJoin q3 (leftJoin q2 q1 cond12) cond23
leftJoin4 :: (Default Unpackspec b2 b2,
......
src/Gargantext/Database/Query/Table/Context.hs 0 → 100644
View file @ 156790ff
{-|
import Gargantext.Database.Prelude (Cmd, runPGSQuery)
Module : Gargantext.Database.Query.Table.Node
Description : Main Tools of Node to the database
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module Gargantext.Database.Query.Table.Context
where
import Control.Arrow (returnA)
import Gargantext.Core
import Gargantext.Core.Types
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Prelude
import Gargantext.Database.Query.Filter (limit', offset')
import Gargantext.Database.Query.Table.Node.Error
import Gargantext.Database.Schema.Context
import Gargantext.Prelude hiding (sum, head)
import Opaleye hiding (FromField)
import Prelude hiding (null, id, map, sum)
queryContextSearchTable :: Select ContextSearchRead
queryContextSearchTable = selectTable contextTableSearch
selectContext :: Column SqlInt4 -> Select ContextRead
selectContext id' = proc () -> do
row <- queryContextTable -< ()
restrict -< _context_id row .== id'
returnA -< row
runGetContexts :: Select ContextRead -> Cmd err [Context HyperdataAny]
runGetContexts = runOpaQuery
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | order by publication date
-- Favorites (Bool), node_ngrams
selectContextsWith :: HasDBid NodeType
=> ParentId -> Maybe NodeType
-> Maybe Offset -> Maybe Limit -> Select ContextRead
selectContextsWith parentId maybeContextType maybeOffset maybeLimit =
--offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId
limit' maybeLimit $ offset' maybeOffset
$ orderBy (asc _context_id)
$ selectContextsWith' parentId maybeContextType
selectContextsWith' :: HasDBid NodeType
=> ParentId -> Maybe NodeType -> Select ContextRead
selectContextsWith' parentId maybeContextType = proc () -> do
context' <- (proc () -> do
row@(Context _ _ typeId _ parentId' _ _ _) <- queryContextTable -< ()
restrict -< parentId' .== (pgNodeId parentId)
let typeId' = maybe 0 toDBid maybeContextType
restrict -< if typeId' > 0
then typeId .== (sqlInt4 (typeId' :: Int))
else (sqlBool True)
returnA -< row ) -< ()
returnA -< context'
------------------------------------------------------------------------
getDocumentsV3WithParentId :: HasDBid NodeType => NodeId -> Cmd err [Context HyperdataDocumentV3]
getDocumentsV3WithParentId n = runOpaQuery $ selectContextsWith' n (Just NodeDocument)
-- TODO: merge with getDocumentsWithParentId by having a class IsHyperdataDocument
getDocumentsWithParentId :: HasDBid NodeType => NodeId -> Cmd err [Context HyperdataDocument]
getDocumentsWithParentId n = runOpaQuery $ selectContextsWith' n (Just NodeDocument)
------------------------------------------------------------------------
selectContextsWithParentID :: NodeId -> Select ContextRead
selectContextsWithParentID n = proc () -> do
row@(Context _ _ _ _ parent_id _ _ _) <- queryContextTable -< ()
restrict -< parent_id .== (pgNodeId n)
returnA -< row
------------------------------------------------------------------------
-- | Example of use:
-- runCmdReplEasy (getNodesWithType NodeList (Proxy :: Proxy HyperdataList))
getContextsWithType :: (HasNodeError err, JSONB a, HasDBid NodeType) => NodeType -> proxy a -> Cmd err [Context a]
getContextsWithType nt _ = runOpaQuery $ selectContextsWithType nt
where
selectContextsWithType :: HasDBid NodeType
=> NodeType -> Select ContextRead
selectContextsWithType nt' = proc () -> do
row@(Context _ _ tn _ _ _ _ _) <- queryContextTable -< ()
restrict -< tn .== (sqlInt4 $ toDBid nt')
returnA -< row
getContextsIdWithType :: (HasNodeError err, HasDBid NodeType) => NodeType -> Cmd err [ContextId]
getContextsIdWithType nt = do
ns <- runOpaQuery $ selectContextsIdWithType nt
pure (map NodeId ns)
selectContextsIdWithType :: HasDBid NodeType
=> NodeType -> Select (Column SqlInt4)
selectContextsIdWithType nt = proc () -> do
row@(Context _ _ tn _ _ _ _ _) <- queryContextTable -< ()
restrict -< tn .== (sqlInt4 $ toDBid nt)
returnA -< _context_id row
------------------------------------------------------------------------
src/Gargantext/Database/Query/Table/ContextNodeNgrams.hs 0 → 100644
View file @ 156790ff
{-|
Module : Gargantext.Database.Schema.NodeNodeNgrams
Description : TODO: remove this module and table in database
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Query.Table.ContextNodeNgrams
( module Gargantext.Database.Schema.ContextNodeNgrams
, queryContextNodeNgramsTable
, insertContextNodeNgrams
)
where
import Gargantext.Database.Admin.Types.Node (pgNodeId, pgContextId)
import Gargantext.Database.Prelude (Cmd, mkCmd)
import Gargantext.Database.Schema.Ngrams (pgNgramsTypeId)
import Gargantext.Database.Schema.ContextNodeNgrams
import Gargantext.Database.Schema.Prelude
import Prelude
queryContextNodeNgramsTable :: Query ContextNodeNgramsRead
queryContextNodeNgramsTable = selectTable contextNodeNgramsTable
-- | Insert utils
insertContextNodeNgrams :: [ContextNodeNgrams] -> Cmd err Int
insertContextNodeNgrams = insertContextNodeNgramsW
. map (\(ContextNodeNgrams c n ng nt w) ->
ContextNodeNgrams (pgContextId c)
(pgNodeId n)
(sqlInt4 ng)
(pgNgramsTypeId nt)
(sqlDouble w)
)
insertContextNodeNgramsW :: [ContextNodeNgramsWrite] -> Cmd err Int
insertContextNodeNgramsW nnnw =
mkCmd $ \c -> fromIntegral <$> runInsert_ c insertNothing
where
insertNothing = Insert { iTable = contextNodeNgramsTable
, iRows = nnnw
, iReturning = rCount
, iOnConflict = (Just DoNothing)
}
src/Gargantext/Database/Query/Table/NodeNodeNgrams2.hs → src/Gargantext/Database/Query/Table/ContextNodeNgrams2.hs
View file @ 156790ff
......@@ -15,36 +15,36 @@ Portability : POSIX
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Query.Table.NodeNodeNgrams2
( module Gargantext.Database.Schema.NodeNodeNgrams2
, insertNodeNodeNgrams2
module Gargantext.Database.Query.Table.ContextNodeNgrams2
( module Gargantext.Database.Schema.ContextNodeNgrams2
, insertContextNodeNgrams2
)
where
import Gargantext.Database.Schema.Prelude
import Gargantext.Database.Schema.NodeNodeNgrams2
import Gargantext.Database.Schema.ContextNodeNgrams2
import Gargantext.Database.Admin.Types.Node (pgNodeId)
import Gargantext.Database.Prelude (Cmd, mkCmd)
import Prelude
_queryNodeNodeNgrams2Table :: Query NodeNodeNgrams2Read
_queryNodeNodeNgrams2Table = selectTable nodeNodeNgrams2Table
_queryContextNodeNgrams2Table :: Query ContextNodeNgrams2Read
_queryContextNodeNgrams2Table = selectTable contextNodeNgrams2Table
-- | Insert utils
insertNodeNodeNgrams2 :: [NodeNodeNgrams2] -> Cmd err Int
insertNodeNodeNgrams2 = insertNodeNodeNgrams2W
. map (\(NodeNodeNgrams2 n1 n2 w) ->
NodeNodeNgrams2 (pgNodeId n1)
(sqlInt4 n2)
(sqlDouble w)
insertContextNodeNgrams2 :: [ContextNodeNgrams2] -> Cmd err Int
insertContextNodeNgrams2 = insertContextNodeNgrams2W
. map (\(ContextNodeNgrams2 n1 n2 w) ->
ContextNodeNgrams2 (pgNodeId n1)
(sqlInt4 n2)
(sqlDouble w)
)
insertNodeNodeNgrams2W :: [NodeNodeNgrams2Write] -> Cmd err Int
insertNodeNodeNgrams2W nnnw =
insertContextNodeNgrams2W :: [ContextNodeNgrams2Write] -> Cmd err Int
insertContextNodeNgrams2W nnnw =
mkCmd $ \c -> fromIntegral <$> runInsert_ c insertNothing
where
insertNothing = Insert { iTable = nodeNodeNgrams2Table
insertNothing = Insert { iTable = contextNodeNgrams2Table
, iRows = nnnw
, iReturning = rCount
, iOnConflict = (Just DoNothing)
......
src/Gargantext/Database/Query/Table/Ngrams.hs
View file @ 156790ff
......@@ -32,7 +32,7 @@ import qualified Data.HashMap.Strict as HashMap
import Gargantext.Core.Types
import Gargantext.Database.Prelude (runOpaQuery, Cmd)
import Gargantext.Database.Prelude (runPGSQuery, formatPGSQuery)
import Gargantext.Database.Query.Table.NodeNodeNgrams
import Gargantext.Database.Query.Table.ContextNodeNgrams
import Gargantext.Database.Schema.Ngrams
import Gargantext.Database.Schema.Prelude
import Gargantext.Database.Types
......@@ -45,16 +45,16 @@ selectNgramsByDoc :: [ListId] -> DocId -> NgramsType -> Cmd err [Text]
selectNgramsByDoc lIds dId nt = runOpaQuery (query lIds dId nt)
where
join :: Query (NgramsRead, NodeNodeNgramsReadNull)
join = leftJoin queryNgramsTable queryNodeNodeNgramsTable on1
join :: Query (NgramsRead, ContextNodeNgramsReadNull)
join = leftJoin queryNgramsTable queryContextNodeNgramsTable on1
where
on1 (ng,nnng) = ng^.ngrams_id .== nnng^.nnng_ngrams_id
on1 (ng,cnng) = ng^.ngrams_id .== cnng^.cnng_ngrams_id
query cIds' dId' nt' = proc () -> do
(ng,nnng) <- join -< ()
restrict -< foldl (\b cId -> ((toNullable $ pgNodeId cId) .== nnng^.nnng_node1_id) .|| b) (sqlBool True) cIds'
restrict -< (toNullable $ pgNodeId dId') .== nnng^.nnng_node2_id
restrict -< (toNullable $ pgNgramsType nt') .== nnng^.nnng_ngramsType
(ng,cnng) <- join -< ()
restrict -< foldl (\b cId -> ((toNullable $ pgNodeId cId) .== cnng^.cnng_node_id) .|| b) (sqlBool True) cIds'
restrict -< (toNullable $ pgNodeId dId') .== cnng^.cnng_context_id
restrict -< (toNullable $ pgNgramsType nt') .== cnng^.cnng_ngramsType
returnA -< ng^.ngrams_terms
......
src/Gargantext/Database/Query/Table/Node/Document/Add.hs
View file @ 156790ff
......@@ -54,10 +54,10 @@ inputSqlTypes = ["int4","int4","int4"]
-- TODO return id of added documents only
queryAdd :: Query
queryAdd = [sql|
WITH input_rows(node1_id,node2_id,category) AS (?)
INSERT INTO nodes_nodes (node1_id, node2_id,category)
WITH input_rows(node_id,context_id,category) AS (?)
INSERT INTO nodes_contexts (node_id, context_id,category)
SELECT * FROM input_rows
ON CONFLICT (node1_id, node2_id) DO NOTHING -- on unique index
ON CONFLICT (node_id, context_id) DO NOTHING -- on unique index
RETURNING 1
;
|]
......
src/Gargantext/Database/Query/Table/Node/Document/Insert.hs
View file @ 156790ff
......@@ -90,7 +90,7 @@ import Database.PostgreSQL.Simple (formatQuery)
-- UserId : user who is inserting the documents
-- ParentId : folder ID which is parent of the inserted documents
-- Administrator of the database has to create a uniq index as following SQL command:
-- `create unique index on nodes (typename, parent_id, (hyperdata ->> 'uniqId'));`
-- `create unique index on contexts table (typename, parent_id, (hyperdata ->> 'uniqId'));`
insertDb :: (InsertDb a, HasDBid NodeType) => UserId -> ParentId -> [a] -> Cmd err [ReturnId]
insertDb u p = runPGSQuery queryInsert . Only . Values fields . map (insertDb' u p)
where
......@@ -155,7 +155,7 @@ queryInsert :: Query
queryInsert = [sql|
WITH input_rows(hash_id,typename,user_id,parent_id,name,date,hyperdata) AS (?)
, ins AS (
INSERT INTO nodes (hash_id, typename,user_id,parent_id,name,date,hyperdata)
INSERT INTO contexts (hash_id, typename,user_id,parent_id,name,date,hyperdata)
SELECT * FROM input_rows
ON CONFLICT (hash_id) DO NOTHING -- on unique index -- this does not return the ids
RETURNING id,hash_id
......@@ -170,7 +170,7 @@ queryInsert = [sql|
, n.id
, hash_id
FROM input_rows
JOIN nodes n USING (hash_id); -- columns of unique index
JOIN contexts n USING (hash_id); -- columns of unique index
|]
------------------------------------------------------------------------
......
src/Gargantext/Database/Query/Table/NodeContext.hs 0 → 100644
View file @ 156790ff
{-|
Module : Gargantext.Database.Query.Table.NodeNode
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
Here is a longer description of this module, containing some
commentary with @some markup@.
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Query.Table.NodeContext
( module Gargantext.Database.Schema.NodeContext
, queryNodeContextTable
, selectDocsDates
, selectDocNodes
, selectDocs
, nodeContextsCategory
, nodeContextsScore
, getNodeContext
, insertNodeContext
, deleteNodeContext
, selectPublicContexts
, selectCountDocs
)
where
import Control.Arrow (returnA)
import Control.Lens (view, (^.))
import Data.Maybe (catMaybes)
import Data.Text (Text, splitOn)
import Database.PostgreSQL.Simple.SqlQQ (sql)
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
import qualified Opaleye as O
import Opaleye
import Gargantext.Core
import Gargantext.Core.Types
import Gargantext.Database.Schema.NodeContext
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Prelude
import Gargantext.Database.Schema.Node
import Gargantext.Database.Schema.Context
import Gargantext.Prelude
queryNodeContextTable :: Select NodeContextRead
queryNodeContextTable = selectTable nodeContextTable
-- | not optimized (get all ngrams without filters)
_nodesContexts :: Cmd err [NodeContext]
_nodesContexts = runOpaQuery queryNodeContextTable
------------------------------------------------------------------------
-- | Basic NodeContext tools
getNodeContext :: NodeId -> Cmd err [NodeContext]
getNodeContext n = runOpaQuery (selectNodeContext $ pgNodeId n)
where
selectNodeContext :: Column SqlInt4 -> Select NodeContextRead
selectNodeContext n' = proc () -> do
ns <- queryNodeContextTable -< ()
restrict -< _nc_node_id ns .== n'
returnA -< ns
------------------------------------------------------------------------
insertNodeContext :: [NodeContext] -> Cmd err Int
insertNodeContext ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
$ Insert nodeContextTable ns' rCount (Just DoNothing))
where
ns' :: [NodeContextWrite]
ns' = map (\(NodeContext n c x y)
-> NodeContext (pgNodeId n)
(pgNodeId c)
(sqlDouble <$> x)
(sqlInt4 <$> y)
) ns
------------------------------------------------------------------------
type Node_Id = NodeId
type Context_Id = NodeId
deleteNodeContext :: Node_Id -> Context_Id -> Cmd err Int
deleteNodeContext n c = mkCmd $ \conn ->
fromIntegral <$> runDelete_ conn
(Delete nodeContextTable
(\(NodeContext n_id c_id _ _) -> n_id .== pgNodeId n
.&& c_id .== pgNodeId c
)
rCount
)
------------------------------------------------------------------------
-- | Favorite management
_nodeContextCategory :: CorpusId -> DocId -> Int -> Cmd err [Int]
_nodeContextCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (c,cId,dId)
where
favQuery :: PGS.Query
favQuery = [sql|UPDATE nodes_contexts SET category = ?
WHERE node_id = ? AND context_id = ?
RETURNING context_id;
|]
nodeContextsCategory :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
nodeContextsCategory inputData = map (\(PGS.Only a) -> a)
<$> runPGSQuery catQuery (PGS.Only $ Values fields inputData)
where
fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
catQuery :: PGS.Query
catQuery = [sql| UPDATE nodes_contexts as nn0
SET category = nn1.category
FROM (?) as nn1(node_id,context_id,category)
WHERE nn0.node1_id = nn1.node_id
AND nn0.node2_id = nn1.context_id
RETURNING nn1.context_id
|]
------------------------------------------------------------------------
-- | Score management
_nodeContextScore :: CorpusId -> DocId -> Int -> Cmd err [Int]
_nodeContextScore cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery scoreQuery (c,cId,dId)
where
scoreQuery :: PGS.Query
scoreQuery = [sql|UPDATE nodes_contexts SET score = ?
WHERE node_id = ? AND context_id = ?
RETURNING context_id;
|]
nodeContextsScore :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
nodeContextsScore inputData = map (\(PGS.Only a) -> a)
<$> runPGSQuery catScore (PGS.Only $ Values fields inputData)
where
fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
catScore :: PGS.Query
catScore = [sql| UPDATE nodes_contexts as nn0
SET score = nn1.score
FROM (?) as nn1(node_id, context_id, score)
WHERE nn0.node_id = nn1.node_id
AND nn0.context_id = nn1.context_id
RETURNING nn1.context_id
|]
------------------------------------------------------------------------
selectCountDocs :: HasDBid NodeType => CorpusId -> Cmd err Int
selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
where
queryCountDocs cId' = proc () -> do
(c, nc) <- joinInCorpus -< ()
restrict -< nc^.nc_node_id .== (toNullable $ pgNodeId cId')
restrict -< nc^.nc_category .>= (toNullable $ sqlInt4 1)
restrict -< c^.context_typename .== (sqlInt4 $ toDBid NodeDocument)
returnA -< c
-- | TODO use UTCTime fast
selectDocsDates :: HasDBid NodeType => CorpusId -> Cmd err [Text]
selectDocsDates cId = map (head' "selectDocsDates" . splitOn "-")
<$> catMaybes
<$> map (view hd_publication_date)
<$> selectDocs cId
selectDocs :: HasDBid NodeType => CorpusId -> Cmd err [HyperdataDocument]
selectDocs cId = runOpaQuery (queryDocs cId)
queryDocs :: HasDBid NodeType => CorpusId -> O.Select (Column SqlJsonb)
queryDocs cId = proc () -> do
(c, nn) <- joinInCorpus -< ()
restrict -< nn^.nc_node_id .== (toNullable $ pgNodeId cId)
restrict -< nn^.nc_category .>= (toNullable $ sqlInt4 1)
restrict -< c^.context_typename .== (sqlInt4 $ toDBid NodeDocument)
returnA -< view (context_hyperdata) c
selectDocNodes :: HasDBid NodeType => CorpusId -> Cmd err [Context HyperdataDocument]
selectDocNodes cId = runOpaQuery (queryDocNodes cId)
queryDocNodes :: HasDBid NodeType => CorpusId -> O.Select ContextRead
queryDocNodes cId = proc () -> do
(c, nc) <- joinInCorpus -< ()
restrict -< nc^.nc_node_id .== (toNullable $ pgNodeId cId)
restrict -< nc^.nc_category .>= (toNullable $ sqlInt4 1)
restrict -< c^.context_typename .== (sqlInt4 $ toDBid NodeDocument)
returnA -< c
joinInCorpus :: O.Select (ContextRead, NodeContextReadNull)
joinInCorpus = leftJoin queryContextTable queryNodeContextTable cond
where
cond :: (ContextRead, NodeContextRead) -> Column SqlBool
cond (c, nc) = c^.context_id .== nc^.nc_node_id
joinOn1 :: O.Select (NodeRead, NodeContextReadNull)
joinOn1 = leftJoin queryNodeTable queryNodeContextTable cond
where
cond :: (NodeRead, NodeContextRead) -> Column SqlBool
cond (n, nc) = nc^.nc_node_id .== n^.node_id
------------------------------------------------------------------------
selectPublicContexts :: HasDBid NodeType => (Hyperdata a, DefaultFromField SqlJsonb a)
=> Cmd err [(Node a, Maybe Int)]
selectPublicContexts = runOpaQuery (queryWithType NodeFolderPublic)
queryWithType :: HasDBid NodeType =>NodeType -> O.Select (NodeRead, Column (Nullable SqlInt4))
queryWithType nt = proc () -> do
(n, nc) <- joinOn1 -< ()
restrict -< n^.node_typename .== (sqlInt4 $ toDBid nt)
returnA -< (n, nc^.nc_context_id)
src/Gargantext/Database/Schema/Context.hs 0 → 100644
View file @ 156790ff
{-|
Module : Gargantext.Database.Schema.Node
Description : Main requests of Node to the database
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module Gargantext.Database.Schema.Context where
import Control.Lens hiding (elements, (&), Context)
import Gargantext.Database.Schema.Prelude
import Prelude hiding (null, id, map, sum)
------------------------------------------------------------------------
-- Main polymorphic Node definition
data ContextPoly id
hash_id
typename
user_id
parent_id
name
date
hyperdata =
Context { _context_id :: !id
, _context_hash_id :: !hash_id
, _context_typename :: !typename
, _context_user_id :: !user_id
, _context_parent_id :: !parent_id
, _context_name :: !name
, _context_date :: !date
, _context_hyperdata :: !hyperdata
} deriving (Show, Generic)
------------------------------------------------------------------------
-- Automatic instances derivation
$(deriveJSON (unPrefix "_context_") ''ContextPoly)
$(makeLenses ''ContextPoly)
$(makeAdaptorAndInstance "pContext" ''ContextPoly)
$(makeLensesWith abbreviatedFields ''ContextPoly)
contextTable :: Table ContextWrite ContextRead
contextTable = Table "contexts" (pContext Context { _context_id = optionalTableField "id"
, _context_hash_id = optionalTableField "hash_id"
, _context_typename = requiredTableField "typename"
, _context_user_id = requiredTableField "user_id"
, _context_parent_id = optionalTableField "parent_id"
, _context_name = requiredTableField "name"
, _context_date = optionalTableField "date"
, _context_hyperdata = requiredTableField "hyperdata"
-- ignoring ts_vector field here
}
)
queryContextTable :: Query ContextRead
queryContextTable = selectTable contextTable
------------------------------------------------------------------------
type ContextWrite = ContextPoly (Maybe (Column SqlInt4) )
(Maybe (Column SqlText) )
(Column SqlInt4)
(Column SqlInt4)
(Maybe (Column SqlInt4) )
(Column SqlText)
(Maybe (Column SqlTimestamptz))
(Column SqlJsonb)
type ContextRead = ContextPoly (Column SqlInt4 )
(Column SqlText )
(Column SqlInt4 )
(Column SqlInt4 )
(Column SqlInt4 )
(Column SqlText )
(Column SqlTimestamptz )
(Column SqlJsonb )
type ContextReadNull = ContextPoly (Column (Nullable SqlInt4))
(Column (Nullable SqlText))
(Column (Nullable SqlInt4))
(Column (Nullable SqlInt4))
(Column (Nullable SqlInt4))
(Column (Nullable SqlText))
(Column (Nullable SqlTimestamptz))
(Column (Nullable SqlJsonb))
------------------------------------------------------------------------
-- | Context(Read|Write)Search is slower than Context(Write|Read) use it
-- for full text search only
type ContextSearchWrite =
ContextPolySearch
(Maybe (Column SqlInt4) )
(Column SqlInt4 )
(Column SqlInt4 )
(Column (Nullable SqlInt4) )
(Column SqlText )
(Maybe (Column SqlTimestamptz))
(Column SqlJsonb )
(Maybe (Column SqlTSVector) )
type ContextSearchRead =
ContextPolySearch
(Column SqlInt4 )
(Column SqlInt4 )
(Column SqlInt4 )
(Column (Nullable SqlInt4 ))
(Column SqlText )
(Column SqlTimestamptz )
(Column SqlJsonb )
(Column SqlTSVector )
type ContextSearchReadNull =
ContextPolySearch
(Column (Nullable SqlInt4) )
(Column (Nullable SqlInt4) )
(Column (Nullable SqlInt4) )
(Column (Nullable SqlInt4) )
(Column (Nullable SqlText) )
(Column (Nullable SqlTimestamptz))
(Column (Nullable SqlJsonb) )
(Column (Nullable SqlTSVector) )
data ContextPolySearch id
typename
user_id
parent_id
name
date
hyperdata
search =
ContextSearch { _cs_id :: id
, _cs_typename :: typename
, _cs_user_id :: user_id
-- , ContextUniqId :: shaId
, _cs_parent_id :: parent_id
, _cs_name :: name
, _cs_date :: date
, _cs_hyperdata :: hyperdata
, _cs_search :: search
} deriving (Show, Generic)
$(makeAdaptorAndInstance "pContextSearch" ''ContextPolySearch)
$(makeLensesWith abbreviatedFields ''ContextPolySearch)
$(deriveJSON (unPrefix "_cs_") ''ContextPolySearch)
$(makeLenses ''ContextPolySearch)
contextTableSearch :: Table ContextSearchWrite ContextSearchRead
contextTableSearch = Table "contexts" ( pContextSearch
ContextSearch { _cs_id = optionalTableField "id"
, _cs_typename = requiredTableField "typename"
, _cs_user_id = requiredTableField "user_id"
, _cs_parent_id = requiredTableField "parent_id"
, _cs_name = requiredTableField "name"
, _cs_date = optionalTableField "date"
, _cs_hyperdata = requiredTableField "hyperdata"
, _cs_search = optionalTableField "search"
}
)
------------------------------------------------------------------------
src/Gargantext/Database/Schema/ContextNodeNgrams.hs 0 → 100644
View file @ 156790ff
{-|
Module : Gargantext.Database.Schema.NodeNodeNgrams
Description : TODO: remove this module and table in database
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Schema.ContextNodeNgrams
where
import Prelude
import Gargantext.Database.Schema.Prelude
import Gargantext.Database.Schema.Ngrams (NgramsTypeId, NgramsId)
import Gargantext.Database.Admin.Types.Node
type ContextNodeNgrams =
ContextNodeNgramsPoly ContextId ListId NgramsId NgramsTypeId Double
data ContextNodeNgramsPoly c n ngrams_id ngt w
= ContextNodeNgrams { _cnng_context_id :: !c
, _cnng_node_id :: !n
, _cnng_ngrams_id :: !ngrams_id
, _cnng_ngramsType :: !ngt
, _cnng_weight :: !w
} deriving (Show)
type ContextNodeNgramsWrite =
ContextNodeNgramsPoly (Column SqlInt4 )
(Column SqlInt4 )
(Column SqlInt4 )
(Column SqlInt4 )
(Column SqlFloat8)
type ContextNodeNgramsRead =
ContextNodeNgramsPoly (Column SqlInt4 )
(Column SqlInt4 )
(Column SqlInt4 )
(Column SqlInt4 )
(Column SqlFloat8)
type ContextNodeNgramsReadNull =
ContextNodeNgramsPoly (Column (Nullable SqlInt4 ))
(Column (Nullable SqlInt4 ))
(Column (Nullable SqlInt4 ))
(Column (Nullable SqlInt4 ))
(Column (Nullable SqlFloat8))
$(makeAdaptorAndInstance "pContextNodeNgrams" ''ContextNodeNgramsPoly)
makeLenses ''ContextNodeNgramsPoly
contextNodeNgramsTable :: Table ContextNodeNgramsWrite ContextNodeNgramsRead
contextNodeNgramsTable = Table "context_node_ngrams"
( pContextNodeNgrams ContextNodeNgrams
{ _cnng_context_id = requiredTableField "context_id"
, _cnng_node_id = requiredTableField "node_id"
, _cnng_ngrams_id = requiredTableField "ngrams_id"
, _cnng_ngramsType = requiredTableField "ngrams_type"
, _cnng_weight = requiredTableField "weight"
}
)
src/Gargantext/Database/Schema/ContextNodeNgrams2.hs 0 → 100644
View file @ 156790ff
{-|
Module : Gargantext.Database.Schema.NodeNodeNgrams
Description : TODO: remove this module and table in database
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Schema.ContextNodeNgrams2
where
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Schema.NodeNgrams (NodeNgramsId)
import Gargantext.Database.Schema.Prelude
import Prelude
type ContextNodeNgrams2 =
ContextNodeNgrams2Poly ContextId NodeNgramsId Weight
type Weight = Double
data ContextNodeNgrams2Poly context_id nodengrams_id w
= ContextNodeNgrams2 { _cnng2_context_id :: !context_id
, _cnng2_nodengrams_id :: !nodengrams_id
, _cnng2_weight :: !w
} deriving (Show)
type ContextNodeNgrams2Write =
ContextNodeNgrams2Poly (Column SqlInt4 )
(Column SqlInt4 )
(Column SqlFloat8)
type ContextNodeNgrams2Read =
ContextNodeNgrams2Poly (Column SqlInt4 )
(Column SqlInt4 )
(Column SqlFloat8)
type ContextNodeNgrams2ReadNull =
ContextNodeNgrams2Poly (Column (Nullable SqlInt4 ))
(Column (Nullable SqlInt4 ))
(Column (Nullable SqlFloat8))
$(makeAdaptorAndInstance "pContextNodeNgrams2" ''ContextNodeNgrams2Poly)
makeLenses ''ContextNodeNgrams2Poly
contextNodeNgrams2Table :: Table ContextNodeNgrams2Write ContextNodeNgrams2Read
contextNodeNgrams2Table = Table "context_node_ngrams2"
( pContextNodeNgrams2 ContextNodeNgrams2
{ _cnng2_context_id = requiredTableField "context_id"
, _cnng2_nodengrams_id = requiredTableField "nodengrams_id"
, _cnng2_weight = requiredTableField "weight"
}
)
src/Gargantext/Database/Schema/NgramsPostag.hs
View file @ 156790ff
{-|
Module : Gargantext.Database.Schema.NgramsPostag
Description : Ngram connection to the Database
Description : Ngrams connection to the Database
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
......@@ -26,6 +26,7 @@ import Gargantext.Database.Schema.Prelude
import Gargantext.Prelude
import qualified Database.PostgreSQL.Simple as PGS
data NgramsPostagPoly id
lang_id
algo_id
......@@ -52,28 +53,28 @@ type NgramsPostagDB = NgramsPostagPoly (Maybe Int) Int Int (Maybe Text) Int Int
------------------------------------------------------------------------
type NgramsPosTagWrite = NgramsPostagPoly (Maybe (Column SqlInt4))
(Column SqlInt4)
(Column SqlInt4)
(Maybe (Column SqlText))
(Column SqlInt4)
(Column SqlInt4)
(Maybe (Column SqlInt4))
(Column SqlInt4)
(Column SqlInt4)
(Maybe (Column SqlText))
(Column SqlInt4)
(Column SqlInt4)
(Maybe (Column SqlInt4))
type NgramsPosTagRead = NgramsPostagPoly (Column SqlInt4)
(Column SqlInt4)
(Column SqlInt4)
(Column SqlText)
(Column SqlInt4)
(Column SqlInt4)
(Column SqlInt4)
(Column SqlInt4)
(Column SqlInt4)
(Column SqlText)
(Column SqlInt4)
(Column SqlInt4)
(Column SqlInt4)
type NgramsPosTagReadNull = NgramsPostagPoly (Column (Nullable SqlInt4))
(Column (Nullable SqlInt4))
(Column (Nullable SqlInt4))
(Column (Nullable SqlText))
(Column (Nullable SqlInt4))
(Column (Nullable SqlInt4))
(Column (Nullable SqlInt4))
(Column (Nullable SqlInt4))
(Column (Nullable SqlInt4))
(Column (Nullable SqlText))
(Column (Nullable SqlInt4))
(Column (Nullable SqlInt4))
(Column (Nullable SqlInt4))
makeLenses ''NgramsPostagPoly
instance PGS.ToRow NgramsPostagDB where
......
src/Gargantext/Database/Schema/NodeContext.hs 0 → 100644
View file @ 156790ff
{-|
Module : Gargantext.Database.Schema.NodeNode
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
Here is a longer description of this module, containing some
commentary with @some markup@.
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Schema.NodeContext where
import Gargantext.Core.Types
import Gargantext.Database.Schema.Prelude
import Gargantext.Database.Schema.NodeNode () -- Just importing some instances
import Gargantext.Prelude
data NodeContextPoly node_id context_id score cat
= NodeContext { _nc_node_id :: !node_id
, _nc_context_id :: !context_id
, _nc_score :: !score
, _nc_category :: !cat
} deriving (Show)
type NodeContextWrite = NodeContextPoly (Column (SqlInt4))
(Column (SqlInt4))
(Maybe (Column (SqlFloat8)))
(Maybe (Column (SqlInt4)))
type NodeContextRead = NodeContextPoly (Column (SqlInt4))
(Column (SqlInt4))
(Column (SqlFloat8))
(Column (SqlInt4))
type NodeContextReadNull = NodeContextPoly (Column (Nullable SqlInt4))
(Column (Nullable SqlInt4))
(Column (Nullable SqlFloat8))
(Column (Nullable SqlInt4))
type NodeContext = NodeContextPoly NodeId NodeId (Maybe Double) (Maybe Int)
$(makeAdaptorAndInstance "pNodeContext" ''NodeContextPoly)
makeLenses ''NodeContextPoly
nodeContextTable :: Table NodeContextWrite NodeContextRead
nodeContextTable =
Table "nodes_contexts"
( pNodeContext
NodeContext { _nc_node_id = requiredTableField "node_id"
, _nc_context_id = requiredTableField "context_id"
, _nc_score = optionalTableField "score"
, _nc_category = optionalTableField "category"
}
)
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