2 Module : Gargantext.Database.Schema.NodeNgrams
3 Description : NodeNgram for Ngram indexation or Lists
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
10 NodeNgram: relation between a Node and a Ngrams
12 if Node is a Document then it is indexing
13 if Node is a List then it is listing (either Stop, Candidate or Map)
17 {-# OPTIONS_GHC -fno-warn-orphans #-}
19 {-# LANGUAGE Arrows #-}
20 {-# LANGUAGE FlexibleInstances #-}
21 {-# LANGUAGE FunctionalDependencies #-}
22 {-# LANGUAGE MultiParamTypeClasses #-}
23 {-# LANGUAGE NoImplicitPrelude #-}
24 {-# LANGUAGE OverloadedStrings #-}
25 {-# LANGUAGE QuasiQuotes #-}
26 {-# LANGUAGE RankNTypes #-}
27 {-# LANGUAGE TemplateHaskell #-}
31 module Gargantext.Database.Schema.NodeNgram where
33 import Data.Text (Text)
34 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
35 import Control.Monad (void)
36 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
37 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
38 import Database.PostgreSQL.Simple.SqlQQ (sql)
39 import Gargantext.Core.Types.Main (ListId, ListTypeId)
40 import Gargantext.Database.Utils (mkCmd, Cmd, execPGSQuery)
41 import Gargantext.Database.Schema.NodeNgramsNgrams
42 import Gargantext.Prelude
44 import qualified Database.PostgreSQL.Simple as PGS (Only(..))
47 data NodeNgramPoly id node_id ngram_id weight ngrams_type
48 = NodeNgram { nodeNgram_id :: id
49 , nodeNgram_node_id :: node_id
50 , nodeNgram_ngrams_id :: ngram_id
51 , nodeNgram_weight :: weight
52 , nodeNgram_type :: ngrams_type
57 (Maybe (Column PGInt4 ))
71 type NodeNgramReadNull =
73 (Column (Nullable PGInt4 ))
74 (Column (Nullable PGInt4 ))
75 (Column (Nullable PGInt4 ))
76 (Column (Nullable PGFloat8))
77 (Column (Nullable PGInt4 ))
80 NodeNgramPoly (Maybe Int) Int Int Double Int
82 $(makeAdaptorAndInstance "pNodeNgram" ''NodeNgramPoly)
83 $(makeLensesWith abbreviatedFields ''NodeNgramPoly)
86 nodeNgramTable :: Table NodeNgramWrite NodeNgramRead
87 nodeNgramTable = Table "nodes_ngrams"
88 ( pNodeNgram NodeNgram
89 { nodeNgram_id = optional "id"
90 , nodeNgram_node_id = required "node_id"
91 , nodeNgram_ngrams_id = required "ngram_id"
92 , nodeNgram_weight = required "weight"
93 , nodeNgram_type = required "ngrams_type"
97 queryNodeNgramTable :: Query NodeNgramRead
98 queryNodeNgramTable = queryTable nodeNgramTable
100 insertNodeNgrams :: [NodeNgram] -> Cmd err Int
101 insertNodeNgrams = insertNodeNgramW
102 . map (\(NodeNgram _ n g w t) ->
103 NodeNgram Nothing (pgInt4 n) (pgInt4 g)
104 (pgDouble w) (pgInt4 t)
107 insertNodeNgramW :: [NodeNgramWrite] -> Cmd err Int
108 insertNodeNgramW nns =
109 mkCmd $ \c -> fromIntegral <$> runInsert_ c insertNothing
111 insertNothing = (Insert { iTable = nodeNgramTable
113 , iReturning = rCount
114 , iOnConflict = (Just DoNothing)
117 type NgramsText = Text
119 updateNodeNgrams' :: [(ListId, NgramsText, ListTypeId)] -> Cmd err ()
120 updateNodeNgrams' [] = pure ()
121 updateNodeNgrams' input = void $ execPGSQuery updateQuery (PGS.Only $ Values fields input)
123 fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","text","int4"]
124 updateQuery = [sql| UPDATE nodes_ngrams as old SET
125 ngrams_type = new.typeList
126 from (?) as new(node_id,terms,typeList)
127 JOIN ngrams ON ngrams.terms = new.terms
128 WHERE old.node_id = new.node_id
129 AND old.ngram_id = ngrams.id;
132 data NodeNgramsUpdate = NodeNgramsUpdate
133 { _nnu_lists_update :: [(ListId, NgramsText, ListTypeId)]
134 , _nnu_add_children :: [(ListId, NgramsParent, NgramsChild, Maybe Double)]
135 , _nnu_rem_children :: [(ListId, NgramsParent, NgramsChild, Maybe Double)]
138 -- TODO wrap these updates in a transaction.
139 updateNodeNgrams :: NodeNgramsUpdate -> Cmd err ()
140 updateNodeNgrams nnu = do
141 updateNodeNgrams' $ _nnu_lists_update nnu
142 ngramsGroup Del $ _nnu_rem_children nnu
143 ngramsGroup Add $ _nnu_add_children nnu