src/Gargantext/Database/Action/Query/Tree/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.Action.Query.Tree.Root
  28   where
  29
  30 import Control.Arrow (returnA)
  31 import Gargantext.Core.Types.Individu (User(..))
  32 import Gargantext.Database.Admin.Config (nodeTypeId)
  33 import Gargantext.Database.Action.Query.Node.User (HyperdataUser)
  34 import Gargantext.Database.Schema.Node (NodeRead)
  35 import Gargantext.Database.Schema.Node (queryNodeTable)
  36 import Gargantext.Database.Schema.User (UserPoly(..))
  37 import Gargantext.Database.Action.Query.User (queryUserTable)
  38 import Gargantext.Database.Admin.Types.Node (Node, NodePoly(..), NodeType(NodeUser))
  39 import Gargantext.Database.Admin.Utils (Cmd, runOpaQuery)
  40 import Gargantext.Prelude
  41 import Opaleye (restrict, (.==), Query)
  42 import Opaleye.PGTypes (pgStrictText, pgInt4)
  43
  44 getRoot :: User -> Cmd err [Node HyperdataUser]
  45 getRoot = runOpaQuery . selectRoot
  46
  47 selectRoot :: User -> Query NodeRead
  48 selectRoot (UserName username) = proc () -> do
  49     row   <- queryNodeTable -< ()
  50     users <- queryUserTable -< ()
  51     restrict -< _node_typename row   .== (pgInt4 $ nodeTypeId NodeUser)
  52     restrict -< user_username  users .== (pgStrictText username)
  53     restrict -< _node_userId   row   .== (user_id users)
  54     returnA  -< row
  55
  56 selectRoot (UserDBId uid) = proc () -> do
  57     row   <- queryNodeTable -< ()
  58     restrict -< _node_typename row   .== (pgInt4 $ nodeTypeId NodeUser)
  59     restrict -< _node_userId   row   .== (pgInt4 uid)
  60     returnA  -< row
  61