src/Gargantext/Database/NodeNgram.hs

   1 {-|
   2 Module      : Gargantext.Database.NodeNgram
   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 QuasiQuotes            #-}
  25 {-# LANGUAGE TemplateHaskell        #-}
  26
  27
  28 module Gargantext.Database.NodeNgram where
  29
  30 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
  31 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  32 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
  33 import Database.PostgreSQL.Simple.SqlQQ (sql)
  34 import Gargantext.Database.Node (mkCmd, Cmd(..))
  35 import Gargantext.Prelude
  36 import Opaleye
  37 import qualified Database.PostgreSQL.Simple as PGS (Connection, query, Only(..))
  38
  39 -- | TODO : remove id
  40 data NodeNgramPoly id node_id ngram_id weight ngrams_type
  41    = NodeNgram { nodeNgram_NodeNgramId      :: id
  42                , nodeNgram_NodeNgramNodeId  :: node_id
  43                , nodeNgram_NodeNgramNgramId :: ngram_id
  44                , nodeNgram_NodeNgramWeight  :: weight
  45                , nodeNgram_NodeNgramType    :: ngrams_type
  46                } deriving (Show)
  47
  48 type NodeNgramWrite =
  49      NodeNgramPoly
  50         (Maybe (Column PGInt4  ))
  51                (Column PGInt4  )
  52                (Column PGInt4  )
  53                (Column PGFloat8)
  54                (Column PGInt4  )
  55
  56 type NodeNgramRead =
  57      NodeNgramPoly
  58        (Column PGInt4  )
  59        (Column PGInt4  )
  60        (Column PGInt4  )
  61        (Column PGFloat8)
  62        (Column PGInt4  )
  63
  64 type NodeNgram =
  65      NodeNgramPoly (Maybe Int) Int Int Double Int
  66
  67 $(makeAdaptorAndInstance "pNodeNgram" ''NodeNgramPoly)
  68 $(makeLensesWith abbreviatedFields    ''NodeNgramPoly)
  69
  70
  71 nodeNgramTable :: Table NodeNgramWrite NodeNgramRead
  72 nodeNgramTable  = Table "nodes_ngrams"
  73   ( pNodeNgram NodeNgram
  74     { nodeNgram_NodeNgramId      = optional "id"
  75     , nodeNgram_NodeNgramNodeId  = required "node_id"
  76     , nodeNgram_NodeNgramNgramId = required "ngram_id"
  77     , nodeNgram_NodeNgramWeight  = required "weight"
  78     , nodeNgram_NodeNgramType    = required "ngrams_type"
  79     }
  80   )
  81
  82 queryNodeNgramTable :: Query NodeNgramRead
  83 queryNodeNgramTable = queryTable nodeNgramTable
  84
  85 insertNodeNgrams :: [NodeNgram] -> Cmd Int
  86 insertNodeNgrams = insertNodeNgramW
  87                  . map (\(NodeNgram _ n g w t) ->
  88                           NodeNgram Nothing (pgInt4 n)   (pgInt4 g)
  89                                             (pgDouble w) (pgInt4 t)
  90                         )
  91
  92 insertNodeNgramW :: [NodeNgramWrite] -> Cmd Int
  93 insertNodeNgramW nns =
  94   mkCmd $ \c -> fromIntegral
  95        <$> runInsertMany c nodeNgramTable nns
  96
  97 -- TODO: remove these type (duplicate with others)
  98 type ListId     = Int
  99 type NgramsId   = Int
 100 type ListTypeId = Int
 101
 102 updateNodeNgrams :: PGS.Connection -> [(ListId, NgramsId, ListTypeId)] -> IO [PGS.Only Int]
 103 updateNodeNgrams c input = PGS.query c updateQuery (PGS.Only $ Values fields $ input)
 104   where
 105     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
 106     updateQuery = [sql| UPDATE nodes_ngrams as old SET
 107                  ngrams_type = new.typeList
 108                  from (?) as new(node_id,ngram_id,typeList)
 109                  WHERE old.node_id = new.node_id
 110                  AND   old.gram_id = new.gram_id
 111                  RETURNING new.ngram_id
 112                  |]
 113
 114
 115