diff --git a/bin/gargantext-init/Main.hs b/bin/gargantext-init/Main.hs index a0c3efdbc5ca981fe825a4d6f8a5653982c33214..9497d9875bd802bc455af6f7ef693c329d4fabc3 100644 --- a/bin/gargantext-init/Main.hs +++ b/bin/gargantext-init/Main.hs @@ -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 diff --git a/devops/postgres/create b/devops/postgres/create index 658826bfd596c63751626737e20a0cce5e86a8cf..a5197666f22b2916a2ff1393e8591ec88ffe520b 100755 --- a/devops/postgres/create +++ b/devops/postgres/create @@ -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}" diff --git a/devops/postgres/schema.sql b/devops/postgres/schema.sql index ba7064a3cc64c06246f08cca5649d7edf265c9b1..f5e7d93ee275a76378b33bb3e0c01a140c701788 100644 --- a/devops/postgres/schema.sql +++ b/devops/postgres/schema.sql @@ -19,8 +19,8 @@ CREATE TABLE public.auth_user ( date_joined TIMESTAMP with time zone DEFAULT now() NOT NULL, PRIMARY KEY (id) ); - ALTER TABLE public.auth_user OWNER TO gargantua; +----------------------------------------------------------------- -- TODO add publication_date -- TODO typename -> type_id @@ -38,6 +38,25 @@ CREATE TABLE public.nodes ( FOREIGN KEY (user_id) REFERENCES public.auth_user(id) ON DELETE CASCADE ); ALTER TABLE public.nodes OWNER TO gargantua; +-------------------------------------------------------------- + +-- TODO add publication_date +-- 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; + -------------------------------------------------------------- -- | Ngrams CREATE TABLE public.ngrams ( @@ -50,51 +69,51 @@ ALTER TABLE public.ngrams OWNER TO gargantua; -- | Ngrams PosTag CREATE TABLE public.ngrams_postag ( - id SERIAL, - lang_id INTEGER, - algo_id INTEGER, - postag CHARACTER varying(5), - ngrams_id INTEGER NOT NULL, - lemm_id INTEGER NOT NULL, - score INTEGER DEFAULT 1 ::integer NOT NULL, + id SERIAL , + lang_id INTEGER , + algo_id INTEGER , + postag CHARACTER varying(5) , + ngrams_id INTEGER NOT NULL , + lemm_id INTEGER NOT NULL , + score INTEGER DEFAULT 1 ::integer NOT NULL , FOREIGN KEY (ngrams_id) REFERENCES public.ngrams(id) ON DELETE CASCADE, FOREIGN KEY (lemm_id) REFERENCES public.ngrams(id) ON DELETE CASCADE ); ALTER TABLE public.ngrams_postag OWNER TO gargantua; -------------------------------------------------------------- +-- Node here should have type NodeList CREATE TABLE public.node_ngrams ( - id SERIAL, - node_id INTEGER NOT NULL, - node_subtype INTEGER, - ngrams_id INTEGER NOT NULL, - ngrams_type INTEGER, -- change to ngrams_field? (no for pedagogic reason) - ngrams_field INTEGER, - ngrams_tag INTEGER, - ngrams_class INTEGER, - weight double precision, - PRIMARY KEY (id), - FOREIGN KEY (node_id) REFERENCES public.nodes(id) ON DELETE CASCADE, + id SERIAL , + node_id INTEGER NOT NULL , + node_subtype INTEGER , + ngrams_id INTEGER NOT NULL , + ngrams_type INTEGER , -- change to ngrams_field? (no for pedagogic reason) + ngrams_field INTEGER , + ngrams_tag INTEGER , + ngrams_class INTEGER , + weight double precision , + PRIMARY KEY (id) , + FOREIGN KEY (node_id) REFERENCES public.nodes(id) ON DELETE CASCADE , FOREIGN KEY (ngrams_id) REFERENCES public.ngrams(id) ON DELETE CASCADE ); ALTER TABLE public.node_ngrams OWNER TO gargantua; -CREATE TABLE public.node_nodengrams_nodengrams ( - node_id INTEGER NOT NULL, - node_ngrams1_id INTEGER NOT NULL, - node_ngrams2_id INTEGER NOT NULL, - weight double precision, - FOREIGN KEY (node_id) REFERENCES public.nodes(id) ON DELETE CASCADE, - FOREIGN KEY (node_ngrams1_id) REFERENCES public.node_ngrams(id) ON DELETE CASCADE, - FOREIGN KEY (node_ngrams2_id) REFERENCES public.node_ngrams(id) ON DELETE CASCADE, - PRIMARY KEY (node_id, node_ngrams1_id, node_ngrams2_id) -); -ALTER TABLE public.node_nodengrams_nodengrams OWNER TO gargantua; +--CREATE TABLE public.context_nodengrams_nodengrams ( +-- context_id INTEGER NOT NULL , +-- node_ngrams1_id INTEGER NOT NULL , +-- node_ngrams2_id INTEGER NOT NULL , +-- weight double precision , +-- FOREIGN KEY (node_id) REFERENCES public.contexts(id) ON DELETE CASCADE , +-- FOREIGN KEY (node_ngrams1_id) REFERENCES public.node_ngrams(id) ON DELETE CASCADE, +-- FOREIGN KEY (node_ngrams2_id) REFERENCES public.node_ngrams(id) ON DELETE CASCADE, +-- PRIMARY KEY (node_id, node_ngrams1_id, node_ngrams2_id) +--); +--ALTER TABLE public.context_nodengrams_nodengrams OWNER TO gargantua; -------------------------------------------------------------- -------------------------------------------------------------- -- --- --CREATE TABLE public.nodes_ngrams_ngrams ( -- node_id integer NOT NULL REFERENCES public.nodes(id) ON DELETE CASCADE, -- ngram1_id integer NOT NULL REFERENCES public.ngrams(id) ON DELETE CASCADE, @@ -109,31 +128,43 @@ ALTER TABLE public.node_nodengrams_nodengrams OWNER TO gargantua; CREATE TABLE public.nodes_nodes ( node1_id INTEGER NOT NULL REFERENCES public.nodes(id) ON DELETE CASCADE, node2_id INTEGER NOT NULL REFERENCES public.nodes(id) ON DELETE CASCADE, - score REAL, - category INTEGER, + score REAL , + category INTEGER , PRIMARY KEY (node1_id, node2_id) ); ALTER TABLE public.nodes_nodes OWNER TO gargantua; ---------------------------------------------------------------- -CREATE TABLE public.node_node_ngrams ( -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 (node1_id, node2_id, ngrams_id, ngrams_type) +-- 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.node_node_ngrams OWNER TO gargantua; +ALTER TABLE public.nodes_contexts OWNER TO gargantua; + +--------------------------------------------------------------- +CREATE TABLE public.context_node_ngrams ( + context_id INTEGER NOT NULL REFERENCES public.nodes (id) ON DELETE CASCADE, + node_id INTEGER NOT NULL REFERENCES public.contexts (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) + ); -CREATE TABLE public.node_node_ngrams2 ( -node_id INTEGER NOT NULL REFERENCES public.nodes (id) ON DELETE CASCADE, -nodengrams_id INTEGER NOT NULL REFERENCES public.node_ngrams (id) ON DELETE CASCADE, -weight double precision, -PRIMARY KEY (node_id, nodengrams_id) + +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.node_node_ngrams2 OWNER TO gargantua; +ALTER TABLE public.context_node_ngrams2 OWNER TO gargantua; -------------------------------------------------------------- @@ -148,7 +179,6 @@ ALTER TABLE public.node_node_ngrams2 OWNER TO gargantua; -- If needed for rights management at row level -- CREATE EXTENSION IF NOT EXISTS acl WITH SCHEMA public; - CREATE TABLE public.rights ( user_id INTEGER NOT NULL REFERENCES public.auth_user(id) ON DELETE CASCADE, node_id INTEGER NOT NULL REFERENCES public.nodes(id) ON DELETE CASCADE, @@ -171,6 +201,15 @@ CREATE INDEX ON public.nodes USING btree (id, typename, date ASC); CREATE INDEX ON public.nodes USING btree (id, typename, date DESC); CREATE INDEX ON public.nodes USING btree (typename, id); CREATE UNIQUE INDEX ON public.nodes USING btree (hash_id); + +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); + + -- CREATE UNIQUE INDEX ON public.nodes USING btree (((hyperdata ->> 'uniqId'::text))); -- CREATE UNIQUE INDEX ON public.nodes USING btree (((hyperdata ->> 'uniqIdBdd'::text))); -- CREATE UNIQUE INDEX ON public.nodes USING btree (typename, parent_id, ((hyperdata ->> 'uniqId'::text))); @@ -178,23 +217,37 @@ CREATE UNIQUE INDEX ON public.nodes USING btree (hash_id); CREATE UNIQUE INDEX ON public.ngrams (terms); -- TEST GIN CREATE INDEX ON public.ngrams USING btree (id, terms); CREATE UNIQUE INDEX ON public.ngrams_postag (lang_id,algo_id,postag,ngrams_id,lemm_id); + +-- To save the Node Ngrams Repo CREATE INDEX ON public.node_ngrams USING btree (node_id,node_subtype); CREATE UNIQUE INDEX ON public.node_ngrams USING btree (node_id,node_subtype, ngrams_id); + + +-- To make the links between Nodes in Tree/Forest CREATE UNIQUE INDEX ON public.nodes_nodes USING btree (node1_id, node2_id); CREATE INDEX ON public.nodes_nodes USING btree (node1_id, node2_id, category); -CREATE UNIQUE INDEX ON public.node_node_ngrams USING btree (node1_id, node2_id, ngrams_id, ngrams_type); -CREATE INDEX ON public.node_node_ngrams USING btree (node1_id, node2_id); -CREATE INDEX ON public.node_node_ngrams USING btree (ngrams_id, node2_id); -CREATE INDEX ON public.node_node_ngrams USING btree (ngrams_type); -CREATE INDEX ON public.node_nodengrams_nodengrams USING btree (node_id, node_ngrams1_id, node_ngrams2_id); -CREATE INDEX ON public.node_nodengrams_nodengrams USING btree (node_ngrams1_id); -CREATE INDEX ON public.node_nodengrams_nodengrams USING btree (node_ngrams2_id); -CREATE INDEX ON public.node_node_ngrams2 USING btree (node_id); -CREATE INDEX ON public.node_node_ngrams2 USING btree (nodengrams_id); -CREATE INDEX ON public.node_node_ngrams2 USING btree (node_id, nodengrams_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); + +-- CREATE INDEX ON public.context_nodengrams_nodengrams USING btree (context_id, node_ngrams1_id, node_ngrams2_id); +-- CREATE INDEX ON public.context_nodengrams_nodengrams USING btree (node_ngrams1_id); +-- CREATE INDEX ON public.context_nodengrams_nodengrams USING btree (node_ngrams2_id); + + ------------------------------------------------------------------------ -- Ngrams Full DB Extraction Optim -- TODO remove hard parameter and move elsewhere diff --git a/src/Gargantext/Database/Action/Flow.hs b/src/Gargantext/Database/Action/Flow.hs index 9b224fbb982362424b8d2376a3dd4602470d32c4..7ddb0d69e246d03d467ff0ad9cd128cad7f5438a 100644 --- a/src/Gargantext/Database/Action/Flow.hs +++ b/src/Gargantext/Database/Action/Flow.hs @@ -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 diff --git a/src/Gargantext/Database/Action/Flow/Utils.hs b/src/Gargantext/Database/Action/Flow/Utils.hs index 976d9dfc16bc9aef2483da4b43863e4e1b528040..5c5488a2a01708435d4d04e861392bc59a0c299e 100644 --- a/src/Gargantext/Database/Action/Flow/Utils.hs +++ b/src/Gargantext/Database/Action/Flow/Utils.hs @@ -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)) diff --git a/src/Gargantext/Database/Action/Metrics/NgramsByNode.hs b/src/Gargantext/Database/Action/Metrics/NgramsByNode.hs index eb264c0f0909f3adb87555b45beb88b0bdc416e7..19d32ad6aa1694a0fc6ebab6f991042919631a42 100644 --- a/src/Gargantext/Database/Action/Metrics/NgramsByNode.hs +++ b/src/Gargantext/Database/Action/Metrics/NgramsByNode.hs @@ -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 ) diff --git a/src/Gargantext/Database/Admin/Trigger/NodeNodeNgrams.hs b/src/Gargantext/Database/Admin/Trigger/ContextNodeNgrams.hs similarity index 80% rename from src/Gargantext/Database/Admin/Trigger/NodeNodeNgrams.hs rename to src/Gargantext/Database/Admin/Trigger/ContextNodeNgrams.hs index 56bdf759678b70cd8e896f8802abbffb80d0e417..89db396ba33fa1ee9fb57a24968f6a417f3baebb 100644 --- a/src/Gargantext/Database/Admin/Trigger/NodeNodeNgrams.hs +++ b/src/Gargantext/Database/Admin/Trigger/ContextNodeNgrams.hs @@ -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(); |] - diff --git a/src/Gargantext/Database/Admin/Trigger/Init.hs b/src/Gargantext/Database/Admin/Trigger/Init.hs index cc0e1a16a8278f85f5c20692e57d366cdaf22358..0e7221206909d040b3cfc3c96d8bd75f796cddbc 100644 --- a/src/Gargantext/Database/Admin/Trigger/Init.hs +++ b/src/Gargantext/Database/Admin/Trigger/Init.hs @@ -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 diff --git a/src/Gargantext/Database/Admin/Trigger/Nodes.hs b/src/Gargantext/Database/Admin/Trigger/Nodes.hs index 5c31003d7350d8a28b12e514b8c2f82794e94437..03787396092d10193256cd70bda9ec3b3f740e37 100644 --- a/src/Gargantext/Database/Admin/Trigger/Nodes.hs +++ b/src/Gargantext/Database/Admin/Trigger/Nodes.hs @@ -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(); + |] diff --git a/src/Gargantext/Database/Admin/Types/Node.hs b/src/Gargantext/Database/Admin/Types/Node.hs index 82d91c9ff73594670f1965c3efb8b2b3a49d1663..3b0749af07722a28257acc4330ba5996704c3ed4 100644 --- a/src/Gargantext/Database/Admin/Types/Node.hs +++ b/src/Gargantext/Database/Admin/Types/Node.hs @@ -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 diff --git a/src/Gargantext/Database/Query/Facet.hs b/src/Gargantext/Database/Query/Facet.hs index 7e6ee61c92469f21b94b2a4d96afbc56068938f1..6565eb4ccca6f91b0cc35b4afc9b9a4df65bd1da 100644 --- a/src/Gargantext/Database/Query/Facet.hs +++ b/src/Gargantext/Database/Query/Facet.hs @@ -66,9 +66,10 @@ import Gargantext.Database.Admin.Types.Hyperdata import Gargantext.Database.Query.Filter import Gargantext.Database.Query.Join (leftJoin5) import Gargantext.Database.Query.Table.Ngrams -import Gargantext.Database.Query.Table.Node (queryNodeSearchTable) -import Gargantext.Database.Query.Table.NodeNode -import Gargantext.Database.Query.Table.NodeNodeNgrams +import Gargantext.Database.Query.Table.Context +import Gargantext.Database.Schema.Context +import Gargantext.Database.Query.Table.NodeContext +import Gargantext.Database.Query.Table.ContextNodeNgrams import Gargantext.Database.Prelude import Gargantext.Database.Schema.Node import Gargantext.Prelude (printDebug) @@ -188,13 +189,13 @@ instance ToSchema FacetDoc where -- | Mock and Quickcheck instances instance Arbitrary FacetDoc where arbitrary = elements [ FacetDoc id' (jour year 01 01) t hp (Just cat) (Just ngramCount) (Just score) - | id' <- [1..10] - , year <- [1990..2000] - , t <- ["title", "another title"] - , hp <- arbitraryHyperdataDocuments - , cat <- [0..2] + | id' <- [1..10] + , year <- [1990..2000] + , t <- ["title", "another title"] + , hp <- arbitraryHyperdataDocuments + , cat <- [0..2] , ngramCount <- [3..100] - , score <- [3..100] + , score <- [3..100] ] -- Facets / Views for the Front End @@ -242,8 +243,6 @@ instance Arbitrary OrderBy -- TODO-SECURITY check - ---{- runViewAuthorsDoc :: HasDBid NodeType => ContactId -> IsTrash @@ -264,11 +263,6 @@ viewAuthorsDoc :: HasDBid NodeType viewAuthorsDoc cId _ nt = proc () -> do (doc,(_,(_,(_,contact')))) <- queryAuthorsDoc -< () - {-nn <- queryNodeNodeTable -< () - restrict -< nn_node1_id nn .== _node_id doc - -- restrict -< nn_delete nn .== (sqlBool t) - -} - restrict -< _node_id contact' .== (toNullable $ pgNodeId cId) restrict -< _node_typename doc .== (sqlInt4 $ toDBid nt) @@ -280,26 +274,25 @@ viewAuthorsDoc cId _ nt = proc () -> do , facetDoc_ngramCount = toNullable $ sqlDouble 1 , facetDoc_score = toNullable $ sqlDouble 1 } -queryAuthorsDoc :: Select (NodeRead, (NodeNodeNgramsReadNull, (NgramsReadNull, (NodeNodeNgramsReadNull, NodeReadNull)))) -queryAuthorsDoc = leftJoin5 queryNodeTable queryNodeNodeNgramsTable queryNgramsTable queryNodeNodeNgramsTable queryNodeTable cond12 cond23 cond34 cond45 +queryAuthorsDoc :: Select (NodeRead, (ContextNodeNgramsReadNull, (NgramsReadNull, (ContextNodeNgramsReadNull, NodeReadNull)))) +queryAuthorsDoc = leftJoin5 queryNodeTable queryContextNodeNgramsTable queryNgramsTable queryContextNodeNgramsTable queryNodeTable cond12 cond23 cond34 cond45 where - cond12 :: (NodeNodeNgramsRead, NodeRead) -> Column SqlBool - cond12 (nodeNgram, doc) = _node_id doc - .== _nnng_node1_id nodeNgram + cond12 :: (ContextNodeNgramsRead, NodeRead) -> Column SqlBool + cond12 (nodeNgram, doc) = _node_id doc + .== _cnng_context_id nodeNgram - cond23 :: (NgramsRead, (NodeNodeNgramsRead, NodeReadNull)) -> Column SqlBool + cond23 :: (NgramsRead, (ContextNodeNgramsRead, NodeReadNull)) -> Column SqlBool cond23 (ngrams', (nodeNgram, _)) = ngrams'^.ngrams_id - .== _nnng_ngrams_id nodeNgram + .== _cnng_ngrams_id nodeNgram - cond34 :: (NodeNodeNgramsRead, (NgramsRead, (NodeNodeNgramsReadNull, NodeReadNull))) -> Column SqlBool - cond34 (nodeNgram2, (ngrams', (_,_)))= ngrams'^.ngrams_id .== _nnng_ngrams_id nodeNgram2 + cond34 :: (ContextNodeNgramsRead, (NgramsRead, (ContextNodeNgramsReadNull, NodeReadNull))) -> Column SqlBool + cond34 (nodeNgram2, (ngrams', (_,_)))= ngrams'^.ngrams_id .== _cnng_ngrams_id nodeNgram2 - cond45 :: (NodeRead, (NodeNodeNgramsRead, (NgramsReadNull, (NodeNodeNgramsReadNull, NodeReadNull)))) -> Column SqlBool - cond45 (contact', (nodeNgram2', (_, (_,_)))) = _node_id contact' .== _nnng_node1_id nodeNgram2' + cond45 :: (NodeRead, (ContextNodeNgramsRead, (NgramsReadNull, (ContextNodeNgramsReadNull, NodeReadNull)))) -> Column SqlBool + cond45 (contact', (nodeNgram2', (_, (_,_)))) = _node_id contact' .== _cnng_context_id nodeNgram2' ---} ------------------------------------------------------------------------- +------------------------------------------------------------------------ -- TODO-SECURITY check runViewDocuments :: HasDBid NodeType => CorpusId @@ -310,29 +303,11 @@ runViewDocuments :: HasDBid NodeType -> Maybe Text -> Cmd err [FacetDoc] runViewDocuments cId t o l order query = do --- docs <- runPGSQuery viewDocuments' --- ( cId --- , ntId --- , (if t then 0 else 1) :: Int --- , fromMaybe "" query --- , fromMaybe "" query) --- pure $ (\(id, date, name', hyperdata, category, score) -> FacetDoc id date name' hyperdata category score score) <$> docs printDebug "[runViewDocuments] sqlQuery" $ showSql sqlQuery runOpaQuery $ filterWith o l order sqlQuery where ntId = toDBid NodeDocument sqlQuery = viewDocuments cId t ntId query --- viewDocuments' :: DPS.Query --- viewDocuments' = [sql| --- SELECT n.id, n.date, n.name, n.hyperdata, nn.category, nn.score --- FROM nodes AS n --- JOIN nodes_nodes AS nn --- ON n.id = nn.node2_id --- WHERE nn.node1_id = ? -- corpusId --- AND n.typename = ? -- NodeTypeId --- AND nn.category = ? -- isTrash or not --- AND (n.search @@ to_tsquery(?) OR ? = '') -- query with an OR hack for empty to_tsquery('') results --- |] runCountDocuments :: HasDBid NodeType => CorpusId -> IsTrash -> Maybe Text -> Cmd err Int runCountDocuments cId t mQuery = do @@ -346,53 +321,50 @@ viewDocuments :: CorpusId -> NodeTypeId -> Maybe Text -> Select FacetDocRead -viewDocuments cId t ntId mQuery = viewDocumentsQuery cId t ntId mQuery >>> proc (n, nn) -> do - returnA -< FacetDoc { facetDoc_id = _ns_id n - , facetDoc_created = _ns_date n - , facetDoc_title = _ns_name n - , facetDoc_hyperdata = _ns_hyperdata n - , facetDoc_category = toNullable $ nn^.nn_category - , facetDoc_ngramCount = toNullable $ nn^.nn_score - , facetDoc_score = toNullable $ nn^.nn_score } +viewDocuments cId t ntId mQuery = viewDocumentsQuery cId t ntId mQuery >>> proc (c, nc) -> do + returnA -< FacetDoc { facetDoc_id = _cs_id c + , facetDoc_created = _cs_date c + , facetDoc_title = _cs_name c + , facetDoc_hyperdata = _cs_hyperdata c + , facetDoc_category = toNullable $ nc^.nc_category + , facetDoc_ngramCount = toNullable $ nc^.nc_score + , facetDoc_score = toNullable $ nc^.nc_score + } viewDocuments' :: CorpusId -> IsTrash -> NodeTypeId -> Maybe Text -> Select NodeRead -viewDocuments' cId t ntId mQuery = viewDocumentsQuery cId t ntId mQuery >>> proc (n, _nn) -> do - returnA -< Node { _node_id = _ns_id n +viewDocuments' cId t ntId mQuery = viewDocumentsQuery cId t ntId mQuery >>> proc (c, _nc) -> do + returnA -< Node { _node_id = _cs_id c , _node_hash_id = "" - , _node_typename = _ns_typename n - , _node_user_id = _ns_user_id n + , _node_typename = _cs_typename c + , _node_user_id = _cs_user_id c , _node_parent_id = -1 - , _node_name = _ns_name n - , _node_date = _ns_date n - , _node_hyperdata = _ns_hyperdata n } + , _node_name = _cs_name c + , _node_date = _cs_date c + , _node_hyperdata = _cs_hyperdata c + } viewDocumentsQuery :: CorpusId -> IsTrash -> NodeTypeId -> Maybe Text - -> Select (NodeSearchRead, NodeNodeRead) + -> Select (ContextSearchRead, NodeContextRead) viewDocumentsQuery cId t ntId mQuery = proc () -> do - n <- queryNodeSearchTable -< () - nn <- queryNodeNodeTable -< () - restrict -< n^.ns_id .== nn^.nn_node2_id - restrict -< nn^.nn_node1_id .== (pgNodeId cId) - restrict -< n^.ns_typename .== (sqlInt4 ntId) - restrict -< if t then nn^.nn_category .== (sqlInt4 0) - else nn^.nn_category .>= (sqlInt4 1) - + c <- queryContextSearchTable -< () + nc <- queryNodeContextTable -< () + restrict -< c^.cs_id .== nc^.nc_context_id + restrict -< nc^.nc_node_id .== (pgNodeId cId) + restrict -< c^.cs_typename .== (sqlInt4 ntId) + restrict -< if t then nc^.nc_category .== (sqlInt4 0) + else nc^.nc_category .>= (sqlInt4 1) let query = (fromMaybe "" mQuery) - -- iLikeQuery = T.intercalate "" ["%", query, "%"] - -- restrict -< (n^.node_name) `ilike` (sqlStrictText iLikeQuery) restrict -< if query == "" then sqlBool True - --else (n^.ns_search) @@ (pgTSQuery (T.unpack query)) - else (n^.ns_search) @@ (plaintoTSQuery $ T.unpack query) - - returnA -< (n, nn) + else (c^.cs_search) @@ (plaintoTSQuery $ T.unpack query) + returnA -< (c, nc) ------------------------------------------------------------------------ filterWith :: (SqlOrd date, SqlOrd title, SqlOrd category, SqlOrd score, hyperdata ~ Column SqlJsonb) => diff --git a/src/Gargantext/Database/Query/Join.hs b/src/Gargantext/Database/Query/Join.hs index 51421ee482fcbbe2d1fcfe609df0c5fe64e2d772..a4b8483ccc49d08e951dd50c48cd13ede721bcb3 100644 --- a/src/Gargantext/Database/Query/Join.hs +++ b/src/Gargantext/Database/Query/Join.hs @@ -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, diff --git a/src/Gargantext/Database/Query/Table/Context.hs b/src/Gargantext/Database/Query/Table/Context.hs new file mode 100644 index 0000000000000000000000000000000000000000..ed434d8fa8b8c72c84e016db4bd5a77eb1141c91 --- /dev/null +++ b/src/Gargantext/Database/Query/Table/Context.hs @@ -0,0 +1,120 @@ +{-| +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 + +------------------------------------------------------------------------ diff --git a/src/Gargantext/Database/Query/Table/ContextNodeNgrams.hs b/src/Gargantext/Database/Query/Table/ContextNodeNgrams.hs new file mode 100644 index 0000000000000000000000000000000000000000..d346b942d7fc98f014eb1967d56a8997644359cc --- /dev/null +++ b/src/Gargantext/Database/Query/Table/ContextNodeNgrams.hs @@ -0,0 +1,55 @@ +{-| +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) + } diff --git a/src/Gargantext/Database/Query/Table/NodeNodeNgrams2.hs b/src/Gargantext/Database/Query/Table/ContextNodeNgrams2.hs similarity index 51% rename from src/Gargantext/Database/Query/Table/NodeNodeNgrams2.hs rename to src/Gargantext/Database/Query/Table/ContextNodeNgrams2.hs index 6c193a0361e1b242a6e0c7206124a54527aeb7af..2e70ba8019103dd0bf024a92143386e9d1f09589 100644 --- a/src/Gargantext/Database/Query/Table/NodeNodeNgrams2.hs +++ b/src/Gargantext/Database/Query/Table/ContextNodeNgrams2.hs @@ -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) diff --git a/src/Gargantext/Database/Query/Table/Ngrams.hs b/src/Gargantext/Database/Query/Table/Ngrams.hs index ca90f08a06c35d934ba96d3ae89c00b4818e17c0..28519aebf110690a952ea2826c8834fea14dcd47 100644 --- a/src/Gargantext/Database/Query/Table/Ngrams.hs +++ b/src/Gargantext/Database/Query/Table/Ngrams.hs @@ -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 diff --git a/src/Gargantext/Database/Query/Table/Node/Document/Add.hs b/src/Gargantext/Database/Query/Table/Node/Document/Add.hs index 8a86da71f5c3c6a252efec25fd83a7022361c8bc..cd31c020efbc05fad244ae259b8354ec5c5b52b0 100644 --- a/src/Gargantext/Database/Query/Table/Node/Document/Add.hs +++ b/src/Gargantext/Database/Query/Table/Node/Document/Add.hs @@ -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 ; |] diff --git a/src/Gargantext/Database/Query/Table/Node/Document/Insert.hs b/src/Gargantext/Database/Query/Table/Node/Document/Insert.hs index 9be36e6e32a0b8386abe3be6ceb609a857796c9b..4503ae49acc34020ea8c7da3ae730a7c7f7800e1 100644 --- a/src/Gargantext/Database/Query/Table/Node/Document/Insert.hs +++ b/src/Gargantext/Database/Query/Table/Node/Document/Insert.hs @@ -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 |] ------------------------------------------------------------------------ diff --git a/src/Gargantext/Database/Query/Table/NodeContext.hs b/src/Gargantext/Database/Query/Table/NodeContext.hs new file mode 100644 index 0000000000000000000000000000000000000000..58b3792ac61253e909d6871b217c8f874ab723bc --- /dev/null +++ b/src/Gargantext/Database/Query/Table/NodeContext.hs @@ -0,0 +1,217 @@ +{-| +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) diff --git a/src/Gargantext/Database/Schema/Context.hs b/src/Gargantext/Database/Schema/Context.hs new file mode 100644 index 0000000000000000000000000000000000000000..3aac72530325c27620b14dd447a6fa4e83497d98 --- /dev/null +++ b/src/Gargantext/Database/Schema/Context.hs @@ -0,0 +1,178 @@ +{-| +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" + } + ) +------------------------------------------------------------------------ diff --git a/src/Gargantext/Database/Schema/ContextNodeNgrams.hs b/src/Gargantext/Database/Schema/ContextNodeNgrams.hs new file mode 100644 index 0000000000000000000000000000000000000000..45b74fc46b2761a5a83fff60ed1dbf82c96e5bb5 --- /dev/null +++ b/src/Gargantext/Database/Schema/ContextNodeNgrams.hs @@ -0,0 +1,74 @@ +{-| +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" + } + ) diff --git a/src/Gargantext/Database/Schema/ContextNodeNgrams2.hs b/src/Gargantext/Database/Schema/ContextNodeNgrams2.hs new file mode 100644 index 0000000000000000000000000000000000000000..640f0db2dbdf2e9ef56a3c7608d62ad7a6193ee5 --- /dev/null +++ b/src/Gargantext/Database/Schema/ContextNodeNgrams2.hs @@ -0,0 +1,63 @@ +{-| +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" + } + ) diff --git a/src/Gargantext/Database/Schema/NgramsPostag.hs b/src/Gargantext/Database/Schema/NgramsPostag.hs index 1001a1004a6c0c664030d21688b0953237b9f8a7..0bd56c15134cf85c1c63a49d460ff1ecb3757d58 100644 --- a/src/Gargantext/Database/Schema/NgramsPostag.hs +++ b/src/Gargantext/Database/Schema/NgramsPostag.hs @@ -1,6 +1,6 @@ {-| 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 diff --git a/src/Gargantext/Database/Schema/NodeContext.hs b/src/Gargantext/Database/Schema/NodeContext.hs new file mode 100644 index 0000000000000000000000000000000000000000..6173f51d7c510545e4ac90f3c08fab3937cdf45f --- /dev/null +++ b/src/Gargantext/Database/Schema/NodeContext.hs @@ -0,0 +1,65 @@ +{-| +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" + } + )