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
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
Changes
1
Show 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