]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Node.hs
[FACET DOC QUERY] needs Full Text filter and Sum ngrams count but type is ok for...
[gargantext.git] / src / Gargantext / Database / Node.hs
1 {-|
2 Module : Gargantext.Database.Node
3 Description : Main requests of Node to the 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 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
12 {-# LANGUAGE TemplateHaskell #-}
13 {-# LANGUAGE FlexibleInstances #-}
14 {-# LANGUAGE DeriveGeneric #-}
15 {-# LANGUAGE MultiParamTypeClasses #-}
16 {-# LANGUAGE FunctionalDependencies #-}
17 {-# LANGUAGE Arrows #-}
18 {-# OPTIONS_GHC -fno-warn-orphans #-}
19
20 module Gargantext.Database.Node where
21
22 import Database.PostgreSQL.Simple.FromField ( Conversion
23 , ResultError(ConversionFailed)
24 , FromField
25 , fromField
26 , returnError
27 )
28 import Prelude hiding (null, id, map, sum)
29
30 import Gargantext.Types
31 import Gargantext.Types.Main (NodeType)
32 import Gargantext.Database.NodeNode
33 -- import Gargantext.Database.NodeNgram
34 import Gargantext.Prelude hiding (sum)
35
36
37 import Database.PostgreSQL.Simple.Internal (Field)
38 import Control.Arrow (returnA)
39 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
40 import Data.Aeson
41 import Data.Maybe (Maybe, fromMaybe)
42 import Data.Text (Text)
43 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
44 import Data.Typeable (Typeable)
45 import qualified Data.ByteString.Internal as DBI
46 import Database.PostgreSQL.Simple (Connection)
47 import Opaleye
48
49 -- | Types for Node Database Management
50 data PGTSVector
51
52 type NodeWrite = NodePoly (Maybe (Column PGInt4)) (Column PGInt4)
53 (Column PGInt4) (Column (Nullable PGInt4))
54 (Column (PGText)) (Maybe (Column PGTimestamptz))
55 (Column PGJsonb) -- (Maybe (Column PGTSVector))
56
57 type NodeRead = NodePoly (Column PGInt4) (Column PGInt4)
58 (Column PGInt4) (Column (Nullable PGInt4))
59 (Column (PGText)) (Column PGTimestamptz)
60 (Column PGJsonb) -- (Column PGTSVector)
61
62 -- Facets / Views for the Front End
63 type FacetDocRead = Facet (Column PGInt4) (Column PGJsonb) (Column PGBool) (Column PGFloat8)
64 -- type FacetDocWrite = Facet (Column PGInt4) (Column PGJsonb) (Column PGBool) (Column PGFloat8)
65
66
67 instance FromField HyperdataCorpus where
68 fromField = fromField'
69
70 instance FromField HyperdataDocument where
71 fromField = fromField'
72
73 instance FromField HyperdataProject where
74 fromField = fromField'
75
76 instance FromField HyperdataUser where
77 fromField = fromField'
78
79
80 instance QueryRunnerColumnDefault PGJsonb HyperdataDocument where
81 queryRunnerColumnDefault = fieldQueryRunnerColumn
82
83 instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus where
84 queryRunnerColumnDefault = fieldQueryRunnerColumn
85
86 instance QueryRunnerColumnDefault PGJsonb HyperdataProject where
87 queryRunnerColumnDefault = fieldQueryRunnerColumn
88
89 instance QueryRunnerColumnDefault PGJsonb HyperdataUser where
90 queryRunnerColumnDefault = fieldQueryRunnerColumn
91
92
93
94 fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DBI.ByteString -> Conversion b
95 fromField' field mb = do
96 v <- fromField field mb
97 valueToHyperdata v
98 where
99 valueToHyperdata v = case fromJSON v of
100 Success a -> pure a
101 Error _err -> returnError ConversionFailed field "cannot parse hyperdata"
102
103
104
105 $(makeAdaptorAndInstance "pNode" ''NodePoly)
106 $(makeLensesWith abbreviatedFields ''NodePoly)
107
108 $(makeAdaptorAndInstance "pFacetDoc" ''Facet)
109 $(makeLensesWith abbreviatedFields ''Facet)
110
111
112
113 nodeTable :: Table NodeWrite NodeRead
114 nodeTable = Table "nodes" (pNode Node { node_id = optional "id"
115 , node_typename = required "typename"
116 , node_userId = required "user_id"
117 , node_parentId = required "parent_id"
118 , node_name = required "name"
119 , node_date = optional "date"
120 , node_hyperdata = required "hyperdata"
121 -- , node_titleAbstract = optional "title_abstract"
122 }
123 )
124
125
126 queryNodeTable :: Query NodeRead
127 queryNodeTable = queryTable nodeTable
128
129
130 selectNodes :: Column PGInt4 -> Query NodeRead
131 selectNodes id = proc () -> do
132 row <- queryNodeTable -< ()
133 restrict -< node_id row .== id
134 returnA -< row
135
136 runGetNodes :: Connection -> Query NodeRead -> IO [Node Value]
137 runGetNodes = runQuery
138
139
140 type ParentId = NodeId
141 type Limit = Int
142 type Offset = Int
143
144 -- | order by publication date
145 -- Favorites (Bool), node_ngrams
146 selectNodesWith :: ParentId -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> Query NodeRead
147 selectNodesWith parentId maybeNodeType maybeOffset maybeLimit =
148 --offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId
149 limit' maybeLimit $ offset' maybeOffset $ orderBy (asc node_id) $ selectNodesWith' parentId maybeNodeType
150
151
152 limit' :: Maybe Limit -> Query a -> Query a
153 limit' maybeLimit query = maybe query (\l -> limit l query) maybeLimit
154
155
156 offset' :: Maybe Offset -> Query a -> Query a
157 offset' maybeOffset query = maybe query (\o -> offset o query) maybeOffset
158
159
160 selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead
161 selectNodesWith' parentId maybeNodeType = proc () -> do
162 node <- (proc () -> do
163 row@(Node _ typeId _ parentId' _ _ _) <- queryNodeTable -< ()
164 restrict -< parentId' .== (toNullable $ pgInt4 parentId)
165
166 let typeId' = maybe 0 nodeTypeId maybeNodeType
167
168 restrict -< if typeId' > 0
169 then typeId .== (pgInt4 (typeId' :: Int))
170 else (pgBool True)
171 returnA -< row ) -< ()
172 returnA -< node
173
174
175
176 getDocFacet :: Connection -> Int -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> IO [FacetDoc Value]
177 getDocFacet conn parentId nodeType maybeOffset maybeLimit =
178 runQuery conn $ selectDocFacet parentId nodeType maybeOffset maybeLimit
179
180 selectDocFacet :: ParentId -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> Query FacetDocRead
181 selectDocFacet parentId maybeNodeType maybeOffset maybeLimit =
182 -- limit' maybeLimit $ offset' maybeOffset $ orderBy (asc docFacet_id) $ selectDocFacet' parentId maybeNodeType
183 limit' maybeLimit $ offset' maybeOffset $ selectDocFacet' parentId maybeNodeType
184 --
185
186 selectDocFacet' :: ParentId -> Maybe NodeType -> Query FacetDocRead
187 selectDocFacet' parentId maybeNodeType = proc () -> do
188 node <- (proc () -> do
189 -- Selecting the documents
190 (Node n_id typeId _ parentId' _ _ hyperdata) <- queryNodeTable -< ()
191 restrict -< parentId' .== (toNullable $ pgInt4 parentId)
192
193 let typeId' = maybe 0 nodeTypeId maybeNodeType
194 restrict -< if typeId' > 0
195 then typeId .== (pgInt4 (typeId' :: Int))
196 else (pgBool True)
197
198 -- Ngram count by document
199 -- nodeNgramNgram@(NodeNgram _ n_id_nn _ weight) <- queryNodeNgramTable -< ()
200 -- restrict -< n_id_nn .== n_id
201 let ngramCount = (pgDouble 10) -- groupBy n_id
202
203 -- Favorite Column
204 (Node n_id_fav typeId_fav _ parentId_fav _ _ _) <- queryNodeTable -< ()
205 (NodeNode n1_id n2_id count) <- queryNodeNodeTable -< ()
206
207 restrict -< typeId_fav .== 15 .&& parentId_fav .== (toNullable $ pgInt4 parentId)
208 restrict -< n1_id .== n_id_fav .&& n_id .== n2_id
209
210 let isFav = ifThenElse (isNull count) (pgBool False) (pgBool True)
211
212 returnA -< (FacetDoc n_id hyperdata isFav ngramCount)) -< ()
213 returnA -< node
214
215
216
217
218 deleteNode :: Connection -> Int -> IO Int
219 deleteNode conn n = fromIntegral
220 <$> runDelete conn nodeTable
221 (\(Node n_id _ _ _ _ _ _) -> n_id .== pgInt4 n)
222
223 deleteNodes :: Connection -> [Int] -> IO Int
224 deleteNodes conn ns = fromIntegral
225 <$> runDelete conn nodeTable
226 (\(Node n_id _ _ _ _ _ _) -> in_ ((map pgInt4 ns)) n_id)
227
228
229 getNodesWith :: Connection -> Int -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> IO [Node Value]
230 getNodesWith conn parentId nodeType maybeOffset maybeLimit =
231 runQuery conn $ selectNodesWith
232 parentId nodeType maybeOffset maybeLimit
233
234
235 -- NP check type
236 getNodesWithParentId :: Connection -> Int -> Maybe Text -> IO [Node Value]
237 getNodesWithParentId conn n _ = runQuery conn $ selectNodesWithParentID n
238
239 selectNodesWithParentID :: Int -> Query NodeRead
240 selectNodesWithParentID n = proc () -> do
241 row@(Node _ _ _ parent_id _ _ _) <- queryNodeTable -< ()
242 restrict -< if n > 0
243 then
244 parent_id .== (toNullable $ pgInt4 n)
245 else
246 isNull parent_id
247 returnA -< row
248
249
250
251 selectNodesWithType :: Column PGInt4 -> Query NodeRead
252 selectNodesWithType type_id = proc () -> do
253 row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()
254 restrict -< tn .== type_id
255 returnA -< row
256
257 getNode :: Connection -> Int -> IO (Node Value)
258 getNode conn id = do
259 fromMaybe (error "TODO: 404") . headMay <$> runQuery conn (limit 1 $ selectNodes (pgInt4 id))
260
261 getNodesWithType :: Connection -> Column PGInt4 -> IO [Node Value]
262 getNodesWithType conn type_id = do
263 runQuery conn $ selectNodesWithType type_id
264
265