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