Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
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
Przemyslaw Kaminski
haskell-gargantext
Commits
905ef6b1
Commit
905ef6b1
authored
Dec 13, 2018
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[GRAPH][Search] Query -> FacetDoc.
parent
be92ab3a
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
41 additions
and
31 deletions
+41
-31
Search.hs
src/Gargantext/API/Search.hs
+0
-1
Facet.hs
src/Gargantext/Database/Facet.hs
+31
-26
TextSearch.hs
src/Gargantext/Database/TextSearch.hs
+10
-4
No files found.
src/Gargantext/API/Search.hs
View file @
905ef6b1
...
...
@@ -97,7 +97,6 @@ instance ToSchema SearchResults where
defaultSchemaOptions
{
fieldLabelModifier
=
\
fieldLabel
->
drop
4
fieldLabel
}
-----------------------------------------------------------------------
type
SearchAPI
=
Post
'[
J
SON
]
SearchResults
-----------------------------------------------------------------------
...
...
src/Gargantext/Database/Facet.hs
View file @
905ef6b1
...
...
@@ -26,7 +26,6 @@ Portability : POSIX
module
Gargantext.Database.Facet
where
------------------------------------------------------------------------
import
Control.Arrow
(
returnA
)
import
Control.Lens.TH
(
makeLensesWith
,
abbreviatedFields
)
import
Data.Aeson
(
FromJSON
,
ToJSON
)
...
...
@@ -74,7 +73,6 @@ type FacetAuthors = FacetDoc
type
FacetTerms
=
FacetDoc
data
Facet
id
created
title
hyperdata
favorite
ngramCount
=
FacetDoc
{
facetDoc_id
::
id
,
facetDoc_created
::
created
...
...
@@ -83,7 +81,14 @@ data Facet id created title hyperdata favorite ngramCount =
,
facetDoc_favorite
::
favorite
,
facetDoc_ngramCount
::
ngramCount
}
deriving
(
Show
,
Generic
)
{- | TODO after demo
data Facet id date hyperdata score =
FacetDoc { facetDoc_id :: id
, facetDoc_date :: date
, facetDoc_hyperdata :: hyperdata
, facetDoc_score :: score
} deriving (Show, Generic)
-}
-- | JSON instance
$
(
deriveJSON
(
unPrefix
"facetDoc_"
)
''
F
acet
)
...
...
@@ -92,7 +97,6 @@ $(deriveJSON (unPrefix "facetDoc_") ''Facet)
instance
ToSchema
FacetDoc
-- | Mock and Quickcheck instances
instance
Arbitrary
FacetDoc
where
arbitrary
=
elements
[
FacetDoc
id'
(
jour
year
01
01
)
t
hp
fav
ngramCount
|
id'
<-
[
1
..
10
]
...
...
@@ -129,9 +133,9 @@ instance Arbitrary FacetChart where
-----------------------------------------------------------------------
type
Trash
=
Bool
data
OrderBy
=
DateAsc
|
DateDesc
|
TitleAsc
|
TitleDesc
|
FavDesc
|
Fav
Asc
data
OrderBy
=
DateAsc
|
DateDesc
|
TitleAsc
|
TitleDesc
|
ScoreDesc
|
Score
Asc
deriving
(
Generic
,
Enum
,
Bounded
,
Read
,
Show
)
-- | NgramCoun
...
...
@@ -141,8 +145,8 @@ instance FromHttpApiData OrderBy
parseUrlPiece
"DateDesc"
=
pure
DateDesc
parseUrlPiece
"TitleAsc"
=
pure
TitleAsc
parseUrlPiece
"TitleDesc"
=
pure
TitleDesc
parseUrlPiece
"
FavAsc"
=
pure
Fav
Asc
parseUrlPiece
"
FavDesc"
=
pure
Fav
Desc
parseUrlPiece
"
ScoreAsc"
=
pure
Score
Asc
parseUrlPiece
"
ScoreDesc"
=
pure
Score
Desc
parseUrlPiece
_
=
Left
"Unexpected value of OrderBy"
instance
ToParamSchema
OrderBy
...
...
@@ -155,7 +159,7 @@ instance Arbitrary OrderBy
runViewAuthorsDoc
::
Connection
->
ContactId
->
Trash
->
Maybe
Offset
->
Maybe
Limit
->
Maybe
OrderBy
->
IO
[
FacetDoc
]
runViewAuthorsDoc
c
cId
t
o
l
order
=
runQuery
c
(
filter
Documents
o
l
order
$
viewAuthorsDoc
cId
t
ntId
)
runViewAuthorsDoc
c
cId
t
o
l
order
=
runQuery
c
(
filter
With
o
l
order
$
viewAuthorsDoc
cId
t
ntId
)
where
ntId
=
NodeDocument
...
...
@@ -199,7 +203,7 @@ runViewDocuments cId t o l order = mkCmd $ \c -> runViewDocuments' c cId t o l o
-- | TODO use only Cmd with Reader and delete function below
runViewDocuments'
::
Connection
->
CorpusId
->
Trash
->
Maybe
Offset
->
Maybe
Limit
->
Maybe
OrderBy
->
IO
[
FacetDoc
]
runViewDocuments'
c
cId
t
o
l
order
=
runQuery
c
(
filter
Documents
o
l
order
runViewDocuments'
c
cId
t
o
l
order
=
runQuery
c
(
filter
With
o
l
order
$
viewDocuments
cId
t
ntId
)
where
ntId
=
nodeTypeId
NodeDocument
...
...
@@ -216,22 +220,23 @@ viewDocuments cId t ntId = proc () -> do
------------------------------------------------------------------------
filterDocuments
::
(
PGOrd
date
,
PGOrd
title
,
PGOrd
favorite
)
=>
filterWith
::
(
PGOrd
date
,
PGOrd
title
,
PGOrd
score
)
=>
Maybe
Gargantext
.
Core
.
Types
.
Offset
->
Maybe
Gargantext
.
Core
.
Types
.
Limit
->
Maybe
OrderBy
->
Select
(
Facet
id
(
Column
date
)
(
Column
title
)
hyperdata
(
Column
favorite
)
ngramCount
)
->
Query
(
Facet
id
(
Column
date
)
(
Column
title
)
hyperdata
(
Column
favorite
)
ngramCount
)
filterDocuments
o
l
order
q
=
limit'
l
$
offset'
o
$
orderBy
ordering
q
where
ordering
=
case
order
of
(
Just
DateAsc
)
->
asc
facetDoc_created
(
Just
TitleAsc
)
->
asc
facetDoc_title
(
Just
TitleDesc
)
->
desc
facetDoc_title
(
Just
FavAsc
)
->
asc
facetDoc_favorite
(
Just
FavDesc
)
->
desc
facetDoc_favorite
_
->
desc
facetDoc_created
->
Select
(
Facet
id
(
Column
date
)
(
Column
title
)
hyperdata
(
Column
score
)
ngramCount
)
->
Select
(
Facet
id
(
Column
date
)
(
Column
title
)
hyperdata
(
Column
score
)
ngramCount
)
filterWith
o
l
order
q
=
limit'
l
$
offset'
o
$
orderBy
(
orderWith
order
)
q
orderWith
::
(
PGOrd
b1
,
PGOrd
b2
,
PGOrd
b3
)
=>
Maybe
OrderBy
->
Order
(
Facet
id
(
Column
b1
)
(
Column
b2
)
hyperdata
(
Column
b3
)
score
)
orderWith
order
=
case
order
of
(
Just
DateAsc
)
->
asc
facetDoc_created
(
Just
TitleAsc
)
->
asc
facetDoc_title
(
Just
TitleDesc
)
->
desc
facetDoc_title
(
Just
ScoreAsc
)
->
asc
facetDoc_favorite
(
Just
ScoreDesc
)
->
desc
facetDoc_favorite
_
->
desc
facetDoc_created
src/Gargantext/Database/TextSearch.hs
View file @
905ef6b1
...
...
@@ -18,12 +18,14 @@ import Data.Aeson
import
Data.List
(
intersperse
)
import
Data.String
(
IsString
(
..
))
import
Data.Text
(
Text
,
words
,
unpack
)
import
Data.Time
(
UTCTime
)
import
Database.PostgreSQL.Simple
-- (Query, Connection)
import
Database.PostgreSQL.Simple.ToField
import
Gargantext.Database.Config
(
nodeTypeId
)
import
Gargantext.Database.Types.Node
(
NodeType
(
..
))
import
Gargantext.Prelude
--import Gargantext.Database.Node.Contact
import
Gargantext.Database.Facet
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.Ngrams
import
Gargantext.Database.Schema.NodeNode
...
...
@@ -50,16 +52,20 @@ queryInDatabase _ q = proc () -> do
------------------------------------------------------------------------
-- | todo add limit and offset and order
searchInCorpus
::
Connection
->
CorpusId
->
Text
->
IO
[(
NodeId
,
HyperdataDocument
)]
searchInCorpus
c
cId
q
=
runQuery
c
(
queryInCorpus
cId
q
)
searchInCorpus
::
Connection
->
CorpusId
->
Text
->
IO
[
FacetDoc
]
searchInCorpus
c
cId
q
=
map
toFacet
<$>
runQuery'
where
toFacet
(
nId
,
d
,
h
)
=
FacetDoc
nId
d
(
maybe
"Empty Title"
identity
$
_hyperdataDocument_title
h
)
h
True
0
runQuery'
::
IO
[(
Int
,
UTCTime
,
HyperdataDocument
)]
runQuery'
=
runQuery
c
(
queryInCorpus
cId
q
)
queryInCorpus
::
CorpusId
->
Text
->
O
.
Query
(
Column
PGInt4
,
Column
PGJsonb
)
queryInCorpus
::
CorpusId
->
Text
->
O
.
Query
(
Column
PGInt4
,
Column
PG
Timestamptz
,
Column
PG
Jsonb
)
queryInCorpus
cId
q
=
proc
()
->
do
(
n
,
nn
)
<-
joinInCorpus
-<
()
restrict
-<
(
nodeNode_node1_id
nn
)
.==
(
toNullable
$
pgInt4
cId
)
restrict
-<
(
_ns_search
n
)
@@
(
pgTSQuery
(
unpack
q
))
restrict
-<
(
_ns_typename
n
)
.==
(
pgInt4
$
nodeTypeId
NodeDocument
)
returnA
-<
(
_ns_id
n
,
_ns_hyperdata
n
)
returnA
-<
(
_ns_id
n
,
_ns_
date
n
,
_ns_
hyperdata
n
)
joinInCorpus
::
O
.
Query
(
NodeSearchRead
,
NodeNodeReadNull
)
joinInCorpus
=
leftJoin
queryNodeSearchTable
queryNodeNodeTable
cond
...
...
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