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 NoImplicitPrelude #-}
  14 {-# LANGUAGE FlexibleContexts  #-}
  15 {-# LANGUAGE RankNTypes        #-}
  16 {-# LANGUAGE TemplateHaskell   #-}
  17 {-# LANGUAGE QuasiQuotes       #-}
  18
  19 module Gargantext.Database.Query.Table.Ngrams
  20   ( module Gargantext.Database.Schema.Ngrams
  21   , queryNgramsTable
  22   , selectNgramsByDoc
  23   , insertNgrams
  24   )
  25     where
  26
  27 import Control.Arrow (returnA)
  28 import Control.Lens ((^.))
  29 import Data.Text (Text)
  30 import Data.Map (Map, fromList, lookup)
  31 import Gargantext.Core.Types
  32 import Gargantext.Database.Admin.Types.Node (pgNodeId)
  33 import Gargantext.Database.Admin.Utils (runOpaQuery, Cmd)
  34 import Gargantext.Database.Schema.Ngrams
  35 import Gargantext.Database.Admin.Utils (Cmd, runPGSQuery, runOpaQuery, formatPGSQuery)
  36 import Gargantext.Database.Query.Table.NodeNodeNgrams
  37 import Gargantext.Prelude
  38 import Gargantext.Database.Schema.Prelude
  39 import Data.ByteString.Internal (ByteString)
  40 import qualified Database.PostgreSQL.Simple as PGS
  41 import Opaleye
  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