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.Aeson
  27 -- import qualified Data.ByteString.Lazy as BSL
  28 import Data.List (zip)
  29 import Data.Map (Map, toList, fromList)
  30 -- import qualified Data.Text as T
  31 -- import qualified Data.Text.Encoding as TE
  32 import Network.HTTP.Media ((//), (/:))
  33 import Servant
  34
  35 import Gargantext.Prelude
  36 import Gargantext.API.Ngrams
  37 import Gargantext.API.Types (GargServer)
  38 import Gargantext.Database.Flow (FlowCmdM)
  39 import Gargantext.Database.Schema.Ngrams (NgramsType(..), ngramsTypes)
  40 import Gargantext.Database.Types.Node
  41
  42 type NgramsList = (Map NgramsType (Versioned NgramsTableMap))
  43
  44 data HTML
  45 instance Accept HTML where
  46   contentType _ = "text" // "html" /: ("charset", "utf-8")
  47 instance ToJSON a => MimeRender HTML a where
  48   mimeRender _ = encode
  49
  50 type API = Get '[JSON] NgramsList
  51       :<|> ReqBody '[JSON] NgramsList :> Put '[JSON] Bool
  52       :<|> Get '[HTML] NgramsList
  53
  54 api :: ListId -> GargServer API
  55 api l = get l :<|> put l :<|> get l
  56
  57 get :: RepoCmdM env err m
  58     => ListId -> m NgramsList
  59 get lId = fromList
  60        <$> zip ngramsTypes
  61        <$> mapM (getNgramsTableMap lId) ngramsTypes
  62
  63 getHtml :: RepoCmdM env err m
  64         => ListId -> m NgramsList
  65 getHtml lId = do
  66   lst <- get lId
  67   return lst
  68   --return $ TE.decodeUtf8 $ BSL.toStrict $ encode lst
  69
  70
  71 -- TODO : purge list
  72 put :: FlowCmdM env err m
  73     => ListId
  74     -> NgramsList
  75     -> m Bool
  76 put l m = do
  77   -- TODO check with Version for optim
  78   _ <- mapM (\(nt, Versioned _v ns) -> putListNgrams' l nt ns) $ toList m
  79   -- TODO reindex
  80   pure True
  81
  82