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