{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
module Gargantext.API.Node.Contact
import Data.Swagger
import Data.Text (Text)
import GHC.Generics (Generic)
-import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
-import Gargantext.API.Admin.Settings (HasSettings)
+import Servant
+import Servant.Job.Async (JobFunction(..), serveJobsAPI)
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary
+
+import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
+import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Node
-import Gargantext.API.Node.Corpus.New (AsyncJobs)
import Gargantext.API.Prelude (GargServer, simuLogs)
import Gargantext.Core (Lang(..))
+import Gargantext.Core.Text.Terms (TermType(..))
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Action.Flow (flow)
import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Admin.Types.Hyperdata.Contact (hyperdataContact)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Prelude (($), liftBase, (.), printDebug, pure)
-import Gargantext.Text.Terms (TermType(..))
-import Servant
-import Servant.Job.Async (JobFunction(..), serveJobsAPI)
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary
------------------------------------------------------------------------
type API = "contact" :> Summary "Contact endpoint"
, _scst_remaining = Just 0
, _scst_events = Just []
}
-
-
addContact _uId _nId _p logStatus = do
simuLogs logStatus 10