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