]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Query/Table/Ngrams.hs
[VERSION] +1 to 0.0.4.9.9.6
[gargantext.git] / 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.Text (Text)
28 import qualified Database.PostgreSQL.Simple as PGS
29 import qualified Data.List as List
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 = selectTable 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) (sqlBool 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 =
71 if List.null ns
72 then pure HashMap.empty
73 else HashMap.fromList <$> map (\(Indexed i t) -> (t, i)) <$> (insertNgrams' ns)
74
75 -- TODO-ACCESS: access must not be checked here but when insertNgrams' is called.
76 insertNgrams' :: [Ngrams] -> Cmd err [Indexed Int Text]
77 insertNgrams' ns = runPGSQuery queryInsertNgrams (PGS.Only $ Values fields ns)
78 where
79 fields = map (\t -> QualifiedIdentifier Nothing t) ["text", "int4"]
80
81 _insertNgrams_Debug :: [(Text, Size)] -> Cmd err ByteString
82 _insertNgrams_Debug ns = formatPGSQuery queryInsertNgrams (PGS.Only $ Values fields ns)
83 where
84 fields = map (\t -> QualifiedIdentifier Nothing t) ["text", "int4"]
85
86 ----------------------
87 queryInsertNgrams :: PGS.Query
88 queryInsertNgrams = [sql|
89 WITH input_rows(terms,n) AS (?)
90 , ins AS (
91 INSERT INTO ngrams (terms,n)
92 SELECT * FROM input_rows
93 ON CONFLICT (terms) DO NOTHING -- unique index created here
94 RETURNING id,terms
95 )
96
97 SELECT id, terms
98 FROM ins
99 UNION ALL
100 SELECT c.id, terms
101 FROM input_rows
102 JOIN ngrams c USING (terms); -- columns of unique index
103 |]