src/Gargantext/API/Ngrams/List.hs

   1 {-|
   2 Module      : Gargantext.API.Ngrams.List
   3 Description : Get Ngrams (lists)
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 -}
  11
  12 {-# LANGUAGE DataKinds         #-}
  13 {-# LANGUAGE DeriveGeneric     #-}
  14 {-# LANGUAGE FlexibleContexts  #-}
  15 {-# LANGUAGE FlexibleInstances #-}
  16 {-# LANGUAGE MultiParamTypeClasses #-}
  17 {-# LANGUAGE NoImplicitPrelude #-}
  18 {-# LANGUAGE OverloadedStrings #-}
  19 {-# LANGUAGE RankNTypes        #-}
  20 {-# LANGUAGE TemplateHaskell   #-}
  21 {-# LANGUAGE TypeOperators     #-}
  22
  23 module Gargantext.API.Ngrams.List
  24   where
  25
  26 import Data.Text (Text)
  27 import Data.Aeson
  28 import Data.List (zip)
  29 import Data.Map (Map, toList, fromList)
  30 import Network.HTTP.Media ((//), (/:))
  31 import Servant
  32
  33 import Gargantext.Prelude
  34 import Gargantext.API.Ngrams
  35 import Gargantext.API.Types (GargServer)
  36 import Gargantext.Database.Flow (FlowCmdM)
  37 import Gargantext.Database.Schema.Ngrams (NgramsType(..), ngramsTypes)
  38 import Gargantext.Database.Types.Node
  39
  40 type NgramsList = (Map NgramsType (Versioned NgramsTableMap))
  41
  42 data HTML
  43 instance Accept HTML where
  44   contentType _ = "text" // "html" /: ("charset", "utf-8")
  45 instance ToJSON a => MimeRender HTML a where
  46   mimeRender _ = encode
  47
  48 type API = Get '[JSON] NgramsList
  49       :<|> ReqBody '[JSON] NgramsList :> Put '[JSON] Bool
  50       :<|> Get '[HTML] (Headers '[Header "Content-Disposition" Text] NgramsList)
  51
  52 api :: ListId -> GargServer API
  53 api l = get l :<|> put l :<|> getHtml l
  54
  55 get :: RepoCmdM env err m
  56     => ListId -> m NgramsList
  57 get lId = fromList
  58        <$> zip ngramsTypes
  59        <$> mapM (getNgramsTableMap lId) ngramsTypes
  60
  61 getHtml :: RepoCmdM env err m
  62         => ListId -> m (Headers '[Header "Content-Disposition" Text] NgramsList)
  63 getHtml lId = do
  64   lst <- get lId
  65   return $ addHeader "attachment" lst
  66
  67
  68 -- TODO : purge list
  69 put :: FlowCmdM env err m
  70     => ListId
  71     -> NgramsList
  72     -> m Bool
  73 put l m = do
  74   -- TODO check with Version for optim
  75   _ <- mapM (\(nt, Versioned _v ns) -> putListNgrams' l nt ns) $ toList m
  76   -- TODO reindex
  77   pure True
  78
  79