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
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
Julien Moutinho
haskell-gargantext
Commits
ede03640
Commit
ede03640
authored
Jan 03, 2023
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[ngrams] list csv/json export endpoints
parent
b157a335
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
47 additions
and
14 deletions
+47
-14
List.hs
src/Gargantext/API/Ngrams/List.hs
+23
-13
Servant.hs
src/Gargantext/Utils/Servant.hs
+24
-1
No files found.
src/Gargantext/API/Ngrams/List.hs
View file @
ede03640
...
...
@@ -58,6 +58,7 @@ import qualified Data.Map as Map
import
qualified
Data.Set
as
Set
import
qualified
Data.Text
as
Text
import
qualified
Data.Vector
as
Vec
import
qualified
Gargantext.Database.Query.Table.Ngrams
as
TableNgrams
import
qualified
Gargantext.Utils.Servant
as
GUS
import
qualified
Prelude
import
qualified
Protolude
as
P
...
...
@@ -65,10 +66,14 @@ import qualified Protolude as P
type
GETAPI
=
Summary
"Get List"
:>
"lists"
:>
Capture
"listId"
ListId
:>
Capture
"fileType"
Text
:>
Get
'[
J
SON
,
GUS
.
CSV
,
HTML
]
(
Headers
'[
H
eader
"Content-Disposition"
Text
]
NgramsList
)
:>
"json"
:>
Get
'[
J
SON
,
HTML
]
(
Headers
'[
H
eader
"Content-Disposition"
Text
]
NgramsList
)
:<|>
"lists"
:>
Capture
"listId"
ListId
:>
"csv"
:>
Get
'[
G
US
.
CSV
]
(
Headers
'[
H
eader
"Content-Disposition"
Text
]
NgramsTableMap
)
getApi
::
GargServer
GETAPI
getApi
=
get
getApi
=
get
Json
:<|>
getCsv
----------------------
type
JSONAPI
=
Summary
"Update List"
...
...
@@ -96,9 +101,9 @@ csvApi :: ServerT CSVAPI (GargM Env GargError)
csvApi
=
csvPostAsync
------------------------------------------------------------------------
get
::
HasNodeStory
env
err
m
=>
ListId
->
Text
->
m
(
Headers
'[
H
eader
"Content-Disposition"
Text
]
NgramsList
)
get
lId
"JSON"
=
do
get
Json
::
HasNodeStory
env
err
m
=>
ListId
->
m
(
Headers
'[
H
eader
"Content-Disposition"
Text
]
NgramsList
)
get
Json
lId
=
do
lst
<-
getNgramsList
lId
let
(
NodeId
id'
)
=
lId
return
$
addHeader
(
concat
[
"attachment; filename=GarganText_NgramsList-"
...
...
@@ -106,15 +111,20 @@ get lId "JSON" = do
,
".json"
]
)
lst
get
lId
"CSV"
=
do
getCsv
::
HasNodeStory
env
err
m
=>
ListId
->
m
(
Headers
'[
H
eader
"Content-Disposition"
Text
]
NgramsTableMap
)
getCsv
lId
=
do
lst
<-
getNgramsList
lId
let
(
NodeId
id'
)
=
lId
return
$
addHeader
(
concat
[
"attachment; filename=GarganText_NgramsList-"
,
pack
$
show
id'
,
".csv"
]
)
lst
get
lId
_
=
get
lId
"JSON"
return
$
case
Map
.
lookup
TableNgrams
.
NgramsTerms
lst
of
Nothing
->
noHeader
Map
.
empty
Just
(
Versioned
{
_v_data
})
->
addHeader
(
concat
[
"attachment; filename=GarganText_NgramsList-"
,
pack
$
show
id'
,
".csv"
]
)
_v_data
------------------------------------------------------------------------
-- TODO : purge list
...
...
src/Gargantext/Utils/Servant.hs
View file @
ede03640
module
Gargantext.Utils.Servant
where
import
qualified
Data.ByteString.Lazy.Char8
as
BSC
import
Data.Csv
(
encodeDefaultOrderedByName
,
DefaultOrdered
,
ToNamedRecord
)
import
Data.Csv
(
defaultEncodeOptions
,
encodeByNameWith
,
encodeDefaultOrderedByName
,
header
,
namedRecord
,
(
.=
),
DefaultOrdered
,
EncodeOptions
(
..
),
NamedRecord
,
Quoting
(
QuoteNone
),
ToNamedRecord
)
import
qualified
Data.Map
as
Map
import
qualified
Data.Text
as
T
import
Gargantext.API.Ngrams.Types
(
mSetToList
,
NgramsRepoElement
(
..
),
NgramsTableMap
,
NgramsTerm
(
..
),
unNgramsTerm
)
import
Gargantext.Core.Types.Main
(
ListType
(
..
))
import
Network.HTTP.Media
((
//
),
(
/:
))
import
qualified
Prelude
import
Protolude
...
...
@@ -16,6 +20,25 @@ instance Accept CSV where
instance
(
DefaultOrdered
a
,
ToNamedRecord
a
)
=>
MimeRender
CSV
[
a
]
where
mimeRender
_
val
=
encodeDefaultOrderedByName
val
-- CSV:
-- header: status\tlabel\tforms
-- item: map\taccountability\taccounting|&|accoutns|&|account
instance
MimeRender
CSV
NgramsTableMap
where
-- mimeRender _ _val = encode ([] :: [(Text, Text)])
mimeRender
_
val
=
encodeByNameWith
encOptions
(
header
[
"status"
,
"label"
,
"forms"
])
$
fn
<$>
Map
.
toList
val
where
encOptions
=
defaultEncodeOptions
{
encDelimiter
=
fromIntegral
(
ord
'
\t
'
)
,
encQuoting
=
QuoteNone
}
fn
::
(
NgramsTerm
,
NgramsRepoElement
)
->
NamedRecord
fn
(
NgramsTerm
term
,
NgramsRepoElement
{
_nre_list
,
_nre_children
})
=
namedRecord
[
"status"
.=
toText
_nre_list
,
"label"
.=
term
,
"forms"
.=
(
T
.
intercalate
"|&|"
$
unNgramsTerm
<$>
mSetToList
_nre_children
)]
toText
::
ListType
->
Text
toText
CandidateTerm
=
"candidate"
toText
MapTerm
=
"map"
toText
StopTerm
=
"stop"
instance
Read
a
=>
MimeUnrender
CSV
a
where
mimeUnrender
_
bs
=
case
BSC
.
take
len
bs
of
"text/csv"
->
return
.
read
.
BSC
.
unpack
$
BSC
.
drop
len
bs
...
...
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