]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Schema/Node.hs
Merge remote-tracking branch 'origin/dev-phylo' into dev-merge
[gargantext.git] / src / Gargantext / Database / Schema / Node.hs
1 {-|
2 Module : Gargantext.Database.Schema.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
12 {-# OPTIONS_GHC -fno-warn-orphans #-}
13
14 {-# LANGUAGE Arrows #-}
15 {-# LANGUAGE ConstraintKinds #-}
16 {-# LANGUAGE FunctionalDependencies #-}
17 {-# LANGUAGE TemplateHaskell #-}
18 {-# LANGUAGE TypeFamilies #-}
19
20 module Gargantext.Database.Schema.Node where
21
22 import Control.Lens hiding (elements, (&))
23 import Gargantext.Database.Schema.Prelude
24 import Prelude hiding (null, id, map, sum)
25
26 ------------------------------------------------------------------------
27 -- Main polymorphic Node definition
28 data NodePoly id
29 hash_id
30 typename
31 user_id
32 parent_id
33 name
34 date
35 hyperdata =
36 Node { _node_id :: !id
37 , _node_hash_id :: !hash_id
38 , _node_typename :: !typename
39
40 , _node_user_id :: !user_id
41 , _node_parent_id :: !parent_id
42
43 , _node_name :: !name
44 , _node_date :: !date
45
46 , _node_hyperdata :: !hyperdata
47 } deriving (Show, Generic)
48
49 ------------------------------------------------------------------------
50 -- Automatic instances derivation
51 $(deriveJSON (unPrefix "_node_") ''NodePoly)
52 $(makeLenses ''NodePoly)
53
54 $(makeAdaptorAndInstance "pNode" ''NodePoly)
55 $(makeLensesWith abbreviatedFields ''NodePoly)
56
57 nodeTable :: Table NodeWrite NodeRead
58 nodeTable = Table "nodes" (pNode Node { _node_id = optionalTableField "id"
59 , _node_hash_id = optionalTableField "hash_id"
60 , _node_typename = requiredTableField "typename"
61 , _node_user_id = requiredTableField "user_id"
62
63 , _node_parent_id = optionalTableField "parent_id"
64 , _node_name = requiredTableField "name"
65 , _node_date = optionalTableField "date"
66
67 , _node_hyperdata = requiredTableField "hyperdata"
68 -- ignoring ts_vector field here
69 }
70 )
71
72 queryNodeTable :: Query NodeRead
73 queryNodeTable = selectTable nodeTable
74 ------------------------------------------------------------------------
75 type NodeHWrite a = NodePoly (Maybe (Field SqlInt4) )
76 (Maybe (Field SqlText) )
77 (Field SqlInt4)
78 (Field SqlInt4)
79 (Maybe (Field SqlInt4) )
80 (Field SqlText)
81 (Maybe (Field SqlTimestamptz))
82 (Field a)
83
84 type NodeHRead a = NodePoly (Field SqlInt4 )
85 (Field SqlText )
86 (Field SqlInt4 )
87 (Field SqlInt4 )
88 (Field SqlInt4 )
89 (Field SqlText )
90 (Field SqlTimestamptz )
91 (Field a )
92 ------------------------------------------------------------------------
93 type NodeWrite = NodeHWrite SqlJsonb
94
95 type NodeRead = NodeHRead SqlJsonb
96 ------------------------------------------------------------------------
97 -- | Node(Read|Write)Search is slower than Node(Write|Read) use it
98 -- for full text search only
99
100 type NodeSearchWrite =
101 NodePolySearch
102 (Maybe (Field SqlInt4) )
103 (Field SqlInt4 )
104 (Field SqlInt4 )
105 (FieldNullable SqlInt4)
106 (Field SqlText )
107 (Maybe (Field SqlTimestamptz))
108 (Field SqlJsonb )
109 (Maybe (Field SqlTSVector) )
110
111 type NodeSearchRead =
112 NodePolySearch
113 (Field SqlInt4 )
114 (Field SqlInt4 )
115 (Field SqlInt4 )
116 (FieldNullable SqlInt4 )
117 (Field SqlText )
118 (Field SqlTimestamptz )
119 (Field SqlJsonb )
120 (Field SqlTSVector )
121
122
123 data NodePolySearch id
124 typename
125 user_id
126 parent_id
127 name
128 date
129 hyperdata
130 search =
131 NodeSearch { _ns_id :: id
132 , _ns_typename :: typename
133 , _ns_user_id :: user_id
134 -- , nodeUniqId :: shaId
135 , _ns_parent_id :: parent_id
136 , _ns_name :: name
137 , _ns_date :: date
138
139 , _ns_hyperdata :: hyperdata
140 , _ns_search :: search
141 } deriving (Show, Generic)
142
143 $(makeAdaptorAndInstance "pNodeSearch" ''NodePolySearch)
144 $(makeLensesWith abbreviatedFields ''NodePolySearch)
145 $(deriveJSON (unPrefix "_ns_") ''NodePolySearch)
146 $(makeLenses ''NodePolySearch)
147
148 nodeTableSearch :: Table NodeSearchWrite NodeSearchRead
149 nodeTableSearch = Table "nodes" ( pNodeSearch
150 NodeSearch { _ns_id = optionalTableField "id"
151 , _ns_typename = requiredTableField "typename"
152 , _ns_user_id = requiredTableField "user_id"
153
154 , _ns_parent_id = requiredTableField "parent_id"
155 , _ns_name = requiredTableField "name"
156 , _ns_date = optionalTableField "date"
157
158 , _ns_hyperdata = requiredTableField "hyperdata"
159 , _ns_search = optionalTableField "search"
160 }
161 )
162 ------------------------------------------------------------------------