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.HashMap.Strict (HashMap)
  26 import Data.ByteString.Internal (ByteString)
  27 import Data.Text (Text)
  28 import qualified Database.PostgreSQL.Simple as PGS
  29 import qualified Data.List                  as List
  30 import qualified Data.HashMap.Strict        as HashMap
  31
  32 import Gargantext.Core.Types
  33 import Gargantext.Database.Prelude (runOpaQuery, Cmd)
  34 import Gargantext.Database.Prelude (runPGSQuery, formatPGSQuery)
  35 import Gargantext.Database.Query.Table.NodeNodeNgrams
  36 import Gargantext.Database.Schema.Ngrams
  37 import Gargantext.Database.Schema.Prelude
  38 import Gargantext.Database.Types
  39 import Gargantext.Prelude
  40
  41 queryNgramsTable :: Query NgramsRead
  42 queryNgramsTable = queryTable ngramsTable
  43
  44 selectNgramsByDoc :: [ListId] -> DocId -> NgramsType -> Cmd err [Text]
  45 selectNgramsByDoc lIds dId nt = runOpaQuery (query lIds dId nt)
  46   where
  47
  48     join :: Query (NgramsRead, NodeNodeNgramsReadNull)
  49     join = leftJoin queryNgramsTable queryNodeNodeNgramsTable on1
  50       where
  51         on1 (ng,nnng) = ng^.ngrams_id .== nnng^.nnng_ngrams_id
  52
  53     query cIds' dId' nt' = proc () -> do
  54       (ng,nnng) <- join -< ()
  55       restrict -< foldl (\b cId -> ((toNullable $ pgNodeId cId) .== nnng^.nnng_node1_id) .|| b) (pgBool True) cIds'
  56       restrict -< (toNullable $ pgNodeId dId')    .== nnng^.nnng_node2_id
  57       restrict -< (toNullable $ pgNgramsType nt') .== nnng^.nnng_ngramsType
  58       returnA  -< ng^.ngrams_terms
  59
  60
  61 _postNgrams :: CorpusId -> DocId -> [Text] -> Cmd err Int
  62 _postNgrams = undefined
  63
  64 _dbGetNgramsDb :: Cmd err [NgramsDB]
  65 _dbGetNgramsDb = runOpaQuery queryNgramsTable
  66
  67
  68 -- TODO-ACCESS: access must not be checked here but when insertNgrams is called.
  69 insertNgrams :: [Ngrams] -> Cmd err (HashMap Text NgramsId)
  70 insertNgrams ns =
  71   if List.null ns
  72      then pure HashMap.empty
  73      else HashMap.fromList <$> map (\(Indexed i t) -> (t, i)) <$> (insertNgrams' ns)
  74
  75 -- TODO-ACCESS: access must not be checked here but when insertNgrams' is called.
  76 insertNgrams' :: [Ngrams] -> Cmd err [Indexed Int Text]
  77 insertNgrams' ns = runPGSQuery queryInsertNgrams (PGS.Only $ Values fields ns)
  78   where
  79     fields = map (\t -> QualifiedIdentifier Nothing t) ["text", "int4"]
  80
  81 _insertNgrams_Debug :: [(Text, Size)] -> Cmd err ByteString
  82 _insertNgrams_Debug ns = formatPGSQuery queryInsertNgrams (PGS.Only $ Values fields ns)
  83   where
  84     fields = map (\t -> QualifiedIdentifier Nothing t) ["text", "int4"]
  85
  86 ----------------------
  87 queryInsertNgrams :: PGS.Query
  88 queryInsertNgrams = [sql|
  89     WITH input_rows(terms,n) AS (?)
  90     , ins AS (
  91        INSERT INTO ngrams (terms,n)
  92        SELECT * FROM input_rows
  93        ON CONFLICT (terms) DO NOTHING -- unique index created here
  94        RETURNING id,terms
  95        )
  96
  97     SELECT id, terms
  98     FROM   ins
  99     UNION  ALL
 100     SELECT c.id, terms
 101     FROM   input_rows
 102     JOIN   ngrams c USING (terms);     -- columns of unique index
 103            |]
 104
 105