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
a910c0de
Commit
a910c0de
authored
Jul 27, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[API] Search API using generics with front
parent
314ed198
Pipeline
#986
failed with stage
Changes
3
Pipelines
1
Show whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
42 additions
and
24 deletions
+42
-24
Search.hs
src/Gargantext/API/Search.hs
+35
-15
Contact.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Contact.hs
+0
-2
Facet.hs
src/Gargantext/Database/Query/Facet.hs
+7
-7
No files found.
src/Gargantext/API/Search.hs
View file @
a910c0de
...
...
@@ -19,15 +19,16 @@ Count API part of Gargantext.
module
Gargantext.API.Search
where
import
Data.Aeson
.TH
(
deriveJSON
)
import
Data.Aeson
import
Data.Swagger
import
Data.Text
(
Text
)
import
Data.Time
(
UTCTime
)
import
GHC.Generics
(
Generic
)
import
Gargantext.API.Prelude
(
GargServer
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefix
Swagger
)
import
Gargantext.Core.Utils.Prefix
(
unPrefixSwagger
)
import
Gargantext.Database.Query.Facet
import
Gargantext.Database.Action.Search
import
Gargantext.Database.Action.Flow.Pairing
(
isPairedWith
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataContact
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Prelude
...
...
@@ -39,31 +40,47 @@ import Test.QuickCheck.Arbitrary
data
SearchType
=
SearchDoc
|
SearchContact
deriving
(
Generic
)
$
(
deriveJSON
(
unPrefix
""
)
''
S
earchType
)
instance
FromJSON
SearchType
where
parseJSON
=
genericParseJSON
(
defaultOptions
{
sumEncoding
=
ObjectWithSingleField
})
instance
ToJSON
SearchType
where
toJSON
=
genericToJSON
(
defaultOptions
{
sumEncoding
=
ObjectWithSingleField
})
instance
ToSchema
SearchType
instance
Arbitrary
SearchType
where
arbitrary
=
elements
[
SearchDoc
,
SearchContact
]
-----------------------------------------------------------------------
data
SearchQuery
=
SearchQuery
{
sq_query
::
[
Text
]
,
sq_type
::
SearchType
data
SearchQuery
=
SearchQuery
{
query
::
!
[
Text
]
,
expected
::
!
SearchType
}
deriving
(
Generic
)
$
(
deriveJSON
(
unPrefix
"sq_"
)
''
S
earchQuery
)
instance
FromJSON
SearchQuery
where
parseJSON
=
genericParseJSON
(
defaultOptions
{
sumEncoding
=
ObjectWithSingleField
})
instance
ToJSON
SearchQuery
where
toJSON
=
genericToJSON
(
defaultOptions
{
sumEncoding
=
ObjectWithSingleField
})
instance
ToSchema
SearchQuery
where
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"
sq_
"
)
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
""
)
instance
Arbitrary
SearchQuery
where
arbitrary
=
elements
[
SearchQuery
[
"electrodes"
]
SearchDoc
]
-----------------------------------------------------------------------
data
SearchResult
=
SearchResultDoc
{
sr_result
::
[
FacetDoc
]}
|
SearchResultContact
{
sr_results
::
[
FacetPaired
Int
UTCTime
HyperdataContact
Int
]
}
|
SearchNoResult
{
sr_message
::
Text
}
data
SearchResult
=
SearchResultDoc
{
docs
::
!
[
FacetDoc
]}
|
SearchResultContact
{
contacts
::
!
[
FacetPaired
Int
UTCTime
HyperdataContact
Int
]
}
|
SearchNoResult
{
message
::
!
Text
}
deriving
(
Generic
)
$
(
deriveJSON
(
unPrefix
"sr_"
)
''
S
earchResult
)
instance
FromJSON
SearchResult
where
parseJSON
=
genericParseJSON
(
defaultOptions
{
sumEncoding
=
ObjectWithSingleField
})
instance
ToJSON
SearchResult
where
toJSON
=
genericToJSON
(
defaultOptions
{
sumEncoding
=
ObjectWithSingleField
})
instance
Arbitrary
SearchResult
where
arbitrary
=
do
...
...
@@ -88,7 +105,10 @@ type API results = Summary "Search endpoint"
api
::
NodeId
->
GargServer
(
API
SearchResult
)
api
nId
(
SearchQuery
q
SearchDoc
)
o
l
order
=
SearchResultDoc
<$>
searchInCorpus
nId
False
q
o
l
order
api
nId
(
SearchQuery
q
SearchContact
)
o
l
order
=
-- SearchPairedResults <$> searchInCorpusWithContacts pId aId q o l order
pure
$
SearchNoResult
"Need Implementation"
api
nId
(
SearchQuery
q
SearchContact
)
o
l
order
=
do
aIds
<-
isPairedWith
NodeAnnuaire
nId
-- TODO if paired with several corpus
case
head
aIds
of
Nothing
->
pure
$
SearchNoResult
"[G.A.Search] pair corpus with an Annuaire"
Just
aId
->
SearchResultContact
<$>
searchInCorpusWithContacts
nId
aId
q
o
l
order
-----------------------------------------------------------------------
src/Gargantext/Database/Admin/Types/Hyperdata/Contact.hs
View file @
a910c0de
...
...
@@ -29,8 +29,6 @@ import Gargantext.Prelude
import
Gargantext.Database.Admin.Types.Hyperdata.Prelude
--------------------------------------------------------------------------------
data
HyperdataContact
=
HyperdataContact
{
_hc_bdd
::
Maybe
Text
-- ID of Database source
,
_hc_who
::
Maybe
ContactWho
...
...
src/Gargantext/Database/Query/Facet.hs
View file @
a910c0de
...
...
@@ -75,23 +75,23 @@ import Gargantext.Database.Schema.Node
--instance FromJSON Facet
--instance ToJSON Facet
type
Favorite
=
Int
type
Category
=
Int
type
Title
=
Text
-- TODO remove Title
type
FacetDoc
=
Facet
NodeId
UTCTime
Title
HyperdataDocument
(
Maybe
Favorite
)
(
Maybe
Double
)
type
FacetDoc
=
Facet
NodeId
UTCTime
Title
HyperdataDocument
(
Maybe
Category
)
(
Maybe
Double
)
-- type FacetSources = FacetDoc
-- type FacetAuthors = FacetDoc
-- type FacetTerms = FacetDoc
data
Facet
id
created
title
hyperdata
favorite
ngramCount
=
data
Facet
id
created
title
hyperdata
category
ngramCount
=
FacetDoc
{
facetDoc_id
::
id
,
facetDoc_created
::
created
,
facetDoc_title
::
title
,
facetDoc_hyperdata
::
hyperdata
,
facetDoc_
favorite
::
favorite
,
facetDoc_
ngramCount
::
ngramCount
,
facetDoc_
category
::
category
,
facetDoc_
score
::
ngramCount
}
deriving
(
Show
,
Generic
)
{- | TODO after demo
data Facet id date hyperdata score =
...
...
@@ -318,8 +318,8 @@ orderWith (Just DateDesc) = desc facetDoc_created
orderWith
(
Just
TitleAsc
)
=
asc
facetDoc_title
orderWith
(
Just
TitleDesc
)
=
desc
facetDoc_title
orderWith
(
Just
ScoreAsc
)
=
asc
facetDoc_
favorite
orderWith
(
Just
ScoreDesc
)
=
desc
facetDoc_
favorite
orderWith
(
Just
ScoreAsc
)
=
asc
facetDoc_
category
orderWith
(
Just
ScoreDesc
)
=
desc
facetDoc_
category
orderWith
(
Just
SourceAsc
)
=
asc
facetDoc_source
orderWith
(
Just
SourceDesc
)
=
desc
facetDoc_source
...
...
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