]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Lists.hs
Whooo class types ...
[gargantext.git] / src / Gargantext / Database / Lists.hs
1 {-|
2 Module : Gargantext.Database.Lists
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 {-# OPTIONS_GHC -fno-warn-orphans #-}
13
14 {-# LANGUAGE Arrows #-}
15 {-# LANGUAGE DeriveGeneric #-}
16 {-# LANGUAGE ConstraintKinds #-}
17 {-# LANGUAGE FlexibleContexts #-}
18 {-# LANGUAGE FlexibleInstances #-}
19 {-# LANGUAGE FunctionalDependencies #-}
20 {-# LANGUAGE OverloadedStrings #-}
21 {-# LANGUAGE MultiParamTypeClasses #-}
22 {-# LANGUAGE NoImplicitPrelude #-}
23 {-# LANGUAGE RankNTypes #-}
24 {-# LANGUAGE TemplateHaskell #-}
25
26 module Gargantext.Database.Lists where
27
28 import Control.Arrow (returnA)
29 import Gargantext.Core.Types -- (NodePoly(..), NodeCorpus, ListId)
30 import Gargantext.Core.Types.Individu (Username)
31 import Gargantext.Database.Config (nodeTypeId)
32 import Gargantext.Database.Schema.Node -- (HasNodeError, queryNodeTable)
33 import Gargantext.Database.Schema.User -- (queryUserTable)
34 import Gargantext.Database.Utils
35 import Gargantext.Prelude hiding (sum, head)
36 import Opaleye hiding (FromField)
37 import Opaleye.Internal.QueryArr (Query)
38 import Prelude hiding (null, id, map, sum)
39
40 -- | To get all lists of a user
41 -- /!\ lists of different types of corpora (Annuaire or Documents)
42 listsWith :: HasNodeError err => Username -> Cmd err [Maybe ListId]
43 listsWith u = runOpaQuery (selectLists u)
44 where
45 selectLists u = proc () -> do
46 (auth_user,nodes) <- listsWithJoin2 -< ()
47 restrict -< user_username auth_user .== (pgStrictText u)
48 restrict -< _node_typename nodes .== (toNullable $ pgInt4 $ nodeTypeId NodeList)
49 returnA -< _node_id nodes
50
51 listsWithJoin2 :: Query (UserRead, NodeReadNull)
52 listsWithJoin2 = leftJoin queryUserTable queryNodeTable cond12
53 where
54 cond12 (u,n) = user_id u .== _node_userId n
55
56 {-
57 listsWithJoin3 :: Query (NodeRead, (UserRead, NodeReadNull))
58 listsWithJoin3 = leftJoin3 queryUserTable queryNodeTable queryNodeTable cond12 cond23
59 where
60 cond12 :: (NodeRead
61 cond12 (u,n) = user_id u .== _node_userId n
62 cond23 :: (NodeRead, (UserRead, NodeReadNull)) -> Column PGBool
63 cond23 (n1,(u,n2)) = (toNullable $ _node_id n1) .== _node_parentId n2
64 --}
65