]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Ngrams.hs
fix the weightedlogjaccard
[gargantext.git] / src / Gargantext / Database / Ngrams.hs
1 {-|
2 Module : Gargantext.Database.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
17 module Gargantext.Database.Ngrams
18 where
19
20 import Data.Text (Text)
21 import Gargantext.Core.Types
22 import Gargantext.Database.Utils (runOpaQuery, Cmd)
23 import Gargantext.Database.Schema.Ngrams
24 import Gargantext.Database.Schema.NodeNodeNgrams
25 import Gargantext.Database.Schema.Node
26 import Gargantext.Prelude
27 import Opaleye
28 import Control.Arrow (returnA)
29
30 selectNgramsByDoc :: [CorpusId] -> DocId -> NgramsType -> Cmd err [Text]
31 selectNgramsByDoc cIds dId nt = runOpaQuery (query cIds dId nt)
32 where
33
34 join :: Query (NgramsRead, NodeNodeNgramsReadNull)
35 join = leftJoin queryNgramsTable queryNodeNodeNgramsTable on1
36 where
37 on1 (ng,nnng) = ngrams_id ng .== nnng_ngrams_id nnng
38
39 query cIds' dId' nt' = proc () -> do
40 (ng,nnng) <- join -< ()
41 restrict -< foldl (\b cId -> ((toNullable $ pgNodeId cId) .== nnng_node1_id nnng) .|| b) (pgBool True) cIds'
42 restrict -< (toNullable $ pgNodeId dId') .== nnng_node2_id nnng
43 restrict -< (toNullable $ pgNgramsType nt') .== nnng_ngramsType nnng
44 returnA -< ngrams_terms ng
45
46
47 postNgrams :: CorpusId -> DocId -> [Text] -> Cmd err Int
48 postNgrams = undefined
49