]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/API/GraphQL/User.hs
Merge branch 'dev' into 184-dev-add-support-for-multiple-languages-in-ini-file
[gargantext.git] / src / Gargantext / API / GraphQL / User.hs
1 {-# LANGUAGE DeriveAnyClass #-}
2
3 module Gargantext.API.GraphQL.User where
4
5 import Data.Maybe (listToMaybe)
6 import Data.Morpheus.Types
7 ( GQLType
8 , Resolver, QUERY
9 , lift
10 )
11 import Data.Text (Text)
12 import Gargantext.API.Prelude (GargM, GargError)
13 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser(..))
14 import Gargantext.Database.Prelude (CmdCommon)
15 import Gargantext.Database.Query.Table.User (getUsersWithId, getUserHyperdata)
16 import Gargantext.Database.Schema.User (UserLight(..))
17 import Gargantext.Prelude
18 import GHC.Generics (Generic)
19
20 data User m = User
21 { u_email :: Text
22 , u_hyperdata :: m (Maybe HyperdataUser)
23 , u_id :: Int
24 , u_username :: Text }
25 deriving (Generic, GQLType)
26
27 -- | Arguments to the "user" query.
28 data UserArgs
29 = UserArgs
30 { user_id :: Int
31 } deriving (Generic, GQLType)
32
33 type GqlM e env = Resolver QUERY e (GargM env GargError)
34
35 -- | Function to resolve user from a query.
36 resolveUsers
37 :: (CmdCommon env)
38 => UserArgs -> GqlM e env [User (GqlM e env)]
39 resolveUsers UserArgs { user_id } = dbUsers user_id
40
41 -- | Inner function to fetch the user from DB.
42 dbUsers
43 :: (CmdCommon env)
44 => Int -> GqlM e env [User (GqlM e env)]
45 dbUsers user_id = lift (map toUser <$> getUsersWithId user_id)
46
47 toUser
48 :: (CmdCommon env)
49 => UserLight -> User (GqlM e env)
50 toUser (UserLight { .. }) = User { u_email = userLight_email
51 , u_hyperdata = resolveHyperdata userLight_id
52 , u_id = userLight_id
53 , u_username = userLight_username }
54
55 resolveHyperdata
56 :: (CmdCommon env)
57 => Int -> GqlM e env (Maybe HyperdataUser)
58 resolveHyperdata userid = lift (listToMaybe <$> getUserHyperdata userid)