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   , selectNgramsId
  22   )
  23     where
  24
  25 import Control.Lens ((^.))
  26 import Data.ByteString.Internal (ByteString)
  27 import Data.HashMap.Strict (HashMap)
  28 import Data.Map.Strict (Map)
  29 import Data.Text (Text)
  30 import Gargantext.Core.Types
  31 import Gargantext.Database.Prelude (runOpaQuery, Cmd, formatPGSQuery, runPGSQuery)
  32 import Gargantext.Database.Query.Join (leftJoin3)
  33 import Gargantext.Database.Query.Table.ContextNodeNgrams2
  34 import Gargantext.Database.Query.Table.NodeNgrams (queryNodeNgramsTable)
  35 import Gargantext.Database.Schema.Ngrams
  36 import Gargantext.Database.Schema.NodeNgrams
  37 import Gargantext.Database.Schema.Prelude
  38 import Gargantext.Database.Types
  39 import Gargantext.Prelude
  40 import qualified Data.HashMap.Strict        as HashMap
  41 import qualified Data.List                  as List
  42 import qualified Data.Map.Strict            as Map
  43 import qualified Database.PostgreSQL.Simple as PGS
  44
  45 queryNgramsTable :: Select NgramsRead
  46 queryNgramsTable = selectTable ngramsTable
  47
  48 selectNgramsByDoc :: [ListId] -> DocId -> NgramsType -> Cmd err [Text]
  49 selectNgramsByDoc lIds dId nt = runOpaQuery (query lIds dId nt)
  50   where
  51
  52     join :: Select (NgramsRead, NodeNgramsRead, ContextNodeNgrams2Read)
  53     join = leftJoin3 queryNgramsTable queryNodeNgramsTable queryContextNodeNgrams2Table on1 -- on2
  54       where
  55         on1 :: (NgramsRead, NodeNgramsRead, ContextNodeNgrams2Read) -> Column SqlBool
  56         on1 (ng, nng, cnng) =  (.&&)
  57                                  (ng^.ngrams_id .== nng^.nng_ngrams_id)
  58                                  (nng^.nng_id   .== cnng^.cnng2_nodengrams_id)
  59
  60     query lIds' dId' nt' = proc () -> do
  61       (ng,nng,cnng) <- join -< ()
  62       restrict -< foldl (\b lId -> ((pgNodeId lId) .== nng^.nng_node_id) .|| b) (sqlBool True) lIds'
  63       restrict -< (pgNodeId dId')    .== cnng^.cnng2_context_id
  64       restrict -< (pgNgramsType nt') .== nng^.nng_ngrams_type
  65       returnA  -< ng^.ngrams_terms
  66
  67
  68 _postNgrams :: CorpusId -> DocId -> [Text] -> Cmd err Int
  69 _postNgrams = undefined
  70
  71 _dbGetNgramsDb :: Cmd err [NgramsDB]
  72 _dbGetNgramsDb = runOpaQuery queryNgramsTable
  73
  74
  75 -- TODO-ACCESS: access must not be checked here but when insertNgrams is called.
  76 insertNgrams :: [Ngrams] -> Cmd err (HashMap Text NgramsId)
  77 insertNgrams ns =
  78   if List.null ns
  79      then pure HashMap.empty
  80      else HashMap.fromList <$> map (\(Indexed i t) -> (t, i)) <$> (insertNgrams' ns)
  81
  82 -- TODO-ACCESS: access must not be checked here but when insertNgrams' is called.
  83 insertNgrams' :: [Ngrams] -> Cmd err [Indexed Int Text]
  84 insertNgrams' ns = runPGSQuery queryInsertNgrams (PGS.Only $ Values fields ns)
  85   where
  86     fields = map (\t -> QualifiedIdentifier Nothing t) ["text", "int4"]
  87
  88 _insertNgrams_Debug :: [(Text, Size)] -> Cmd err ByteString
  89 _insertNgrams_Debug ns = formatPGSQuery queryInsertNgrams (PGS.Only $ Values fields ns)
  90   where
  91     fields = map (\t -> QualifiedIdentifier Nothing t) ["text", "int4"]
  92
  93 ----------------------
  94 queryInsertNgrams :: PGS.Query
  95 queryInsertNgrams = [sql|
  96     WITH input_rows(terms,n) AS (?)
  97     , ins AS (
  98        INSERT INTO ngrams (terms,n)
  99        SELECT * FROM input_rows
 100        ON CONFLICT (terms) DO NOTHING -- unique index created here
 101        RETURNING id,terms
 102        )
 103
 104     SELECT id, terms
 105     FROM   ins
 106     UNION  ALL
 107     SELECT c.id, terms
 108     FROM   input_rows
 109     JOIN   ngrams c USING (terms);     -- columns of unique index
 110            |]
 111
 112
 113 --------------------------------------------------------------------------
 114 selectNgramsId :: [Text] -> Cmd err (Map NgramsId Text)
 115 selectNgramsId ns =
 116   if List.null ns
 117      then pure Map.empty
 118      else Map.fromList <$> map (\(Indexed i t) -> (i, t)) <$> (selectNgramsId' ns)
 119
 120 selectNgramsId' :: [Text] -> Cmd err [Indexed Int Text]
 121 selectNgramsId' ns = runPGSQuery querySelectNgramsId ( PGS.Only
 122                                                      $ Values fields ns
 123                                                      )
 124   where
 125     fields = map (\t -> QualifiedIdentifier Nothing t) ["text"]
 126
 127     querySelectNgramsId :: PGS.Query
 128     querySelectNgramsId = [sql|
 129         WITH input_rows(terms) AS (?)
 130         SELECT n.id, n.terms
 131         FROM   ngrams n
 132         JOIN input_rows ir ON ir.terms = n.terms
 133         GROUP BY n.terms, n.id
 134         |]