[VERSION] +1 to 0.0.2.6
[gargantext.git] / src / Gargantext / API / Ngrams.hs
index 6eb76a85a36540e482f22c98b00c406aa69f97cb..a6785ba7afcfb8ce9381b79dedd544c60bd06bc9 100644 (file)
@@ -1,4 +1,3 @@
-{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
 {-|
 Module      : Gargantext.API.Ngrams
 Description : Server API
@@ -16,6 +15,8 @@ add get
 
 -}
 
+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
+
 {-# LANGUAGE ConstraintKinds   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeOperators     #-}
@@ -83,7 +84,7 @@ module Gargantext.API.Ngrams
   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
@@ -131,7 +132,7 @@ import Gargantext.Database.Admin.Types.Node (NodeType(..))
 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)
@@ -275,6 +276,12 @@ currentVersion = do
   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)
@@ -301,6 +308,10 @@ commitStatePatch (Versioned p_version p) = do
     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.
@@ -408,6 +419,7 @@ tableNgramsPostChartsAsync utn logStatus = do
               -- 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
@@ -419,6 +431,7 @@ tableNgramsPostChartsAsync utn logStatus = do
               _ <- Metrics.updateTree cId (Just listId) tabType CandidateTerm
               logRefSuccess
               _ <- Metrics.updateTree cId (Just listId) tabType MapTerm
+-}
               logRefSuccess
 
               getRef
@@ -522,7 +535,7 @@ getTableNgrams _nType nId tabType listId limit_ offset
     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
@@ -539,7 +552,7 @@ getTableNgrams _nType nId tabType listId limit_ offset
                                             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
     ---------------------------------------
@@ -581,13 +594,13 @@ scoresRecomputeTableNgrams nId tabType listId = do
 
     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