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