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
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
hal
Commits
dc9c429b
Commit
dc9c429b
authored
5 years ago
by
Mudada
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
add abstract, source, date, ...
parent
2c3fe64a
Changes
6
Hide whitespace changes
Inline
Side-by-side
Showing
6 changed files
with
95 additions
and
82 deletions
+95
-82
Main.hs
app/Main.hs
+3
-24
HAL.hs
src/HAL.hs
+6
-6
Client.hs
src/HAL/Client.hs
+4
-19
Doc.hs
src/HAL/Doc.hs
+2
-33
Corpus.hs
src/HAL/Doc/Corpus.hs
+43
-0
EntityTree.hs
src/HAL/Doc/EntityTree.hs
+37
-0
No files found.
app/Main.hs
View file @
dc9c429b
...
...
@@ -6,7 +6,7 @@ import Network.HTTP.Client (newManager)
import
Network.HTTP.Client.TLS
(
tlsManagerSettings
)
import
Servant.Client
import
HAL
(
runS
tructure
Request
)
import
HAL
(
runS
earch
Request
)
import
HAL.Client
import
HAL.Doc
import
Tree
...
...
@@ -14,28 +14,7 @@ import Tree
main
::
IO
()
main
=
do
manager'
<-
newManager
tlsManagerSettings
res
<-
runS
tructureRequest
$
Just
"parentDocid_i:302102"
res
<-
runS
earchRequest
$
[
"ia"
]
case
res
of
(
Left
err
)
->
print
err
(
Right
val
)
->
print
val
{-
main :: IO ()
main = do
rootRes <- runHalAPIClient $ structure (Just $ fqRootDoc) (Just "docid, parentDocid_i, label_s") (Just 10000)
case rootRes of
(Left err) -> print err
(Right val) -> do
childrenRes <- runHalAPIClient $ structure (Just $ fqParentDoc) (Just "docid, parentDocid_i, label_s") (Just 10000)
case childrenRes of
(Left err2) -> print err2
(Right val2) -> do
children <- fetchChildren $ val2 ^. docs
let trees = buildTree 0 children <$> (val ^. docs)
let noDuplicateTrees = noDuplicateTree <$> trees
mapM_ putStrLn $ formatTree <$> noDuplicateTrees
where fqParentDoc =
"parentDocid_i:(302102 || 469216 || 6279 || 224096 || 144103 || 497330 || 84538 || 301262 || 481355 || 29212 || 301442 || 542824 || 300362 || 352124 || 300104 || 421532 || 301492)"
fqRootDoc =
"docid:(302102 || 469216 || 6279 || 224096 || 144103 || 497330 || 84538 || 301262 || 481355 || 29212 || 301442 || 542824 || 300362 || 352124 || 300104 || 421532 || 301492)"
-}
(
Right
val
)
->
print
$
_docs
val
This diff is collapsed.
Click to expand it.
src/HAL.hs
View file @
dc9c429b
...
...
@@ -11,17 +11,17 @@ import Network.HTTP.Client.TLS (tlsManagerSettings)
import
Servant.Client
(
BaseUrl
(
..
),
Scheme
(
..
),
ClientM
,
ClientError
,
runClientM
,
mkClientEnv
)
import
HAL.Client
import
HAL.Doc
import
HAL.Doc
.Corpus
runHalAPIClient
::
ClientM
(
Response
Doc
)
->
IO
(
Either
ClientError
(
Response
Doc
))
runHalAPIClient
::
ClientM
(
Response
Corpus
)
->
IO
(
Either
ClientError
(
Response
Corpus
))
runHalAPIClient
cmd
=
do
manager'
<-
newManager
tlsManagerSettings
runClientM
cmd
(
mkClientEnv
manager'
$
BaseUrl
Https
"api.archives-ouvertes.fr"
443
""
)
runStructureRequest
::
Maybe
Text
->
IO
(
Either
ClientError
(
Response
Doc
))
runStructureRequest
::
Maybe
Text
->
IO
(
Either
ClientError
(
Response
Corpus
))
runStructureRequest
rq
=
runHalAPIClient
$
structure
def
rq
(
Just
10000
)
runHalAPIClient
$
structure
(
Just
"docid,title_s,abstract_s,submittedDate_s,source_s,authFullName_s,authOrganism_s"
)
rq
(
Just
10000
)
runSearchRequest
::
[
Text
]
->
IO
(
Either
ClientError
(
Response
Doc
))
runSearchRequest
::
[
Text
]
->
IO
(
Either
ClientError
(
Response
Corpus
))
runSearchRequest
rq
=
runHalAPIClient
$
search
def
rq
Nothing
Nothing
Nothing
runHalAPIClient
$
search
(
Just
"docid,title_s,abstract_s,submittedDate_s,source_s,authFullName_s,authOrganism_s"
)
rq
Nothing
Nothing
Nothing
This diff is collapsed.
Click to expand it.
src/HAL/Client.hs
View file @
dc9c429b
...
...
@@ -25,7 +25,7 @@ type HALAPI doc = Search doc
type
Search
doc
=
"search"
-- fl determine which fields will be returned it can be a list of fields or *
:>
QueryParam
"fl"
doc
:>
QueryParam
"fl"
Text
--
doc
-- TODO: type this monster
-- fq is to filter request
:>
QueryParams
"fq"
Text
...
...
@@ -38,7 +38,7 @@ type Search doc = "search"
:>
Get
'[
J
SON
]
(
Response
doc
)
type
Structure
doc
=
"ref"
:>
"structure"
:>
QueryParam
"fl"
doc
:>
QueryParam
"fl"
Text
:>
QueryParam
"fq"
Text
:>
QueryParam
"rows"
Int
:>
Get
'[
J
SON
]
(
Response
doc
)
...
...
@@ -56,21 +56,6 @@ asc = Just . Asc
desc
::
Text
->
Maybe
SortField
desc
=
Just
.
Desc
-- newtype Doc = Doc (Map Text Value)
-- deriving (Generic)
--
--instance Eq Doc where
-- (==) (Doc doc) (Doc doc') = (doc ! "docid") == (doc' ! "docid")
--
--instance Show Doc where
-- show (Doc o) = (UTF.decode $ BSL.unpack $ encode $ o ! "label_s")
-- <> "("
-- <> (show . encode $ o ! "docid")
-- <> ")"
--
--instance FromJSON Doc
--instance ToJSON Doc
-- Response type
data
Response
doc
=
Response
{
...
...
@@ -91,7 +76,7 @@ halAPI = Proxy
-- search should always have at least `docid` and `label_s` in his fl params
search
::
(
FromJSON
doc
,
ToHttpApiData
doc
)
=>
Maybe
doc
-- fl
Maybe
Text
-- fl
->
[
Text
]
-- fq
->
Maybe
SortField
-- sort
->
Maybe
Int
-- start
...
...
@@ -99,7 +84,7 @@ search :: (FromJSON doc, ToHttpApiData doc) =>
->
ClientM
(
Response
doc
)
structure
::
(
FromJSON
doc
,
ToHttpApiData
doc
)
=>
Maybe
doc
Maybe
Text
->
Maybe
Text
-- fq
->
Maybe
Int
-- rows
->
ClientM
(
Response
doc
)
...
...
This diff is collapsed.
Click to expand it.
src/HAL/Doc.hs
View file @
dc9c429b
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module
HAL.Doc
where
import
GHC.Generics
import
Data.Aeson
((
.:
),
(
.:?
),
(
.!=
),
Value
(
..
),
ToJSON
,
FromJSON
(
..
),
encode
)
import
Data.Default
import
Data.Text
(
pack
,
Text
)
import
Servant.API
(
ToHttpApiData
(
..
))
data
Doc
=
Doc
{
_docid
::
Int
,
_label_s
::
Maybe
Text
,
_parentDocid_i
::
[
Text
]
}
deriving
(
Generic
)
instance
Default
Doc
where
def
=
Doc
def
def
def
instance
FromJSON
Doc
where
parseJSON
(
Object
o
)
=
Doc
<$>
(
o
.:
"docid"
)
<*>
(
o
.:?
"label_s"
)
<*>
(
o
.:?
"parentDocid_i"
.!=
[]
)
instance
ToHttpApiData
Doc
where
toUrlPiece
_
=
"docid,label_s,parentDocid_i"
instance
Show
Doc
where
show
(
Doc
id
label
_
)
=
show
label
<>
"("
<>
show
id
<>
")"
import
HAL.Doc.EntityTree
import
HAL.Doc.Corpus
This diff is collapsed.
Click to expand it.
src/HAL/Doc/Corpus.hs
0 → 100644
View file @
dc9c429b
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
module
HAL.Doc.Corpus
where
import
GHC.Generics
import
Data.Aeson
import
Data.Default
import
Data.Text
(
pack
,
Text
)
import
Control.Applicative
((
<|>
))
import
qualified
Control.Lens
as
L
import
Servant.API
(
ToHttpApiData
(
..
))
data
Corpus
=
Corpus
{
_corpus_docid
::
Int
,
_corpus_title
::
[
Text
],
_corpus_abstract
::
[
Text
],
_corpus_date
::
Maybe
Text
,
_corpus_source
::
Maybe
Text
,
_corpus_authors_names
::
[
Text
],
_corpus_authors_affiliations
::
[
Text
]
}
deriving
(
Show
,
Generic
)
L
.
makeLenses
''
C
orpus
instance
Default
Corpus
where
def
=
Corpus
def
def
def
def
def
def
def
instance
FromJSON
Corpus
where
parseJSON
(
Object
o
)
=
Corpus
<$>
(
o
.:
"docid"
)
<*>
(
o
.:
"title_s"
<|>
return
[]
)
<*>
(
o
.:
"abstract_s"
<|>
return
[]
)
<*>
(
o
.:?
"submittedDate_s"
)
<*>
(
o
.:?
"source_s"
)
<*>
(
o
.:
"authFullName_s"
<|>
return
[]
)
<*>
(
o
.:
"authOrganism_s"
<|>
return
[]
)
instance
ToHttpApiData
Corpus
where
toUrlPiece
_
=
"docid,title_s,abstract_s,submittedDate_s,source_s,authFullName_s,authOrganism_s"
This diff is collapsed.
Click to expand it.
src/HAL/Doc/EntityTree.hs
0 → 100644
View file @
dc9c429b
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module
HAL.Doc.EntityTree
where
import
GHC.Generics
import
Data.Aeson
((
.:
),
(
.:?
),
(
.!=
),
Value
(
..
),
ToJSON
,
FromJSON
(
..
),
encode
)
import
Data.Default
import
Data.Text
(
pack
,
Text
)
import
Servant.API
(
ToHttpApiData
(
..
))
data
EntityTree
=
EntityTree
{
_docid
::
Int
,
_label_s
::
Maybe
Text
,
_parentEntityTreeid_i
::
[
Text
]
}
deriving
(
Generic
)
instance
Default
EntityTree
where
def
=
EntityTree
def
def
def
instance
FromJSON
EntityTree
where
parseJSON
(
Object
o
)
=
EntityTree
<$>
(
o
.:
"docid"
)
<*>
(
o
.:?
"label_s"
)
<*>
(
o
.:?
"parentEntityTreeid_i"
.!=
[]
)
instance
ToHttpApiData
EntityTree
where
toUrlPiece
_
=
"docid,label_s,parentEntityTreeid_i"
instance
Show
EntityTree
where
show
(
EntityTree
id
label
_
)
=
show
label
<>
"("
<>
show
id
<>
")"
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