Skip to content

H
haskell-gargantext
Commit 4c3e98b6 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[PAIRING][COSMETICS]

parent 27c08f8f
Hide whitespace changes
Inline Side-by-side
Showing with 53 additions and 43 deletions
devops/postgres/schema.sql
View file @ 4c3e98b6
......@@ -157,10 +157,10 @@ RETURNS trigger AS $$
begin
IF new.typename = 4 AND new.hyperdata @> '{"language_iso2":"EN"}' THEN
new.search := to_tsvector( 'english' , (new.hyperdata ->> 'title') || ' ' || (new.hyperdata ->> 'abstract'));
ELSIF new.typename = 4 AND new.hyperdata @> '{"language_iso2":"FR"}' THEN
new.search := to_tsvector( 'french' , (new.hyperdata ->> 'title') || ' ' || (new.hyperdata ->> 'abstract'));
ELSIF new.typename = 41 THEN
new.search := to_tsvector( 'french' , (new.hyperdata ->> 'prenom')
|| ' ' || (new.hyperdata ->> 'nom')
......@@ -194,6 +194,3 @@ UPDATE nodes SET hyperdata = hyperdata;
src/Gargantext/Database/Flow/Pairing.hs
View file @ 4c3e98b6
......@@ -20,7 +20,7 @@ module Gargantext.Database.Flow.Pairing
where
--import Debug.Trace (trace)
import Control.Lens (_Just,view)
import Control.Lens (_Just, (^.))
import Database.PostgreSQL.Simple.SqlQQ (sql)
-- import Opaleye
-- import Opaleye.Aggregate
......@@ -37,8 +37,7 @@ import Gargantext.Database.Node.Contact -- (HyperdataContact(..))
import Gargantext.Database.Flow.Utils
import Gargantext.Database.Utils (Cmd, runPGSQuery)
import Gargantext.Database.Types.Node (AnnuaireId, CorpusId, ListId)
import Gargantext.Database.Node.Children (getContacts)
import Gargantext.Core.Types (NodeType(..))
import Gargantext.Database.Node.Children (getAllContacts)
-- TODO mv this type in Types Main
type Terms = Text
......@@ -49,8 +48,9 @@ pairing :: AnnuaireId
-> ListId
-> Cmd err Int
pairing aId cId lId = do
contacts' <- getContacts aId (Just NodeContact)
let contactsMap = pairingPolicyToMap toLower $ toMaps extractNgramsT contacts'
contacts' <- getAllContacts aId
let contactsMap = pairingPolicyToMap toLower
$ toMaps extractNgramsT contacts'
ngramsMap' <- getNgramsTindexed cId Authors
let ngramsMap = pairingPolicyToMap lastName ngramsMap'
......@@ -82,7 +82,8 @@ extractNgramsT :: HyperdataContact
-> Map (NgramsT Ngrams) Int
extractNgramsT contact = fromList [(NgramsT Authors a' , 1)| a' <- authors ]
where
authors = map text2ngrams $ catMaybes [view (hc_who . _Just . cw_lastName) contact]
authors = map text2ngrams
$ catMaybes [ contact^.(hc_who . _Just . cw_lastName) ]
pairMaps :: Map (NgramsT Ngrams) a
......@@ -110,7 +111,7 @@ getNgramsTindexed corpusId ngramsType' = fromList
where
selectQuery = [sql| SELECT n.id,n.terms,n.n from ngrams n
JOIN node_node_ngrams occ ON occ.ngrams_id = n.id
JOIN nodes_nodes nn ON nn.node2_id = occ.node2_id
JOIN nodes_nodes nn ON nn.node2_id = occ.node2_id
WHERE nn.node1_id = ?
AND occ.ngrams_type = ?
......
src/Gargantext/Database/Node/Children.hs
View file @ 4c3e98b6
......@@ -18,6 +18,7 @@ Portability : POSIX
module Gargantext.Database.Node.Children where
import Data.Proxy
import Opaleye
import Gargantext.Core.Types
import Gargantext.Database.Schema.Node
......@@ -29,12 +30,21 @@ import Gargantext.Database.Node.Contact (HyperdataContact)
import Gargantext.Database.Schema.Node (pgNodeId)
import Control.Arrow (returnA)
-- | TODO: use getChildren with Proxy ?
getContacts :: ParentId
-> Maybe NodeType
-> Cmd err [Node HyperdataContact]
getContacts pId maybeNodeType = runOpaQuery $ selectChildren pId maybeNodeType
getAllDocuments :: ParentId -> Cmd err [Node HyperdataDocument]
getAllDocuments pId = getAllChildren pId (Proxy :: Proxy HyperdataDocument)
(Just NodeDocument)
getAllContacts :: ParentId -> Cmd err [Node HyperdataContact]
getAllContacts pId = getAllChildren pId (Proxy :: Proxy HyperdataContact)
(Just NodeContact)
getAllChildren :: JSONB a
=> ParentId
-> proxy a
-> Maybe NodeType
-> Cmd err [Node a]
getAllChildren pId p maybeNodeType = getChildren pId p maybeNodeType Nothing Nothing
getChildren :: JSONB a
=> ParentId
......@@ -62,7 +72,3 @@ selectChildren parentId maybeNodeType = proc () -> do
( (.&&) (n1id .== pgNodeId parentId)
(n2id .== nId))
returnA -< row
src/Gargantext/Database/TextSearch.hs
View file @ 4c3e98b6
......@@ -66,9 +66,11 @@ searchInCorpus :: CorpusId
-> Maybe Limit
-> Maybe OrderBy
-> Cmd err [FacetDoc]
searchInCorpus cId t q o l order = runOpaQuery (filterWith o l order $ queryInCorpus cId t q')
where
q' = intercalate " | " $ map stemIt q
searchInCorpus cId t q o l order = runOpaQuery
$ filterWith o l order
$ queryInCorpus cId t
$ intercalate " | "
$ map stemIt q
queryInCorpus :: CorpusId
-> IsTrash
......@@ -76,12 +78,12 @@ queryInCorpus :: CorpusId
-> O.Query FacetDocRead
queryInCorpus cId t q = proc () -> do
(n, nn) <- joinInCorpus -< ()
restrict -< ( nn^.nn_node1_id) .== (toNullable $ pgNodeId cId)
restrict -< (nn^.nn_node1_id) .== (toNullable $ pgNodeId cId)
restrict -< if t
then ( nn^.nn_category) .== (toNullable $ pgInt4 0)
else ( nn^.nn_category) .>= (toNullable $ pgInt4 1)
then (nn^.nn_category) .== (toNullable $ pgInt4 0)
else (nn^.nn_category) .>= (toNullable $ pgInt4 1)
restrict -< (n ^. ns_search) @@ (pgTSQuery (unpack q))
restrict -< (n ^. ns_typename) .== (pgInt4 $ nodeTypeId NodeDocument)
restrict -< (n ^. ns_typename ) .== (pgInt4 $ nodeTypeId NodeDocument)
returnA -< FacetDoc (n^.ns_id )
(n^.ns_date )
(n^.ns_name )
......@@ -129,29 +131,33 @@ searchInCorpusWithContacts'
-> Maybe OrderBy
-> Cmd err [(FacetPaired Int UTCTime HyperdataDocument Int (Maybe Int, Maybe Text))]
searchInCorpusWithContacts' cId lId q o l order =
runOpaQuery $ queryInCorpusWithContacts cId lId q' o l order
where
q' = intercalate " | " $ map stemIt q
runOpaQuery $ queryInCorpusWithContacts cId lId o l order
$ intercalate " | "
$ map stemIt q
queryInCorpusWithContacts
:: CorpusId
-> ListId
-> Text
-> Maybe Offset
-> Maybe Limit
-> Maybe OrderBy
-> Text
-> O.Query FacetPairedRead
queryInCorpusWithContacts cId lId q _ _ _ = proc () -> do
(docs, (corpusDoc, (docNgrams, (ngrams', (_, contacts))))) <- joinInCorpusWithContacts -< ()
restrict -< (docs^.ns_search) @@ (pgTSQuery $ unpack q )
restrict -< (docs^.ns_typename) .== (pgInt4 $ nodeTypeId NodeDocument)
restrict -< (docNgrams^.nnng_node2_id) .== (toNullable $ pgNodeId lId)
restrict -< (corpusDoc^.nn_node1_id) .== (toNullable $ pgNodeId cId)
-- restrict -< (nng_listType docNgrams) .== (toNullable $ pgNgramsType Authors)
restrict -< (contacts^.node_typename) .== (toNullable $ pgInt4 $ nodeTypeId NodeContact)
-- let contact_id = ifThenElse (isNull $ _node_id contacts) (toNullable $ pgInt4 0) (_node_id contacts)
returnA -< FacetPaired (docs^.ns_id) (docs^.ns_date) (docs^.ns_hyperdata) (pgInt4 0) (contacts^.node_id, ngrams'^.ngrams_terms)
queryInCorpusWithContacts cId lId _ _ _ q = proc () -> do
(n, (nn, (_nng, (ngrams', (_, contacts))))) <- joinInCorpusWithContacts -< ()
restrict -< (n^.ns_search) @@ (pgTSQuery $ unpack q )
restrict -< (n^.ns_typename) .== (pgInt4 $ nodeTypeId NodeDocument)
-- restrict -< (nng^.nnng_node1_id) .== (toNullable $ pgNodeId lId)
restrict -< (nn^.nn_node1_id) .== (toNullable $ pgNodeId cId)
-- -- restrict -< (nng_listType nng) .== (toNullable $ pgNgramsType Authors)
-- restrict -< (contacts^.node_typename) .== (toNullable $ pgInt4 $ nodeTypeId NodeContact)
-- -- let contact_id = ifThenElse (isNull $ _node_id contacts) (toNullable $ pgInt4 0) (_node_id contacts)
returnA -< FacetPaired (n^.ns_id)
(n^.ns_date)
(n^.ns_hyperdata)
(pgInt4 0)
(contacts^.node_id, ngrams'^.ngrams_terms)
joinInCorpusWithContacts :: O.Query ( NodeSearchRead
, ( NodeNodeReadNull
......@@ -179,7 +185,7 @@ joinInCorpusWithContacts =
cond56
where
cond12 :: (NodeNodeNgramsRead, NodeRead) -> Column PGBool
cond12 (ng3, n2) = n2^.node_id .== ng3^.nnng_node1_id
cond12 (nnng, n2) = n2^.node_id .== nnng^.nnng_node1_id
cond23 :: (NgramsRead, (NodeNodeNgramsRead, NodeReadNull)) -> Column PGBool
cond23 (ng2, (nnng2, _)) = nnng2^.nnng_ngrams_id .== ng2^.ngrams_id
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment