src/Gargantext/Database/NodeNgram.hs

   1 {-|
   2 Module      : Gargantext.Database.NodeNgrams
   3 Description : NodeNgram for Ngram indexation or Lists
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 NodeNgram: relation between a Node and a Ngrams
  11
  12 if Node is a Document then it is indexing
  13 if Node is a List     then it is listing (either Stop, Candidate or Map)
  14
  15 -}
  16
  17 {-# OPTIONS_GHC -fno-warn-orphans   #-}
  18
  19 {-# LANGUAGE Arrows                 #-}
  20 {-# LANGUAGE FlexibleInstances      #-}
  21 {-# LANGUAGE FunctionalDependencies #-}
  22 {-# LANGUAGE MultiParamTypeClasses  #-}
  23 {-# LANGUAGE NoImplicitPrelude      #-}
  24 {-# LANGUAGE OverloadedStrings      #-}
  25 {-# LANGUAGE QuasiQuotes            #-}
  26 {-# LANGUAGE TemplateHaskell        #-}
  27
  28
  29 -- TODO NodeNgrams
  30 module Gargantext.Database.NodeNgram where
  31
  32 import Data.Text (Text)
  33 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
  34 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  35 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
  36 import Database.PostgreSQL.Simple.SqlQQ (sql)
  37 import Gargantext.Database.Ngrams (NgramsId)
  38 import Gargantext.Text.List.Types (ListId, ListTypeId)
  39 import Gargantext.Database.Node (mkCmd, Cmd(..))
  40 import Gargantext.Prelude
  41 import Opaleye
  42 import qualified Database.PostgreSQL.Simple as PGS (Connection, query, Only(..))
  43
  44 -- | TODO : remove id
  45 data NodeNgramPoly id node_id ngram_id weight ngrams_type
  46    = NodeNgram { nodeNgram_NodeNgramId      :: id
  47                , nodeNgram_NodeNgramNodeId  :: node_id
  48                , nodeNgram_NodeNgramNgramId :: ngram_id
  49                , nodeNgram_NodeNgramWeight  :: weight
  50                , nodeNgram_NodeNgramType    :: ngrams_type
  51                } deriving (Show)
  52
  53 type NodeNgramWrite =
  54      NodeNgramPoly
  55         (Maybe (Column PGInt4  ))
  56                (Column PGInt4  )
  57                (Column PGInt4  )
  58                (Column PGFloat8)
  59                (Column PGInt4  )
  60
  61 type NodeNgramRead =
  62      NodeNgramPoly
  63        (Column PGInt4  )
  64        (Column PGInt4  )
  65        (Column PGInt4  )
  66        (Column PGFloat8)
  67        (Column PGInt4  )
  68
  69 type NodeNgram =
  70      NodeNgramPoly (Maybe Int) Int Int Double Int
  71
  72 $(makeAdaptorAndInstance "pNodeNgram" ''NodeNgramPoly)
  73 $(makeLensesWith abbreviatedFields    ''NodeNgramPoly)
  74
  75
  76 nodeNgramTable :: Table NodeNgramWrite NodeNgramRead
  77 nodeNgramTable  = Table "nodes_ngrams"
  78   ( pNodeNgram NodeNgram
  79     { nodeNgram_NodeNgramId      = optional "id"
  80     , nodeNgram_NodeNgramNodeId  = required "node_id"
  81     , nodeNgram_NodeNgramNgramId = required "ngram_id"
  82     , nodeNgram_NodeNgramWeight  = required "weight"
  83     , nodeNgram_NodeNgramType    = required "ngrams_type"
  84     }
  85   )
  86
  87 queryNodeNgramTable :: Query NodeNgramRead
  88 queryNodeNgramTable = queryTable nodeNgramTable
  89
  90 insertNodeNgrams :: [NodeNgram] -> Cmd Int
  91 insertNodeNgrams = insertNodeNgramW
  92                  . map (\(NodeNgram _ n g w t) ->
  93                           NodeNgram Nothing (pgInt4 n)   (pgInt4 g)
  94                                             (pgDouble w) (pgInt4 t)
  95                         )
  96
  97 insertNodeNgramW :: [NodeNgramWrite] -> Cmd Int
  98 insertNodeNgramW nns =
  99   mkCmd $ \c -> fromIntegral
 100        <$> runInsertMany c nodeNgramTable nns
 101
 102 type NgramsText = Text
 103
 104 updateNodeNgrams :: PGS.Connection -> [(ListId, NgramsText, ListTypeId)] -> IO [PGS.Only Int]
 105 updateNodeNgrams c input = PGS.query c updateQuery (PGS.Only $ Values fields $ input)
 106   where
 107     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","text","int4"]
 108     updateQuery = [sql| UPDATE nodes_ngrams as old SET
 109                  ngrams_type = new.typeList
 110                  from (?) as new(node_id,terms,typeList)
 111                  JOIN ngrams ON ngrams.terms = new.terms
 112                  WHERE old.node_id = new.node_id
 113                  AND   old.ngram_id = ngrams.id;
 114                  -- RETURNING new.ngram_id
 115                  |]
 116