2 Module : Gargantext.Database.Query.Table.NodeNgrams
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
10 NodeNgrams register Context of Ngrams (named Cgrams then)
14 {-# OPTIONS_GHC -fno-warn-orphans #-}
16 {-# LANGUAGE Arrows #-}
17 {-# LANGUAGE FunctionalDependencies #-}
18 {-# LANGUAGE QuasiQuotes #-}
19 {-# LANGUAGE TemplateHaskell #-}
21 module Gargantext.Database.Query.Table.NodeNgrams
24 , module Gargantext.Database.Schema.NodeNgrams
28 import Data.List.Extra (nubOrd)
30 import Data.Maybe (fromMaybe)
31 import Data.Text (Text)
32 import Database.PostgreSQL.Simple (FromRow)
33 import Database.PostgreSQL.Simple.FromRow (fromRow, field)
34 import Database.PostgreSQL.Simple.SqlQQ (sql)
35 import Database.PostgreSQL.Simple.ToField (toField)
36 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
37 import Gargantext.Core.Types
38 import Gargantext.Database.Prelude
39 import Gargantext.Database.Schema.Ngrams (NgramsType, ngramsTypeId, fromNgramsTypeId)
40 import Gargantext.Database.Schema.NodeNgrams
41 import Gargantext.Prelude
42 import qualified Data.List as List
43 import qualified Data.Map as Map
44 import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
47 -- | Type for query return
48 data Returning = Returning { re_type :: !(Maybe NgramsType)
50 , re_ngrams_id :: !Int
54 instance FromRow Returning where
55 fromRow = Returning <$> (fromNgramsTypeId <$> field) <*> field <*> field
57 getCgramsId :: Map NgramsType (Map Text Int) -> NgramsType -> Text -> Maybe Int
58 getCgramsId mapId nt t = case Map.lookup nt mapId of
60 Just mapId' -> Map.lookup t mapId'
63 -- insertDb :: ListId -> Map NgramsType [NgramsElement] -> Cmd err [Result]
64 listInsertDb :: Show a => ListId
65 -> (ListId -> a -> [NodeNgramsW])
67 -- -> Cmd err [Returning]
68 -> Cmd err (Map NgramsType (Map Text Int))
69 listInsertDb l f ngs = Map.map Map.fromList
70 <$> Map.fromListWith (<>)
71 <$> List.map (\(Returning t tx id) -> (fromJust t, [(tx, id)]))
72 <$> List.filter (\(Returning t _ _) -> isJust t)
73 <$> insertNodeNgrams (f l ngs)
75 -- TODO optimize with size of ngrams
76 insertNodeNgrams :: [NodeNgramsW] -> Cmd err [Returning]
77 insertNodeNgrams nns = runPGSQuery query (PGS.Only $ Values fields nns')
79 fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","text","int4"
80 ,"int4","int4","int4","int4"
82 -- nns' :: [(Int, ListTypeId, NgramsText, NgramsTypeId ,NgramsField, NgramsTag, NgramsClass, Double)]
83 nns' = map (\(NodeNgrams _id (NodeId node_id'') node_subtype ngrams_terms ngrams_type ngrams_field ngrams_tag ngrams_class weight)
84 -> [ toField node_id''
85 , toField $ listTypeId node_subtype
86 , toField $ ngrams_terms
87 , toField $ ngramsTypeId ngrams_type
88 , toField $ fromMaybe 0 ngrams_field
89 , toField $ fromMaybe 0 ngrams_tag
90 , toField $ fromMaybe 0 ngrams_class
97 WITH input(node_id, node_subtype, ngrams_terms, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight) AS (?),
98 return(id, ngrams_type, ngrams_id) AS (
99 INSERT INTO node_ngrams (node_id, node_subtype, ngrams_id, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight)
100 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
101 INNER JOIN ngrams as ng ON ng.terms = i.ngrams_terms
102 ON CONFLICT(node_id, node_subtype, ngrams_id) DO NOTHING
103 -- 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
104 RETURNING id, ngrams_type, ngrams_id
106 SELECT return.ngrams_type, ng.terms, return.id FROM return
107 INNER JOIN ngrams ng ON return.ngrams_id = ng.id;