Skip to content

haskell-gargantext
haskell-gargantext
Commit 1114fe2d authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[DB] Node_NodeNgrams_NodeNgrams

parent ba75f548
Hide whitespace changes
Inline Side-by-side
Showing with 131 additions and 8 deletions
src/Gargantext/Database/Schema/NodeNgrams.hs
View file @ 1114fe2d
......@@ -7,7 +7,8 @@ Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
NodeNgrams: mainly NodeList and its ngrams.
NodeNgrams register Context of Ngrams (named Cgrams then)
-}
......@@ -35,7 +36,6 @@ import Database.PostgreSQL.Simple.SqlQQ (sql)
import Data.Maybe (Maybe, fromMaybe)
import Gargantext.Core.Types
import Gargantext.Database.Utils
import Gargantext.Database.Config (nodeTypeId)
import Gargantext.Database.Schema.Ngrams (NgramsType, NgramsTypeId, ngramsTypeId)
import Gargantext.Prelude
......@@ -105,21 +105,23 @@ type NodeNgramsW =
NgramsType (Maybe NgramsField) (Maybe NgramsTag) (Maybe NgramsClass)
Double
data Result = Result { unResult :: Int }
data Returning = Returning { re_terms :: Text
, re_ngrams_id :: Int
}
deriving (Show)
instance FromRow Result where
fromRow = Result <$> field
instance FromRow Returning where
fromRow = Returning <$> field <*> field
-- insertDb :: ListId -> Map NgramsType [NgramsElemet] -> Cmd err [Result]
listInsertDb :: ListId
-> (ListId -> a -> [NodeNgramsW])
-> a
-> Cmd err [Result]
-> Cmd err [Returning]
listInsertDb l f ngs = insertNodeNgrams (f l ngs)
-- TODO optimize with size of ngrams
insertNodeNgrams :: [NodeNgramsW] -> Cmd err [Result]
insertNodeNgrams :: [NodeNgramsW] -> Cmd err [Returning]
insertNodeNgrams nns = runPGSQuery query (PGS.Only $ Values fields nns')
where
fields = map (\t-> QualifiedIdentifier Nothing t) [ "int4","int4","text","int4"
......@@ -140,10 +142,11 @@ insertNodeNgrams nns = runPGSQuery query (PGS.Only $ Values fields nns')
query :: PGS.Query
query = [sql|
INSERT INTO node_ngrams_ngrams VALUES (node_id, node_type, ngrams_id, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight)
INSERT INTO node_ngrams_ngrams nnn VALUES (node_id, node_type, ngrams_id, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight)
SELECT n.node_id, n.node_type, ng.ngrams_id, n.ngrams_type, n.ngrams_field, n.ngrams_tag, n.ngrams_class, n.weight FROM (?)
AS n(node_id, node_type, ngrams_terms, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight)
INNER JOIN ngrams as ng ON ng.terms = n.ngrams_terms
ON CONFLICT(node_id, ngrams_id)
DO UPDATE SET node_type = excluded.node_type, ngrams_type = excluded.ngrams_type, ngrams_field = excluded.ngrams_field, ngrams_tag = excluded.ngrams_tag, ngrams_class = excluded.ngrams_class, weight = excluded.weight
RETURNING nnn.id, n.ngrams_terms
|]
src/Gargantext/Database/Schema/NodeNgramsNgrams.hs → src/Gargantext/Database/Schema/Node_NodeNgrams_NodeNgrams.hs
View file @ 1114fe2d
{-|
Module : Gargantext.Database.Schema.NodeNgramsNgrams
Module : Gargantext.Database.Schema.Node_NodeNgrams_NodeNgrams
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
......@@ -7,10 +7,13 @@ Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
NodeNgramsNgrams table is used to group Ngrams
- NodeId :: List Id
- NgramId_1, NgramId_2 where all NgramId_2 will be added to NgramId_1
- weight: probability of the relation (TODO, fixed to 1 for simple stemming)
lgrams: listed ngrams
Node_NodeNgrams_NodeNgrams table is used to group ngrams
- first NodeId :: Referential / space node (corpus)
- NodeNgrams where Node is List
- lgrams1_id, lgrams2_id where all lgrams2_id will be added to lgrams1_id
- weight: score the relation
Next Step benchmark:
- recursive queries of postgres
......@@ -29,7 +32,7 @@ Next Step benchmark:
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Gargantext.Database.Schema.NodeNgramsNgrams
module Gargantext.Database.Schema.Node_NodeNgrams_NodeNgrams
where
import Control.Lens (view)
......@@ -38,60 +41,61 @@ import Control.Monad.IO.Class (liftIO)
import Data.Maybe (Maybe)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Gargantext.Database.Utils (Cmd, runOpaQuery, connection)
import Gargantext.Database.Types.Node (ListId)
import Gargantext.Database.Types.Node (CorpusId)
import Gargantext.Database.Schema.Node (pgNodeId)
import Gargantext.Prelude
import Opaleye
data NodeNgramsNgramsPoly node_id ngram1_id ngram2_id weight =
NodeNgramsNgrams { _nng_NodeId :: node_id
, _nng_Ngram1Id :: ngram1_id
, _nng_Ngram2Id :: ngram2_id
, _nng_Weight :: weight
} deriving (Show)
type NodeNgramsNgramsWrite =
NodeNgramsNgramsPoly (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Maybe (Column PGFloat8))
type NodeNgramsNgramsRead =
NodeNgramsNgramsPoly (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGFloat8)
type NodeNgramsNgrams =
NodeNgramsNgramsPoly ListId
Int
Int
(Maybe Double)
$(makeAdaptorAndInstance "pNodeNgramsNgrams"
''NodeNgramsNgramsPoly)
data Node_NodeNgrams_NodeNgrams_Poly node_id nng1_id nng2_id weight =
Node_NodeNgrams_NodeNgrams { _nnn_node_id :: node_id
, _nnn_nng1_id :: nng1_id
, _nnn_nng2_id :: nng2_id
, _nnn_weight :: weight
} deriving (Show)
type Node_NodeNgrams_NodeNgrams_Write =
Node_NodeNgrams_NodeNgrams_Poly
(Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Maybe (Column PGFloat8))
type Node_NodeNgrams_NodeNgrams_Read =
Node_NodeNgrams_NodeNgrams_Poly
(Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGFloat8)
type ListNgramsId = Int
type Node_NodeNgrams_NodeNgrams =
Node_NodeNgrams_NodeNgrams_Poly CorpusId ListNgramsId ListNgramsId (Maybe Double)
$(makeAdaptorAndInstance "pNode_NodeNgrams_NodeNgrams"
''Node_NodeNgrams_NodeNgrams_Poly)
$(makeLensesWith abbreviatedFields
''NodeNgramsNgramsPoly)
''Node_NodeNgrams_NodeNgrams_Poly)
nodeNgramsNgramsTable :: Table NodeNgramsNgramsWrite NodeNgramsNgramsRead
nodeNgramsNgramsTable =
Table "nodes_ngrams_ngrams"
( pNodeNgramsNgrams NodeNgramsNgrams
{ _nng_NodeId = required "node_id"
, _nng_Ngram1Id = required "ngram1_id"
, _nng_Ngram2Id = required "ngram2_id"
, _nng_Weight = optional "weight"
node_NodeNgrams_NodeNgrams_Table :: Table Node_NodeNgrams_NodeNgrams_Write Node_NodeNgrams_NodeNgrams_Read
node_NodeNgrams_NodeNgrams_Table =
Table "nodes_nodengrams_nodengrams"
( pNode_NodeNgrams_NodeNgrams Node_NodeNgrams_NodeNgrams
{ _nnn_node_id = required "node_id"
, _nnn_nng1_id = required "nng1_id"
, _nnn_nng2_id = required "nng2_id"
, _nnn_weight = optional "weight"
}
)
queryNodeNgramsNgramsTable :: Query NodeNgramsNgramsRead
queryNodeNgramsNgramsTable = queryTable nodeNgramsNgramsTable
queryNode_NodeNgrams_NodeNgrams_Table :: Query Node_NodeNgrams_NodeNgrams_Read
queryNode_NodeNgrams_NodeNgrams_Table = queryTable node_NodeNgrams_NodeNgrams_Table
-- | Select NodeNgramsNgrams
-- TODO not optimized (get all ngrams without filters)
nodeNgramsNgrams :: Cmd err [NodeNgramsNgrams]
nodeNgramsNgrams = runOpaQuery queryNodeNgramsNgramsTable
node_Node_NodeNgrams_NodeNgrams :: Cmd err [Node_NodeNgrams_NodeNgrams]
node_Node_NodeNgrams_NodeNgrams = runOpaQuery queryNode_NodeNgrams_NodeNgrams_Table
instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
queryRunnerColumnDefault = fieldQueryRunnerColumn
......@@ -101,17 +105,16 @@ instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
-- TODO: Add option on conflict
insertNodeNgramsNgramsNew :: [NodeNgramsNgrams] -> Cmd err Int64
insertNodeNgramsNgramsNew = insertNodeNgramsNgramsW
. map (\(NodeNgramsNgrams n ng1 ng2 maybeWeight) ->
NodeNgramsNgrams (pgNodeId n )
insert_Node_NodeNgrams_NodeNgrams :: [Node_NodeNgrams_NodeNgrams] -> Cmd err Int64
insert_Node_NodeNgrams_NodeNgrams = insert_Node_NodeNgrams_NodeNgrams_W
. map (\(Node_NodeNgrams_NodeNgrams n ng1 ng2 maybeWeight) ->
Node_NodeNgrams_NodeNgrams (pgNodeId n )
(pgInt4 ng1)
(pgInt4 ng2)
(pgDouble <$> maybeWeight)
)
insertNodeNgramsNgramsW :: [NodeNgramsNgramsWrite] -> Cmd err Int64
insertNodeNgramsNgramsW ns = do
insert_Node_NodeNgrams_NodeNgrams_W :: [Node_NodeNgrams_NodeNgrams_Write] -> Cmd err Int64
insert_Node_NodeNgrams_NodeNgrams_W ns = do
c <- view connection
liftIO $ runInsertMany c nodeNgramsNgramsTable ns
liftIO $ runInsertMany c node_NodeNgrams_NodeNgrams_Table ns
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