Commit ede03640 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[ngrams] list csv/json export endpoints

parent b157a335
...@@ -58,6 +58,7 @@ import qualified Data.Map as Map ...@@ -58,6 +58,7 @@ import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Data.Vector as Vec import qualified Data.Vector as Vec
import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
import qualified Gargantext.Utils.Servant as GUS import qualified Gargantext.Utils.Servant as GUS
import qualified Prelude import qualified Prelude
import qualified Protolude as P import qualified Protolude as P
...@@ -65,10 +66,14 @@ import qualified Protolude as P ...@@ -65,10 +66,14 @@ import qualified Protolude as P
type GETAPI = Summary "Get List" type GETAPI = Summary "Get List"
:> "lists" :> "lists"
:> Capture "listId" ListId :> Capture "listId" ListId
:> Capture "fileType" Text :> "json"
:> Get '[JSON, GUS.CSV, HTML] (Headers '[Header "Content-Disposition" Text] NgramsList) :> Get '[JSON, HTML] (Headers '[Header "Content-Disposition" Text] NgramsList)
:<|> "lists"
:> Capture "listId" ListId
:> "csv"
:> Get '[GUS.CSV] (Headers '[Header "Content-Disposition" Text] NgramsTableMap)
getApi :: GargServer GETAPI getApi :: GargServer GETAPI
getApi = get getApi = getJson :<|> getCsv
---------------------- ----------------------
type JSONAPI = Summary "Update List" type JSONAPI = Summary "Update List"
...@@ -96,9 +101,9 @@ csvApi :: ServerT CSVAPI (GargM Env GargError) ...@@ -96,9 +101,9 @@ csvApi :: ServerT CSVAPI (GargM Env GargError)
csvApi = csvPostAsync csvApi = csvPostAsync
------------------------------------------------------------------------ ------------------------------------------------------------------------
get :: HasNodeStory env err m => getJson :: HasNodeStory env err m =>
ListId -> Text -> m (Headers '[Header "Content-Disposition" Text] NgramsList) ListId -> m (Headers '[Header "Content-Disposition" Text] NgramsList)
get lId "JSON" = do getJson lId = do
lst <- getNgramsList lId lst <- getNgramsList lId
let (NodeId id') = lId let (NodeId id') = lId
return $ addHeader (concat [ "attachment; filename=GarganText_NgramsList-" return $ addHeader (concat [ "attachment; filename=GarganText_NgramsList-"
...@@ -106,15 +111,20 @@ get lId "JSON" = do ...@@ -106,15 +111,20 @@ get lId "JSON" = do
, ".json" , ".json"
] ]
) lst ) lst
get lId "CSV" = do
getCsv :: HasNodeStory env err m =>
ListId -> m (Headers '[Header "Content-Disposition" Text] NgramsTableMap)
getCsv lId = do
lst <- getNgramsList lId lst <- getNgramsList lId
let (NodeId id') = lId let (NodeId id') = lId
return $ addHeader (concat [ "attachment; filename=GarganText_NgramsList-" return $ case Map.lookup TableNgrams.NgramsTerms lst of
, pack $ show id' Nothing -> noHeader Map.empty
, ".csv" Just (Versioned { _v_data }) ->
] addHeader (concat [ "attachment; filename=GarganText_NgramsList-"
) lst , pack $ show id'
get lId _ = get lId "JSON" , ".csv"
]
) _v_data
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- TODO : purge list -- TODO : purge list
......
module Gargantext.Utils.Servant where module Gargantext.Utils.Servant where
import qualified Data.ByteString.Lazy.Char8 as BSC 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 Network.HTTP.Media ((//), (/:))
import qualified Prelude import qualified Prelude
import Protolude import Protolude
...@@ -16,6 +20,25 @@ instance Accept CSV where ...@@ -16,6 +20,25 @@ instance Accept CSV where
instance (DefaultOrdered a, ToNamedRecord a) => MimeRender CSV [a] where instance (DefaultOrdered a, ToNamedRecord a) => MimeRender CSV [a] where
mimeRender _ val = encodeDefaultOrderedByName val 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 instance Read a => MimeUnrender CSV a where
mimeUnrender _ bs = case BSC.take len bs of mimeUnrender _ bs = case BSC.take len bs of
"text/csv" -> return . read . BSC.unpack $ BSC.drop len bs "text/csv" -> return . read . BSC.unpack $ BSC.drop len bs
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment