1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
{-|
Module : Gargantext.Database.Query.Table.NodeNgrams
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
NodeNgrams register Context of Ngrams (named Cgrams then)
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.Database.Query.Table.NodeNgrams
( getCgramsId
, listInsertDb
, module Gargantext.Database.Schema.NodeNgrams
, queryNodeNgramsTable
)
where
import Data.List qualified as List
import Data.List.Extra (nubOrd)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromJust)
import Database.PostgreSQL.Simple qualified as PGS (Query, Only(..))
import Gargantext.Core
import Gargantext.Core.Types
import Gargantext.Database.Prelude (DBCmd, runPGSQuery)
import Gargantext.Database.Schema.Ngrams (NgramsType, fromNgramsTypeId)
import Gargantext.Database.Schema.NodeNgrams
import Gargantext.Database.Schema.Prelude (Select, FromRow, sql, fromRow, toField, field, Values(..), QualifiedIdentifier(..), selectTable)
import Gargantext.Prelude
queryNodeNgramsTable :: Select NodeNgramsRead
queryNodeNgramsTable = selectTable nodeNgramsTable
-- | Type for query return
data Returning = Returning { re_type :: !(Maybe NgramsType)
, re_terms :: !Text
, re_ngrams_id :: !Int
}
deriving (Show)
instance FromRow Returning where
fromRow = Returning <$> (fromNgramsTypeId <$> field) <*> field <*> field
getCgramsId :: Map NgramsType (Map Text Int) -> NgramsType -> Text -> Maybe Int
getCgramsId mapId nt t = case Map.lookup nt mapId of
Nothing -> Nothing
Just mapId' -> Map.lookup t mapId'
listInsertDb :: Show a => ListId
-> (ListId -> a -> [NodeNgramsW])
-> a
-> DBCmd err (Map NgramsType (Map Text Int))
listInsertDb l f ngs = Map.map Map.fromList
<$> Map.fromListWith (<>)
<$> List.map (\(Returning t tx id) -> (fromJust t, [(tx, id)]))
<$> List.filter (\(Returning t _ _) -> isJust t)
<$> insertNodeNgrams (f l ngs)
-- TODO optimize with size of ngrams
insertNodeNgrams :: [NodeNgramsW] -> DBCmd err [Returning]
insertNodeNgrams nns = runPGSQuery query (PGS.Only $ Values fields nns')
where
fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","text","int4"
,"int4","int4","int4","int4"
,"float8"]
-- nns' :: [(Int, ListTypeId, NgramsText, NgramsTypeId ,NgramsField, NgramsTag, NgramsClass, Double)]
nns' = map (\(NodeNgrams _id node_id'' node_subtype ngrams_terms ngrams_type ngrams_field ngrams_tag ngrams_class weight)
-> [ toField node_id''
, toField $ toDBid node_subtype
, toField $ ngrams_terms
, toField $ toDBid ngrams_type
, toField $ fromMaybe 0 ngrams_field
, toField $ fromMaybe 0 ngrams_tag
, toField $ fromMaybe 0 ngrams_class
, toField weight
]
) $ nubOrd nns
query :: PGS.Query
query = [sql|
WITH input(node_id, node_subtype, ngrams_terms, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight) AS (?),
return(id, ngrams_type, ngrams_id) AS (
INSERT INTO node_ngrams (node_id, node_subtype, ngrams_id, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight)
SELECT i.node_id, i.node_subtype, ng.id, i.ngrams_type, i.ngrams_field, i.ngrams_tag, i.ngrams_class, i.weight FROM input as i
INNER JOIN ngrams as ng ON ng.terms = i.ngrams_terms
ON CONFLICT(node_id, node_subtype, ngrams_id) DO NOTHING
-- DO UPDATE SET node_subtype = excluded.node_subtype, ngrams_type = excluded.ngrams_type, ngrams_field = excluded.ngrams_field, ngrams_tag = excluded.ngrams_tag, ngrams_class = excluded.ngrams_class, weight = excluded.weight
RETURNING id, ngrams_type, ngrams_id
)
SELECT return.ngrams_type, ng.terms, return.id FROM return
INNER JOIN ngrams ng ON return.ngrams_id = ng.id;
|]