[REFACT] FlowList integration to Terms with instances
[gargantext.git] / src / Gargantext / API / Ngrams.hs
index 3500c6271b189d456243721e74bc79a1bddd097c..e8f9db90e92e46e399d6c14abfe97deb7682197b 100644 (file)
@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -fno-warn-unused-top-binds -fno-warn-name-shadowing #-}
+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
 {-|
 Module      : Gargantext.API.Ngrams
 Description : Server API
@@ -18,7 +18,6 @@ add get
 
 {-# LANGUAGE ConstraintKinds   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE TypeOperators     #-}
 {-# LANGUAGE TypeFamilies      #-}
 
@@ -84,7 +83,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
@@ -114,7 +113,7 @@ import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
 import Prelude (error)
-import Gargantext.Prelude
+import Gargantext.Prelude hiding (log)
 
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Types (HasSettings)
@@ -130,9 +129,9 @@ import Gargantext.Database.Action.Metrics.NgramsByNode (getOccByNgramsOnlyFast')
 import Gargantext.Database.Admin.Config (userMaster)
 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.Node.Error (HasNodeError)
 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)
@@ -276,6 +275,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)
@@ -349,14 +354,14 @@ tableNgramsPut tabType listId (Versioned p_version p_table)
       pure ret
 
 
-tableNgramsPutAsync :: ( FlowCmdM env err m
-                        , HasSettings env
-                        )
-                      => UpdateTableNgrams
-                      -> (JobLog -> m ())
-                      -> m JobLog
-tableNgramsPutAsync utn logStatus = do
-      -- let (Versioned p_version p_table) = utn ^. utn_patch
+tableNgramsPostChartsAsync :: ( FlowCmdM env err m
+                              , HasNodeError err
+                              , HasSettings env
+                              )
+                            => UpdateTableNgramsCharts
+                            -> (JobLog -> m ())
+                            -> m JobLog
+tableNgramsPostChartsAsync utn logStatus = do
       let tabType = utn ^. utn_tab_type
       let listId = utn ^. utn_list_id
 
@@ -376,52 +381,53 @@ tableNgramsPutAsync utn logStatus = do
           case tabType of
             Authors -> do
               -- printDebug "[tableNgramsPut] Authors, updating Pie, cId" cId
-              let jl = jobLogInit 1
-              logStatus jl
+              (logRef, logRefSuccess, getRef) <- runJobLog 1 logStatus
+              logRef
               _ <- Metrics.updatePie cId (Just listId) tabType Nothing
-              pure $ jobLogSuccess jl
+              logRefSuccess
+
+              getRef
             Institutes -> do
               -- printDebug "[tableNgramsPut] Institutes, updating Tree, cId" cId
               -- printDebug "[tableNgramsPut] updating tree StopTerm, cId" cId
-              let jl = jobLogInit 3
-              logStatus jl
+              (logRef, logRefSuccess, getRef) <- runJobLog 3 logStatus
+              logRef
               _ <- Metrics.updateTree cId (Just listId) tabType StopTerm
               -- printDebug "[tableNgramsPut] updating tree CandidateTerm, cId" cId
-              let jl = jobLogSuccess jl
-              logStatus jl
+              logRefSuccess
               _ <- Metrics.updateTree cId (Just listId) tabType CandidateTerm
               -- printDebug "[tableNgramsPut] updating tree MapTerm, cId" cId
-              let jl = jobLogSuccess jl
-              logStatus jl
+              logRefSuccess
               _ <- Metrics.updateTree cId (Just listId) tabType MapTerm
-              pure $ jobLogSuccess jl
+              logRefSuccess
+
+              getRef
             Sources -> do
               -- printDebug "[tableNgramsPut] Sources, updating chart, cId" cId
-              let jl = jobLogInit 1
-              logStatus jl
+              (logRef, logRefSuccess, getRef) <- runJobLog 1 logStatus
+              logRef
               _ <- Metrics.updatePie cId (Just listId) tabType Nothing
-              pure $ jobLogSuccess jl
+              logRefSuccess
+
+              getRef
             Terms -> do
               -- printDebug "[tableNgramsPut] Terms, updating Metrics (Histo), cId" cId
-              let jl = jobLogInit 6
-              logStatus jl
+              (logRef, logRefSuccess, getRef) <- runJobLog 6 logStatus
+              logRef
               _ <- Metrics.updateChart cId (Just listId) tabType Nothing
-              let jl = jobLogSuccess jl
-              logStatus jl
+              logRefSuccess
               _ <- Metrics.updatePie cId (Just listId) tabType Nothing
-              let jl = jobLogSuccess jl
-              logStatus jl
+              logRefSuccess
               _ <- Metrics.updateScatter cId (Just listId) tabType Nothing
-              let jl = jobLogSuccess jl
-              logStatus jl
+              logRefSuccess
               _ <- Metrics.updateTree cId (Just listId) tabType StopTerm
-              let jl = jobLogSuccess jl
-              logStatus jl
+              logRefSuccess
               _ <- Metrics.updateTree cId (Just listId) tabType CandidateTerm
-              let jl = jobLogSuccess jl
-              logStatus jl
+              logRefSuccess
               _ <- Metrics.updateTree cId (Just listId) tabType MapTerm
-              pure $ jobLogSuccess jl
+              logRefSuccess
+
+              getRef
             _ -> do
               printDebug "[tableNgramsPut] no update for tabType = " tabType
               pure $ jobLogFail $ jobLogInit 1
@@ -658,8 +664,9 @@ type TableNgramsApi =  TableNgramsApiGet
 
 type TableNgramsAsyncApi = Summary "Table Ngrams Async API"
                            :> "async"
+                           :> "charts"
                            :> "update"
-                           :> AsyncJobs JobLog '[JSON] UpdateTableNgrams JobLog
+                           :> AsyncJobs JobLog '[JSON] UpdateTableNgramsCharts JobLog
 
 getTableNgramsCorpus :: (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
                => NodeId
@@ -729,12 +736,12 @@ apiNgramsTableDoc dId =  getTableNgramsDoc dId
 apiNgramsAsync :: NodeId -> GargServer TableNgramsAsyncApi
 apiNgramsAsync _dId =
   serveJobsAPI $
-    JobFunction (\i l ->
+    JobFunction $ \i log ->
       let
         log' x = do
-          printDebug "tableNgramsPutAsync" x
-          liftBase $ l x
-      in tableNgramsPutAsync i log')
+          printDebug "tableNgramsPostChartsAsync" x
+          liftBase $ log x
+      in tableNgramsPostChartsAsync i log'
 
 -- Did the given list of ngrams changed since the given version?
 -- The returned value is versioned boolean value, meaning that one always retrieve the