1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
{-|
Module : Gargantext.Database.Query.Table.Node.Children
Description : Main requests of Node to the database
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
module Gargantext.Database.Query.Table.Node.Children
where
import Control.Arrow (returnA)
import Data.Proxy
import Gargantext.Core
import Gargantext.Core.Types
import Gargantext.Core.Types.Query (Limit, Offset)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument, HyperdataContact)
import Gargantext.Database.Prelude (DBCmd, JSONB, runCountOpaQuery, runOpaQuery)
import Gargantext.Database.Query.Filter
import Gargantext.Database.Query.Table.NodeContext
import Gargantext.Database.Schema.Context
import Gargantext.Database.Schema.Node
import Gargantext.Prelude
import Opaleye
-- TODO getAllTableDocuments
getAllDocuments :: HasDBid NodeType => ParentId -> DBCmd err (TableResult (Node HyperdataDocument))
getAllDocuments pId = getAllChildren pId (Proxy :: Proxy HyperdataDocument)
(Just NodeDocument)
-- TODO getAllTableContacts
getAllContacts :: HasDBid NodeType => ParentId -> DBCmd err (TableResult (Node HyperdataContact))
getAllContacts pId = getAllChildren pId (Proxy :: Proxy HyperdataContact)
(Just NodeContact)
getAllChildren :: (JSONB a, HasDBid NodeType)
=> ParentId
-> proxy a
-> Maybe NodeType
-> DBCmd err (NodeTableResult a)
getAllChildren pId p maybeNodeType = getChildren pId p maybeNodeType Nothing Nothing
getChildren :: (JSONB a, HasDBid NodeType)
=> ParentId
-> proxy a
-> Maybe NodeType
-> Maybe Offset
-> Maybe Limit
-> DBCmd err (NodeTableResult a)
getChildren pId p t@(Just NodeDocument) maybeOffset maybeLimit = getChildrenContext pId p t maybeOffset maybeLimit
getChildren pId p t@(Just NodeContact ) maybeOffset maybeLimit = getChildrenContext pId p t maybeOffset maybeLimit
getChildren a b c d e = getChildrenNode a b c d e
getChildrenNode :: (JSONB a, HasDBid NodeType)
=> ParentId
-> proxy a
-> Maybe NodeType
-> Maybe Offset
-> Maybe Limit
-> DBCmd err (NodeTableResult a)
getChildrenNode pId _ maybeNodeType maybeOffset maybeLimit = do
-- printDebug "getChildrenNode" (pId, maybeNodeType)
let query = selectChildrenNode pId maybeNodeType
docs <- runOpaQuery
$ limit' maybeLimit
$ offset' maybeOffset
$ orderBy (asc _node_id)
$ query
docCount <- runCountOpaQuery query
pure $ TableResult { tr_docs = docs, tr_count = docCount }
selectChildrenNode :: HasDBid NodeType
=> ParentId
-> Maybe NodeType
-> Select NodeRead
selectChildrenNode parentId maybeNodeType = proc () -> do
row@(Node _ _ typeName _ parent_id _ _ _) <- queryNodeTable -< ()
let nodeType = maybe 0 toDBid maybeNodeType
restrict -< typeName .== sqlInt4 nodeType
restrict -< parent_id .== (pgNodeId parentId)
returnA -< row
getChildrenContext :: (JSONB a, HasDBid NodeType)
=> ParentId
-> proxy a
-> Maybe NodeType
-> Maybe Offset
-> Maybe Limit
-> DBCmd err (NodeTableResult a)
getChildrenContext pId _ maybeNodeType maybeOffset maybeLimit = do
-- printDebug "getChildrenContext" (pId, maybeNodeType)
let query = selectChildren' pId maybeNodeType
docs <- runOpaQuery
$ limit' maybeLimit
$ offset' maybeOffset
$ orderBy (asc _context_id)
$ query
docCount <- runCountOpaQuery query
pure $ TableResult { tr_docs = map context2node docs, tr_count = docCount }
selectChildren' :: HasDBid NodeType
=> ParentId
-> Maybe NodeType
-> Select ContextRead
selectChildren' parentId maybeNodeType = proc () -> do
row@(Context cid _ typeName _ _ _ _ _) <- queryContextTable -< ()
(NodeContext _ nid cid' _ _) <- queryNodeContextTable -< ()
let nodeType = maybe 0 toDBid maybeNodeType
restrict -< typeName .== sqlInt4 nodeType
restrict -< nid .== pgNodeId parentId
restrict -< cid .== cid'
returnA -< row