]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Root.hs
issues with hidden module when trying to make a bin file
[gargantext.git] / src / Gargantext / Database / Root.hs
1 {-|
2 Module : Gargantext.Database.Root
3 Description : Main requests to get root of users
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 GeneralizedNewtypeDeriving #-}
21 {-# LANGUAGE OverloadedStrings #-}
22 {-# LANGUAGE MultiParamTypeClasses #-}
23 {-# LANGUAGE NoImplicitPrelude #-}
24 {-# LANGUAGE RankNTypes #-}
25 {-# LANGUAGE TemplateHaskell #-}
26
27 module Gargantext.Database.Root where
28
29 import Opaleye (restrict, (.==), Query)
30 import Opaleye.PGTypes (pgStrictText, pgInt4)
31 import Control.Arrow (returnA)
32 import Gargantext.Prelude
33 import Gargantext.Database.Types.Node (Node, NodePoly(..), NodeType(NodeUser), HyperdataUser)
34 import Gargantext.Database.Schema.Node (NodeRead)
35 import Gargantext.Database.Schema.Node (queryNodeTable)
36 import Gargantext.Database.Schema.User (queryUserTable, UserPoly(..))
37 import Gargantext.Database.Config (nodeTypeId)
38 import Gargantext.Core.Types.Individu (Username)
39 import Gargantext.Database.Utils (Cmd, runOpaQuery)
40
41 getRoot :: Username -> Cmd err [Node HyperdataUser]
42 getRoot = runOpaQuery . selectRoot
43
44 selectRoot :: Username -> Query NodeRead
45 selectRoot username = proc () -> do
46 row <- queryNodeTable -< ()
47 users <- queryUserTable -< ()
48 restrict -< _node_typename row .== (pgInt4 $ nodeTypeId NodeUser)
49 restrict -< user_username users .== (pgStrictText username)
50 restrict -< _node_userId row .== (user_id users)
51 returnA -< row
52
53