src/Gargantext/Database/Query/Table/Ngrams.hs

   1 {-|
   2 Module      : Gargantext.Database.Query.Table.Ngrams
   3 Description : Deal with in Gargantext Database.
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 -}
  11
  12 {-# LANGUAGE Arrows            #-}
  13 {-# LANGUAGE QuasiQuotes       #-}
  14 {-# LANGUAGE TemplateHaskell   #-}
  15
  16 module Gargantext.Database.Query.Table.Ngrams
  17   ( module Gargantext.Database.Schema.Ngrams
  18   , queryNgramsTable
  19   , selectNgramsByDoc
  20   , insertNgrams
  21   )
  22     where
  23
  24 import Control.Lens ((^.))
  25 import Data.ByteString.Internal (ByteString)
  26 import Data.HashMap.Strict (HashMap)
  27 import Data.Text (Text)
  28 import qualified Data.HashMap.Strict        as HashMap
  29 import qualified Data.List                  as List
  30 import qualified Database.PostgreSQL.Simple as PGS
  31
  32 import Gargantext.Core.Types
  33 import Gargantext.Database.Prelude (runOpaQuery, Cmd, formatPGSQuery, runPGSQuery)
  34 import Gargantext.Database.Query.Join (leftJoin3)
  35 import Gargantext.Database.Query.Table.ContextNodeNgrams2
  36 import Gargantext.Database.Schema.Ngrams
  37 import Gargantext.Database.Schema.NodeNgrams
  38 import Gargantext.Database.Query.Table.NodeNgrams (queryNodeNgramsTable)
  39 import Gargantext.Database.Schema.Prelude
  40 import Gargantext.Database.Types
  41 import Gargantext.Prelude
  42
  43 queryNgramsTable :: Select NgramsRead
  44 queryNgramsTable = selectTable ngramsTable
  45
  46 selectNgramsByDoc :: [ListId] -> DocId -> NgramsType -> Cmd err [Text]
  47 selectNgramsByDoc lIds dId nt = runOpaQuery (query lIds dId nt)
  48   where
  49
  50     join :: Select (NgramsRead, NodeNgramsRead, ContextNodeNgrams2Read)
  51     join = leftJoin3 queryNgramsTable queryNodeNgramsTable queryContextNodeNgrams2Table on1 -- on2
  52       where
  53         on1 :: (NgramsRead, NodeNgramsRead, ContextNodeNgrams2Read) -> Column SqlBool
  54         on1 (ng, nng, cnng) =  (.&&)
  55                                  (ng^.ngrams_id .== nng^.nng_ngrams_id)
  56                                  (nng^.nng_id   .== cnng^.cnng2_nodengrams_id)
  57
  58     query lIds' dId' nt' = proc () -> do
  59       (ng,nng,cnng) <- join -< ()
  60       restrict -< foldl (\b lId -> ((pgNodeId lId) .== nng^.nng_node_id) .|| b) (sqlBool True) lIds'
  61       restrict -< (pgNodeId dId')    .== cnng^.cnng2_context_id
  62       restrict -< (pgNgramsType nt') .== nng^.nng_ngrams_type
  63       returnA  -< ng^.ngrams_terms
  64
  65
  66 _postNgrams :: CorpusId -> DocId -> [Text] -> Cmd err Int
  67 _postNgrams = undefined
  68
  69 _dbGetNgramsDb :: Cmd err [NgramsDB]
  70 _dbGetNgramsDb = runOpaQuery queryNgramsTable
  71
  72
  73 -- TODO-ACCESS: access must not be checked here but when insertNgrams is called.
  74 insertNgrams :: [Ngrams] -> Cmd err (HashMap Text NgramsId)
  75 insertNgrams ns =
  76   if List.null ns
  77      then pure HashMap.empty
  78      else HashMap.fromList <$> map (\(Indexed i t) -> (t, i)) <$> (insertNgrams' ns)
  79
  80 -- TODO-ACCESS: access must not be checked here but when insertNgrams' is called.
  81 insertNgrams' :: [Ngrams] -> Cmd err [Indexed Int Text]
  82 insertNgrams' ns = runPGSQuery queryInsertNgrams (PGS.Only $ Values fields ns)
  83   where
  84     fields = map (\t -> QualifiedIdentifier Nothing t) ["text", "int4"]
  85
  86 _insertNgrams_Debug :: [(Text, Size)] -> Cmd err ByteString
  87 _insertNgrams_Debug ns = formatPGSQuery queryInsertNgrams (PGS.Only $ Values fields ns)
  88   where
  89     fields = map (\t -> QualifiedIdentifier Nothing t) ["text", "int4"]
  90
  91 ----------------------
  92 queryInsertNgrams :: PGS.Query
  93 queryInsertNgrams = [sql|
  94     WITH input_rows(terms,n) AS (?)
  95     , ins AS (
  96        INSERT INTO ngrams (terms,n)
  97        SELECT * FROM input_rows
  98        ON CONFLICT (terms) DO NOTHING -- unique index created here
  99        RETURNING id,terms
 100        )
 101
 102     SELECT id, terms
 103     FROM   ins
 104     UNION  ALL
 105     SELECT c.id, terms
 106     FROM   input_rows
 107     JOIN   ngrams c USING (terms);     -- columns of unique index
 108            |]