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
154
Issues
154
List
Board
Labels
Milestones
Merge Requests
13
Merge Requests
13
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
ed6f6bcb
Commit
ed6f6bcb
authored
Jul 28, 2021
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[searx] fetching searx json page works now
parent
22e2da48
Pipeline
#1682
passed with stage
in 30 minutes and 55 seconds
Changes
1
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
39 additions
and
14 deletions
+39
-14
Searx.hs
src/Gargantext/API/Node/Corpus/Searx.hs
+39
-14
No files found.
src/Gargantext/API/Node/Corpus/Searx.hs
View file @
ed6f6bcb
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TemplateHaskell #-}
module
Gargantext.API.Node.Corpus.Searx
where
...
...
@@ -10,7 +11,8 @@ import GHC.Generics (Generic)
import
Network.HTTP.Client
import
Network.HTTP.Client.TLS
import
Protolude
(
encodeUtf8
,
Text
)
import
qualified
Prelude
as
Prelude
import
Protolude
(
encodeUtf8
,
Text
,
Either
)
import
Gargantext.Prelude
import
Gargantext.Prelude.Config
...
...
@@ -25,7 +27,7 @@ import Gargantext.Database.Prelude (hasConfig)
data
SearxResult
=
SearxResult
{
_sr_url
::
Text
,
_sr_title
::
Text
,
_sr_content
::
Text
,
_sr_content
::
Maybe
Text
,
_sr_engine
::
Text
,
_sr_score
::
Double
,
_sr_category
::
Text
...
...
@@ -50,6 +52,33 @@ data SearxResponse = SearxResponse
$
(
deriveJSON
(
unPrefix
"_srs_"
)
''
S
earxResponse
)
data
FetchSearxParams
=
FetchSearxParams
{
_fsp_manager
::
Manager
,
_fsp_pageno
::
Int
,
_fsp_query
::
Text
,
_fsp_url
::
Text
}
fetchSearxPage
::
FetchSearxParams
->
IO
(
Either
Prelude
.
String
SearxResponse
)
fetchSearxPage
(
FetchSearxParams
{
_fsp_manager
,
_fsp_pageno
,
_fsp_query
,
_fsp_url
})
=
do
-- searx search API:
-- https://searx.github.io/searx/dev/search_api.html?highlight=json
req
<-
parseRequest
$
T
.
unpack
_fsp_url
let
request
=
urlEncodedBody
[
--("category_general", "1")
(
"q"
,
encodeUtf8
_fsp_query
)
,
(
"pageno"
,
encodeUtf8
$
T
.
pack
$
show
_fsp_pageno
)
--, ("time_range", "None")
--, ("language", "en-US") -- TODO
,
(
"format"
,
"json"
)
]
req
res
<-
httpLbs
request
_fsp_manager
let
dec
=
Aeson
.
eitherDecode
$
responseBody
res
::
(
Either
Prelude
.
String
SearxResponse
)
pure
dec
triggerSearxSearch
::
(
MonadBase
IO
m
,
FlowCmdM
env
err
m
)
=>
CorpusId
->
API
.
Query
...
...
@@ -64,19 +93,15 @@ triggerSearxSearch cid q l = do
let
surl
=
_gc_frame_searx_url
cfg
printDebug
"[triggerSearxSearch] surl"
surl
res
<-
liftBase
$
do
manager
<-
newManager
tlsManagerSettings
req
<-
parseRequest
$
T
.
unpack
surl
let
request
=
urlEncodedBody
[
(
"category_general"
,
"1"
)
,
(
"q"
,
encodeUtf8
q
)
,
(
"pageno"
,
"1"
)
,
(
"time_range"
,
"None"
)
,
(
"language"
,
"en-US"
)
-- TODO
,
(
"format"
,
"json"
)]
req
httpLbs
request
manager
let
dec
=
Aeson
.
decode
$
responseBody
res
::
(
Maybe
SearxResponse
)
printDebug
"[triggerSearxSearch] dec"
dec
manager
<-
liftBase
$
newManager
tlsManagerSettings
res
<-
liftBase
$
fetchSearxPage
$
FetchSearxParams
{
_fsp_manager
=
manager
,
_fsp_pageno
=
1
,
_fsp_query
=
q
,
_fsp_url
=
surl
}
printDebug
"[triggerSearxSearch] res"
res
pure
()
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