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
199
Issues
199
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
0dc3d444
Commit
0dc3d444
authored
Dec 13, 2018
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[Graph Search] union of pairs.
parent
cce2004f
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
14 additions
and
8 deletions
+14
-8
Facet.hs
src/Gargantext/Database/Facet.hs
+0
-7
TextSearch.hs
src/Gargantext/Database/TextSearch.hs
+8
-1
Node.hs
src/Gargantext/Database/Types/Node.hs
+6
-0
No files found.
src/Gargantext/Database/Facet.hs
View file @
0dc3d444
...
...
@@ -90,13 +90,6 @@ data Facet id date hyperdata score =
} deriving (Show, Generic)
-}
{-
type PairLabel = Text
instance ToJSON PairLabel
instance ToSchema PairLabel
instance Arbitrary PairLabel where
arbitrary = elements (["Label 1", "Label 2"] :: [PairLabel])
-}
data
Pair
i
l
=
Pair
{
_p_id
::
i
,
_p_label
::
l
}
deriving
(
Show
,
Generic
)
...
...
src/Gargantext/Database/TextSearch.hs
View file @
0dc3d444
...
...
@@ -15,6 +15,8 @@ Portability : POSIX
module
Gargantext.Database.TextSearch
where
import
Data.Aeson
import
Data.Map.Strict
hiding
(
map
)
import
Data.Maybe
import
Data.List
(
intersperse
)
import
Data.String
(
IsString
(
..
))
import
Data.Text
(
Text
,
words
,
unpack
,
intercalate
)
...
...
@@ -75,7 +77,12 @@ joinInCorpus = leftJoin queryNodeSearchTable queryNodeNodeTable cond
type
AuthorName
=
Text
searchInCorpusWithContacts
::
Connection
->
CorpusId
->
[
Text
]
->
Maybe
Offset
->
Maybe
Limit
->
Maybe
OrderBy
->
IO
[
FacetPaired
Int
UTCTime
HyperdataDocument
Int
[
Pair
Int
Text
]]
searchInCorpusWithContacts
=
undefined
searchInCorpusWithContacts
c
cId
q
o
l
order
=
map
(
\
((
i
,
u
,
h
,
s
),
ps
)
->
FacetPaired
i
u
h
s
(
catMaybes
ps
))
<$>
toList
<$>
fromListWith
(
<>
)
<$>
map
(
\
(
FacetPaired
i
u
h
s
p
)
->
((
i
,
u
,
h
,
s
),
[
maybePair
p
]))
<$>
searchInCorpusWithContacts'
c
cId
q
o
l
order
where
maybePair
(
Pair
Nothing
Nothing
)
=
Nothing
maybePair
(
Pair
_
Nothing
)
=
Nothing
maybePair
(
Pair
Nothing
_
)
=
Nothing
maybePair
(
Pair
(
Just
i
)
(
Just
l
))
=
Just
$
Pair
i
l
searchInCorpusWithContacts'
::
Connection
->
CorpusId
->
[
Text
]
->
Maybe
Offset
->
Maybe
Limit
->
Maybe
OrderBy
->
IO
[(
FacetPaired
Int
UTCTime
HyperdataDocument
Int
(
Pair
(
Maybe
Int
)
(
Maybe
Text
)))]
searchInCorpusWithContacts'
c
cId
q
o
l
order
=
runQuery
c
$
queryInCorpusWithContacts
cId
q'
o
l
order
...
...
src/Gargantext/Database/Types/Node.hs
View file @
0dc3d444
...
...
@@ -131,6 +131,12 @@ data HyperdataDocument = HyperdataDocument { _hyperdataDocument_bdd
$
(
deriveJSON
(
unPrefix
"_hyperdataDocument_"
)
''
H
yperdataDocument
)
$
(
makeLenses
''
H
yperdataDocument
)
instance
Eq
HyperdataDocument
where
(
==
)
h1
h2
=
(
==
)
(
_hyperdataDocument_uniqId
h1
)
(
_hyperdataDocument_uniqId
h2
)
instance
Ord
HyperdataDocument
where
compare
h1
h2
=
compare
(
_hyperdataDocument_uniqId
h1
)
(
_hyperdataDocument_uniqId
h2
)
instance
Hyperdata
HyperdataDocument
instance
ToField
HyperdataDocument
where
...
...
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