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 (ListId, ListTypeId)
  39 import Gargantext.Database.Utils (mkCmd, Cmd, runPGSQuery)
  40 import Gargantext.Prelude
  41 import Opaleye
  42 import qualified Database.PostgreSQL.Simple as PGS (Only(..))
  43
  44 -- | TODO : remove id
  45 data NodeNgramPoly id node_id ngram_id weight ngrams_type
  46    = NodeNgram { nodeNgram_id      :: id
  47                , nodeNgram_node_id  :: node_id
  48                , nodeNgram_ngrams_id :: ngram_id
  49                , nodeNgram_weight  :: weight
  50                , nodeNgram_type    :: 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 NodeNgramReadNull =
  70      NodeNgramPoly
  71        (Column (Nullable PGInt4  ))
  72        (Column (Nullable PGInt4  ))
  73        (Column (Nullable PGInt4  ))
  74        (Column (Nullable PGFloat8))
  75        (Column (Nullable PGInt4  ))
  76
  77 type NodeNgram =
  78      NodeNgramPoly (Maybe Int) Int Int Double Int
  79
  80 $(makeAdaptorAndInstance "pNodeNgram" ''NodeNgramPoly)
  81 $(makeLensesWith abbreviatedFields    ''NodeNgramPoly)
  82
  83
  84 nodeNgramTable :: Table NodeNgramWrite NodeNgramRead
  85 nodeNgramTable  = Table "nodes_ngrams"
  86   ( pNodeNgram NodeNgram
  87     { nodeNgram_id        = optional "id"
  88     , nodeNgram_node_id   = required "node_id"
  89     , nodeNgram_ngrams_id = required "ngram_id"
  90     , nodeNgram_weight    = required "weight"
  91     , nodeNgram_type      = required "ngrams_type"
  92     }
  93   )
  94
  95 queryNodeNgramTable :: Query NodeNgramRead
  96 queryNodeNgramTable = queryTable nodeNgramTable
  97
  98 insertNodeNgrams :: [NodeNgram] -> Cmd err Int
  99 insertNodeNgrams = insertNodeNgramW
 100                  . map (\(NodeNgram _ n g w t) ->
 101                           NodeNgram Nothing (pgInt4 n)   (pgInt4 g)
 102                                             (pgDouble w) (pgInt4 t)
 103                         )
 104
 105 insertNodeNgramW :: [NodeNgramWrite] -> Cmd err Int
 106 insertNodeNgramW nns =
 107   mkCmd $ \c -> fromIntegral <$> runInsert_ c insertNothing
 108     where
 109       insertNothing = (Insert { iTable = nodeNgramTable
 110                               , iRows  = nns
 111                               , iReturning = rCount
 112                               , iOnConflict = (Just DoNothing)
 113                               })
 114
 115 type NgramsText = Text
 116
 117 updateNodeNgrams :: [(ListId, NgramsText, ListTypeId)] -> Cmd err [PGS.Only Int]
 118 updateNodeNgrams input = runPGSQuery updateQuery (PGS.Only $ Values fields $ input)
 119   where
 120     fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","text","int4"]
 121     updateQuery = [sql| UPDATE nodes_ngrams as old SET
 122                  ngrams_type = new.typeList
 123                  from (?) as new(node_id,terms,typeList)
 124                  JOIN ngrams ON ngrams.terms = new.terms
 125                  WHERE old.node_id = new.node_id
 126                  AND   old.ngram_id = ngrams.id;
 127                  -- RETURNING new.ngram_id
 128                  |]
 129