src/Gargantext/API/GraphQL/Annuaire.hs

   1 {-# LANGUAGE DeriveAnyClass #-}
   2 {-# LANGUAGE DuplicateRecordFields #-}
   3
   4 module Gargantext.API.GraphQL.Annuaire where
   5
   6 import Control.Lens
   7 import Data.Morpheus.Types
   8   ( GQLType
   9   , Resolver
  10   , QUERY
  11   , lift
  12   )
  13 import Data.Proxy
  14 import Data.Text (Text)
  15 import Gargantext.API.Prelude (GargM, GargError)
  16 import Gargantext.Core.Mail.Types (HasMail)
  17 import Gargantext.Database.Admin.Types.Hyperdata.Contact
  18   ( HyperdataContact
  19   , ContactWho
  20   , cw_firstName
  21   , cw_lastName
  22   , hc_who, ContactWhere, hc_where, cw_organization, cw_labTeamDepts, cw_role, cw_office, cw_country, cw_city, cw_touch, ct_mail, ct_phone, ct_url, hc_title, hc_source)
  23 import Gargantext.Database.Admin.Types.Node (NodeId(..))
  24 import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
  25 import Gargantext.Database.Query.Table.Context (getContextWith)
  26 import Gargantext.Database.Schema.Node (node_hyperdata)
  27 import Gargantext.Prelude
  28 import GHC.Generics (Generic)
  29
  30 data AnnuaireContact = AnnuaireContact
  31   { ac_title        :: Maybe Text
  32   , ac_source       :: Maybe Text
  33   , ac_id           :: Int
  34   , ac_firstName    :: Maybe Text
  35   , ac_lastName     :: Maybe Text
  36   , ac_labTeamDepts :: [Text]
  37   , ac_organization :: [Text]
  38   , ac_role         :: Maybe Text
  39   , ac_office       :: Maybe Text
  40   , ac_country      :: Maybe Text
  41   , ac_city         :: Maybe Text
  42   , ac_touchMail    :: Maybe Text
  43   , ac_touchPhone   :: Maybe Text
  44   , ac_touchUrl     :: Maybe Text
  45   }
  46   deriving (Generic, GQLType, Show)
  47
  48 -- | Arguments to the "user info" query.
  49 data AnnuaireContactArgs
  50   = AnnuaireContactArgs
  51     { contact_id :: Int
  52     } deriving (Generic, GQLType)
  53
  54 type GqlM e env = Resolver QUERY e (GargM env GargError)
  55
  56 -- | Function to resolve user from a query.
  57 resolveAnnuaireContacts
  58   :: (HasConnectionPool env, HasConfig env, HasMail env)
  59   => AnnuaireContactArgs -> GqlM e env [AnnuaireContact]
  60 resolveAnnuaireContacts AnnuaireContactArgs { contact_id } = dbAnnuaireContacts contact_id
  61
  62 -- | Inner function to fetch the user from DB.
  63 dbAnnuaireContacts
  64   :: (HasConnectionPool env, HasConfig env, HasMail env)
  65   => Int -> GqlM e env [AnnuaireContact]
  66 dbAnnuaireContacts contact_id = do
  67   -- lift $ printDebug "[dbUsers]" user_id
  68 --  user <- getUsersWithId user_id
  69 --  hyperdata <- getUserHyperdata user_id
  70 --  lift (map toUser <$> zip user hyperdata)
  71   c <- lift $ getContextWith (NodeId contact_id) (Proxy :: Proxy HyperdataContact)
  72   pure [toAnnuaireContact (contact_id, c ^. node_hyperdata)]
  73
  74 toAnnuaireContact :: (Int, HyperdataContact) -> AnnuaireContact
  75 toAnnuaireContact (c_id, c_hyperdata) =
  76   AnnuaireContact { ac_title = c_hyperdata ^. ac_titleL
  77                   , ac_source = c_hyperdata ^. ac_sourceL
  78                   , ac_id = c_id
  79                   , ac_firstName = c_hyperdata ^. ac_firstNameL
  80                   , ac_lastName = c_hyperdata ^. ac_lastNameL
  81                   , ac_organization = c_hyperdata ^. ac_organizationL
  82                   , ac_labTeamDepts = c_hyperdata ^. ac_labTeamDeptsL
  83                   , ac_role = c_hyperdata ^. ac_roleL
  84                   , ac_office = c_hyperdata ^. ac_officeL
  85                   , ac_country = c_hyperdata ^. ac_countryL
  86                   , ac_city = c_hyperdata ^. ac_cityL
  87                   , ac_touchMail = c_hyperdata ^. ac_touchMailL
  88                   , ac_touchPhone = c_hyperdata ^. ac_touchPhoneL
  89                   , ac_touchUrl = c_hyperdata ^. ac_touchUrlL }
  90
  91 ac_titleL :: Traversal' HyperdataContact (Maybe Text)
  92 ac_titleL = hc_title
  93 ac_sourceL :: Traversal' HyperdataContact (Maybe Text)
  94 ac_sourceL = hc_source
  95 contactWhoL :: Traversal' HyperdataContact ContactWho
  96 contactWhoL = hc_who . _Just
  97 ac_firstNameL :: Traversal' HyperdataContact (Maybe Text)
  98 ac_firstNameL = contactWhoL . cw_firstName
  99 ac_lastNameL :: Traversal' HyperdataContact (Maybe Text)
 100 ac_lastNameL = contactWhoL . cw_lastName
 101 contactWhereL :: Traversal' HyperdataContact ContactWhere
 102 contactWhereL = hc_where . ix 0
 103 ac_organizationL :: Traversal' HyperdataContact [Text]
 104 ac_organizationL = contactWhereL . cw_organization
 105 ac_labTeamDeptsL :: Traversal' HyperdataContact [Text]
 106 ac_labTeamDeptsL = contactWhereL . cw_labTeamDepts
 107 ac_roleL :: Traversal' HyperdataContact (Maybe Text)
 108 ac_roleL = contactWhereL . cw_role
 109 ac_officeL :: Traversal' HyperdataContact (Maybe Text)
 110 ac_officeL = contactWhereL . cw_office
 111 ac_countryL :: Traversal' HyperdataContact (Maybe Text)
 112 ac_countryL = contactWhereL . cw_country
 113 ac_cityL :: Traversal' HyperdataContact (Maybe Text)
 114 ac_cityL = contactWhereL . cw_city
 115 ac_touchMailL :: Traversal' HyperdataContact (Maybe Text)
 116 ac_touchMailL = contactWhereL . cw_touch . _Just . ct_mail
 117 ac_touchPhoneL :: Traversal' HyperdataContact (Maybe Text)
 118 ac_touchPhoneL = contactWhereL . cw_touch . _Just . ct_phone
 119 ac_touchUrlL :: Traversal' HyperdataContact (Maybe Text)
 120 ac_touchUrlL = contactWhereL . cw_touch . _Just . ct_url