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