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
195
Issues
195
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
fd45f6ca
Commit
fd45f6ca
authored
May 24, 2022
by
Karen Konou
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[Doc upload] Null pId for unit doc upload
parent
459bf29b
Pipeline
#2863
failed with stage
in 40 minutes and 48 seconds
Changes
2
Pipelines
1
Show whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
7 additions
and
7 deletions
+7
-7
Flow.hs
src/Gargantext/Database/Action/Flow.hs
+2
-2
Insert.hs
src/Gargantext/Database/Query/Table/Node/Document/Insert.hs
+5
-5
No files found.
src/Gargantext/Database/Action/Flow.hs
View file @
fd45f6ca
...
@@ -349,7 +349,7 @@ insertMasterDocs :: ( FlowCmdM env err m
...
@@ -349,7 +349,7 @@ insertMasterDocs :: ( FlowCmdM env err m
->
m
[
DocId
]
->
m
[
DocId
]
insertMasterDocs
c
lang
hs
=
do
insertMasterDocs
c
lang
hs
=
do
(
masterUserId
,
_
,
masterCorpusId
)
<-
getOrMk_RootWithCorpus
(
UserName
userMaster
)
(
Left
corpusMasterName
)
c
(
masterUserId
,
_
,
masterCorpusId
)
<-
getOrMk_RootWithCorpus
(
UserName
userMaster
)
(
Left
corpusMasterName
)
c
(
ids'
,
documentsWithId
)
<-
insertDocs
masterUserId
masterCorpusId
(
map
(
toNode
masterUserId
masterCorpusId
)
hs
)
(
ids'
,
documentsWithId
)
<-
insertDocs
masterUserId
masterCorpusId
(
map
(
toNode
masterUserId
Nothing
)
hs
)
_
<-
Doc
.
add
masterCorpusId
ids'
_
<-
Doc
.
add
masterCorpusId
ids'
-- TODO
-- TODO
-- create a corpus with database name (CSV or PubMed)
-- create a corpus with database name (CSV or PubMed)
...
@@ -413,7 +413,7 @@ insertDocs :: ( FlowCmdM env err m
...
@@ -413,7 +413,7 @@ insertDocs :: ( FlowCmdM env err m
->
m
([
ContextId
],
[
Indexed
ContextId
a
])
->
m
([
ContextId
],
[
Indexed
ContextId
a
])
insertDocs
uId
cId
hs
=
do
insertDocs
uId
cId
hs
=
do
let
docs
=
map
addUniqId
hs
let
docs
=
map
addUniqId
hs
newIds
<-
insertDb
uId
cId
docs
newIds
<-
insertDb
uId
Nothing
docs
-- printDebug "newIds" newIds
-- printDebug "newIds" newIds
let
let
newIds'
=
map
reId
newIds
newIds'
=
map
reId
newIds
...
...
src/Gargantext/Database/Query/Table/Node/Document/Insert.hs
View file @
fd45f6ca
...
@@ -91,14 +91,14 @@ import Database.PostgreSQL.Simple (formatQuery)
...
@@ -91,14 +91,14 @@ import Database.PostgreSQL.Simple (formatQuery)
-- ParentId : folder ID which is parent of the inserted documents
-- ParentId : folder ID which is parent of the inserted documents
-- Administrator of the database has to create a uniq index as following SQL command:
-- Administrator of the database has to create a uniq index as following SQL command:
-- `create unique index on contexts table (typename, parent_id, (hyperdata ->> 'uniqId'));`
-- `create unique index on contexts table (typename, parent_id, (hyperdata ->> 'uniqId'));`
insertDb
::
(
InsertDb
a
,
HasDBid
NodeType
)
=>
UserId
->
ParentId
->
[
a
]
->
Cmd
err
[
ReturnId
]
insertDb
::
(
InsertDb
a
,
HasDBid
NodeType
)
=>
UserId
->
Maybe
ParentId
->
[
a
]
->
Cmd
err
[
ReturnId
]
insertDb
u
p
=
runPGSQuery
queryInsert
.
Only
.
Values
fields
.
map
(
insertDb'
u
p
)
insertDb
u
p
=
runPGSQuery
queryInsert
.
Only
.
Values
fields
.
map
(
insertDb'
u
p
)
where
where
fields
=
map
(
\
t
->
QualifiedIdentifier
Nothing
t
)
inputSqlTypes
fields
=
map
(
\
t
->
QualifiedIdentifier
Nothing
t
)
inputSqlTypes
class
InsertDb
a
class
InsertDb
a
where
where
insertDb'
::
HasDBid
NodeType
=>
UserId
->
ParentId
->
a
->
[
Action
]
insertDb'
::
HasDBid
NodeType
=>
UserId
->
Maybe
ParentId
->
a
->
[
Action
]
instance
InsertDb
HyperdataDocument
instance
InsertDb
HyperdataDocument
...
@@ -272,10 +272,10 @@ maybeText = maybe (DT.pack "") identity
...
@@ -272,10 +272,10 @@ maybeText = maybe (DT.pack "") identity
class
ToNode
a
class
ToNode
a
where
where
-- TODO Maybe NodeId
-- TODO Maybe NodeId
toNode
::
HasDBid
NodeType
=>
UserId
->
ParentId
->
a
->
Node
a
toNode
::
HasDBid
NodeType
=>
UserId
->
Maybe
ParentId
->
a
->
Node
a
instance
ToNode
HyperdataDocument
where
instance
ToNode
HyperdataDocument
where
toNode
u
p
h
=
Node
0
Nothing
(
toDBid
NodeDocument
)
u
(
Just
p
)
n
date
h
toNode
u
p
h
=
Node
0
Nothing
(
toDBid
NodeDocument
)
u
p
n
date
h
where
where
n
=
maybe
"No Title"
(
DT
.
take
255
)
(
_hd_title
h
)
n
=
maybe
"No Title"
(
DT
.
take
255
)
(
_hd_title
h
)
date
=
jour
y
m
d
date
=
jour
y
m
d
...
@@ -288,7 +288,7 @@ instance ToNode HyperdataDocument where
...
@@ -288,7 +288,7 @@ instance ToNode HyperdataDocument where
-- TODO better Node
-- TODO better Node
instance
ToNode
HyperdataContact
where
instance
ToNode
HyperdataContact
where
toNode
u
p
h
=
Node
0
Nothing
(
toDBid
NodeContact
)
u
(
Just
p
)
"Contact"
date
h
toNode
u
p
h
=
Node
0
Nothing
(
toDBid
NodeContact
)
u
p
"Contact"
date
h
where
where
date
=
jour
2020
01
01
date
=
jour
2020
01
01
...
...
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