Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Przemyslaw Kaminski
haskell-gargantext
Commits
a53c3ad2
Commit
a53c3ad2
authored
Jul 23, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[API] AddContact (Post, needs refact)
parent
ad4a84da
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
131 additions
and
9 deletions
+131
-9
Contact.hs
src/Gargantext/API/Node/Contact.hs
+104
-0
Update.hs
src/Gargantext/API/Node/Update.hs
+4
-4
Flow.hs
src/Gargantext/Database/Action/Flow.hs
+1
-0
Contact.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Contact.hs
+22
-5
No files found.
src/Gargantext/API/Node/Contact.hs
0 → 100644
View file @
a53c3ad2
{-|
Module : Gargantext.API.Node.Contact
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module
Gargantext.API.Node.Contact
where
import
Data.Aeson
import
Data.Either
(
Either
(
Right
))
import
Data.Maybe
(
Maybe
(
..
))
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
Gargantext.API.Node.Corpus.New
(
AsyncJobs
)
import
Gargantext.API.Prelude
(
GargServer
,
simuLogs
)
import
Gargantext.Core
(
Lang
(
..
))
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
(
HyperdataAnnuaire
(
..
))
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
=
Summary
" Add Contact to Annuaire"
:>
AsyncJobs
JobLog
'[
J
SON
]
AddContactParams
JobLog
------------------------------------------------------------------------
data
AddContactParams
=
AddContactParams
{
firstname
::
!
Text
,
lastname
::
!
Text
}
|
AddContactParamsAdvanced
{
firstname
::
!
Text
,
lastname
::
!
Text
-- TODO add others fields
}
deriving
(
Generic
)
----------------------------------------------------------------------
api
::
User
->
NodeId
->
GargServer
API
api
u
nId
=
serveJobsAPI
$
JobFunction
(
\
p
log
->
let
log'
x
=
do
printDebug
"addContact"
x
liftBase
$
log
x
in
addContact
u
nId
p
(
liftBase
.
log'
)
)
addContact
::
(
HasSettings
env
,
FlowCmdM
env
err
m
)
=>
User
->
NodeId
->
AddContactParams
->
(
JobLog
->
m
()
)
->
m
JobLog
addContact
u
nId
(
AddContactParams
fn
ln
)
logStatus
=
do
logStatus
JobLog
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
1
,
_scst_events
=
Just
[]
}
_
<-
flow
(
Nothing
::
Maybe
HyperdataAnnuaire
)
u
(
Right
[
nId
])
(
Multi
EN
)
[[
hyperdataContact
fn
ln
]]
pure
JobLog
{
_scst_succeeded
=
Just
2
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
0
,
_scst_events
=
Just
[]
}
addContact
_uId
_nId
_p
logStatus
=
do
simuLogs
logStatus
10
------------------------------------------------------------------------
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance
FromJSON
AddContactParams
where
parseJSON
=
genericParseJSON
(
defaultOptions
{
sumEncoding
=
ObjectWithSingleField
})
instance
ToJSON
AddContactParams
where
toJSON
=
genericToJSON
(
defaultOptions
{
sumEncoding
=
ObjectWithSingleField
})
instance
ToSchema
AddContactParams
instance
Arbitrary
AddContactParams
where
arbitrary
=
elements
[
AddContactParams
"Pierre"
"Dupont"
]
------------------------------------------------------------------------
src/Gargantext/API/Node/Update.hs
View file @
a53c3ad2
...
...
@@ -41,10 +41,10 @@ type API = Summary " Update node according to NodeType params"
:>
AsyncJobs
JobLog
'[
J
SON
]
UpdateNodeParams
JobLog
------------------------------------------------------------------------
data
UpdateNodeParams
=
UpdateNodeParamsList
{
methodList
::
Method
}
|
UpdateNodeParamsGraph
{
methodGraph
::
GraphMetric
}
|
UpdateNodeParamsTexts
{
methodTexts
::
Granularity
}
|
UpdateNodeParamsBoard
{
methodBoard
::
Charts
}
data
UpdateNodeParams
=
UpdateNodeParamsList
{
methodList
::
!
Method
}
|
UpdateNodeParamsGraph
{
methodGraph
::
!
GraphMetric
}
|
UpdateNodeParamsTexts
{
methodTexts
::
!
Granularity
}
|
UpdateNodeParamsBoard
{
methodBoard
::
!
Charts
}
deriving
(
Generic
)
----------------------------------------------------------------------
...
...
src/Gargantext/Database/Action/Flow.hs
View file @
a53c3ad2
...
...
@@ -27,6 +27,7 @@ module Gargantext.Database.Action.Flow -- (flowDatabase, ngrams2list)
(
FlowCmdM
,
getDataText
,
flowDataText
,
flow
,
flowCorpusFile
,
flowCorpus
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/Contact.hs
View file @
a53c3ad2
...
...
@@ -54,6 +54,15 @@ defaultHyperdataContact = HyperdataContact (Just "bdd")
(
Just
"DO NOT expose this"
)
(
Just
"DO NOT expose this"
)
hyperdataContact
::
FirstName
->
LastName
->
HyperdataContact
hyperdataContact
fn
ln
=
HyperdataContact
Nothing
(
Just
(
contactWho
fn
ln
))
[]
Nothing
Nothing
Nothing
Nothing
Nothing
-- TOD0 contact metadata (Type is too flat)
data
ContactMetaData
=
...
...
@@ -78,12 +87,20 @@ data ContactWho =
,
_cw_freetags
::
[
Text
]
}
deriving
(
Eq
,
Show
,
Generic
)
type
FirstName
=
Text
type
LastName
=
Text
defaultContactWho
::
ContactWho
defaultContactWho
=
ContactWho
(
Just
"123123"
)
(
Just
"First Name"
)
(
Just
"Last Name"
)
[
"keyword A"
]
[
"freetag A"
]
defaultContactWho
=
contactWho
"Pierre"
"Dupont"
contactWho
::
FirstName
->
LastName
->
ContactWho
contactWho
fn
ln
=
ContactWho
Nothing
(
Just
fn
)
(
Just
ln
)
[]
[]
data
ContactWhere
=
ContactWhere
{
_cw_organization
::
[
Text
]
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment