Root.hs 1.82 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
{-|
Module      : Gargantext.Database.Root
Description : Main requests to get root of users
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX
-}

{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-orphans        #-}

{-# LANGUAGE Arrows                 #-}
{-# LANGUAGE DeriveGeneric          #-}
{-# LANGUAGE ConstraintKinds        #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE NoImplicitPrelude      #-}
24
{-# LANGUAGE RankNTypes             #-}
25 26 27 28
{-# LANGUAGE TemplateHaskell        #-}

module Gargantext.Database.Root where

29
import Opaleye (restrict, (.==), Query)
30 31 32 33
import Opaleye.PGTypes (pgStrictText, pgInt4)
import Control.Arrow (returnA)
import Gargantext.Prelude
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 38
import Gargantext.Database.Config (nodeTypeId)
import Gargantext.Core.Types.Individu (Username)
39
import Gargantext.Database.Utils (Cmd, runOpaQuery)
40

41 42
getRoot :: Username -> Cmd err [Node HyperdataUser]
getRoot = runOpaQuery . selectRoot
43 44 45 46 47 48 49 50 51 52

selectRoot :: Username -> Query NodeRead
selectRoot username = proc () -> do
    row   <- queryNodeTable -< ()
    users <- queryUserTable -< ()
    restrict -< _node_typename   row .== (pgInt4 $ nodeTypeId NodeUser)
    restrict -< user_username  users .== (pgStrictText username)
    restrict -< _node_userId    row .== (user_id users)
    returnA  -< row