Fix haddock parse error
[gargantext.git] / src / Gargantext / API / Ngrams.hs
index dfaa97879daa6693e47a54750928ad661407534c..c4a965f3ed01144c78e2a8f8dafda559794330f3 100644 (file)
@@ -1,4 +1,3 @@
-{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
 {-|
 Module      : Gargantext.API.Ngrams
 Description : Server API
@@ -16,12 +15,14 @@ add get
 
 -}
 
+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
+
 {-# LANGUAGE ConstraintKinds   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE TypeOperators     #-}
 {-# LANGUAGE TypeFamilies      #-}
 
+{-# LANGUAGE IncoherentInstances #-}
 module Gargantext.API.Ngrams
   ( TableNgramsApi
   , TableNgramsApiGet
@@ -33,7 +34,6 @@ module Gargantext.API.Ngrams
   , apiNgramsTableCorpus
   , apiNgramsTableDoc
 
-  , NgramsStatePatch
   , NgramsTablePatch
   , NgramsTableMap
 
@@ -52,21 +52,12 @@ module Gargantext.API.Ngrams
   , r_version
   , r_state
   , r_history
-  , NgramsRepo
   , NgramsRepoElement(..)
-  , saveRepo
+  , saveNodeStory
   , initRepo
 
-  , RepoEnv(..)
-  , renv_var
-  , renv_lock
-
   , TabType(..)
 
-  , HasRepoVar(..)
-  , HasRepoSaver(..)
-  , HasRepo(..)
-  , RepoCmdM
   , QueryParamR
   , TODO
 
@@ -78,65 +69,65 @@ module Gargantext.API.Ngrams
 
   , Version
   , Versioned(..)
+  , VersionedWithCount(..)
   , currentVersion
   , listNgramsChangedSince
+  , MinSize, MaxSize, OrderBy, NgramsTable
+  , UpdateTableNgramsCharts
   )
   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 Data.Either (Either(..))
 import Data.Foldable
-import qualified Data.List as List
 import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
-import qualified Data.Map.Strict.Patch as PM
 import Data.Maybe (fromMaybe)
 import Data.Monoid
 import Data.Ord (Down(..))
 import Data.Patch.Class (Action(act), Transformable(..), ours)
-import qualified Data.Set as S
-import qualified Data.Set as Set
 import Data.Swagger hiding (version, patch)
-import Data.Text (Text, isInfixOf, unpack)
+import Data.Text (Text, isInfixOf, unpack, pack)
 import Data.Text.Lazy.IO as DTL
 import Formatting (hprint, int, (%))
-import Formatting.Clock (timeSpecs)
 import GHC.Generics (Generic)
-import Servant hiding (Patch)
-import System.Clock (getTime, TimeSpec, Clock(..))
-import Servant.Job.Async (JobFunction(..), serveJobsAPI)
-import System.IO (stderr)
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
-
-import Prelude (error)
-import Gargantext.Prelude hiding (log)
-
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Types (HasSettings)
-import qualified Gargantext.API.Metrics as Metrics
+import Gargantext.API.Job
 import Gargantext.API.Ngrams.Types
 import Gargantext.API.Prelude
-import Gargantext.Core.Types (ListType(..), NodeId, ListId, DocId, Limit, Offset, TODO, assertValid)
-import Gargantext.Core.Utils (something)
--- import Gargantext.Core.Viz.Graph.API (recomputeGraph)
--- import Gargantext.Core.Viz.Graph.Distances (Distance(Conditional))
+import Gargantext.Core.NodeStory
+import Gargantext.Core.Mail.Types (HasMail)
+import Gargantext.Core.Types (ListType(..), NodeId, ListId, DocId, Limit, Offset, TODO, assertValid, HasInvalidError)
+import Gargantext.API.Ngrams.Tools
 import Gargantext.Database.Action.Flow.Types
-import Gargantext.Database.Action.Metrics.NgramsByNode (getOccByNgramsOnlyFast')
+import Gargantext.Database.Action.Metrics.NgramsByContext (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.Ngrams hiding (NgramsType(..), ngramsType, ngrams_terms)
+import Gargantext.Database.Query.Table.Node (getNode)
 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.Schema.Node (node_id, node_parent_id, node_user_id)
+import Gargantext.Prelude hiding (log)
+import Gargantext.Prelude.Clock (hasTime, getTime)
+import Prelude (error)
+import Servant hiding (Patch)
+import Servant.Job.Async (JobFunction(..), serveJobsAPI)
+import System.IO (stderr)
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+import qualified Data.Aeson.Text as DAT
+import qualified Data.List as List
+import qualified Data.Map.Strict as Map
+import qualified Data.Map.Strict.Patch as PM
+import qualified Data.Set as S
+import qualified Data.Set as Set
+import qualified Gargantext.API.Metrics as Metrics
 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)
-import Gargantext.Prelude.Job
 
 {-
 -- TODO sequences of modifications (Patchs)
@@ -185,25 +176,28 @@ mkChildrenGroups addOrRem nt patches =
 
 ------------------------------------------------------------------------
 
-saveRepo :: ( MonadReader env m, MonadBase IO m, HasRepoSaver env )
+saveNodeStory :: ( MonadReader env m, MonadBase IO m, HasNodeStorySaver env )
          => m ()
-saveRepo = liftBase =<< view repoSaver
+saveNodeStory = liftBase =<< view hasNodeStorySaver
+
 
 listTypeConflictResolution :: ListType -> ListType -> ListType
 listTypeConflictResolution _ _ = undefined -- TODO Use Map User ListType
 
+
 ngramsStatePatchConflictResolution
   :: TableNgrams.NgramsType
-  -> NodeId
   -> NgramsTerm
   -> ConflictResolutionNgramsPatch
-ngramsStatePatchConflictResolution _ngramsType _nodeId _ngramsTerm
+ngramsStatePatchConflictResolution _ngramsType _ngramsTerm
   = (ours, (const ours, ours), (False, False))
                              -- (False, False) mean here that Mod has always priority.
                              -- (True, False) <- would mean priority to the left (same as ours).
-
   -- undefined {- TODO think this through -}, listTypeConflictResolution)
 
+
+
+
 -- Current state:
 --   Insertions are not considered as patches,
 --   they do not extend history,
@@ -221,7 +215,7 @@ copyListNgrams srcListId dstListId ngramsType = do
   var <- view repoVar
   liftBase $ modifyMVar_ var $
     pure . (r_state . at ngramsType %~ (Just . f . something))
-  saveRepo
+  saveNodeStory
   where
     f :: Map NodeId NgramsTableMap -> Map NodeId NgramsTableMap
     f m = m & at dstListId %~ insertNewOnly (m ^. at srcListId)
@@ -236,58 +230,70 @@ addListNgrams listId ngramsType nes = do
   var <- view repoVar
   liftBase $ modifyMVar_ var $
     pure . (r_state . at ngramsType . _Just . at listId . _Just <>~ m)
-  saveRepo
+  saveNodeStory
   where
     m = Map.fromList $ (\n -> (n ^. ne_ngrams, n)) <$> nes
 -}
 
--- UNSAFE
-rmListNgrams ::  RepoCmdM env err m
-              => ListId
-              -> TableNgrams.NgramsType
-              -> m ()
-rmListNgrams l nt = setListNgrams l nt mempty
-
 -- | TODO: incr the Version number
 -- && should use patch
 -- UNSAFE
-setListNgrams ::  RepoCmdM env err m
+
+setListNgrams ::  HasNodeStory env err m
               => NodeId
               -> TableNgrams.NgramsType
               -> Map NgramsTerm NgramsRepoElement
               -> m ()
 setListNgrams listId ngramsType ns = do
-  var <- view repoVar
+  -- printDebug "[setListNgrams]" (listId, ngramsType)
+  getter <- view hasNodeStory
+  var <- liftBase $ (getter ^. nse_getter) [listId]
   liftBase $ modifyMVar_ var $
-    pure . ( r_state
-           . at ngramsType %~
-             (Just .
-               (at listId .~ ( Just ns))
-               . something
-             )
+    pure . ( unNodeStory
+           . at listId . _Just
+            . a_state
+              . at ngramsType
+              .~ Just ns
            )
-  saveRepo
+  saveNodeStory
 
 
-currentVersion :: RepoCmdM env err m
-               => m Version
-currentVersion = do
-  var <- view repoVar
-  r   <- liftBase $ readMVar var
-  pure $ r ^. r_version
+currentVersion :: HasNodeStory env err m
+               => ListId -> m Version
+currentVersion listId = do
+  nls <- getRepo [listId]
+  pure $ nls ^. unNodeStory . at listId . _Just . a_version
 
 
--- tableNgramsPut :: (HasInvalidError err, RepoCmdM env err m)
-commitStatePatch :: RepoCmdM env err m => Versioned NgramsStatePatch -> m (Versioned NgramsStatePatch)
-commitStatePatch (Versioned p_version p) = do
-  var <- view repoVar
-  vq' <- liftBase $ modifyMVar var $ \r -> do
+newNgramsFromNgramsStatePatch :: NgramsStatePatch' -> [Ngrams]
+newNgramsFromNgramsStatePatch p =
+  [ text2ngrams (unNgramsTerm n)
+  | (n,np) <- p ^.. _PatchMap
+                -- . each . _PatchMap
+                . each . _NgramsTablePatch
+                . _PatchMap . ifolded . withIndex
+  , _ <- np ^.. patch_new . _Just
+  ]
+
+
+
+
+commitStatePatch :: (HasNodeStory env err m, HasMail env)
+                 => ListId
+                 ->    Versioned NgramsStatePatch'
+                 -> m (Versioned NgramsStatePatch')
+commitStatePatch listId (Versioned p_version p) = do
+  -- printDebug "[commitStatePatch]" listId
+  var <- getNodeStoryVar [listId]
+  vq' <- liftBase $ modifyMVar var $ \ns -> do
     let
-      q = mconcat $ take (r ^. r_version - p_version) (r ^. r_history)
+      a = ns ^. unNodeStory . at listId . _Just
+      q = mconcat $ take (a ^. a_version - p_version) (a ^. a_history)
       (p', q') = transformWith ngramsStatePatchConflictResolution p q
-      r' = r & r_version +~ 1
-             & r_state   %~ act p'
-             & r_history %~ (p' :)
+      a' = a & a_version +~ 1
+             & a_state   %~ act p'
+             & a_history %~ (p' :)
+
     {-
     -- Ideally we would like to check these properties. However:
     -- * They should be checked only to debug the code. The client data
@@ -299,32 +305,48 @@ commitStatePatch (Versioned p_version p) = do
     assertValid $ transformable p q
     assertValid $ applicable p' (r ^. r_state)
     -}
-    pure (r', Versioned (r' ^. r_version) q')
+    printDebug "[commitStatePatch] a version" (a ^. a_version)
+    printDebug "[commitStatePatch] a' version" (a' ^. a_version)
+    pure ( ns & unNodeStory . at listId .~ (Just a')
+         , Versioned (a' ^. a_version) q'
+         )
+  saveNodeStory
+  -- Save new ngrams
+  _ <- insertNgrams (newNgramsFromNgramsStatePatch p)
 
-  saveRepo
   pure vq'
 
+
+
 -- This is a special case of tableNgramsPut where the input patch is empty.
-tableNgramsPull :: RepoCmdM env err m
+tableNgramsPull :: HasNodeStory env err m
                 => ListId
                 -> TableNgrams.NgramsType
                 -> Version
                 -> m (Versioned NgramsTablePatch)
 tableNgramsPull listId ngramsType p_version = do
-  var <- view repoVar
+  printDebug "[tableNgramsPull]" (listId, ngramsType)
+  var <- getNodeStoryVar [listId]
   r <- liftBase $ readMVar var
 
   let
-    q = mconcat $ take (r ^. r_version - p_version) (r ^. r_history)
-    q_table = q ^. _PatchMap . at ngramsType . _Just . _PatchMap . at listId . _Just
+    a = r ^. unNodeStory . at listId . _Just
+    q = mconcat $ take (a ^. a_version - p_version) (a ^. a_history)
+    q_table = q ^. _PatchMap . at ngramsType . _Just
+
+  pure (Versioned (a ^. a_version) q_table)
 
-  pure (Versioned (r ^. r_version) q_table)
 
+
+
+-- tableNgramsPut :: (HasInvalidError err, RepoCmdM env err m)
 -- Apply the given patch to the DB and returns the patch to be applied on the
 -- client.
 -- TODO-ACCESS check
-tableNgramsPut :: ( FlowCmdM env err m
-                  , HasSettings env
+tableNgramsPut :: ( HasNodeStory    env err m
+                  , HasInvalidError     err
+                  , HasSettings     env
+                  , HasMail         env
                   )
                  => TabType
                  -> ListId
@@ -332,24 +354,26 @@ tableNgramsPut :: ( FlowCmdM env err m
                  -> m (Versioned NgramsTablePatch)
 tableNgramsPut tabType listId (Versioned p_version p_table)
   | p_table == mempty = do
+      printDebug "[tableNgramsPut]" ("TableEmpty" :: Text)
       let ngramsType        = ngramsTypeFromTabType tabType
       tableNgramsPull listId ngramsType p_version
 
   | otherwise         = do
+      printDebug "[tableNgramsPut]" ("TableNonEmpty" :: Text)
       let ngramsType        = ngramsTypeFromTabType tabType
-          (p0, p0_validity) = PM.singleton listId p_table
-          (p, p_validity)   = PM.singleton ngramsType p0
+          (p, p_validity)   = PM.singleton ngramsType p_table
 
-      assertValid p0_validity
       assertValid p_validity
 
-      ret <- commitStatePatch (Versioned p_version p)
-        <&> v_data %~ (view (_PatchMap . at ngramsType . _Just . _PatchMap . at listId . _Just))
+      ret <- commitStatePatch listId (Versioned p_version p)
+        <&> v_data %~ (view (_PatchMap . at ngramsType . _Just))
 
       pure ret
 
 
-tableNgramsPostChartsAsync :: ( FlowCmdM env err m
+
+tableNgramsPostChartsAsync :: ( HasNodeStory env err m
+                              , FlowCmdM     env err m
                               , HasNodeError err
                               , HasSettings env
                               )
@@ -362,20 +386,20 @@ tableNgramsPostChartsAsync utn logStatus = do
 
       node <- getNode listId
       let nId = node ^. node_id
-          _uId = node ^. node_userId
-          mCId = node ^. node_parentId
+          _uId = node ^. node_user_id
+          mCId = node ^. node_parent_id
 
-      printDebug "[tableNgramsPut] tabType" tabType
-      printDebug "[tableNgramsPut] listId" listId
+      -- printDebug "[tableNgramsPostChartsAsync] tabType" tabType
+      -- printDebug "[tableNgramsPostChartsAsync] listId" listId
 
       case mCId of
         Nothing -> do
-          printDebug "[tableNgramsPut] can't update charts, no parent, nId" nId
+          printDebug "[tableNgramsPostChartsAsync] can't update charts, no parent, nId" nId
           pure $ jobLogFail $ jobLogInit 1
         Just cId -> do
           case tabType of
             Authors -> do
-              -- printDebug "[tableNgramsPut] Authors, updating Pie, cId" cId
+              -- printDebug "[tableNgramsPostChartsAsync] Authors, updating Pie, cId" cId
               (logRef, logRefSuccess, getRef) <- runJobLog 1 logStatus
               logRef
               _ <- Metrics.updatePie cId (Just listId) tabType Nothing
@@ -383,22 +407,22 @@ tableNgramsPostChartsAsync utn logStatus = do
 
               getRef
             Institutes -> do
-              -- printDebug "[tableNgramsPut] Institutes, updating Tree, cId" cId
-              -- printDebug "[tableNgramsPut] updating tree StopTerm, cId" cId
+              -- printDebug "[tableNgramsPostChartsAsync] Institutes, updating Tree, cId" cId
+              -- printDebug "[tableNgramsPostChartsAsync] updating tree StopTerm, cId" cId
               (logRef, logRefSuccess, getRef) <- runJobLog 3 logStatus
               logRef
               _ <- Metrics.updateTree cId (Just listId) tabType StopTerm
-              -- printDebug "[tableNgramsPut] updating tree CandidateTerm, cId" cId
+              -- printDebug "[tableNgramsPostChartsAsync] updating tree CandidateTerm, cId" cId
               logRefSuccess
               _ <- Metrics.updateTree cId (Just listId) tabType CandidateTerm
-              -- printDebug "[tableNgramsPut] updating tree MapTerm, cId" cId
+              -- printDebug "[tableNgramsPostChartsAsync] updating tree MapTerm, cId" cId
               logRefSuccess
               _ <- Metrics.updateTree cId (Just listId) tabType MapTerm
               logRefSuccess
 
               getRef
             Sources -> do
-              -- printDebug "[tableNgramsPut] Sources, updating chart, cId" cId
+              -- printDebug "[tableNgramsPostChartsAsync] Sources, updating chart, cId" cId
               (logRef, logRefSuccess, getRef) <- runJobLog 1 logStatus
               logRef
               _ <- Metrics.updatePie cId (Just listId) tabType Nothing
@@ -406,9 +430,10 @@ tableNgramsPostChartsAsync utn logStatus = do
 
               getRef
             Terms -> do
-              -- printDebug "[tableNgramsPut] Terms, updating Metrics (Histo), cId" cId
+              -- printDebug "[tableNgramsPostChartsAsync] 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
@@ -420,11 +445,12 @@ tableNgramsPostChartsAsync utn logStatus = do
               _ <- Metrics.updateTree cId (Just listId) tabType CandidateTerm
               logRefSuccess
               _ <- Metrics.updateTree cId (Just listId) tabType MapTerm
+-}
               logRefSuccess
 
               getRef
             _ -> do
-              printDebug "[tableNgramsPut] no update for tabType = " tabType
+              printDebug "[tableNgramsPostChartsAsync] no update for tabType = " tabType
               pure $ jobLogFail $ jobLogInit 1
 
   {-
@@ -435,17 +461,18 @@ tableNgramsPostChartsAsync utn logStatus = do
   }
   -}
 
-getNgramsTableMap :: RepoCmdM env err m
+getNgramsTableMap :: HasNodeStory env err m
                   => NodeId
                   -> TableNgrams.NgramsType
                   -> m (Versioned NgramsTableMap)
 getNgramsTableMap nodeId ngramsType = do
-  v    <- view repoVar
+  v    <- getNodeStoryVar [nodeId]
   repo <- liftBase $ readMVar v
-  pure $ Versioned (repo ^. r_version)
-                   (repo ^. r_state . at ngramsType . _Just . at nodeId . _Just)
+  pure $ Versioned (repo ^. unNodeStory . at nodeId . _Just . a_version)
+                   (repo ^. unNodeStory . at nodeId . _Just . a_state . at ngramsType . _Just)
 
-dumpJsonTableMap :: RepoCmdM env err m
+
+dumpJsonTableMap :: HasNodeStory env err m
                  => Text
                  -> NodeId
                  -> TableNgrams.NgramsType
@@ -455,6 +482,7 @@ dumpJsonTableMap fpath nodeId ngramsType = do
   liftBase $ DTL.writeFile (unpack fpath) (DAT.encodeToLazyText m)
   pure ()
 
+
 type MinSize = Int
 type MaxSize = Int
 
@@ -463,23 +491,20 @@ type MaxSize = Int
 -- | Table of Ngrams is a ListNgrams formatted (sorted and/or cut).
 -- TODO: should take only one ListId
 
-getTime' :: MonadBase IO m => m TimeSpec
-getTime' = liftBase $ getTime ProcessCPUTime
-
 
 getTableNgrams :: forall env err m.
-                  (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
+                  (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env, HasMail env)
                => NodeType -> NodeId -> TabType
-               -> ListId -> Limit -> Maybe Offset
+               -> ListId   -> Limit  -> Maybe Offset
                -> Maybe ListType
                -> Maybe MinSize -> Maybe MaxSize
                -> Maybe OrderBy
                -> (NgramsTerm -> Bool)
-               -> m (Versioned NgramsTable)
+               -> m (VersionedWithCount NgramsTable)
 getTableNgrams _nType nId tabType listId limit_ offset
                listType minSize maxSize orderBy searchQuery = do
 
-  t0 <- getTime'
+  t0 <- getTime
   -- lIds <- selectNodesWithUsername NodeList userMaster
   let
     ngramsType = ngramsTypeFromTabType tabType
@@ -498,18 +523,30 @@ getTableNgrams _nType nId tabType listId limit_ offset
     selected_inner roots n = maybe False (`Set.member` roots) (n ^. ne_root)
 
     ---------------------------------------
-    sortOnOrder Nothing = identity
+    sortOnOrder Nothing          = sortOnOrder (Just ScoreDesc)
     sortOnOrder (Just TermAsc)   = List.sortOn $ view ne_ngrams
     sortOnOrder (Just TermDesc)  = List.sortOn $ Down . view ne_ngrams
     sortOnOrder (Just ScoreAsc)  = List.sortOn $ view ne_occurrences
     sortOnOrder (Just ScoreDesc) = List.sortOn $ Down . view ne_occurrences
 
+    ---------------------------------------
+    filteredNodes :: Map NgramsTerm NgramsElement -> [NgramsElement]
+    filteredNodes tableMap = rootOf <$> list & filter selected_node
+      where
+        rootOf ne = maybe ne (\r -> fromMaybe (panic "getTableNgrams: invalid root")
+                                              (tableMap ^. at r)
+                             )
+                             (ne ^. ne_root)
+        list = tableMap ^.. each
+
     ---------------------------------------
     selectAndPaginate :: Map NgramsTerm NgramsElement -> [NgramsElement]
     selectAndPaginate tableMap = roots <> inners
       where
         list = tableMap ^.. each
-        rootOf ne = maybe ne (\r -> fromMaybe (panic "getTableNgrams: invalid root") (tableMap ^. at r))
+        rootOf ne = maybe ne (\r -> fromMaybe (panic "getTableNgrams: invalid root")
+                                              (tableMap ^. at r)
+                             )
                              (ne ^. ne_root)
         selected_nodes = list & take limit_
                               . drop offset'
@@ -523,24 +560,20 @@ 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)
-      t1 <- getTime'
+      let ngrams_terms = table ^.. each . ne_ngrams
+      -- printDebug "ngrams_terms" ngrams_terms
+      t1 <- getTime
       occurrences <- getOccByNgramsOnlyFast' nId
                                              listId
                                             ngramsType
                                             ngrams_terms
-      t2 <- getTime'
+      --printDebug "occurrences" occurrences
+      t2 <- getTime
       liftBase $ hprint stderr
-        ("getTableNgrams/setScores #ngrams=" % int % " time=" % timeSpecs % "\n")
+        ("getTableNgrams/setScores #ngrams=" % int % " time=" % hasTime % "\n")
         (length ngrams_terms) t1 t2
-      {-
-      occurrences <- getOccByNgramsOnlySlow nType nId
-                                            (lIds <> [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
     ---------------------------------------
@@ -549,28 +582,39 @@ getTableNgrams _nType nId tabType listId limit_ offset
   -- trace (show lists) $
   -- getNgramsTableMap ({-lists <>-} listIds) ngramsType
 
+
   let scoresNeeded = needsScores orderBy
   tableMap1 <- getNgramsTableMap listId ngramsType
-  t1 <- getTime'
+  t1 <- getTime
+
   tableMap2 <- tableMap1 & v_data %%~ setScores scoresNeeded
                                     . Map.mapWithKey ngramsElementFromRepo
-  t2 <- getTime'
+
+  fltr <- tableMap2 & v_data %%~ fmap NgramsTable . setScores (not scoresNeeded)
+                                                  . filteredNodes
+
+  let fltrCount = length $ fltr ^. v_data . _NgramsTable
+
+  t2 <- getTime
   tableMap3 <- tableMap2 & v_data %%~ fmap NgramsTable
                                     . setScores (not scoresNeeded)
                                     . selectAndPaginate
-  t3 <- getTime'
+  t3 <- getTime
   liftBase $ hprint stderr
-            ("getTableNgrams total=" % timeSpecs
-                          % " map1=" % timeSpecs
-                          % " map2=" % timeSpecs
-                          % " map3=" % timeSpecs
+            ("getTableNgrams total=" % hasTime
+                          % " map1=" % hasTime
+                          % " map2=" % hasTime
+                          % " map3=" % hasTime
                           % " sql="  % (if scoresNeeded then "map2" else "map3")
                           % "\n"
             ) t0 t3 t0 t1 t1 t2 t2 t3
-  pure tableMap3
+  pure $ toVersionedWithCount fltrCount tableMap3
+
 
 
-scoresRecomputeTableNgrams :: forall env err m. (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env) => NodeId -> TabType -> ListId -> m Int
+scoresRecomputeTableNgrams :: forall env err m.
+  (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env, HasMail env)
+  => NodeId -> TabType -> ListId -> m Int
 scoresRecomputeTableNgrams nId tabType listId = do
   tableMap <- getNgramsTableMap listId ngramsType
   _ <- tableMap & v_data %%~ setScores
@@ -582,18 +626,19 @@ 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
 
 
 
+
 -- APIs
 
 -- TODO: find a better place for the code above, All APIs stay here
@@ -609,6 +654,8 @@ instance FromHttpApiData OrderBy
     parseUrlPiece "ScoreDesc" = pure ScoreDesc
     parseUrlPiece _           = Left "Unexpected value of OrderBy"
 
+instance ToHttpApiData OrderBy where
+  toUrlPiece = pack . show
 
 instance ToParamSchema OrderBy
 instance FromJSON  OrderBy
@@ -633,7 +680,7 @@ type TableNgramsApiGet = Summary " Table Ngrams API Get"
                       :> QueryParam  "maxTermSize" MaxSize
                       :> QueryParam  "orderBy"     OrderBy
                       :> QueryParam  "search"      Text
-                      :> Get    '[JSON] (Versioned NgramsTable)
+                      :> Get    '[JSON] (VersionedWithCount NgramsTable)
 
 type TableNgramsApiPut = Summary " Table Ngrams API Change"
                        :> QueryParamR "ngramsType" TabType
@@ -663,7 +710,7 @@ type TableNgramsAsyncApi = Summary "Table Ngrams Async API"
                            :> "update"
                            :> AsyncJobs JobLog '[JSON] UpdateTableNgramsCharts JobLog
 
-getTableNgramsCorpus :: (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
+getTableNgramsCorpus :: (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env, HasMail env)
                => NodeId
                -> TabType
                -> ListId
@@ -673,18 +720,23 @@ getTableNgramsCorpus :: (RepoCmdM env err m, HasNodeError err, HasConnectionPool
                -> Maybe MinSize -> Maybe MaxSize
                -> Maybe OrderBy
                -> Maybe Text -- full text search
-               -> m (Versioned NgramsTable)
+               -> m (VersionedWithCount NgramsTable)
 getTableNgramsCorpus nId tabType listId limit_ offset listType minSize maxSize orderBy mt =
   getTableNgrams NodeCorpus nId tabType listId limit_ offset listType minSize maxSize orderBy searchQuery
     where
       searchQuery (NgramsTerm nt) = maybe (const True) isInfixOf mt nt
 
-getTableNgramsVersion :: (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
+
+
+getTableNgramsVersion :: (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
                => NodeId
                -> TabType
                -> ListId
                -> m Version
-getTableNgramsVersion _nId _tabType _listId = currentVersion
+getTableNgramsVersion _nId _tabType listId = currentVersion listId
+
+
+
   -- TODO: limit?
   -- Versioned { _v_version = v } <- getTableNgramsCorpus nId tabType listId 100000 Nothing Nothing Nothing Nothing Nothing Nothing
   -- This line above looks like a waste of computation to finally get only the version.
@@ -692,14 +744,14 @@ getTableNgramsVersion _nId _tabType _listId = currentVersion
 
 
 -- | Text search is deactivated for now for ngrams by doc only
-getTableNgramsDoc :: (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
+getTableNgramsDoc :: (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env, HasMail env)
                => DocId -> TabType
                -> ListId -> Limit -> Maybe Offset
                -> Maybe ListType
                -> Maybe MinSize -> Maybe MaxSize
                -> Maybe OrderBy
                -> Maybe Text -- full text search
-               -> m (Versioned NgramsTable)
+               -> m (VersionedWithCount NgramsTable)
 getTableNgramsDoc dId tabType listId limit_ offset listType minSize maxSize orderBy _mt = do
   ns <- selectNodesWithUsername NodeList userMaster
   let ngramsType = ngramsTypeFromTabType tabType
@@ -712,21 +764,20 @@ getTableNgramsDoc dId tabType listId limit_ offset listType minSize maxSize orde
 apiNgramsTableCorpus :: ( GargServerC env err m
                         )
                      => NodeId -> ServerT TableNgramsApi m
-apiNgramsTableCorpus cId =  getTableNgramsCorpus cId
+apiNgramsTableCorpus cId =  getTableNgramsCorpus       cId
                        :<|> tableNgramsPut
                        :<|> scoresRecomputeTableNgrams cId
-                       :<|> getTableNgramsVersion cId
-                       :<|> apiNgramsAsync cId
+                       :<|> getTableNgramsVersion      cId
+                       :<|> apiNgramsAsync             cId
 
 apiNgramsTableDoc :: ( GargServerC env err m
                      )
                   => DocId -> ServerT TableNgramsApi m
-apiNgramsTableDoc dId =  getTableNgramsDoc dId
+apiNgramsTableDoc dId =  getTableNgramsDoc          dId
                     :<|> tableNgramsPut
                     :<|> scoresRecomputeTableNgrams dId
-                    :<|> getTableNgramsVersion dId
-                    :<|> apiNgramsAsync dId
-                    -- > index all the corpus accordingly (TODO AD)
+                    :<|> getTableNgramsVersion      dId
+                    :<|> apiNgramsAsync             dId
 
 apiNgramsAsync :: NodeId -> GargServer TableNgramsAsyncApi
 apiNgramsAsync _dId =
@@ -750,10 +801,12 @@ apiNgramsAsync _dId =
 -- * currentVersion: good computation, good bandwidth, bad precision.
 -- * listNgramsChangedSince: good precision, good bandwidth, bad computation.
 -- * tableNgramsPull: good precision, good bandwidth (if you use the received data!), bad computation.
-listNgramsChangedSince :: RepoCmdM env err m
+listNgramsChangedSince :: HasNodeStory env err m
                        => ListId -> TableNgrams.NgramsType -> Version -> m (Versioned Bool)
 listNgramsChangedSince listId ngramsType version
   | version < 0 =
-      Versioned <$> currentVersion <*> pure True
+      Versioned <$> currentVersion listId <*> pure True
   | otherwise   =
       tableNgramsPull listId ngramsType version & mapped . v_data %~ (== mempty)
+
+