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