Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
hal
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
3
Issues
3
List
Board
Labels
Milestones
Merge Requests
2
Merge Requests
2
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
crawlers
hal
Commits
b99b9e56
Verified
Commit
b99b9e56
authored
Mar 18, 2024
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Use fq for lang filter
Also, some refactoring for app (add debug etc).
parent
5edaca5c
Changes
2
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
131 additions
and
95 deletions
+131
-95
Main.hs
app/Main.hs
+30
-19
HAL.hs
src/HAL.hs
+101
-76
No files found.
app/Main.hs
View file @
b99b9e56
...
@@ -5,21 +5,24 @@ module Main where
...
@@ -5,21 +5,24 @@ module Main where
import
Conduit
(
sinkList
,
mapM_C
,
(
.|
),
runConduit
)
import
Conduit
(
sinkList
,
mapM_C
,
(
.|
),
runConduit
)
import
Data.LanguageCodes
(
ISO639_1
(
..
))
import
Data.LanguageCodes
(
ISO639_1
(
..
))
import
Data.Text
qualified
as
T
import
Data.Text
qualified
as
T
import
HAL
(
getMetadataWith
,
getMetadataWithC
,
getMetadataWithCursorC
)
import
HAL
(
getMetadataWith
CursorOptsC
,
countResultsOpts'
,
HalCrawlerOptions
(
..
),
defaultHalOptions
)
import
HAL.Doc
import
HAL.Doc
import
HAL.Doc.Corpus
(
Corpus
(
..
))
import
HAL.Doc.Corpus
(
Corpus
(
..
))
import
Network.HTTP.Client
(
newManager
)
import
Network.HTTP.Client
(
newManager
)
import
Network.HTTP.Client.TLS
(
tlsManagerSettings
)
import
Network.HTTP.Client.TLS
(
tlsManagerSettings
)
import
Options.Applicative
import
Options.Applicative
import
Prelude
qualified
import
Protolude
import
Protolude
data
CountParams
=
CountParams
data
CountParams
=
CountParams
{
cp_query
::
[
T
.
Text
]
}
{
cp_query
::
T
.
Text
,
cp_lang
::
Maybe
ISO639_1
}
data
FetchParams
=
FetchParams
data
FetchParams
=
FetchParams
{
fp_query
::
[
T
.
Text
]
{
fp_query
::
T
.
Text
,
fp_limit
::
Integer
}
,
fp_limit
::
Integer
,
fp_lang
::
Maybe
ISO639_1
}
data
Command
=
data
Command
=
Count
CountParams
Count
CountParams
...
@@ -28,14 +31,19 @@ data Command =
...
@@ -28,14 +31,19 @@ data Command =
countParams
::
Parser
Command
countParams
::
Parser
Command
countParams
=
Count
<$>
countParams
=
Count
<$>
(
CountParams
(
CountParams
<$>
many
(
strArgument
(
metavar
"query"
)))
<$>
strArgument
(
metavar
"query"
)
<*>
optional
(
option
(
maybeReader
readLang
)
(
long
"lang"
)))
fetchParams
::
Parser
Command
fetchParams
::
Parser
Command
fetchParams
=
Fetch
<$>
fetchParams
=
Fetch
<$>
(
FetchParams
(
FetchParams
<$>
many
(
strArgument
(
metavar
"query"
))
<$>
strArgument
(
metavar
"query"
)
<*>
option
auto
(
long
"limit"
))
<*>
option
auto
(
long
"limit"
)
<*>
optional
(
option
(
maybeReader
readLang
)
(
long
"lang"
)))
readLang
::
Prelude
.
String
->
Maybe
ISO639_1
readLang
=
readMaybe
params
::
Parser
Command
params
::
Parser
Command
params
=
subparser
params
=
subparser
(
command
"count"
(
info
countParams
(
progDesc
"Count number of docs for a given query"
))
(
command
"count"
(
info
countParams
(
progDesc
"Count number of docs for a given query"
))
...
@@ -55,13 +63,15 @@ main = run =<< execParser opts
...
@@ -55,13 +63,15 @@ main = run =<< execParser opts
-- (Right val) -> print $ _docs val
-- (Right val) -> print $ _docs val
run
::
Command
->
IO
()
run
::
Command
->
IO
()
run
(
Count
(
CountParams
{
cp_query
}))
=
do
run
(
Count
(
CountParams
{
cp_query
,
cp_lang
}))
=
do
res
<-
getMetadataWithC
cp_query
(
Just
0
)
Nothing
Nothi
ng
res
<-
countResultsOpts'
opts
cp_query
cp_la
ng
case
res
of
case
res
of
Left
err
->
putText
$
show
err
Left
err
->
putText
$
show
err
Right
(
cnt
,
_docsC
)
->
putText
$
show
cnt
Right
cnt
->
putText
$
show
cnt
run
(
Fetch
(
FetchParams
{
fp_query
,
fp_limit
}))
=
do
where
res
<-
getMetadataWithCursorC
fp_query
(
Just
fp_limit
)
Nothing
opts
=
defaultHalOptions
{
_hco_debugLogs
=
True
}
run
(
Fetch
(
FetchParams
{
fp_query
,
fp_limit
,
fp_lang
}))
=
do
res
<-
getMetadataWithCursorOptsC
opts
fp_query
(
Just
fp_limit
)
fp_lang
case
res
of
case
res
of
Left
err
->
putText
$
show
err
Left
err
->
putText
$
show
err
Right
(
_cnt
,
docsC
)
->
do
Right
(
_cnt
,
docsC
)
->
do
...
@@ -70,13 +80,14 @@ run (Fetch (FetchParams { fp_query, fp_limit })) = do
...
@@ -70,13 +80,14 @@ run (Fetch (FetchParams { fp_query, fp_limit })) = do
.|
mapM_C
printCorpus
.|
mapM_C
printCorpus
.|
sinkList
.|
sinkList
pure
()
pure
()
where
where
printCorpus
Corpus
{
..
}
=
do
opts
=
defaultHalOptions
{
_hco_debugLogs
=
True
}
putText
$
"docid: "
<>
_corpus_docid
<>
" ["
<>
(
T
.
intercalate
" "
_corpus_title
)
<>
"]"
printCorpus
Corpus
{
..
}
=
do
putText
$
" "
<>
(
T
.
intercalate
" "
_corpus_abstract
)
putText
$
"docid: "
<>
_corpus_docid
<>
" ["
<>
(
T
.
intercalate
" "
_corpus_title
)
<>
"]"
putText
$
" "
<>
show
_corpus_abstract_lang_map
putText
$
" "
<>
(
T
.
intercalate
" "
_corpus_abstract
)
putText
$
" "
<>
show
_corpus_original
putText
$
" "
<>
show
_corpus_abstract_lang_map
putText
"------------"
putText
$
" "
<>
show
_corpus_original
putText
"------------"
-- data
-- data
...
...
src/HAL.hs
View file @
b99b9e56
This diff is collapsed.
Click to expand it.
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