{-| 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; |]