src/Gargantext/Database/Schema/NodeNgrams.hs

   1 {-|
   2 Module      : Gargantext.Database.Schema.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
  15 {-# OPTIONS_GHC -fno-warn-orphans #-}
  16
  17 {-# LANGUAGE Arrows                 #-}
  18 {-# LANGUAGE FlexibleInstances      #-}
  19 {-# LANGUAGE FunctionalDependencies #-}
  20 {-# LANGUAGE QuasiQuotes            #-}
  21 {-# LANGUAGE MultiParamTypeClasses  #-}
  22 {-# LANGUAGE NoImplicitPrelude      #-}
  23 {-# LANGUAGE OverloadedStrings      #-}
  24 {-# LANGUAGE RankNTypes             #-}
  25 {-# LANGUAGE TemplateHaskell        #-}
  26
  27 module Gargantext.Database.Schema.NodeNgrams where
  28
  29 import Data.Text (Text)
  30 import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
  31 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
  32 import Database.PostgreSQL.Simple.FromRow (fromRow, field)
  33 import Database.PostgreSQL.Simple.ToField (toField)
  34 import Database.PostgreSQL.Simple (FromRow)
  35 import Database.PostgreSQL.Simple.SqlQQ (sql)
  36 -- import Control.Lens.TH (makeLenses)
  37 import Data.Maybe (Maybe, fromMaybe)
  38 import Gargantext.Core.Types
  39 import Gargantext.Database.Utils
  40 import Gargantext.Database.Schema.Ngrams (NgramsType, ngramsTypeId)
  41 import Gargantext.Prelude
  42
  43 data NodeNgramsPoly id
  44                     node_id'
  45                     node_subtype
  46                     ngrams_id
  47                     ngrams_type
  48                     ngrams_field
  49                     ngrams_tag
  50                     ngrams_class
  51                     weight
  52                    = NodeNgrams { _nng_id        :: id
  53                                 , _nng_node_id   :: node_id'
  54                                 , _nng_node_subtype :: node_subtype
  55                                 , _nng_ngrams_id :: ngrams_id
  56                                 , _nng_ngrams_type :: ngrams_type
  57                                 , _nng_ngrams_field :: ngrams_field
  58                                 , _nng_ngrams_tag :: ngrams_tag
  59                                 , _nng_ngrams_class :: ngrams_class
  60                                 , _nng_ngrams_weight :: weight
  61                               } deriving (Show)
  62
  63 {-
  64 type NodeNgramsWrite = NodeNgramsPoly (Maybe (Column (PGInt4)))
  65                                       (Column (PGInt4))
  66                                       (Maybe  (Column (PGInt4)))
  67                                       (Column (PGInt4))
  68                                       (Maybe  (Column (PGInt4)))
  69                                       (Maybe  (Column (PGInt4)))
  70                                       (Maybe  (Column (PGInt4)))
  71                                       (Maybe  (Column (PGInt4)))
  72                                       (Maybe  (Column (PGFloat8)))
  73
  74 type NodeNodeRead    = NodeNgramsPoly (Column PGInt4)
  75                                       (Column PGInt4)
  76                                       (Column PGInt4)
  77                                       (Column PGInt4)
  78                                       (Column PGInt4)
  79                                       (Column PGInt4)
  80                                       (Column PGInt4)
  81                                       (Column PGInt4)
  82                                       (Column PGFloat8)
  83
  84 type NodeNgramsReadNull = NodeNgramsPoly (Column (Nullable PGInt4))
  85                                          (Column (Nullable PGInt4))
  86                                          (Column (Nullable PGInt4))
  87                                          (Column (Nullable PGInt4))
  88
  89                                          (Column (Nullable PGInt4))
  90                                          (Column (Nullable PGInt4))
  91                                          (Column (Nullable PGInt4))
  92                                          (Column (Nullable PGInt4))
  93                                          (Column (Nullable PGFloat8))
  94 -}
  95 type NgramsId = Int
  96 type NgramsField = Int
  97 type NgramsTag   = Int
  98 type NgramsClass = Int
  99 type NgramsText  = Text
 100
 101 -- Example of list Ngrams
 102 -- type ListNgrams = NodeNgramsPoly (Maybe Int) ListType Text
 103
 104 type NodeNgramsW =
 105   NodeNgramsPoly (Maybe Int) NodeId ListType NgramsText
 106                   NgramsType (Maybe NgramsField) (Maybe NgramsTag) (Maybe NgramsClass)
 107                   Double
 108
 109 data Returning = Returning { re_terms :: Text
 110                            , re_ngrams_id :: Int
 111                            }
 112   deriving (Show)
 113
 114 instance FromRow Returning where
 115   fromRow = Returning <$> field <*> field
 116
 117 -- insertDb :: ListId -> Map NgramsType [NgramsElemet] -> Cmd err [Result]
 118 listInsertDb :: Show a => ListId
 119              -> (ListId -> a -> [NodeNgramsW])
 120              -> a
 121              -> Cmd err [Returning]
 122 listInsertDb l f ngs = insertNodeNgrams (f l ngs)
 123
 124 -- TODO optimize with size of ngrams
 125 insertNodeNgrams :: [NodeNgramsW] -> Cmd err [Returning]
 126 insertNodeNgrams nns = runPGSQuery query (PGS.Only $ Values fields nns')
 127   where
 128     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","text","int4"
 129                                                       ,"int4","int4","int4","int4"
 130                                                       ,"float8"]
 131     -- nns' :: [(Int, ListTypeId, NgramsText, NgramsTypeId ,NgramsField, NgramsTag, NgramsClass, Double)]
 132     nns' = map (\(NodeNgrams _id (NodeId node_id'') node_subtype ngrams_terms ngrams_type ngrams_field ngrams_tag ngrams_class weight)
 133                               -> [ toField node_id''
 134                                  , toField $ listTypeId node_subtype
 135                                  , toField $ ngrams_terms
 136                                  , toField $ ngramsTypeId ngrams_type
 137                                  , toField $ fromMaybe 0 ngrams_field
 138                                  , toField $ fromMaybe 0 ngrams_tag
 139                                  , toField $ fromMaybe 0 ngrams_class
 140                                  , toField weight
 141                                  ]
 142                   ) nns
 143
 144     query :: PGS.Query
 145     query = [sql|
 146           WITH input(node_id, node_subtype, ngrams_terms, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight) AS (?),
 147           return(id, ngrams_id) AS (
 148             INSERT INTO node_ngrams (node_id, node_subtype, ngrams_id, ngrams_type, ngrams_field, ngrams_tag, ngrams_class, weight)
 149             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
 150             INNER JOIN ngrams as ng ON ng.terms = i.ngrams_terms
 151             ON CONFLICT(node_id, node_subtype, ngrams_id)
 152             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
 153             RETURNING id, ngrams_id
 154           )
 155           SELECT ng.terms, return.id FROM return
 156           INNER JOIN ngrams ng ON return.ngrams_id = ng.id;
 157   |]