src/Gargantext/Database/Query/Table/NodeNgrams.hs

   1 {-|
   2 Module      : Gargantext.Database.Query.Table.NodeNgrams
   3 Description :
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 NodeNgrams register Context of Ngrams (named Cgrams then)
  11
  12 -}
  13
  14 {-# OPTIONS_GHC -fno-warn-orphans #-}
  15
  16 {-# LANGUAGE Arrows                 #-}
  17 {-# LANGUAGE FunctionalDependencies #-}
  18 {-# LANGUAGE QuasiQuotes            #-}
  19 {-# LANGUAGE TemplateHaskell        #-}
  20
  21 module Gargantext.Database.Query.Table.NodeNgrams
  22   ( getCgramsId
  23   , listInsertDb
  24   , module Gargantext.Database.Schema.NodeNgrams
  25   )
  26   where
  27
  28 import Data.List.Extra (nubOrd)
  29 import Data.Map (Map)
  30 import Data.Maybe (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(..))
  45
  46
  47 -- | Type for query return
  48 data Returning = Returning { re_type      :: !(Maybe NgramsType)
  49                            , re_terms     :: !Text
  50                            , re_ngrams_id :: !Int
  51                            }
  52   deriving (Show)
  53
  54 instance FromRow Returning where
  55   fromRow = Returning <$> (fromNgramsTypeId <$> field) <*> field <*> field
  56
  57 getCgramsId :: Map NgramsType (Map Text Int) -> NgramsType -> Text -> Maybe Int
  58 getCgramsId mapId nt t = case Map.lookup nt mapId of
  59   Nothing     -> Nothing
  60   Just mapId' -> Map.lookup t mapId'
  61
  62
  63 -- insertDb :: ListId -> Map NgramsType [NgramsElement] -> Cmd err [Result]
  64 listInsertDb :: Show a => ListId
  65              -> (ListId -> a -> [NodeNgramsW])
  66              -> a
  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)
  74
  75 -- TODO optimize with size of ngrams
  76 insertNodeNgrams :: [NodeNgramsW] -> Cmd err [Returning]
  77 insertNodeNgrams nns = runPGSQuery query (PGS.Only $ Values fields nns')
  78   where
  79     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","text","int4"
  80                                                       ,"int4","int4","int4","int4"
  81                                                       ,"float8"]
  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
  91                                  , toField weight
  92                                  ]
  93                   ) $ nubOrd nns
  94
  95     query :: PGS.Query
  96     query = [sql|
  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
 105           )
 106           SELECT return.ngrams_type, ng.terms, return.id FROM return
 107           INNER JOIN ngrams ng ON return.ngrams_id = ng.id;
 108   |]