]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Queries.hs
[CORS] Adding CORS for test with frontend/Purescript.
[gargantext.git] / src / Gargantext / Database / Queries.hs
1 {-|
2 Module : Gargantext.Database.Queries
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.Queries where
21
22 import Gargantext.Prelude
23 import Gargantext.Types (Limit, Offset, NodePoly)
24 import Data.Maybe (Maybe, maybe)
25 import Control.Arrow ((>>>))
26 import Control.Applicative ((<*>))
27 import Opaleye
28 -- (Query, limit, offset)
29
30
31 type NodeWrite = NodePoly (Maybe (Column PGInt4 ))
32 (Column PGInt4 )
33 (Column PGInt4 )
34 (Column (Nullable PGInt4 ))
35 (Column (PGText ))
36 (Maybe (Column PGTimestamptz))
37 (Column PGJsonb )
38 -- (Maybe (Column PGTSVector))
39
40 type NodeRead = NodePoly (Column PGInt4 )
41 (Column PGInt4 )
42 (Column PGInt4 )
43 (Column (Nullable PGInt4 ))
44 (Column (PGText ))
45 (Column PGTimestamptz )
46 (Column PGJsonb)
47 -- (Column PGTSVector)
48
49
50
51 type NodeReadNull = NodePoly (Column (Nullable PGInt4 ))
52 (Column (Nullable PGInt4 ))
53 (Column (Nullable PGInt4 ))
54 (Column (Nullable PGInt4 ))
55 (Column (Nullable PGText ))
56 (Column (Nullable PGTimestamptz ))
57 (Column (Nullable PGJsonb))
58
59
60
61
62 join3 :: Query columnsA -> Query columnsB -> Query columnsC
63 -> ((columnsA, columnsB, columnsC) -> Column PGBool)
64 -> Query (columnsA, columnsB, columnsC)
65 join3 q1 q2 q3 cond = ((,,) <$> q1 <*> q2 <*> q3) >>> keepWhen cond
66
67
68 --leftJoin3 :: Query columnsL1 -> Query columnsR -> Query columnsL
69 -- -> ((columnsL1, columnsR) -> Column PGBool)
70 -- -> ((columnsL, (columnsL1, nullableColumnsR1)) -> Column PGBool)
71 -- -> Query (columnsL, nullableColumnsR)
72 --leftJoin3 q1 q2 q3 cond12 cond23 = leftJoin q3 (leftJoin q1 q2 cond12) cond23
73
74 limit' :: Maybe Limit -> Query a -> Query a
75 limit' maybeLimit query = maybe query (\l -> limit l query) maybeLimit
76
77 offset' :: Maybe Offset -> Query a -> Query a
78 offset' maybeOffset query = maybe query (\o -> offset o query) maybeOffset
79
80
81