src/Gargantext/Database/Schema/NodeNgramsNgrams.hs

   1 {-|
   2 Module      : Gargantext.Database.Schema.NodeNgramsNgrams
   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 NodeNgramsNgrams table is used to group Ngrams
  11 - NodeId :: List Id
  12 - NgramId_1, NgramId_2 where all NgramId_2 will be added to NgramId_1
  13 - weight: probability of the relation (TODO, fixed to 1 for simple stemming)
  14
  15 Next Step benchmark:
  16 - recursive queries of postgres
  17 - group with: https://en.wikipedia.org/wiki/Nested_set_model
  18
  19 -}
  20
  21 {-# LANGUAGE Arrows                 #-}
  22 {-# LANGUAGE FlexibleInstances      #-}
  23 {-# LANGUAGE FunctionalDependencies #-}
  24 {-# LANGUAGE MultiParamTypeClasses  #-}
  25 {-# LANGUAGE NoImplicitPrelude      #-}
  26 {-# LANGUAGE OverloadedStrings      #-}
  27 {-# LANGUAGE QuasiQuotes            #-}
  28 {-# LANGUAGE RankNTypes             #-}
  29 {-# LANGUAGE TemplateHaskell        #-}
  30 {-# OPTIONS_GHC -fno-warn-orphans   #-}
  31
  32 module Gargantext.Database.Schema.NodeNgramsNgrams
  33   where
  34
  35 import Control.Lens (view)
  36 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
  37 import Control.Monad (void)
  38 import Control.Monad.IO.Class (liftIO)
  39 import Data.Text (Text)
  40 import Data.Maybe (Maybe)
  41 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  42 import Database.PostgreSQL.Simple.SqlQQ (sql)
  43 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
  44 import Gargantext.Database.Utils (Cmd, runOpaQuery, execPGSQuery, connection)
  45 import Gargantext.Database.Types.Node (ListId)
  46 import Gargantext.Database.Schema.Node (pgNodeId)
  47 import Gargantext.Prelude
  48 import Opaleye
  49 import qualified Database.PostgreSQL.Simple as PGS
  50
  51 data NodeNgramsNgramsPoly node_id ngram1_id ngram2_id weight =
  52   NodeNgramsNgrams { _nng_NodeId   :: node_id
  53                    , _nng_Ngram1Id :: ngram1_id
  54                    , _nng_Ngram2Id :: ngram2_id
  55                    , _nng_Weight   :: weight
  56                    } deriving (Show)
  57
  58 type NodeNgramsNgramsWrite =
  59   NodeNgramsNgramsPoly (Column PGInt4          )
  60                      (Column PGInt4          )
  61                      (Column PGInt4          )
  62                      (Maybe (Column PGFloat8))
  63
  64 type NodeNgramsNgramsRead  =
  65   NodeNgramsNgramsPoly (Column PGInt4  )
  66                      (Column PGInt4  )
  67                      (Column PGInt4  )
  68                      (Column PGFloat8)
  69
  70 type NodeNgramsNgrams =
  71   NodeNgramsNgramsPoly ListId
  72                      Int
  73                      Int
  74                     (Maybe Double)
  75
  76 $(makeAdaptorAndInstance "pNodeNgramsNgrams"
  77                          ''NodeNgramsNgramsPoly)
  78 $(makeLensesWith abbreviatedFields
  79                          ''NodeNgramsNgramsPoly)
  80
  81
  82 nodeNgramsNgramsTable :: Table NodeNgramsNgramsWrite NodeNgramsNgramsRead
  83 nodeNgramsNgramsTable  =
  84   Table "nodes_ngrams_ngrams"
  85        ( pNodeNgramsNgrams NodeNgramsNgrams
  86                        { _nng_NodeId   = required "node_id"
  87                        , _nng_Ngram1Id = required "ngram1_id"
  88                        , _nng_Ngram2Id = required "ngram2_id"
  89                        , _nng_Weight   = optional "weight"
  90                        }
  91        )
  92
  93 queryNodeNgramsNgramsTable :: Query NodeNgramsNgramsRead
  94 queryNodeNgramsNgramsTable = queryTable nodeNgramsNgramsTable
  95
  96 -- | Select NodeNgramsNgrams
  97 -- TODO not optimized (get all ngrams without filters)
  98 nodeNgramsNgrams :: Cmd err [NodeNgramsNgrams]
  99 nodeNgramsNgrams = runOpaQuery queryNodeNgramsNgramsTable
 100
 101 instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
 102     queryRunnerColumnDefault = fieldQueryRunnerColumn
 103
 104 instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
 105     queryRunnerColumnDefault = fieldQueryRunnerColumn
 106
 107
 108 -- TODO: Add option on conflict
 109 insertNodeNgramsNgramsNew :: [NodeNgramsNgrams] -> Cmd err Int
 110 insertNodeNgramsNgramsNew = insertNodeNgramsNgramsW
 111                  . map (\(NodeNgramsNgrams n ng1 ng2 maybeWeight) ->
 112                           NodeNgramsNgrams (pgNodeId n  )
 113                                            (pgInt4 ng1)
 114                                            (pgInt4 ng2)
 115                                            (pgDouble <$> maybeWeight)
 116                         )
 117
 118 insertNodeNgramsNgramsW :: [NodeNgramsNgramsWrite] -> Cmd err Int
 119 insertNodeNgramsNgramsW ns = do
 120   c <- view connection
 121   liftIO $ fromIntegral <$> runInsertMany c nodeNgramsNgramsTable ns
 122
 123 ------------------------------------------------------------------------
 124 data Action   = Del | Add
 125
 126 type NgramsParent = Text
 127 type NgramsChild  = Text
 128
 129
 130 ngramsGroup :: Action -> [(ListId, NgramsParent, NgramsChild, Maybe Double)]
 131              -> Cmd err ()
 132 ngramsGroup _ [] = pure ()
 133 ngramsGroup action ngs = runNodeNgramsNgrams q ngs
 134   where
 135     q = case action of
 136           Del -> queryDelNodeNgramsNgrams
 137           Add -> queryInsertNodeNgramsNgrams
 138
 139
 140 runNodeNgramsNgrams :: PGS.Query -> [(ListId, NgramsParent, NgramsChild, Maybe Double)] -> Cmd err ()
 141 runNodeNgramsNgrams q ngs = void $ execPGSQuery q (PGS.Only $ Values fields ngs')
 142   where
 143     ngs'   = map (\(n,ng1,ng2,w) -> (n,ng1,ng2,maybe 0 identity w)) ngs
 144     fields = map (\t -> QualifiedIdentifier Nothing t)
 145                  ["int4","text","text","float8"]
 146
 147 --------------------------------------------------------------------
 148 -- TODO: on conflict update weight
 149 queryInsertNodeNgramsNgrams :: PGS.Query
 150 queryInsertNodeNgramsNgrams = [sql|
 151     WITH input_rows(nId,ng1,ng2,w) AS (?)
 152     INSERT INTO nodes_ngrams_ngrams (node_id,ngram1_id,ngram2_id,weight)
 153     SELECT nId,ngrams1.id,ngrams2.id,w FROM input_rows
 154     JOIN ngrams ngrams1 ON ngrams1.terms = ng1
 155     JOIN ngrams ngrams2 ON ngrams2.terms = ng2
 156     ON CONFLICT (node_id,ngram1_id,ngram2_id) DO NOTHING -- unique index created here
 157            |]
 158
 159 queryDelNodeNgramsNgrams :: PGS.Query
 160 queryDelNodeNgramsNgrams = [sql|
 161     WITH input(nId,ng1,ng2,w) AS (?)
 162     DELETE FROM nodes_ngrams_ngrams nnn
 163     JOIN ngrams ngrams1 ON ngrams.terms = ng1
 164     JOIN ngrams ngrams2 ON ngrams.terms = ng2
 165     WHERE   nnn.node_id = input.nId
 166       AND nnn.ngram1_id = ngrams1.id
 167       AND nnn.ngram2_id = ngrams2.id
 168        ;)
 169            |]
 170