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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
{-|
Module : Gargantext.Database.Schema.NodeNgrams
Description : NodeNgram for Ngram indexation or Lists
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
NodeNgram: relation between a Node and a Ngrams
if Node is a Document then it is indexing
if Node is a List then it is listing (either Stop, Candidate or Map)
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
-- TODO NodeNgrams
module Gargantext.Database.Schema.NodeNgram where
import Data.ByteString (ByteString)
import Data.Text (Text)
import Control.Lens.TH (makeLenses)
import Control.Monad (void)
import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
import Database.PostgreSQL.Simple.SqlQQ (sql)
import Gargantext.Database.Utils (mkCmd, Cmd, execPGSQuery)
import Gargantext.Core.Types.Main (ListTypeId)
import Gargantext.Database.Types.Node (NodeId, ListId)
import Gargantext.Database.Schema.Node (pgNodeId)
import Gargantext.Database.Schema.Ngrams (NgramsTypeId, pgNgramsTypeId)
import Gargantext.Prelude
import Gargantext.Database.Utils (formatPGSQuery)
import Opaleye
import qualified Database.PostgreSQL.Simple as DPS
-- | TODO : remove id
data NodeNgramPoly node_id ngrams_id parent_id ngrams_type list_type weight
= NodeNgram { nng_node_id :: node_id
, nng_ngrams_id :: ngrams_id
, nng_parent_id :: parent_id
, nng_ngramsType :: ngrams_type
, nng_listType :: list_type
, nng_weight :: weight
} deriving (Show)
type NodeNgramWrite =
NodeNgramPoly
(Column PGInt4 )
(Column PGInt4 )
(Maybe (Column PGInt4))
(Column PGInt4 )
(Column PGInt4 )
(Column PGFloat8)
type NodeNgramRead =
NodeNgramPoly
(Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column PGFloat8)
type NodeNgramReadNull =
NodeNgramPoly
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGFloat8))
type NodeNgram =
NodeNgramPoly NodeId Int (Maybe NgramsParentId) NgramsTypeId Int Double
newtype NgramsParentId = NgramsParentId Int
deriving (Show, Eq, Num)
pgNgramsParentId :: NgramsParentId -> Column PGInt4
pgNgramsParentId (NgramsParentId n) = pgInt4 n
$(makeAdaptorAndInstance "pNodeNgram" ''NodeNgramPoly)
makeLenses ''NodeNgramPoly
nodeNgramTable :: Table NodeNgramWrite NodeNgramRead
nodeNgramTable = Table "nodes_ngrams"
( pNodeNgram NodeNgram
{ nng_node_id = required "node_id"
, nng_ngrams_id = required "ngrams_id"
, nng_parent_id = optional "parent_id"
, nng_ngramsType = required "ngrams_type"
, nng_listType = required "list_type"
, nng_weight = required "weight"
}
)
queryNodeNgramTable :: Query NodeNgramRead
queryNodeNgramTable = queryTable nodeNgramTable
--{-
insertNodeNgrams :: [NodeNgram] -> Cmd err Int
insertNodeNgrams = insertNodeNgramW
. map (\(NodeNgram n g p ngt lt w) ->
NodeNgram (pgNodeId n)
(pgInt4 g)
(pgNgramsParentId <$> p)
(pgNgramsTypeId ngt)
(pgInt4 lt)
(pgDouble w)
)
insertNodeNgramW :: [NodeNgramWrite] -> Cmd err Int
insertNodeNgramW nns =
mkCmd $ \c -> fromIntegral <$> runInsert_ c insertNothing
where
insertNothing = (Insert { iTable = nodeNgramTable
, iRows = nns
, iReturning = rCount
, iOnConflict = (Just DoNothing)
})
--}
type NgramsText = Text
updateNodeNgrams' :: ListId -> [(NgramsTypeId, NgramsText, ListTypeId)] -> Cmd err ()
updateNodeNgrams' _ [] = pure ()
updateNodeNgrams' listId input = void $ execPGSQuery updateQuery (DPS.Only $ Values fields input')
where
fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","text","int4"]
input' = map (\(nt,t,lt) -> (listId, nt, t, lt)) input
updateNodeNgrams'_debug :: ListId -> [(NgramsTypeId, NgramsText, ListTypeId)] -> Cmd err ByteString
updateNodeNgrams'_debug listId input = formatPGSQuery updateQuery (DPS.Only $ Values fields input')
where
fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","text","int4"]
input' = map (\(nt,t,lt) -> (listId, nt, t, lt)) input
updateQuery :: DPS.Query
updateQuery = [sql|
WITH new(node_id,ngrams_type,terms,typeList) as (?)
INSERT into nodes_ngrams (node_id,ngrams_id,ngrams_type,list_type,weight)
SELECT node_id,ngrams.id,ngrams_type,typeList,1 FROM new
JOIN ngrams ON ngrams.terms = new.terms
ON CONFLICT (node_id, ngrams_id, ngrams_type) DO
-- DO NOTHING
UPDATE SET list_type = excluded.list_type
;
|]