src/Gargantext/Database/NodeNgramsNgrams.hs

   1 {-|
   2 Module      : Gargantext.Database.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 TemplateHaskell        #-}
  29 {-# OPTIONS_GHC -fno-warn-orphans   #-}
  30
  31 module Gargantext.Database.NodeNgramsNgrams
  32   where
  33
  34 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
  35 import Data.Maybe (Maybe)
  36 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  37 import Database.PostgreSQL.Simple.SqlQQ (sql)
  38 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
  39 import Gargantext.Database.Node (mkCmd, Cmd(..))
  40 import Gargantext.Prelude
  41 import Opaleye
  42 import qualified Database.PostgreSQL.Simple as DPS
  43
  44 data NodeNgramsNgramsPoly node_id ngram1_id ngram2_id weight =
  45   NodeNgramsNgrams { _nng_NodeId   :: node_id
  46                    , _nng_Ngram1Id :: ngram1_id
  47                    , _nng_Ngram2Id :: ngram2_id
  48                    , _nng_Weight   :: weight
  49                    } deriving (Show)
  50
  51
  52 type NodeNgramsNgramsWrite =
  53   NodeNgramsNgramsPoly (Column PGInt4          )
  54                      (Column PGInt4          )
  55                      (Column PGInt4          )
  56                      (Maybe (Column PGFloat8))
  57
  58 type NodeNgramsNgramsRead  =
  59   NodeNgramsNgramsPoly (Column PGInt4  )
  60                      (Column PGInt4  )
  61                      (Column PGInt4  )
  62                      (Column PGFloat8)
  63
  64 type NodeNgramsNgrams =
  65   NodeNgramsNgramsPoly Int
  66                      Int
  67                      Int
  68                     (Maybe Double)
  69
  70 $(makeAdaptorAndInstance "pNodeNgramsNgrams"
  71                          ''NodeNgramsNgramsPoly)
  72 $(makeLensesWith abbreviatedFields
  73                          ''NodeNgramsNgramsPoly)
  74
  75
  76 nodeNgramsNgramsTable :: Table NodeNgramsNgramsWrite NodeNgramsNgramsRead
  77 nodeNgramsNgramsTable  =
  78   Table "nodes_ngrams_ngrams"
  79        ( pNodeNgramsNgrams NodeNgramsNgrams
  80                        { _nng_NodeId   = required "node_id"
  81                        , _nng_Ngram1Id = required "ngram1_id"
  82                        , _nng_Ngram2Id = required "ngram2_id"
  83                        , _nng_Weight   = optional "weight"
  84                        }
  85        )
  86
  87 queryNodeNgramsNgramsTable :: Query NodeNgramsNgramsRead
  88 queryNodeNgramsNgramsTable = queryTable nodeNgramsNgramsTable
  89
  90 -- | Select NodeNgramsNgrams
  91 -- TODO not optimized (get all ngrams without filters)
  92 nodeNgramsNgrams :: DPS.Connection -> IO [NodeNgramsNgrams]
  93 nodeNgramsNgrams conn = runQuery conn queryNodeNgramsNgramsTable
  94
  95 instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
  96     queryRunnerColumnDefault = fieldQueryRunnerColumn
  97
  98 instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
  99     queryRunnerColumnDefault = fieldQueryRunnerColumn
 100
 101
 102 -- TODO: Add option on conflict
 103 insertNodeNgramsNgramsNew :: [NodeNgramsNgrams] -> Cmd Int
 104 insertNodeNgramsNgramsNew = insertNodeNgramsNgramsW
 105                  . map (\(NodeNgramsNgrams n ng1 ng2 maybeWeight) ->
 106                           NodeNgramsNgrams (pgInt4 n  )
 107                                            (pgInt4 ng1)
 108                                            (pgInt4 ng2)
 109                                            (pgDouble <$> maybeWeight)
 110                         )
 111
 112 insertNodeNgramsNgramsW :: [NodeNgramsNgramsWrite] -> Cmd Int
 113 insertNodeNgramsNgramsW ns =
 114   mkCmd $ \c -> fromIntegral
 115        <$> runInsertMany c nodeNgramsNgramsTable ns
 116
 117 ------------------------------------------------------------------------
 118 data Action   = Del | Add
 119
 120 ngramsGroup :: Action -> [NodeNgramsNgrams] -> Cmd [Int]
 121 ngramsGroup a ngs = mkCmd $ \c -> ngramsGroup' c a ngs
 122
 123 -- TODO: remove this function (use Reader Monad only)
 124 ngramsGroup' :: DPS.Connection -> Action -> [NodeNgramsNgrams] -> IO [Int]
 125 ngramsGroup' c action ngs = runNodeNgramsNgrams c q ngs
 126   where
 127     q = case action of
 128           Del -> queryDelNodeNgramsNgrams
 129           Add -> queryInsertNodeNgramsNgrams
 130
 131
 132 runNodeNgramsNgrams :: DPS.Connection -> DPS.Query -> [NodeNgramsNgrams] -> IO [Int]
 133 runNodeNgramsNgrams c q ngs = map (\(DPS.Only a) -> a) <$> DPS.query c q (DPS.Only $ Values fields ngs' )
 134   where
 135     ngs'   = map (\(NodeNgramsNgrams n ng1 ng2 w) -> (n,ng1,ng2,maybe 0 identity w)) ngs
 136     fields = map (\t -> QualifiedIdentifier Nothing t)
 137                  ["int4","int4","int4","double"]
 138
 139 --------------------------------------------------------------------
 140 -- TODO: on conflict update weight
 141 queryInsertNodeNgramsNgrams :: DPS.Query
 142 queryInsertNodeNgramsNgrams = [sql|
 143     WITH input_rows(nId,ng1,ng2,w) AS (?)
 144     , ins AS (
 145        INSERT INTO nodes_ngrams_ngrams (node_id,ngram1_id,ngram2_id,weight)
 146        SELECT * FROM input_rows
 147        ON CONFLICT (node_id,ngram1_id,ngram2_id) DO NOTHING -- unique index created here
 148        )
 149            |]
 150
 151 queryDelNodeNgramsNgrams :: DPS.Query
 152 queryDelNodeNgramsNgrams = [sql|
 153     WITH input(nId,ng1,ng2,w) AS (?)
 154     , DELETE FROM nodes_ngrams_ngrams
 155     WHERE   node_id = input.nId
 156       AND ngram1_id = input.ng1
 157       AND ngram2_id = input.ng2
 158        ;)
 159            |]
 160