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 NoImplicitPrelude #-}
  16 {-# LANGUAGE OverloadedStrings #-}
  17 {-# LANGUAGE RankNTypes        #-}
  18 {-# LANGUAGE TemplateHaskell   #-}
  19 {-# LANGUAGE TypeOperators     #-}
  20
  21 module Gargantext.API.Ngrams.List
  22   where
  23
  24 import Gargantext.Prelude
  25 import Gargantext.API.Ngrams
  26 import Servant
  27 import Data.List (zip)
  28 import Data.Map (Map, toList, fromList)
  29 import Gargantext.Database.Types.Node
  30 import Gargantext.Database.Schema.Ngrams (NgramsType(..), ngramsTypes)
  31 import Gargantext.Database.Flow (FlowCmdM)
  32 import Gargantext.API.Types (GargServer)
  33 import Gargantext.API.Ngrams (putListNgrams')
  34
  35 type NgramsList = (Map NgramsType (Versioned NgramsTableMap))
  36
  37 type API = Get '[JSON] NgramsList
  38       :<|> ReqBody '[JSON] NgramsList :> Put '[JSON] Bool
  39
  40 api :: ListId -> GargServer API
  41 api l = get l :<|> put l
  42
  43 get :: RepoCmdM env err m
  44     => ListId -> m NgramsList
  45 get lId = fromList
  46        <$> zip ngramsTypes
  47        <$> mapM (getNgramsTableMap lId) ngramsTypes
  48
  49 put :: FlowCmdM env err m
  50     => ListId
  51     -> NgramsList
  52     -> m Bool
  53 put l m = do
  54   -- TODO check with Version for optim
  55   _ <- mapM (\(nt, Versioned _v ns) -> putListNgrams' l nt ns) $ toList m
  56   pure True
  57