]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Schema/Node_NodeNgramsNodeNgrams.hs
Merge branch 'dev' into dev-graph-explorer-gexf
[gargantext.git] / src / Gargantext / Database / Schema / Node_NodeNgramsNodeNgrams.hs
1 {-|
2 Module : Gargantext.Database.Schema.Node_NodeNgrams_NodeNgrams
3 Description :
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
8 Portability : POSIX
9
10 lgrams: listed ngrams
11
12 Node_NodeNgrams_NodeNgrams table is used to group ngrams
13 - first NodeId :: Referential / space node (corpus)
14 - NodeNgrams where Node is List
15 - lgrams1_id, lgrams2_id where all lgrams2_id will be added to lgrams1_id
16 - weight: score the relation
17
18 Next Step benchmark:
19 - recursive queries of postgres
20 - group with: https://en.wikipedia.org/wiki/Nested_set_model
21
22 -}
23
24 {-# LANGUAGE Arrows #-}
25 {-# LANGUAGE FlexibleContexts #-}
26 {-# LANGUAGE FlexibleInstances #-}
27 {-# LANGUAGE FunctionalDependencies #-}
28 {-# LANGUAGE MultiParamTypeClasses #-}
29 {-# LANGUAGE NoImplicitPrelude #-}
30 {-# LANGUAGE OverloadedStrings #-}
31 {-# LANGUAGE QuasiQuotes #-}
32 {-# LANGUAGE RankNTypes #-}
33 {-# LANGUAGE TemplateHaskell #-}
34 {-# OPTIONS_GHC -fno-warn-orphans #-}
35
36 module Gargantext.Database.Schema.Node_NodeNgramsNodeNgrams
37 where
38
39 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
40 import Data.Maybe (Maybe)
41 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
42 import Gargantext.Database.Utils (Cmd, runOpaQuery, mkCmd)
43 import Gargantext.Database.Types.Node (CorpusId)
44 import Gargantext.Database.Schema.Node (pgNodeId)
45 import Gargantext.Prelude
46 import Opaleye
47
48 data Node_NodeNgrams_NodeNgrams_Poly node_id nng1_id nng2_id weight =
49 Node_NodeNgrams_NodeNgrams { _nnn_node_id :: node_id
50 , _nnn_nng1_id :: nng1_id
51 , _nnn_nng2_id :: nng2_id
52 , _nnn_weight :: weight
53 } deriving (Show)
54
55 type Node_NodeNgrams_NodeNgrams_Write =
56 Node_NodeNgrams_NodeNgrams_Poly
57 (Column PGInt4 )
58 (Maybe (Column PGInt4 ))
59 (Column PGInt4 )
60 (Maybe (Column PGFloat8))
61
62 type Node_NodeNgrams_NodeNgrams_Read =
63 Node_NodeNgrams_NodeNgrams_Poly
64 (Column PGInt4 )
65 (Column PGInt4 )
66 (Column PGInt4 )
67 (Column PGFloat8)
68
69 type ListNgramsId = Int
70
71 type Node_NodeNgrams_NodeNgrams =
72 Node_NodeNgrams_NodeNgrams_Poly CorpusId (Maybe ListNgramsId) ListNgramsId (Maybe Double)
73
74 $(makeAdaptorAndInstance "pNode_NodeNgrams_NodeNgrams"
75 ''Node_NodeNgrams_NodeNgrams_Poly)
76 $(makeLensesWith abbreviatedFields
77 ''Node_NodeNgrams_NodeNgrams_Poly)
78
79
80 node_NodeNgrams_NodeNgrams_Table :: Table Node_NodeNgrams_NodeNgrams_Write Node_NodeNgrams_NodeNgrams_Read
81 node_NodeNgrams_NodeNgrams_Table =
82 Table "node_nodengrams_nodengrams"
83 ( pNode_NodeNgrams_NodeNgrams Node_NodeNgrams_NodeNgrams
84 { _nnn_node_id = required "node_id"
85 , _nnn_nng1_id = optional "node_ngrams1_id"
86 , _nnn_nng2_id = required "node_ngrams2_id"
87 , _nnn_weight = optional "weight"
88 }
89 )
90
91 queryNode_NodeNgrams_NodeNgrams_Table :: Query Node_NodeNgrams_NodeNgrams_Read
92 queryNode_NodeNgrams_NodeNgrams_Table = queryTable node_NodeNgrams_NodeNgrams_Table
93
94 -- | Select NodeNgramsNgrams
95 -- TODO not optimized (get all ngrams without filters)
96 node_Node_NodeNgrams_NodeNgrams :: Cmd err [Node_NodeNgrams_NodeNgrams]
97 node_Node_NodeNgrams_NodeNgrams = runOpaQuery queryNode_NodeNgrams_NodeNgrams_Table
98
99 instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
100 queryRunnerColumnDefault = fieldQueryRunnerColumn
101
102 instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
103 queryRunnerColumnDefault = fieldQueryRunnerColumn
104
105
106 -- TODO: Add option on conflict
107 insert_Node_NodeNgrams_NodeNgrams :: [Node_NodeNgrams_NodeNgrams] -> Cmd err Int64
108 insert_Node_NodeNgrams_NodeNgrams = insert_Node_NodeNgrams_NodeNgrams_W
109 . map (\(Node_NodeNgrams_NodeNgrams n ng1 ng2 maybeWeight) ->
110 Node_NodeNgrams_NodeNgrams (pgNodeId n )
111 (pgInt4 <$> ng1)
112 (pgInt4 ng2)
113 (pgDouble <$> maybeWeight)
114 )
115
116 insert_Node_NodeNgrams_NodeNgrams_W :: [Node_NodeNgrams_NodeNgrams_Write] -> Cmd err Int64
117 insert_Node_NodeNgrams_NodeNgrams_W ns =
118 mkCmd $ \c -> runInsert_ c Insert { iTable = node_NodeNgrams_NodeNgrams_Table
119 , iRows = ns
120 , iReturning = rCount
121 , iOnConflict = (Just DoNothing)
122 }