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