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
eace00f9
Commit
eace00f9
authored
Jan 10, 2023
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FIX] Duplicates
parent
ca1549e0
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
33 additions
and
37 deletions
+33
-37
Types.hs
src/Gargantext/Database/Action/Flow/Types.hs
+2
-0
Insert.hs
src/Gargantext/Database/Query/Table/Node/Document/Insert.hs
+31
-37
No files found.
src/Gargantext/Database/Action/Flow/Types.hs
View file @
eace00f9
...
@@ -41,6 +41,7 @@ type FlowCmdM env err m =
...
@@ -41,6 +41,7 @@ type FlowCmdM env err m =
type
FlowCorpus
a
=
(
AddUniqId
a
type
FlowCorpus
a
=
(
AddUniqId
a
,
UniqId
a
,
UniqId
a
,
UniqParameters
a
,
InsertDb
a
,
InsertDb
a
,
ExtractNgramsT
a
,
ExtractNgramsT
a
,
HasText
a
,
HasText
a
...
@@ -50,5 +51,6 @@ type FlowCorpus a = ( AddUniqId a
...
@@ -50,5 +51,6 @@ type FlowCorpus a = ( AddUniqId a
type
FlowInsertDB
a
=
(
AddUniqId
a
type
FlowInsertDB
a
=
(
AddUniqId
a
,
UniqId
a
,
UniqId
a
,
UniqParameters
a
,
InsertDb
a
,
InsertDb
a
)
)
src/Gargantext/Database/Query/Table/Node/Document/Insert.hs
View file @
eace00f9
...
@@ -57,7 +57,7 @@ module Gargantext.Database.Query.Table.Node.Document.Insert
...
@@ -57,7 +57,7 @@ module Gargantext.Database.Query.Table.Node.Document.Insert
import
Control.Lens
(
set
,
view
)
import
Control.Lens
(
set
,
view
)
import
Control.Lens.Cons
import
Control.Lens.Cons
import
Control.Lens.Prism
import
Control.Lens.Prism
import
Data.Aeson
(
toJSON
,
encode
,
ToJSON
)
import
Data.Aeson
(
toJSON
,
ToJSON
)
import
Data.Char
(
isAlpha
)
import
Data.Char
(
isAlpha
)
import
Data.Maybe
(
fromMaybe
)
import
Data.Maybe
(
fromMaybe
)
import
Data.Text
(
Text
)
import
Data.Text
(
Text
)
...
@@ -111,7 +111,7 @@ instance InsertDb HyperdataDocument
...
@@ -111,7 +111,7 @@ instance InsertDb HyperdataDocument
,
toField
p
,
toField
p
,
toField
$
maybe
"No Title"
(
DT
.
take
255
)
(
_hd_title
h
)
,
toField
$
maybe
"No Title"
(
DT
.
take
255
)
(
_hd_title
h
)
,
toField
$
_hd_publication_date
h
-- TODO USE UTCTime
,
toField
$
_hd_publication_date
h
-- TODO USE UTCTime
,
(
toField
.
toJSON
)
h
,
(
toField
.
toJSON
)
(
addUniqId
h
)
]
]
instance
InsertDb
HyperdataContact
instance
InsertDb
HyperdataContact
...
@@ -122,7 +122,7 @@ instance InsertDb HyperdataContact
...
@@ -122,7 +122,7 @@ instance InsertDb HyperdataContact
,
toField
p
,
toField
p
,
toField
$
maybe
"Contact"
(
DT
.
take
255
)
(
Just
"Name"
)
-- (_hc_name h)
,
toField
$
maybe
"Contact"
(
DT
.
take
255
)
(
Just
"Name"
)
-- (_hc_name h)
,
toField
$
jour
0
1
1
-- TODO put default date
,
toField
$
jour
0
1
1
-- TODO put default date
,
(
toField
.
toJSON
)
h
,
(
toField
.
toJSON
)
(
addUniqId
h
)
]
]
instance
ToJSON
a
=>
InsertDb
(
Node
a
)
instance
ToJSON
a
=>
InsertDb
(
Node
a
)
...
@@ -197,6 +197,10 @@ class AddUniqId a
...
@@ -197,6 +197,10 @@ class AddUniqId a
where
where
addUniqId
::
a
->
a
addUniqId
::
a
->
a
class
UniqParameters
a
where
uniqParameters
::
ParentId
->
a
->
Text
instance
AddUniqId
HyperdataDocument
instance
AddUniqId
HyperdataDocument
where
where
addUniqId
=
addUniqIdsDoc
addUniqId
=
addUniqIdsDoc
...
@@ -208,46 +212,36 @@ instance AddUniqId HyperdataDocument
...
@@ -208,46 +212,36 @@ instance AddUniqId HyperdataDocument
shaUni
=
hash
$
DT
.
concat
$
map
(
$
doc
)
shaParametersDoc
shaUni
=
hash
$
DT
.
concat
$
map
(
$
doc
)
shaParametersDoc
shaBdd
=
hash
$
DT
.
concat
$
map
(
$
doc
)
([(
\
d
->
maybeText
(
_hd_bdd
d
))]
<>
shaParametersDoc
)
shaBdd
=
hash
$
DT
.
concat
$
map
(
$
doc
)
([(
\
d
->
maybeText
(
_hd_bdd
d
))]
<>
shaParametersDoc
)
shaParametersDoc
::
[(
HyperdataDocument
->
Text
)]
shaParametersDoc
::
[(
HyperdataDocument
->
Text
)]
shaParametersDoc
=
[
\
d
->
filterText
$
maybeText
(
_hd_title
d
)
shaParametersDoc
=
[
\
d
->
filterText
$
maybeText
(
_hd_title
d
)
,
\
d
->
filterText
$
maybeText
(
_hd_abstract
d
)
,
\
d
->
filterText
$
maybeText
(
_hd_abstract
d
)
,
\
d
->
filterText
$
maybeText
(
_hd_source
d
)
,
\
d
->
filterText
$
maybeText
(
_hd_source
d
)
,
\
d
->
maybeText
(
_hd_publication_date
d
)
-- , \d -> maybeText (_hd_publication_date d)
]
]
instance
UniqParameters
HyperdataDocument
where
uniqParameters
_
h
=
filterText
$
DT
.
concat
$
map
maybeText
$
[
_hd_title
h
,
_hd_abstract
h
,
_hd_source
h
]
instance
UniqParameters
HyperdataContact
where
uniqParameters
_
_
=
""
instance
UniqParameters
(
Node
a
)
where
uniqParameters
_
_
=
undefined
filterText
::
Text
->
Text
filterText
::
Text
->
Text
filterText
=
DT
.
toLower
.
(
DT
.
filter
isAlpha
)
filterText
=
DT
.
toLower
.
(
DT
.
filter
isAlpha
)
-- TODO put this elsewhere (fix bin/gargantext-init/Main.hs too)
secret
::
Text
secret
=
"Database secret to change"
instance
(
AddUniqId
a
,
ToJSON
a
,
HasDBid
NodeType
)
=>
AddUniqId
(
Node
a
)
instance
(
UniqParameters
a
,
ToJSON
a
,
HasDBid
NodeType
)
=>
AddUniqId
(
Node
a
)
where
where
addUniqId
(
Node
nid
_
t
u
p
n
d
h
)
=
Node
nid
hashId
t
u
p
n
d
h
addUniqId
(
Node
nid
_
t
u
p
n
d
h
)
=
Node
nid
(
Just
newHash
)
t
u
p
n
d
h
where
where
hashId
=
Just
$
"
\\
x"
<>
(
hash
$
DT
.
concat
params
)
newHash
=
"
\\
x"
<>
(
hash
$
uniqParameters
(
fromMaybe
0
p
)
h
)
params
=
[
secret
,
cs
$
show
$
toDBid
NodeDocument
,
n
,
cs
$
show
p
,
cs
$
encode
h
]
{-
addUniqId n@(Node nid _ t u p n d h) =
case n of
Node HyperdataDocument -> Node nid hashId t u p n d h
where
hashId = "\\x" <> (hash $ DT.concat params)
params = [ secret
, cs $ show $ toDBid NodeDocument
, n
, cs $ show p
, cs $ encode h
]
_ -> undefined
-}
---------------------------------------------------------------------------
---------------------------------------------------------------------------
-- * Uniqueness of document definition
-- * Uniqueness of document definition
...
...
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