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
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
Christian Merten
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 =
type
FlowCorpus
a
=
(
AddUniqId
a
,
UniqId
a
,
UniqParameters
a
,
InsertDb
a
,
ExtractNgramsT
a
,
HasText
a
...
...
@@ -50,5 +51,6 @@ type FlowCorpus a = ( AddUniqId a
type
FlowInsertDB
a
=
(
AddUniqId
a
,
UniqId
a
,
UniqParameters
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
import
Control.Lens
(
set
,
view
)
import
Control.Lens.Cons
import
Control.Lens.Prism
import
Data.Aeson
(
toJSON
,
encode
,
ToJSON
)
import
Data.Aeson
(
toJSON
,
ToJSON
)
import
Data.Char
(
isAlpha
)
import
Data.Maybe
(
fromMaybe
)
import
Data.Text
(
Text
)
...
...
@@ -111,7 +111,7 @@ instance InsertDb HyperdataDocument
,
toField
p
,
toField
$
maybe
"No Title"
(
DT
.
take
255
)
(
_hd_title
h
)
,
toField
$
_hd_publication_date
h
-- TODO USE UTCTime
,
(
toField
.
toJSON
)
h
,
(
toField
.
toJSON
)
(
addUniqId
h
)
]
instance
InsertDb
HyperdataContact
...
...
@@ -122,7 +122,7 @@ instance InsertDb HyperdataContact
,
toField
p
,
toField
$
maybe
"Contact"
(
DT
.
take
255
)
(
Just
"Name"
)
-- (_hc_name h)
,
toField
$
jour
0
1
1
-- TODO put default date
,
(
toField
.
toJSON
)
h
,
(
toField
.
toJSON
)
(
addUniqId
h
)
]
instance
ToJSON
a
=>
InsertDb
(
Node
a
)
...
...
@@ -197,6 +197,10 @@ class AddUniqId a
where
addUniqId
::
a
->
a
class
UniqParameters
a
where
uniqParameters
::
ParentId
->
a
->
Text
instance
AddUniqId
HyperdataDocument
where
addUniqId
=
addUniqIdsDoc
...
...
@@ -208,46 +212,36 @@ instance AddUniqId HyperdataDocument
shaUni
=
hash
$
DT
.
concat
$
map
(
$
doc
)
shaParametersDoc
shaBdd
=
hash
$
DT
.
concat
$
map
(
$
doc
)
([(
\
d
->
maybeText
(
_hd_bdd
d
))]
<>
shaParametersDoc
)
shaParametersDoc
::
[(
HyperdataDocument
->
Text
)]
shaParametersDoc
=
[
\
d
->
filterText
$
maybeText
(
_hd_title
d
)
,
\
d
->
filterText
$
maybeText
(
_hd_abstract
d
)
,
\
d
->
filterText
$
maybeText
(
_hd_source
d
)
,
\
d
->
maybeText
(
_hd_publication_date
d
)
]
shaParametersDoc
::
[(
HyperdataDocument
->
Text
)]
shaParametersDoc
=
[
\
d
->
filterText
$
maybeText
(
_hd_title
d
)
,
\
d
->
filterText
$
maybeText
(
_hd_abstract
d
)
,
\
d
->
filterText
$
maybeText
(
_hd_source
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
=
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
addUniqId
(
Node
nid
_
t
u
p
n
d
h
)
=
Node
nid
hashId
t
u
p
n
d
h
where
hashId
=
Just
$
"
\\
x"
<>
(
hash
$
DT
.
concat
params
)
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
-}
addUniqId
(
Node
nid
_
t
u
p
n
d
h
)
=
Node
nid
(
Just
newHash
)
t
u
p
n
d
h
where
newHash
=
"
\\
x"
<>
(
hash
$
uniqParameters
(
fromMaybe
0
p
)
h
)
---------------------------------------------------------------------------
-- * 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