-{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
{-|
Module : Gargantext.API.Ngrams
Description : Server API
-}
+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
+
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
where
import Control.Concurrent
-import Control.Lens ((.~), view, (^.), (^..), (+~), (%~), (.~), sumOf, at, _Just, Each(..), (%%~), mapped)
+import Control.Lens ((.~), view, (^.), (^..), (+~), (%~), (.~), sumOf, at, _Just, Each(..), (%%~), mapped, ifolded, withIndex)
import Control.Monad.Reader
import Data.Aeson hiding ((.=))
import qualified Data.Aeson.Text as DAT
import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Table.Node.Select
-import Gargantext.Database.Query.Table.Ngrams hiding (NgramsType(..), ngrams, ngramsType, ngrams_terms)
+import Gargantext.Database.Query.Table.Ngrams hiding (NgramsType(..), ngramsType, ngrams_terms)
import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
import Gargantext.Database.Query.Table.Node (getNode)
import Gargantext.Database.Schema.Node (node_id, node_parentId, node_userId)
r <- liftBase $ readMVar var
pure $ r ^. r_version
+newNgramsFromNgramsStatePatch :: NgramsStatePatch -> [Ngrams]
+newNgramsFromNgramsStatePatch p =
+ [ text2ngrams (unNgramsTerm n)
+ | (n,np) <- p ^.. _PatchMap . each . _PatchMap . each . _NgramsTablePatch . _PatchMap . ifolded . withIndex
+ , _ <- np ^.. patch_new . _Just
+ ]
-- tableNgramsPut :: (HasInvalidError err, RepoCmdM env err m)
commitStatePatch :: RepoCmdM env err m => Versioned NgramsStatePatch -> m (Versioned NgramsStatePatch)
pure (r', Versioned (r' ^. r_version) q')
saveRepo
+
+ -- Save new ngrams
+ _ <- insertNgrams (newNgramsFromNgramsStatePatch p)
+
pure vq'
-- This is a special case of tableNgramsPut where the input patch is empty.
-- printDebug "[tableNgramsPut] Terms, updating Metrics (Histo), cId" cId
(logRef, logRefSuccess, getRef) <- runJobLog 6 logStatus
logRef
+{-
_ <- Metrics.updateChart cId (Just listId) tabType Nothing
logRefSuccess
_ <- Metrics.updatePie cId (Just listId) tabType Nothing
_ <- Metrics.updateTree cId (Just listId) tabType CandidateTerm
logRefSuccess
_ <- Metrics.updateTree cId (Just listId) tabType MapTerm
+-}
logRefSuccess
getRef
setScores :: forall t. Each t t NgramsElement NgramsElement => Bool -> t -> m t
setScores False table = pure table
setScores True table = do
- let ngrams_terms = unNgramsTerm <$> (table ^.. each . ne_ngrams)
+ let ngrams_terms = table ^.. each . ne_ngrams
t1 <- getTime'
occurrences <- getOccByNgramsOnlyFast' nId
listId
ngrams_terms
-}
let
- setOcc ne = ne & ne_occurrences .~ sumOf (at (unNgramsTerm (ne ^. ne_ngrams)) . _Just) occurrences
+ setOcc ne = ne & ne_occurrences .~ sumOf (at (ne ^. ne_ngrams) . _Just) occurrences
pure $ table & each %~ setOcc
---------------------------------------
setScores :: forall t. Each t t NgramsElement NgramsElement => t -> m t
setScores table = do
- let ngrams_terms = unNgramsTerm <$> (table ^.. each . ne_ngrams)
+ let ngrams_terms = table ^.. each . ne_ngrams
occurrences <- getOccByNgramsOnlyFast' nId
listId
ngramsType
ngrams_terms
let
- setOcc ne = ne & ne_occurrences .~ sumOf (at (unNgramsTerm (ne ^. ne_ngrams)) . _Just) occurrences
+ setOcc ne = ne & ne_occurrences .~ sumOf (at (ne ^. ne_ngrams) . _Just) occurrences
pure $ table & each %~ setOcc