]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Schema/Context.hs
Merge branch '90-dev-hal-box-fix' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell...
[gargantext.git] / src / Gargantext / Database / Schema / Context.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 {-# OPTIONS_GHC -fno-warn-orphans #-}
12
13 {-# LANGUAGE Arrows #-}
14 {-# LANGUAGE ConstraintKinds #-}
15 {-# LANGUAGE FunctionalDependencies #-}
16 {-# LANGUAGE TemplateHaskell #-}
17 {-# LANGUAGE TypeFamilies #-}
18
19 module Gargantext.Database.Schema.Context where
20
21 import Control.Lens hiding (elements, (&), Context)
22 import Gargantext.Database.Schema.Prelude
23 import Prelude hiding (null, id, map, sum)
24
25
26 ------------------------------------------------------------------------
27 -- Main polymorphic Node definition
28 data ContextPoly id
29 hash_id
30 typename
31 user_id
32 parent_id
33 name
34 date
35 hyperdata =
36 Context { _context_id :: !id
37 , _context_hash_id :: !hash_id
38 , _context_typename :: !typename
39
40 , _context_user_id :: !user_id
41 , _context_parent_id :: !parent_id
42
43 , _context_name :: !name
44 , _context_date :: !date
45
46 , _context_hyperdata :: !hyperdata
47 } deriving (Show, Generic)
48
49 ------------------------------------------------------------------------
50 -- Automatic instances derivation
51 $(deriveJSON (unPrefix "_context_") ''ContextPoly)
52 $(makeLenses ''ContextPoly)
53
54 $(makeAdaptorAndInstance "pContext" ''ContextPoly)
55 $(makeLensesWith abbreviatedFields ''ContextPoly)
56
57 contextTable :: Table ContextWrite ContextRead
58 contextTable = Table "contexts" (pContext Context { _context_id = optionalTableField "id"
59 , _context_hash_id = optionalTableField "hash_id"
60 , _context_typename = requiredTableField "typename"
61 , _context_user_id = requiredTableField "user_id"
62
63 , _context_parent_id = optionalTableField "parent_id"
64 , _context_name = requiredTableField "name"
65 , _context_date = optionalTableField "date"
66
67 , _context_hyperdata = requiredTableField "hyperdata"
68 -- ignoring ts_vector field here
69 }
70 )
71
72 queryContextTable :: Query ContextRead
73 queryContextTable = selectTable contextTable
74 ------------------------------------------------------------------------
75 type ContextWrite = ContextPoly (Maybe (Column SqlInt4) )
76 (Maybe (Column SqlText) )
77 (Column SqlInt4)
78 (Column SqlInt4)
79 (Maybe (Column SqlInt4) )
80 (Column SqlText)
81 (Maybe (Column SqlTimestamptz))
82 (Column SqlJsonb)
83
84 type ContextRead = ContextPoly (Column SqlInt4 )
85 (Column SqlText )
86 (Column SqlInt4 )
87 (Column SqlInt4 )
88 (Column SqlInt4 )
89 (Column SqlText )
90 (Column SqlTimestamptz )
91 (Column SqlJsonb )
92
93 type ContextReadNull = ContextPoly (Column (Nullable SqlInt4))
94 (Column (Nullable SqlText))
95 (Column (Nullable SqlInt4))
96 (Column (Nullable SqlInt4))
97 (Column (Nullable SqlInt4))
98 (Column (Nullable SqlText))
99 (Column (Nullable SqlTimestamptz))
100 (Column (Nullable SqlJsonb))
101 ------------------------------------------------------------------------
102 -- | Context(Read|Write)Search is slower than Context(Write|Read) use it
103 -- for full text search only
104
105 type ContextSearchWrite =
106 ContextPolySearch
107 (Maybe (Column SqlInt4) )
108 (Column SqlInt4 )
109 (Column SqlInt4 )
110 (Column (Nullable SqlInt4) )
111 (Column SqlText )
112 (Maybe (Column SqlTimestamptz))
113 (Column SqlJsonb )
114 (Maybe (Column SqlTSVector) )
115
116 type ContextSearchRead =
117 ContextPolySearch
118 (Column SqlInt4 )
119 (Column SqlInt4 )
120 (Column SqlInt4 )
121 (Column (Nullable SqlInt4 ))
122 (Column SqlText )
123 (Column SqlTimestamptz )
124 (Column SqlJsonb )
125 (Column SqlTSVector )
126
127 type ContextSearchReadNull =
128 ContextPolySearch
129 (Column (Nullable SqlInt4) )
130 (Column (Nullable SqlInt4) )
131 (Column (Nullable SqlInt4) )
132 (Column (Nullable SqlInt4) )
133 (Column (Nullable SqlText) )
134 (Column (Nullable SqlTimestamptz))
135 (Column (Nullable SqlJsonb) )
136 (Column (Nullable SqlTSVector) )
137
138
139 data ContextPolySearch id
140 typename
141 user_id
142 parent_id
143 name
144 date
145 hyperdata
146 search =
147 ContextSearch { _cs_id :: id
148 , _cs_typename :: typename
149 , _cs_user_id :: user_id
150 -- , ContextUniqId :: shaId
151 , _cs_parent_id :: parent_id
152 , _cs_name :: name
153 , _cs_date :: date
154
155 , _cs_hyperdata :: hyperdata
156 , _cs_search :: search
157 } deriving (Show, Generic)
158
159 $(makeAdaptorAndInstance "pContextSearch" ''ContextPolySearch)
160 $(makeLensesWith abbreviatedFields ''ContextPolySearch)
161 $(deriveJSON (unPrefix "_cs_") ''ContextPolySearch)
162 $(makeLenses ''ContextPolySearch)
163
164 contextTableSearch :: Table ContextSearchWrite ContextSearchRead
165 contextTableSearch = Table "contexts" ( pContextSearch
166 ContextSearch { _cs_id = optionalTableField "id"
167 , _cs_typename = requiredTableField "typename"
168 , _cs_user_id = requiredTableField "user_id"
169
170 , _cs_parent_id = requiredTableField "parent_id"
171 , _cs_name = requiredTableField "name"
172 , _cs_date = optionalTableField "date"
173
174 , _cs_hyperdata = requiredTableField "hyperdata"
175 , _cs_search = optionalTableField "search"
176 }
177 )
178 ------------------------------------------------------------------------