]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Schema/NodeNode.hs
remove groups from time matching and work only on ngrams and ids
[gargantext.git] / src / Gargantext / Database / Schema / NodeNode.hs
1 {-|
2 Module : Gargantext.Database.Schema.NodeNode
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 Here is a longer description of this module, containing some
11 commentary with @some markup@.
12 -}
13
14 {-# OPTIONS_GHC -fno-warn-orphans #-}
15
16 {-# LANGUAGE Arrows #-}
17 {-# LANGUAGE FlexibleInstances #-}
18 {-# LANGUAGE FunctionalDependencies #-}
19 {-# LANGUAGE QuasiQuotes #-}
20 {-# LANGUAGE MultiParamTypeClasses #-}
21 {-# LANGUAGE NoImplicitPrelude #-}
22 {-# LANGUAGE OverloadedStrings #-}
23 {-# LANGUAGE RankNTypes #-}
24 {-# LANGUAGE TemplateHaskell #-}
25
26 module Gargantext.Database.Schema.NodeNode where
27
28 import Control.Lens (view)
29 import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
30 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
31 import Database.PostgreSQL.Simple.SqlQQ (sql)
32 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
33 import Data.Maybe (Maybe, catMaybes)
34 import Data.Text (Text, splitOn)
35 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
36 import Gargantext.Database.Schema.Node
37 import Gargantext.Core.Types
38 import Gargantext.Database.Utils
39 import Gargantext.Database.Config (nodeTypeId)
40 import Gargantext.Database.Types.Node (CorpusId, DocId)
41 import Gargantext.Prelude
42 import Opaleye
43 import Control.Arrow (returnA)
44 import qualified Opaleye as O
45
46 data NodeNodePoly node1_id node2_id score cat
47 = NodeNode { nn_node1_id :: node1_id
48 , nn_node2_id :: node2_id
49 , nn_score :: score
50 , nn_category :: cat
51 } deriving (Show)
52
53 type NodeNodeWrite = NodeNodePoly (Column (PGInt4))
54 (Column (PGInt4))
55 (Maybe (Column (PGFloat8)))
56 (Maybe (Column (PGInt4)))
57
58 type NodeNodeRead = NodeNodePoly (Column (PGInt4))
59 (Column (PGInt4))
60 (Column (PGFloat8))
61 (Column (PGInt4))
62
63 type NodeNodeReadNull = NodeNodePoly (Column (Nullable PGInt4))
64 (Column (Nullable PGInt4))
65 (Column (Nullable PGFloat8))
66 (Column (Nullable PGInt4))
67
68 type NodeNode = NodeNodePoly Int Int (Maybe Double) (Maybe Int)
69
70 $(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly)
71 $(makeLensesWith abbreviatedFields ''NodeNodePoly)
72
73 nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
74 nodeNodeTable = Table "nodes_nodes" (pNodeNode
75 NodeNode { nn_node1_id = required "node1_id"
76 , nn_node2_id = required "node2_id"
77 , nn_score = optional "score"
78 , nn_category = optional "category"
79 }
80 )
81
82 queryNodeNodeTable :: Query NodeNodeRead
83 queryNodeNodeTable = queryTable nodeNodeTable
84
85
86 -- | not optimized (get all ngrams without filters)
87 nodesNodes :: Cmd err [NodeNode]
88 nodesNodes = runOpaQuery queryNodeNodeTable
89
90 instance QueryRunnerColumnDefault (Nullable PGInt4) Int where
91 queryRunnerColumnDefault = fieldQueryRunnerColumn
92
93 instance QueryRunnerColumnDefault (Nullable PGFloat8) Int where
94 queryRunnerColumnDefault = fieldQueryRunnerColumn
95
96 instance QueryRunnerColumnDefault (Nullable PGFloat8) Double where
97 queryRunnerColumnDefault = fieldQueryRunnerColumn
98
99 instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
100 queryRunnerColumnDefault = fieldQueryRunnerColumn
101
102 instance QueryRunnerColumnDefault PGInt4 (Maybe Int) where
103 queryRunnerColumnDefault = fieldQueryRunnerColumn
104
105
106 ------------------------------------------------------------------------
107 -- | Favorite management
108 nodeNodeCategory :: CorpusId -> DocId -> Int -> Cmd err [Int]
109 nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (c,cId,dId)
110 where
111 favQuery :: PGS.Query
112 favQuery = [sql|UPDATE nodes_nodes SET category = ?
113 WHERE node1_id = ? AND node2_id = ?
114 RETURNING node2_id;
115 |]
116
117 nodeNodesCategory :: [(CorpusId,DocId,Int)] -> Cmd err [Int]
118 nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
119 <$> runPGSQuery catQuery (PGS.Only $ Values fields inputData)
120 where
121 fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","int4"]
122 catQuery :: PGS.Query
123 catQuery = [sql| UPDATE nodes_nodes as old SET
124 category = new.category
125 from (?) as new(node1_id,node2_id,category)
126 WHERE old.node1_id = new.node1_id
127 AND old.node2_id = new.node2_id
128 RETURNING new.node2_id
129 |]
130
131 ------------------------------------------------------------------------
132 -- | TODO use UTCTime fast
133 selectDocsDates :: CorpusId -> Cmd err [Text]
134 selectDocsDates cId =
135 map (head' "selectDocsDates" . splitOn "-")
136 <$> catMaybes
137 <$> map (view hyperdataDocument_publication_date)
138 <$> selectDocs cId
139
140
141 selectDocs :: CorpusId -> Cmd err [HyperdataDocument]
142 selectDocs cId = runOpaQuery (queryDocs cId)
143
144 queryDocs :: CorpusId -> O.Query (Column PGJsonb)
145 queryDocs cId = proc () -> do
146 (n, nn) <- joinInCorpus -< ()
147 restrict -< ( nn_node1_id nn) .== (toNullable $ pgNodeId cId)
148 restrict -< ( nn_category nn) .>= (toNullable $ pgInt4 1)
149 restrict -< (_node_typename n) .== (pgInt4 $ nodeTypeId NodeDocument)
150 returnA -< view (node_hyperdata) n
151
152
153 selectDocNodes :: CorpusId -> Cmd err [Node HyperdataDocument]
154 selectDocNodes cId = runOpaQuery (queryDocNodes cId)
155
156 queryDocNodes :: CorpusId -> O.Query NodeRead
157 queryDocNodes cId = proc () -> do
158 (n, nn) <- joinInCorpus -< ()
159 restrict -< ( nn_node1_id nn) .== (toNullable $ pgNodeId cId)
160 restrict -< ( nn_category nn) .>= (toNullable $ pgInt4 1)
161 restrict -< (_node_typename n) .== (pgInt4 $ nodeTypeId NodeDocument)
162 returnA -< n
163
164
165 joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
166 joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
167 where
168 cond :: (NodeRead, NodeNodeRead) -> Column PGBool
169 cond (n, nn) = nn_node2_id nn .== (view node_id n)
170
171
172 ------------------------------------------------------------------------
173 -- | Trash management
174 nodeToTrash :: CorpusId -> DocId -> Bool -> Cmd err [PGS.Only Int]
175 nodeToTrash cId dId b = runPGSQuery trashQuery (b,cId,dId)
176 where
177 trashQuery :: PGS.Query
178 trashQuery = [sql|UPDATE nodes_nodes SET delete = ?
179 WHERE node1_id = ? AND node2_id = ?
180 RETURNING node2_id
181 |]
182
183 -- | Trash Massive
184 nodesToTrash :: [(CorpusId,DocId,Bool)] -> Cmd err [Int]
185 nodesToTrash input = map (\(PGS.Only a) -> a)
186 <$> runPGSQuery trashQuery (PGS.Only $ Values fields input)
187 where
188 fields = map (\t-> QualifiedIdentifier Nothing t) ["int4","int4","bool"]
189 trashQuery :: PGS.Query
190 trashQuery = [sql| UPDATE nodes_nodes as old SET
191 delete = new.delete
192 from (?) as new(node1_id,node2_id,delete)
193 WHERE old.node1_id = new.node1_id
194 AND old.node2_id = new.node2_id
195 RETURNING new.node2_id
196 |]
197
198 -- | /!\ Really remove nodes in the Corpus or Annuaire
199 emptyTrash :: CorpusId -> Cmd err [PGS.Only Int]
200 emptyTrash cId = runPGSQuery delQuery (PGS.Only cId)
201 where
202 delQuery :: PGS.Query
203 delQuery = [sql|DELETE from nodes_nodes n
204 WHERE n.node1_id = ?
205 AND n.delete = true
206 RETURNING n.node2_id
207 |]
208 ------------------------------------------------------------------------