[FIX] MERGE
[gargantext.git] / src / Gargantext / API / GraphQL.hs
index 450dff71cd2b2b424e354bbbf83e1076e992118f..30bdda906f2cc9f91b7508504e13d01341856281 100644 (file)
@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -fprint-potential-instances #-}
+
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}  -- permit duplications for field names in multiple constructors
 {-# LANGUAGE KindSignatures #-}  -- for use of Endpoint (name :: Symbol)
@@ -9,7 +11,6 @@ module Gargantext.API.GraphQL where
 import Data.ByteString.Lazy.Char8
   ( ByteString
   )
-import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.Map (Map)
 import Data.Morpheus
   ( App
@@ -33,26 +34,25 @@ import Data.Proxy
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog)
 import Gargantext.API.Prelude (HasJobEnv')
+import qualified Gargantext.API.GraphQL.Annuaire as GQLA
 import qualified Gargantext.API.GraphQL.AsyncTask as GQLAT
 import qualified Gargantext.API.GraphQL.IMT as GQLIMT
 import qualified Gargantext.API.GraphQL.Node as GQLNode
 import qualified Gargantext.API.GraphQL.User as GQLUser
 import qualified Gargantext.API.GraphQL.UserInfo as GQLUserInfo
 import qualified Gargantext.API.GraphQL.TreeFirstLevel as GQLTree
+import qualified Gargantext.API.GraphQL.Team as GQLTeam
 import Gargantext.API.Prelude (GargM, GargError)
+import Gargantext.API.Types
 import Gargantext.Core.Mail.Types (HasMail)
 import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
 import Gargantext.Prelude
 import GHC.Generics (Generic)
-import Network.HTTP.Media ((//), (/:))
-import qualified Prelude
 import Servant
   ( (:<|>) (..)
   , (:>)
-  , Accept (..)
   , Get
   , JSON
-  , MimeRender (..)
   , Post
   , ReqBody
   ,  ServerT
@@ -61,22 +61,26 @@ import qualified Servant.Auth as SA
 import qualified Servant.Auth.Server as SAS
 import Gargantext.API.Admin.Types (HasSettings)
 
+
 -- | Represents possible GraphQL queries.
 data Query m
   = Query
-    { imt_schools :: GQLIMT.SchoolsArgs -> m [GQLIMT.School]
+    { annuaire_contacts :: GQLA.AnnuaireContactArgs -> m [GQLA.AnnuaireContact]
+    , imt_schools :: GQLIMT.SchoolsArgs -> m [GQLIMT.School]
     , job_logs    :: GQLAT.JobLogArgs -> m (Map Int JobLog)
     , nodes       :: GQLNode.NodeArgs -> m [GQLNode.Node]
     , node_parent :: GQLNode.NodeParentArgs -> m [GQLNode.Node]
     , user_infos  :: GQLUserInfo.UserInfoArgs -> m [GQLUserInfo.UserInfo]
     , users       :: GQLUser.UserArgs -> m [GQLUser.User m]
-    , tree        :: GQLTree.TreeArgs -> m GQLTree.TreeFirstLevel 
+    , tree        :: GQLTree.TreeArgs -> m (GQLTree.TreeFirstLevel m)
+    , team        :: GQLTeam.TeamArgs -> m GQLTeam.Team
     } deriving (Generic, GQLType)
 
 data Mutation m
   = Mutation
-    { update_user_info :: GQLUserInfo.UserInfoMArgs -> m Int }
-    deriving (Generic, GQLType)
+    { update_user_info        :: GQLUserInfo.UserInfoMArgs -> m Int 
+    , delete_team_membership :: GQLTeam.TeamDeleteMArgs -> m [Int] 
+    } deriving (Generic, GQLType)
 
 -- | Possible GraphQL Events, i.e. here we describe how we will
 -- manipulate the data.
@@ -100,14 +104,17 @@ rootResolver
   => RootResolver (GargM env GargError) e Query Mutation Undefined
 rootResolver =
   RootResolver
-    { queryResolver = Query { imt_schools = GQLIMT.resolveSchools
-                            , job_logs    = GQLAT.resolveJobLogs
-                            , nodes       = GQLNode.resolveNodes
-                            , node_parent = GQLNode.resolveNodeParent
-                            , user_infos  = GQLUserInfo.resolveUserInfos
-                            , users       = GQLUser.resolveUsers
-                            , tree        = GQLTree.resolveTree }
-    , mutationResolver = Mutation { update_user_info = GQLUserInfo.updateUserInfo }
+    { queryResolver = Query { annuaire_contacts = GQLA.resolveAnnuaireContacts
+                            , imt_schools       = GQLIMT.resolveSchools
+                            , job_logs          = GQLAT.resolveJobLogs
+                            , nodes             = GQLNode.resolveNodes
+                            , node_parent       = GQLNode.resolveNodeParent
+                            , user_infos        = GQLUserInfo.resolveUserInfos
+                            , users             = GQLUser.resolveUsers
+                            , tree              = GQLTree.resolveTree
+                            , team              = GQLTeam.resolveTeam }
+    , mutationResolver = Mutation { update_user_info       = GQLUserInfo.updateUserInfo 
+                                  , delete_team_membership = GQLTeam.deleteTeamMembership }
     , subscriptionResolver = Undefined }
 
 -- | Main GraphQL "app".
@@ -121,13 +128,6 @@ app = deriveApp rootResolver
 -- Now for some boilerplate to integrate the above GraphQL app with
 -- servant.
 
--- | HTML type is needed for the GraphQL Playground.
-data HTML deriving (Typeable)
-instance Accept HTML where
-  contentTypes _ = "text" // "html" /: ("charset", "utf-8") :| ["text" // "html"]
-instance MimeRender HTML ByteString where
-  mimeRender _ = Prelude.id
-
 -- | Servant route for the app we defined above.
 type GQAPI = ReqBody '[JSON] GQLRequest :> Post '[JSON] GQLResponse
 -- type Schema = "schema" :> Get '[PlainText] Text