src/Gargantext/Database/Schema/NodeNgramsNgrams.hs

   1 {-|
   2 Module      : Gargantext.Database.Schema.NodeNgramsNgrams
   3 Description :
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 NodeNgramsNgrams table is used to group Ngrams
  11 - NodeId :: List Id
  12 - NgramId_1, NgramId_2 where all NgramId_2 will be added to NgramId_1
  13 - weight: probability of the relation (TODO, fixed to 1 for simple stemming)
  14
  15 Next Step benchmark:
  16 - recursive queries of postgres
  17 - group with: https://en.wikipedia.org/wiki/Nested_set_model
  18
  19 -}
  20
  21 {-# LANGUAGE Arrows                 #-}
  22 {-# LANGUAGE FlexibleInstances      #-}
  23 {-# LANGUAGE FunctionalDependencies #-}
  24 {-# LANGUAGE MultiParamTypeClasses  #-}
  25 {-# LANGUAGE NoImplicitPrelude      #-}
  26 {-# LANGUAGE OverloadedStrings      #-}
  27 {-# LANGUAGE QuasiQuotes            #-}
  28 {-# LANGUAGE RankNTypes             #-}
  29 {-# LANGUAGE TemplateHaskell        #-}
  30 {-# OPTIONS_GHC -fno-warn-orphans   #-}
  31
  32 module Gargantext.Database.Schema.NodeNgramsNgrams
  33   where
  34
  35 import Control.Lens (view)
  36 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
  37 import Control.Monad.IO.Class (liftIO)
  38 import Data.Maybe (Maybe)
  39 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  40 import Gargantext.Database.Utils (Cmd, runOpaQuery, connection)
  41 import Gargantext.Database.Types.Node (ListId)
  42 import Gargantext.Database.Schema.Node (pgNodeId)
  43 import Gargantext.Prelude
  44 import Opaleye
  45
  46 data NodeNgramsNgramsPoly node_id ngram1_id ngram2_id weight =
  47   NodeNgramsNgrams { _nng_NodeId   :: node_id
  48                    , _nng_Ngram1Id :: ngram1_id
  49                    , _nng_Ngram2Id :: ngram2_id
  50                    , _nng_Weight   :: weight
  51                    } deriving (Show)
  52
  53 type NodeNgramsNgramsWrite =
  54   NodeNgramsNgramsPoly (Column PGInt4          )
  55                      (Column PGInt4          )
  56                      (Column PGInt4          )
  57                      (Maybe (Column PGFloat8))
  58
  59 type NodeNgramsNgramsRead  =
  60   NodeNgramsNgramsPoly (Column PGInt4  )
  61                      (Column PGInt4  )
  62                      (Column PGInt4  )
  63                      (Column PGFloat8)
  64
  65 type NodeNgramsNgrams =
  66   NodeNgramsNgramsPoly ListId
  67                      Int
  68                      Int
  69                     (Maybe Double)
  70
  71 $(makeAdaptorAndInstance "pNodeNgramsNgrams"
  72                          ''NodeNgramsNgramsPoly)
  73 $(makeLensesWith abbreviatedFields
  74                          ''NodeNgramsNgramsPoly)
  75
  76
  77 nodeNgramsNgramsTable :: Table NodeNgramsNgramsWrite NodeNgramsNgramsRead
  78 nodeNgramsNgramsTable  =
  79   Table "nodes_ngrams_ngrams"
  80        ( pNodeNgramsNgrams NodeNgramsNgrams
  81                        { _nng_NodeId   = required "node_id"
  82                        , _nng_Ngram1Id = required "ngram1_id"
  83                        , _nng_Ngram2Id = required "ngram2_id"
  84                        , _nng_Weight   = optional "weight"
  85                        }
  86        )
  87
  88 queryNodeNgramsNgramsTable :: Query NodeNgramsNgramsRead
  89 queryNodeNgramsNgramsTable = queryTable nodeNgramsNgramsTable
  90
  91 -- | Select NodeNgramsNgrams
  92 -- TODO not optimized (get all ngrams without filters)
  93 nodeNgramsNgrams :: Cmd err [NodeNgramsNgrams]
  94 nodeNgramsNgrams = runOpaQuery queryNodeNgramsNgramsTable
  95
  96 instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
  97     queryRunnerColumnDefault = fieldQueryRunnerColumn
  98
  99 instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
 100     queryRunnerColumnDefault = fieldQueryRunnerColumn
 101
 102
 103 -- TODO: Add option on conflict
 104 insertNodeNgramsNgramsNew :: [NodeNgramsNgrams] -> Cmd err Int
 105 insertNodeNgramsNgramsNew = insertNodeNgramsNgramsW
 106                  . map (\(NodeNgramsNgrams n ng1 ng2 maybeWeight) ->
 107                           NodeNgramsNgrams (pgNodeId n  )
 108                                            (pgInt4 ng1)
 109                                            (pgInt4 ng2)
 110                                            (pgDouble <$> maybeWeight)
 111                         )
 112
 113 insertNodeNgramsNgramsW :: [NodeNgramsNgramsWrite] -> Cmd err Int
 114 insertNodeNgramsNgramsW ns = do
 115   c <- view connection
 116   liftIO $ fromIntegral <$> runInsertMany c nodeNgramsNgramsTable ns
 117