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