Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
196
Issues
196
List
Board
Labels
Milestones
Merge Requests
12
Merge Requests
12
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
gargantext
haskell-gargantext
Commits
76268fc5
Commit
76268fc5
authored
Feb 26, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[NodeUser] fake data (basic)
parent
a2db09ac
Pipeline
#753
failed with stage
Changes
4
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
68 additions
and
13 deletions
+68
-13
Types.hs
src/Gargantext/Core/Types.hs
+1
-0
Contact.hs
src/Gargantext/Database/Node/Contact.hs
+40
-3
User.hs
src/Gargantext/Database/Node/User.hs
+18
-2
Node.hs
src/Gargantext/Database/Schema/Node.hs
+9
-8
No files found.
src/Gargantext/Core/Types.hs
View file @
76268fc5
...
...
@@ -47,6 +47,7 @@ import Gargantext.Database.Types.Node
import
Gargantext.Prelude
import
Test.QuickCheck.Arbitrary
(
Arbitrary
,
arbitrary
)
------------------------------------------------------------------------
------------------------------------------------------------------------
type
Name
=
Text
type
Term
=
Text
...
...
src/Gargantext/Database/Node/Contact.hs
View file @
76268fc5
...
...
@@ -21,6 +21,7 @@ module Gargantext.Database.Node.Contact
where
import
Control.Lens
(
makeLenses
)
import
Data.Time.Segment
(
jour
)
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Swagger
(
ToSchema
(
..
),
genericDeclareNamedSchema
)
import
Data.Text
(
Text
)
...
...
@@ -45,24 +46,39 @@ data HyperdataContact =
,
_hc_where
::
[
ContactWhere
]
,
_hc_title
::
Maybe
Text
-- TODO remove (only demo)
,
_hc_source
::
Maybe
Text
-- TODO remove (only demo)
,
_hc_lastValidation
::
Maybe
Text
,
_hc_lastValidation
::
Maybe
Text
-- TODO UTCTime
,
_hc_uniqIdBdd
::
Maybe
Text
,
_hc_uniqId
::
Maybe
Text
}
deriving
(
Eq
,
Show
,
Generic
)
fake_HyperdataContact
::
HyperdataContact
fake_HyperdataContact
=
HyperdataContact
(
Just
"bdd"
)
(
Just
fake_ContactWho
)
[
fake_ContactWhere
]
(
Just
"Title"
)
(
Just
"Source"
)
(
Just
"TODO lastValidation date"
)
(
Just
"DO NOT expose this"
)
(
Just
"DO NOT expose this"
)
-- TOD0 contact metadata (Type is too flat)
data
ContactMetaData
=
ContactMetaData
{
_cm_bdd
::
Maybe
Text
,
_cm_lastValidation
::
Maybe
Text
,
_cm_lastValidation
::
Maybe
Text
-- TODO UTCTIME
}
deriving
(
Eq
,
Show
,
Generic
)
fake_ContactMetaData
::
ContactMetaData
fake_ContactMetaData
=
ContactMetaData
(
Just
"bdd"
)
(
Just
"TODO UTCTime"
)
arbitraryHyperdataContact
::
HyperdataContact
arbitraryHyperdataContact
=
HyperdataContact
Nothing
Nothing
[]
Nothing
Nothing
Nothing
Nothing
Nothing
data
ContactWho
=
ContactWho
{
_cw_id
::
Maybe
Text
,
_cw_firstName
::
Maybe
Text
...
...
@@ -71,6 +87,13 @@ data ContactWho =
,
_cw_freetags
::
[
Text
]
}
deriving
(
Eq
,
Show
,
Generic
)
fake_ContactWho
::
ContactWho
fake_ContactWho
=
ContactWho
(
Just
"123123"
)
(
Just
"First Name"
)
(
Just
"Last Name"
)
[
"keyword A"
]
[
"freetag A"
]
data
ContactWhere
=
ContactWhere
{
_cw_organization
::
[
Text
]
,
_cw_labTeamDepts
::
[
Text
]
...
...
@@ -87,13 +110,27 @@ data ContactWhere =
,
_cw_exit
::
Maybe
UTCTime
}
deriving
(
Eq
,
Show
,
Generic
)
fake_ContactWhere
::
ContactWhere
fake_ContactWhere
=
ContactWhere
[
"Organization A"
]
[
"Organization B"
]
(
Just
"Role"
)
(
Just
"Office"
)
(
Just
"Country"
)
(
Just
"City"
)
(
Just
fake_ContactTouch
)
(
Just
$
jour
01
01
2020
)
(
Just
$
jour
01
01
2029
)
data
ContactTouch
=
ContactTouch
{
_ct_mail
::
Maybe
Text
,
_ct_phone
::
Maybe
Text
,
_ct_url
::
Maybe
Text
}
deriving
(
Eq
,
Show
,
Generic
)
fake_ContactTouch
::
ContactTouch
fake_ContactTouch
=
ContactTouch
(
Just
"email@data.com"
)
(
Just
"+336 328 283 288"
)
(
Just
"https://url.com"
)
-- | ToSchema instances
instance
ToSchema
HyperdataContact
where
...
...
src/Gargantext/Database/Node/User.hs
View file @
76268fc5
...
...
@@ -28,7 +28,7 @@ import Database.PostgreSQL.Simple.FromField (FromField, fromField)
import
GHC.Generics
(
Generic
)
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixSwagger
)
import
Gargantext.Database.Node.Contact
(
HyperdataContact
)
import
Gargantext.Database.Node.Contact
(
HyperdataContact
,
fake_HyperdataContact
)
import
Gargantext.Database.Types.Node
(
Node
,
Hyperdata
,
DocumentId
,
NodeId
(
..
))
import
Gargantext.Database.Utils
(
fromField'
)
import
Gargantext.Prelude
...
...
@@ -37,7 +37,6 @@ import Test.QuickCheck (elements)
import
Test.QuickCheck.Arbitrary
(
Arbitrary
,
arbitrary
)
------------------------------------------------------------------------
type
NodeUser
=
Node
HyperdataUser
data
HyperdataUser
=
...
...
@@ -58,6 +57,19 @@ data HyperdataPublic =
}
deriving
(
Eq
,
Show
,
Generic
)
-- | Fake instances
fake_HyperdataUser
::
HyperdataUser
fake_HyperdataUser
=
HyperdataUser
(
Just
fake_HyperdataPrivate
)
(
Just
fake_HyperdataContact
)
(
Just
fake_HyperdataPublic
)
fake_HyperdataPublic
::
HyperdataPublic
fake_HyperdataPublic
=
HyperdataPublic
"pseudo"
[
1
..
10
]
fake_HyperdataPrivate
::
HyperdataPrivate
fake_HyperdataPrivate
=
HyperdataPrivate
"password"
EN
-- | ToSchema instances
instance
ToSchema
HyperdataUser
where
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"_hu_"
)
...
...
@@ -112,3 +124,7 @@ makeLenses ''HyperdataPublic
$
(
deriveJSON
(
unPrefix
"_hu_"
)
''
H
yperdataUser
)
$
(
deriveJSON
(
unPrefix
"_hpr_"
)
''
H
yperdataPrivate
)
$
(
deriveJSON
(
unPrefix
"_hpu_"
)
''
H
yperdataPublic
)
src/Gargantext/Database/Schema/Node.hs
View file @
76268fc5
...
...
@@ -41,7 +41,7 @@ import Gargantext.Core.Types.Individu (Username)
import
Gargantext.Database.Config
(
nodeTypeId
)
import
Gargantext.Database.Queries.Filter
(
limit'
,
offset'
)
import
Gargantext.Database.Types.Node
(
NodeType
(
..
),
defaultCorpus
,
Hyperdata
,
HyperData
(
..
))
import
Gargantext.Database.Node.User
(
HyperdataUser
(
..
))
import
Gargantext.Database.Node.User
(
HyperdataUser
(
..
)
,
fake_HyperdataUser
)
import
Gargantext.Database.Node.Contact
(
HyperdataContact
(
..
),
arbitraryHyperdataContact
)
import
Gargantext.Database.Utils
import
Gargantext.Prelude
hiding
(
sum
,
head
)
...
...
@@ -393,14 +393,11 @@ getNodesWithType :: Column PGInt4 -> Cmd err [Node HyperdataDocument]
getNodesWithType
=
runOpaQuery
.
selectNodesWithType
------------------------------------------------------------------------
defaultUser
::
HyperdataUser
defaultUser
=
HyperdataUser
Nothing
Nothing
Nothing
nodeUserW
::
Maybe
Name
->
Maybe
HyperdataUser
->
UserId
->
NodeWrite
nodeUserW
maybeName
maybeHyperdata
=
node
NodeUser
name
user
Nothing
where
name
=
maybe
"User"
identity
maybeName
user
=
maybe
default
User
identity
maybeHyperdata
user
=
maybe
fake_Hyperdata
User
identity
maybeHyperdata
nodeContactW
::
Maybe
Name
->
Maybe
HyperdataContact
->
AnnuaireId
->
UserId
->
NodeWrite
...
...
@@ -409,7 +406,6 @@ nodeContactW maybeName maybeContact aId =
where
name
=
maybe
"Contact"
identity
maybeName
contact
=
maybe
arbitraryHyperdataContact
identity
maybeContact
------------------------------------------------------------------------
defaultFolder
::
HyperdataCorpus
defaultFolder
=
defaultCorpus
...
...
@@ -494,7 +490,6 @@ nodeDefault nt parent = node nt name hyper (Just parent)
hyper
=
(
hasDefaultData
nt
)
------------------------------------------------------------------------
arbitraryListModel
::
HyperdataListModel
arbitraryListModel
=
HyperdataListModel
(
400
,
500
)
"data/models/test.model"
(
Just
0.83
)
...
...
@@ -643,7 +638,7 @@ mkNodeWithParent NodeUser (Just _) _ _ = nodeError UserNoParent
------------------------------------------------------------------------
mkNodeWithParent
NodeUser
Nothing
uId
name
=
insertNodesWithParentR
Nothing
[
node
NodeUser
name
default
User
Nothing
uId
]
insertNodesWithParentR
Nothing
[
node
NodeUser
name
fake_Hyperdata
User
Nothing
uId
]
mkNodeWithParent
_
Nothing
_
_
=
nodeError
HasParent
------------------------------------------------------------------------
...
...
@@ -756,3 +751,9 @@ pgNodeId = pgInt4 . id2int
getListsWithParentId
::
NodeId
->
Cmd
err
[
Node
HyperdataList
]
getListsWithParentId
n
=
runOpaQuery
$
selectNodesWith'
n
(
Just
NodeList
)
-- import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata)
-- updateNodeUser_fake :: NodeId -> Cmd err Int64
-- updateNodeUser_fake n = updateHyperdata n fake_HyperdataUser
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