src/Gargantext/Database/Schema/NodeNgram.hs

   1 {-|
   2 Module      : Gargantext.Database.Schema.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 RankNTypes             #-}
  27 {-# LANGUAGE TemplateHaskell        #-}
  28
  29
  30 -- TODO NodeNgrams
  31 module Gargantext.Database.Schema.NodeNgram where
  32
  33 import Data.Text (Text)
  34 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
  35 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  36 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
  37 import Database.PostgreSQL.Simple.SqlQQ (sql)
  38 import Gargantext.Core.Types.Main (ListTypeId)
  39 import Gargantext.Database.Utils (mkCmd, Cmd, runPGSQuery)
  40 import Gargantext.Database.Types.Node (NodeId, ListId)
  41 import Gargantext.Database.Schema.Node (pgNodeId)
  42 import Gargantext.Prelude
  43 import Opaleye
  44 import qualified Database.PostgreSQL.Simple as PGS (Only(..))
  45
  46 -- | TODO : remove id
  47 data NodeNgramPoly id node_id ngram_id weight ngrams_type
  48    = NodeNgram { nodeNgram_id      :: id
  49                , nodeNgram_node_id  :: node_id
  50                , nodeNgram_ngrams_id :: ngram_id
  51                , nodeNgram_weight  :: weight
  52                , nodeNgram_type    :: ngrams_type
  53                } deriving (Show)
  54
  55 type NodeNgramWrite =
  56      NodeNgramPoly
  57         (Maybe (Column PGInt4  ))
  58                (Column PGInt4  )
  59                (Column PGInt4  )
  60                (Column PGFloat8)
  61                (Column PGInt4  )
  62
  63 type NodeNgramRead =
  64      NodeNgramPoly
  65        (Column PGInt4  )
  66        (Column PGInt4  )
  67        (Column PGInt4  )
  68        (Column PGFloat8)
  69        (Column PGInt4  )
  70
  71 type NodeNgramReadNull =
  72      NodeNgramPoly
  73        (Column (Nullable PGInt4  ))
  74        (Column (Nullable PGInt4  ))
  75        (Column (Nullable PGInt4  ))
  76        (Column (Nullable PGFloat8))
  77        (Column (Nullable PGInt4  ))
  78
  79 type NodeNgram =
  80      NodeNgramPoly (Maybe NodeId) NodeId Int Double Int
  81
  82 $(makeAdaptorAndInstance "pNodeNgram" ''NodeNgramPoly)
  83 $(makeLensesWith abbreviatedFields    ''NodeNgramPoly)
  84
  85
  86 nodeNgramTable :: Table NodeNgramWrite NodeNgramRead
  87 nodeNgramTable  = Table "nodes_ngrams"
  88   ( pNodeNgram NodeNgram
  89     { nodeNgram_id        = optional "id"
  90     , nodeNgram_node_id   = required "node_id"
  91     , nodeNgram_ngrams_id = required "ngram_id"
  92     , nodeNgram_weight    = required "weight"
  93     , nodeNgram_type      = required "ngrams_type"
  94     }
  95   )
  96
  97 queryNodeNgramTable :: Query NodeNgramRead
  98 queryNodeNgramTable = queryTable nodeNgramTable
  99
 100 insertNodeNgrams :: [NodeNgram] -> Cmd err Int
 101 insertNodeNgrams = insertNodeNgramW
 102                  . map (\(NodeNgram _ n g w t) ->
 103                           NodeNgram Nothing (pgNodeId n)   (pgInt4 g)
 104                                             (pgDouble w) (pgInt4 t)
 105                         )
 106
 107 insertNodeNgramW :: [NodeNgramWrite] -> Cmd err Int
 108 insertNodeNgramW nns =
 109   mkCmd $ \c -> fromIntegral <$> runInsert_ c insertNothing
 110     where
 111       insertNothing = (Insert { iTable = nodeNgramTable
 112                               , iRows  = nns
 113                               , iReturning = rCount
 114                               , iOnConflict = (Just DoNothing)
 115                               })
 116
 117 type NgramsText = Text
 118
 119 updateNodeNgrams :: [(ListId, NgramsText, ListTypeId)] -> Cmd err [PGS.Only Int]
 120 updateNodeNgrams input = runPGSQuery updateQuery (PGS.Only $ Values fields $ input)
 121   where
 122     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","text","int4"]
 123     updateQuery = [sql| UPDATE nodes_ngrams as old SET
 124                  ngrams_type = new.typeList
 125                  from (?) as new(node_id,terms,typeList)
 126                  JOIN ngrams ON ngrams.terms = new.terms
 127                  WHERE old.node_id = new.node_id
 128                  AND   old.ngram_id = ngrams.id;
 129                  -- RETURNING new.ngram_id
 130                  |]
 131