{-|
Module      : Gargantext.API.Ngrams
Description : Server API
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

Ngrams API

-- | TODO
get ngrams filtered by NgramsType
add get 

-}

{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}

{-# LANGUAGE ConstraintKinds   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators     #-}
{-# LANGUAGE TypeFamilies      #-}

module Gargantext.API.Ngrams
  ( TableNgramsApi
  , TableNgramsApiGet
  , TableNgramsApiPut

  , getTableNgrams
  , setListNgrams
  --, rmListNgrams TODO fix before exporting
  , apiNgramsTableCorpus
  , apiNgramsTableDoc

  , NgramsTablePatch
  , NgramsTableMap

  , NgramsTerm(..)

  , NgramsElement(..)
  , mkNgramsElement

  , RootParent(..)

  , MSet
  , mSetFromList
  , mSetToList

  , Repo(..)
  , r_version
  , r_state
  , r_history
  , NgramsRepoElement(..)
  , saveNodeStory
  , initRepo

  , TabType(..)

  , QueryParamR
  , TODO

  -- Internals
  , getNgramsTableMap
  , dumpJsonTableMap
  , tableNgramsPull
  , tableNgramsPut

  , Version
  , Versioned(..)
  , VersionedWithCount(..)
  , currentVersion
  , listNgramsChangedSince
  )
  where

import Control.Concurrent
import Control.Lens ((.~), view, (^.), (^..), (+~), (%~), (.~), sumOf, at, _Just, Each(..), (%%~), mapped, ifolded, withIndex)
import Control.Monad.Reader
import Data.Aeson hiding ((.=))
import Data.Either (Either(..))
import Data.Foldable
import Data.Map.Strict (Map)
import Data.Maybe (fromMaybe)
import Data.Monoid
import Data.Ord (Down(..))
import Data.Patch.Class (Action(act), Transformable(..), ours)
import Data.Swagger hiding (version, patch)
import Data.Text (Text, isInfixOf, unpack)
import Data.Text.Lazy.IO as DTL
import Formatting (hprint, int, (%))
import GHC.Generics (Generic)
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Job
import Gargantext.API.Ngrams.Types
import Gargantext.API.Prelude
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.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.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

{-
-- TODO sequences of modifications (Patchs)
type NgramsIdPatch = Patch NgramsId NgramsPatch

ngramsPatch :: Int -> NgramsPatch
ngramsPatch n = NgramsPatch (DM.fromList [(1, StopTerm)]) (Set.fromList [n]) Set.empty

toEdit :: NgramsId -> NgramsPatch -> Edit NgramsId NgramsPatch
toEdit n p = Edit n p
ngramsIdPatch :: Patch NgramsId NgramsPatch
ngramsIdPatch = fromList $ catMaybes $ reverse [ replace (1::NgramsId) (Just $ ngramsPatch 1) Nothing
                                       , replace (1::NgramsId) Nothing (Just $ ngramsPatch 2)
                                       , replace (2::NgramsId) Nothing (Just $ ngramsPatch 2)
                                       ]

-- applyPatchBack :: Patch -> IO Patch
-- isEmptyPatch = Map.all (\x -> Set.isEmpty (add_children x) && Set.isEmpty ... )
-}
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------

{-
-- TODO: Replace.old is ignored which means that if the current list
-- `MapTerm` and that the patch is `Replace CandidateTerm StopTerm` then
-- the list is going to be `StopTerm` while it should keep `MapTerm`.
-- However this should not happen in non conflicting situations.
mkListsUpdate :: NgramsType -> NgramsTablePatch -> [(NgramsTypeId, NgramsTerm, ListTypeId)]
mkListsUpdate nt patches =
  [ (ngramsTypeId nt, ng, listTypeId lt)
  | (ng, patch) <- patches ^.. ntp_ngrams_patches . ifolded . withIndex
  , lt <- patch ^.. patch_list . new
  ]

mkChildrenGroups :: (PatchSet NgramsTerm -> Set NgramsTerm)
                 -> NgramsType
                 -> NgramsTablePatch
                 -> [(NgramsTypeId, NgramsParent, NgramsChild)]
mkChildrenGroups addOrRem nt patches =
  [ (ngramsTypeId nt, parent, child)
  | (parent, patch) <- patches ^.. ntp_ngrams_patches . ifolded . withIndex
  , child <- patch ^.. patch_children . to addOrRem . folded
  ]
-}

------------------------------------------------------------------------

saveNodeStory :: ( MonadReader env m, MonadBase IO m, HasNodeStorySaver env )
         => m ()
saveNodeStory :: m ()
saveNodeStory = IO () -> m ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> m ()) -> m (IO ()) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Getting (IO ()) env (IO ()) -> m (IO ())
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (IO ()) env (IO ())
forall env. HasNodeStorySaver env => Getter env (IO ())
hasNodeStorySaver


listTypeConflictResolution :: ListType -> ListType -> ListType
listTypeConflictResolution :: ListType -> ListType -> ListType
listTypeConflictResolution ListType
_ ListType
_ = ListType
forall a. HasCallStack => a
undefined -- TODO Use Map User ListType


ngramsStatePatchConflictResolution
  :: TableNgrams.NgramsType
  -> NgramsTerm
  -> ConflictResolutionNgramsPatch
ngramsStatePatchConflictResolution :: NgramsType -> NgramsTerm -> ConflictResolutionNgramsPatch
ngramsStatePatchConflictResolution NgramsType
_ngramsType NgramsTerm
_ngramsTerm
  = (Maybe NgramsRepoElement
-> Maybe NgramsRepoElement -> Maybe NgramsRepoElement
forall a. a -> a -> a
ours, ((Maybe () -> Maybe () -> Maybe ())
-> NgramsTerm -> Maybe () -> Maybe () -> Maybe ()
forall a b. a -> b -> a
const Maybe () -> Maybe () -> Maybe ()
forall a. a -> a -> a
ours, ListType -> ListType -> ListType
forall a. a -> a -> a
ours), (Bool
False, Bool
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,
--   they do not bump version.
insertNewOnly :: a -> Maybe b -> a
insertNewOnly :: a -> Maybe b -> a
insertNewOnly a
m = a -> (b -> a) -> Maybe b -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
m (a -> b -> a
forall a b. a -> b -> a
const (a -> b -> a) -> a -> b -> a
forall a b. (a -> b) -> a -> b
$ [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"insertNewOnly: impossible")
  -- TODO error handling

{- unused
-- TODO refactor with putListNgrams
copyListNgrams :: RepoCmdM env err m
               => NodeId -> NodeId -> NgramsType
               -> m ()
copyListNgrams srcListId dstListId ngramsType = do
  var <- view repoVar
  liftBase $ modifyMVar_ var $
    pure . (r_state . at ngramsType %~ (Just . f . something))
  saveNodeStory
  where
    f :: Map NodeId NgramsTableMap -> Map NodeId NgramsTableMap
    f m = m & at dstListId %~ insertNewOnly (m ^. at srcListId)

-- TODO refactor with putListNgrams
-- The list must be non-empty!
-- The added ngrams must be non-existent!
addListNgrams :: RepoCmdM env err m
              => NodeId -> NgramsType
              -> [NgramsElement] -> m ()
addListNgrams listId ngramsType nes = do
  var <- view repoVar
  liftBase $ modifyMVar_ var $
    pure . (r_state . at ngramsType . _Just . at listId . _Just <>~ m)
  saveNodeStory
  where
    m = Map.fromList $ (\n -> (n ^. ne_ngrams, n)) <$> nes
-}

-- | TODO: incr the Version number
-- && should use patch
-- UNSAFE

setListNgrams ::  HasNodeStory env err m
              => NodeId
              -> TableNgrams.NgramsType
              -> Map NgramsTerm NgramsRepoElement
              -> m ()
setListNgrams :: NodeId -> NgramsType -> Map NgramsTerm NgramsRepoElement -> m ()
setListNgrams NodeId
listId NgramsType
ngramsType Map NgramsTerm NgramsRepoElement
ns = do
  [Char] -> (NodeId, NgramsType) -> m ()
forall a (m :: * -> *).
(Show a, MonadBase IO m) =>
[Char] -> a -> m ()
printDebug [Char]
"[setListNgrams]" (NodeId
listId, NgramsType
ngramsType)
  NodeStoryEnv
getter <- Getting NodeStoryEnv env NodeStoryEnv -> m NodeStoryEnv
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting NodeStoryEnv env NodeStoryEnv
forall env. HasNodeStoryEnv env => Getter env NodeStoryEnv
hasNodeStory
  MVar NodeListStory
var <- IO (MVar NodeListStory) -> m (MVar NodeListStory)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (MVar NodeListStory) -> m (MVar NodeListStory))
-> IO (MVar NodeListStory) -> m (MVar NodeListStory)
forall a b. (a -> b) -> a -> b
$ (NodeStoryEnv
getter NodeStoryEnv
-> Getting
     ([NodeId] -> IO (MVar NodeListStory))
     NodeStoryEnv
     ([NodeId] -> IO (MVar NodeListStory))
-> [NodeId]
-> IO (MVar NodeListStory)
forall s a. s -> Getting a s a -> a
^. Getting
  ([NodeId] -> IO (MVar NodeListStory))
  NodeStoryEnv
  ([NodeId] -> IO (MVar NodeListStory))
Lens' NodeStoryEnv ([NodeId] -> IO (MVar NodeListStory))
nse_getter) [NodeId
listId]
  IO () -> m ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MVar NodeListStory -> (NodeListStory -> IO NodeListStory) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar NodeListStory
var ((NodeListStory -> IO NodeListStory) -> IO ())
-> (NodeListStory -> IO NodeListStory) -> IO ()
forall a b. (a -> b) -> a -> b
$
    NodeListStory -> IO NodeListStory
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NodeListStory -> IO NodeListStory)
-> (NodeListStory -> NodeListStory)
-> NodeListStory
-> IO NodeListStory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( (Map NodeId (Archive NgramsState' NgramsStatePatch')
 -> Identity (Map NodeId (Archive NgramsState' NgramsStatePatch')))
-> NodeListStory -> Identity NodeListStory
forall s1 p1 s2 p2.
Iso
  (NodeStory s1 p1)
  (NodeStory s2 p2)
  (Map NodeId (Archive s1 p1))
  (Map NodeId (Archive s2 p2))
unNodeStory
           ((Map NodeId (Archive NgramsState' NgramsStatePatch')
  -> Identity (Map NodeId (Archive NgramsState' NgramsStatePatch')))
 -> NodeListStory -> Identity NodeListStory)
-> ((Maybe (Map NgramsTerm NgramsRepoElement)
     -> Identity (Maybe (Map NgramsTerm NgramsRepoElement)))
    -> Map NodeId (Archive NgramsState' NgramsStatePatch')
    -> Identity (Map NodeId (Archive NgramsState' NgramsStatePatch')))
-> (Maybe (Map NgramsTerm NgramsRepoElement)
    -> Identity (Maybe (Map NgramsTerm NgramsRepoElement)))
-> NodeListStory
-> Identity NodeListStory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NodeId (Archive NgramsState' NgramsStatePatch'))
-> Lens'
     (Map NodeId (Archive NgramsState' NgramsStatePatch'))
     (Maybe
        (IxValue (Map NodeId (Archive NgramsState' NgramsStatePatch'))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NodeId (Archive NgramsState' NgramsStatePatch'))
NodeId
listId ((Maybe (Archive NgramsState' NgramsStatePatch')
  -> Identity (Maybe (Archive NgramsState' NgramsStatePatch')))
 -> Map NodeId (Archive NgramsState' NgramsStatePatch')
 -> Identity (Map NodeId (Archive NgramsState' NgramsStatePatch')))
-> ((Maybe (Map NgramsTerm NgramsRepoElement)
     -> Identity (Maybe (Map NgramsTerm NgramsRepoElement)))
    -> Maybe (Archive NgramsState' NgramsStatePatch')
    -> Identity (Maybe (Archive NgramsState' NgramsStatePatch')))
-> (Maybe (Map NgramsTerm NgramsRepoElement)
    -> Identity (Maybe (Map NgramsTerm NgramsRepoElement)))
-> Map NodeId (Archive NgramsState' NgramsStatePatch')
-> Identity (Map NodeId (Archive NgramsState' NgramsStatePatch'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Archive NgramsState' NgramsStatePatch'
 -> Identity (Archive NgramsState' NgramsStatePatch'))
-> Maybe (Archive NgramsState' NgramsStatePatch')
-> Identity (Maybe (Archive NgramsState' NgramsStatePatch'))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just
            ((Archive NgramsState' NgramsStatePatch'
  -> Identity (Archive NgramsState' NgramsStatePatch'))
 -> Maybe (Archive NgramsState' NgramsStatePatch')
 -> Identity (Maybe (Archive NgramsState' NgramsStatePatch')))
-> ((Maybe (Map NgramsTerm NgramsRepoElement)
     -> Identity (Maybe (Map NgramsTerm NgramsRepoElement)))
    -> Archive NgramsState' NgramsStatePatch'
    -> Identity (Archive NgramsState' NgramsStatePatch'))
-> (Maybe (Map NgramsTerm NgramsRepoElement)
    -> Identity (Maybe (Map NgramsTerm NgramsRepoElement)))
-> Maybe (Archive NgramsState' NgramsStatePatch')
-> Identity (Maybe (Archive NgramsState' NgramsStatePatch'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NgramsState' -> Identity NgramsState')
-> Archive NgramsState' NgramsStatePatch'
-> Identity (Archive NgramsState' NgramsStatePatch')
forall s1 p s2. Lens (Archive s1 p) (Archive s2 p) s1 s2
a_state
              ((NgramsState' -> Identity NgramsState')
 -> Archive NgramsState' NgramsStatePatch'
 -> Identity (Archive NgramsState' NgramsStatePatch'))
-> ((Maybe (Map NgramsTerm NgramsRepoElement)
     -> Identity (Maybe (Map NgramsTerm NgramsRepoElement)))
    -> NgramsState' -> Identity NgramsState')
-> (Maybe (Map NgramsTerm NgramsRepoElement)
    -> Identity (Maybe (Map NgramsTerm NgramsRepoElement)))
-> Archive NgramsState' NgramsStatePatch'
-> Identity (Archive NgramsState' NgramsStatePatch')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index NgramsState'
-> Lens' NgramsState' (Maybe (IxValue NgramsState'))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index NgramsState'
NgramsType
ngramsType
              ((Maybe (Map NgramsTerm NgramsRepoElement)
  -> Identity (Maybe (Map NgramsTerm NgramsRepoElement)))
 -> NodeListStory -> Identity NodeListStory)
-> Maybe (Map NgramsTerm NgramsRepoElement)
-> NodeListStory
-> NodeListStory
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map NgramsTerm NgramsRepoElement
-> Maybe (Map NgramsTerm NgramsRepoElement)
forall a. a -> Maybe a
Just Map NgramsTerm NgramsRepoElement
ns
           )
  m ()
forall env (m :: * -> *).
(MonadReader env m, MonadBase IO m, HasNodeStorySaver env) =>
m ()
saveNodeStory


currentVersion :: HasNodeStory env err m
               => ListId -> m Version
currentVersion :: NodeId -> m Int
currentVersion NodeId
listId = do
  NodeListStory
nls <- [NodeId] -> m NodeListStory
forall env err (m :: * -> *).
HasNodeStory env err m =>
[NodeId] -> m NodeListStory
getRepo' [NodeId
listId]
  Int -> m Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$ NodeListStory
nls NodeListStory -> Getting Int NodeListStory Int -> Int
forall s a. s -> Getting a s a -> a
^. (Map NodeId (Archive NgramsState' NgramsStatePatch')
 -> Const Int (Map NodeId (Archive NgramsState' NgramsStatePatch')))
-> NodeListStory -> Const Int NodeListStory
forall s1 p1 s2 p2.
Iso
  (NodeStory s1 p1)
  (NodeStory s2 p2)
  (Map NodeId (Archive s1 p1))
  (Map NodeId (Archive s2 p2))
unNodeStory ((Map NodeId (Archive NgramsState' NgramsStatePatch')
  -> Const Int (Map NodeId (Archive NgramsState' NgramsStatePatch')))
 -> NodeListStory -> Const Int NodeListStory)
-> ((Int -> Const Int Int)
    -> Map NodeId (Archive NgramsState' NgramsStatePatch')
    -> Const Int (Map NodeId (Archive NgramsState' NgramsStatePatch')))
-> Getting Int NodeListStory Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NodeId (Archive NgramsState' NgramsStatePatch'))
-> Lens'
     (Map NodeId (Archive NgramsState' NgramsStatePatch'))
     (Maybe
        (IxValue (Map NodeId (Archive NgramsState' NgramsStatePatch'))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NodeId (Archive NgramsState' NgramsStatePatch'))
NodeId
listId ((Maybe (Archive NgramsState' NgramsStatePatch')
  -> Const Int (Maybe (Archive NgramsState' NgramsStatePatch')))
 -> Map NodeId (Archive NgramsState' NgramsStatePatch')
 -> Const Int (Map NodeId (Archive NgramsState' NgramsStatePatch')))
-> ((Int -> Const Int Int)
    -> Maybe (Archive NgramsState' NgramsStatePatch')
    -> Const Int (Maybe (Archive NgramsState' NgramsStatePatch')))
-> (Int -> Const Int Int)
-> Map NodeId (Archive NgramsState' NgramsStatePatch')
-> Const Int (Map NodeId (Archive NgramsState' NgramsStatePatch'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Archive NgramsState' NgramsStatePatch'
 -> Const Int (Archive NgramsState' NgramsStatePatch'))
-> Maybe (Archive NgramsState' NgramsStatePatch')
-> Const Int (Maybe (Archive NgramsState' NgramsStatePatch'))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Archive NgramsState' NgramsStatePatch'
  -> Const Int (Archive NgramsState' NgramsStatePatch'))
 -> Maybe (Archive NgramsState' NgramsStatePatch')
 -> Const Int (Maybe (Archive NgramsState' NgramsStatePatch')))
-> ((Int -> Const Int Int)
    -> Archive NgramsState' NgramsStatePatch'
    -> Const Int (Archive NgramsState' NgramsStatePatch'))
-> (Int -> Const Int Int)
-> Maybe (Archive NgramsState' NgramsStatePatch')
-> Const Int (Maybe (Archive NgramsState' NgramsStatePatch'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int)
-> Archive NgramsState' NgramsStatePatch'
-> Const Int (Archive NgramsState' NgramsStatePatch')
forall s1 p. Lens' (Archive s1 p) Int
a_version


newNgramsFromNgramsStatePatch :: NgramsStatePatch' -> [Ngrams]
newNgramsFromNgramsStatePatch :: NgramsStatePatch' -> [Ngrams]
newNgramsFromNgramsStatePatch NgramsStatePatch'
p =
  [ Text -> Ngrams
text2ngrams (NgramsTerm -> Text
unNgramsTerm NgramsTerm
n)
  | (NgramsTerm
n,NgramsPatch
np) <- NgramsStatePatch'
p NgramsStatePatch'
-> Getting
     (Endo [(NgramsTerm, NgramsPatch)])
     NgramsStatePatch'
     (NgramsTerm, NgramsPatch)
-> [(NgramsTerm, NgramsPatch)]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Map NgramsType NgramsTablePatch
 -> Const
      (Endo [(NgramsTerm, NgramsPatch)])
      (Map NgramsType NgramsTablePatch))
-> NgramsStatePatch'
-> Const (Endo [(NgramsTerm, NgramsPatch)]) NgramsStatePatch'
forall k1 pv1 k2 pv2.
Iso (PatchMap k2 pv2) (PatchMap k1 pv1) (Map k2 pv2) (Map k1 pv1)
_PatchMap
                -- . each . _PatchMap
                ((Map NgramsType NgramsTablePatch
  -> Const
       (Endo [(NgramsTerm, NgramsPatch)])
       (Map NgramsType NgramsTablePatch))
 -> NgramsStatePatch'
 -> Const (Endo [(NgramsTerm, NgramsPatch)]) NgramsStatePatch')
-> (((NgramsTerm, NgramsPatch)
     -> Const
          (Endo [(NgramsTerm, NgramsPatch)]) (NgramsTerm, NgramsPatch))
    -> Map NgramsType NgramsTablePatch
    -> Const
         (Endo [(NgramsTerm, NgramsPatch)])
         (Map NgramsType NgramsTablePatch))
-> Getting
     (Endo [(NgramsTerm, NgramsPatch)])
     NgramsStatePatch'
     (NgramsTerm, NgramsPatch)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NgramsTablePatch
 -> Const (Endo [(NgramsTerm, NgramsPatch)]) NgramsTablePatch)
-> Map NgramsType NgramsTablePatch
-> Const
     (Endo [(NgramsTerm, NgramsPatch)])
     (Map NgramsType NgramsTablePatch)
forall s t a b. Each s t a b => Traversal s t a b
each ((NgramsTablePatch
  -> Const (Endo [(NgramsTerm, NgramsPatch)]) NgramsTablePatch)
 -> Map NgramsType NgramsTablePatch
 -> Const
      (Endo [(NgramsTerm, NgramsPatch)])
      (Map NgramsType NgramsTablePatch))
-> (((NgramsTerm, NgramsPatch)
     -> Const
          (Endo [(NgramsTerm, NgramsPatch)]) (NgramsTerm, NgramsPatch))
    -> NgramsTablePatch
    -> Const (Endo [(NgramsTerm, NgramsPatch)]) NgramsTablePatch)
-> ((NgramsTerm, NgramsPatch)
    -> Const
         (Endo [(NgramsTerm, NgramsPatch)]) (NgramsTerm, NgramsPatch))
-> Map NgramsType NgramsTablePatch
-> Const
     (Endo [(NgramsTerm, NgramsPatch)])
     (Map NgramsType NgramsTablePatch)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PatchMap NgramsTerm NgramsPatch
 -> Const
      (Endo [(NgramsTerm, NgramsPatch)])
      (PatchMap NgramsTerm NgramsPatch))
-> NgramsTablePatch
-> Const (Endo [(NgramsTerm, NgramsPatch)]) NgramsTablePatch
Iso' NgramsTablePatch (PatchMap NgramsTerm NgramsPatch)
_NgramsTablePatch
                ((PatchMap NgramsTerm NgramsPatch
  -> Const
       (Endo [(NgramsTerm, NgramsPatch)])
       (PatchMap NgramsTerm NgramsPatch))
 -> NgramsTablePatch
 -> Const (Endo [(NgramsTerm, NgramsPatch)]) NgramsTablePatch)
-> (((NgramsTerm, NgramsPatch)
     -> Const
          (Endo [(NgramsTerm, NgramsPatch)]) (NgramsTerm, NgramsPatch))
    -> PatchMap NgramsTerm NgramsPatch
    -> Const
         (Endo [(NgramsTerm, NgramsPatch)])
         (PatchMap NgramsTerm NgramsPatch))
-> ((NgramsTerm, NgramsPatch)
    -> Const
         (Endo [(NgramsTerm, NgramsPatch)]) (NgramsTerm, NgramsPatch))
-> NgramsTablePatch
-> Const (Endo [(NgramsTerm, NgramsPatch)]) NgramsTablePatch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map NgramsTerm NgramsPatch
 -> Const
      (Endo [(NgramsTerm, NgramsPatch)]) (Map NgramsTerm NgramsPatch))
-> PatchMap NgramsTerm NgramsPatch
-> Const
     (Endo [(NgramsTerm, NgramsPatch)])
     (PatchMap NgramsTerm NgramsPatch)
forall k1 pv1 k2 pv2.
Iso (PatchMap k2 pv2) (PatchMap k1 pv1) (Map k2 pv2) (Map k1 pv1)
_PatchMap ((Map NgramsTerm NgramsPatch
  -> Const
       (Endo [(NgramsTerm, NgramsPatch)]) (Map NgramsTerm NgramsPatch))
 -> PatchMap NgramsTerm NgramsPatch
 -> Const
      (Endo [(NgramsTerm, NgramsPatch)])
      (PatchMap NgramsTerm NgramsPatch))
-> (((NgramsTerm, NgramsPatch)
     -> Const
          (Endo [(NgramsTerm, NgramsPatch)]) (NgramsTerm, NgramsPatch))
    -> Map NgramsTerm NgramsPatch
    -> Const
         (Endo [(NgramsTerm, NgramsPatch)]) (Map NgramsTerm NgramsPatch))
-> ((NgramsTerm, NgramsPatch)
    -> Const
         (Endo [(NgramsTerm, NgramsPatch)]) (NgramsTerm, NgramsPatch))
-> PatchMap NgramsTerm NgramsPatch
-> Const
     (Endo [(NgramsTerm, NgramsPatch)])
     (PatchMap NgramsTerm NgramsPatch)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Indexed
  NgramsTerm
  NgramsPatch
  (Const (Endo [(NgramsTerm, NgramsPatch)]) NgramsPatch)
-> Map NgramsTerm NgramsPatch
-> Const
     (Endo [(NgramsTerm, NgramsPatch)]) (Map NgramsTerm NgramsPatch)
forall i (f :: * -> *) a.
FoldableWithIndex i f =>
IndexedFold i (f a) a
ifolded (Indexed
   NgramsTerm
   NgramsPatch
   (Const (Endo [(NgramsTerm, NgramsPatch)]) NgramsPatch)
 -> Map NgramsTerm NgramsPatch
 -> Const
      (Endo [(NgramsTerm, NgramsPatch)]) (Map NgramsTerm NgramsPatch))
-> (((NgramsTerm, NgramsPatch)
     -> Const
          (Endo [(NgramsTerm, NgramsPatch)]) (NgramsTerm, NgramsPatch))
    -> Indexed
         NgramsTerm
         NgramsPatch
         (Const (Endo [(NgramsTerm, NgramsPatch)]) NgramsPatch))
-> ((NgramsTerm, NgramsPatch)
    -> Const
         (Endo [(NgramsTerm, NgramsPatch)]) (NgramsTerm, NgramsPatch))
-> Map NgramsTerm NgramsPatch
-> Const
     (Endo [(NgramsTerm, NgramsPatch)]) (Map NgramsTerm NgramsPatch)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((NgramsTerm, NgramsPatch)
 -> Const
      (Endo [(NgramsTerm, NgramsPatch)]) (NgramsTerm, NgramsPatch))
-> Indexed
     NgramsTerm
     NgramsPatch
     (Const (Endo [(NgramsTerm, NgramsPatch)]) NgramsPatch)
forall i (p :: * -> * -> *) (f :: * -> *) s j t.
(Indexable i p, Functor f) =>
p (i, s) (f (j, t)) -> Indexed i s (f t)
withIndex
  , NgramsRepoElement
_ <- NgramsPatch
np NgramsPatch
-> Getting (Endo [NgramsRepoElement]) NgramsPatch NgramsRepoElement
-> [NgramsRepoElement]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (Maybe NgramsRepoElement
 -> Const (Endo [NgramsRepoElement]) (Maybe NgramsRepoElement))
-> NgramsPatch -> Const (Endo [NgramsRepoElement]) NgramsPatch
Traversal' NgramsPatch (Maybe NgramsRepoElement)
patch_new ((Maybe NgramsRepoElement
  -> Const (Endo [NgramsRepoElement]) (Maybe NgramsRepoElement))
 -> NgramsPatch -> Const (Endo [NgramsRepoElement]) NgramsPatch)
-> ((NgramsRepoElement
     -> Const (Endo [NgramsRepoElement]) NgramsRepoElement)
    -> Maybe NgramsRepoElement
    -> Const (Endo [NgramsRepoElement]) (Maybe NgramsRepoElement))
-> Getting (Endo [NgramsRepoElement]) NgramsPatch NgramsRepoElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NgramsRepoElement
 -> Const (Endo [NgramsRepoElement]) NgramsRepoElement)
-> Maybe NgramsRepoElement
-> Const (Endo [NgramsRepoElement]) (Maybe NgramsRepoElement)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just
  ]




commitStatePatch :: (HasNodeStory env err m, HasMail env)
                 => ListId
                 ->    Versioned NgramsStatePatch'
                 -> m (Versioned NgramsStatePatch')
commitStatePatch :: NodeId
-> Versioned NgramsStatePatch' -> m (Versioned NgramsStatePatch')
commitStatePatch NodeId
listId (Versioned Int
p_version NgramsStatePatch'
p) = do
  [Char] -> NodeId -> m ()
forall a (m :: * -> *).
(Show a, MonadBase IO m) =>
[Char] -> a -> m ()
printDebug [Char]
"[commitStatePatch]" NodeId
listId
  MVar NodeListStory
var <- [NodeId] -> m (MVar NodeListStory)
forall env err (m :: * -> *).
HasNodeStory env err m =>
[NodeId] -> m (MVar NodeListStory)
getNodeStoryVar [NodeId
listId]
  Versioned NgramsStatePatch'
vq' <- IO (Versioned NgramsStatePatch') -> m (Versioned NgramsStatePatch')
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (Versioned NgramsStatePatch')
 -> m (Versioned NgramsStatePatch'))
-> IO (Versioned NgramsStatePatch')
-> m (Versioned NgramsStatePatch')
forall a b. (a -> b) -> a -> b
$ MVar NodeListStory
-> (NodeListStory
    -> IO (NodeListStory, Versioned NgramsStatePatch'))
-> IO (Versioned NgramsStatePatch')
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar NodeListStory
var ((NodeListStory -> IO (NodeListStory, Versioned NgramsStatePatch'))
 -> IO (Versioned NgramsStatePatch'))
-> (NodeListStory
    -> IO (NodeListStory, Versioned NgramsStatePatch'))
-> IO (Versioned NgramsStatePatch')
forall a b. (a -> b) -> a -> b
$ \NodeListStory
ns -> do
    let
      a :: Archive NgramsState' NgramsStatePatch'
a = NodeListStory
ns NodeListStory
-> Getting
     (Archive NgramsState' NgramsStatePatch')
     NodeListStory
     (Archive NgramsState' NgramsStatePatch')
-> Archive NgramsState' NgramsStatePatch'
forall s a. s -> Getting a s a -> a
^. (Map NodeId (Archive NgramsState' NgramsStatePatch')
 -> Const
      (Archive NgramsState' NgramsStatePatch')
      (Map NodeId (Archive NgramsState' NgramsStatePatch')))
-> NodeListStory
-> Const (Archive NgramsState' NgramsStatePatch') NodeListStory
forall s1 p1 s2 p2.
Iso
  (NodeStory s1 p1)
  (NodeStory s2 p2)
  (Map NodeId (Archive s1 p1))
  (Map NodeId (Archive s2 p2))
unNodeStory ((Map NodeId (Archive NgramsState' NgramsStatePatch')
  -> Const
       (Archive NgramsState' NgramsStatePatch')
       (Map NodeId (Archive NgramsState' NgramsStatePatch')))
 -> NodeListStory
 -> Const (Archive NgramsState' NgramsStatePatch') NodeListStory)
-> ((Archive NgramsState' NgramsStatePatch'
     -> Const
          (Archive NgramsState' NgramsStatePatch')
          (Archive NgramsState' NgramsStatePatch'))
    -> Map NodeId (Archive NgramsState' NgramsStatePatch')
    -> Const
         (Archive NgramsState' NgramsStatePatch')
         (Map NodeId (Archive NgramsState' NgramsStatePatch')))
-> Getting
     (Archive NgramsState' NgramsStatePatch')
     NodeListStory
     (Archive NgramsState' NgramsStatePatch')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NodeId (Archive NgramsState' NgramsStatePatch'))
-> Lens'
     (Map NodeId (Archive NgramsState' NgramsStatePatch'))
     (Maybe
        (IxValue (Map NodeId (Archive NgramsState' NgramsStatePatch'))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NodeId (Archive NgramsState' NgramsStatePatch'))
NodeId
listId ((Maybe (Archive NgramsState' NgramsStatePatch')
  -> Const
       (Archive NgramsState' NgramsStatePatch')
       (Maybe (Archive NgramsState' NgramsStatePatch')))
 -> Map NodeId (Archive NgramsState' NgramsStatePatch')
 -> Const
      (Archive NgramsState' NgramsStatePatch')
      (Map NodeId (Archive NgramsState' NgramsStatePatch')))
-> ((Archive NgramsState' NgramsStatePatch'
     -> Const
          (Archive NgramsState' NgramsStatePatch')
          (Archive NgramsState' NgramsStatePatch'))
    -> Maybe (Archive NgramsState' NgramsStatePatch')
    -> Const
         (Archive NgramsState' NgramsStatePatch')
         (Maybe (Archive NgramsState' NgramsStatePatch')))
-> (Archive NgramsState' NgramsStatePatch'
    -> Const
         (Archive NgramsState' NgramsStatePatch')
         (Archive NgramsState' NgramsStatePatch'))
-> Map NodeId (Archive NgramsState' NgramsStatePatch')
-> Const
     (Archive NgramsState' NgramsStatePatch')
     (Map NodeId (Archive NgramsState' NgramsStatePatch'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Archive NgramsState' NgramsStatePatch'
 -> Const
      (Archive NgramsState' NgramsStatePatch')
      (Archive NgramsState' NgramsStatePatch'))
-> Maybe (Archive NgramsState' NgramsStatePatch')
-> Const
     (Archive NgramsState' NgramsStatePatch')
     (Maybe (Archive NgramsState' NgramsStatePatch'))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      q :: NgramsStatePatch'
q = [NgramsStatePatch'] -> NgramsStatePatch'
forall a. Monoid a => [a] -> a
mconcat ([NgramsStatePatch'] -> NgramsStatePatch')
-> [NgramsStatePatch'] -> NgramsStatePatch'
forall a b. (a -> b) -> a -> b
$ Int -> [NgramsStatePatch'] -> [NgramsStatePatch']
forall a. Int -> [a] -> [a]
take (Archive NgramsState' NgramsStatePatch'
a Archive NgramsState' NgramsStatePatch'
-> ((Int -> Const Int Int)
    -> Archive NgramsState' NgramsStatePatch'
    -> Const Int (Archive NgramsState' NgramsStatePatch'))
-> Int
forall s a. s -> Getting a s a -> a
^. (Int -> Const Int Int)
-> Archive NgramsState' NgramsStatePatch'
-> Const Int (Archive NgramsState' NgramsStatePatch')
forall s1 p. Lens' (Archive s1 p) Int
a_version Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p_version) (Archive NgramsState' NgramsStatePatch'
a Archive NgramsState' NgramsStatePatch'
-> Getting
     [NgramsStatePatch']
     (Archive NgramsState' NgramsStatePatch')
     [NgramsStatePatch']
-> [NgramsStatePatch']
forall s a. s -> Getting a s a -> a
^. Getting
  [NgramsStatePatch']
  (Archive NgramsState' NgramsStatePatch')
  [NgramsStatePatch']
forall s1 p p2. Lens (Archive s1 p) (Archive s1 p2) [p] [p2]
a_history)
      (NgramsStatePatch'
p', NgramsStatePatch'
q') = ConflictResolution NgramsStatePatch'
-> NgramsStatePatch'
-> NgramsStatePatch'
-> (NgramsStatePatch', NgramsStatePatch')
forall p.
Transformable p =>
ConflictResolution p -> p -> p -> (p, p)
transformWith ConflictResolution NgramsStatePatch'
NgramsType -> NgramsTerm -> ConflictResolutionNgramsPatch
ngramsStatePatchConflictResolution NgramsStatePatch'
p NgramsStatePatch'
q
      a' :: Archive NgramsState' NgramsStatePatch'
a' = Archive NgramsState' NgramsStatePatch'
a Archive NgramsState' NgramsStatePatch'
-> (Archive NgramsState' NgramsStatePatch'
    -> Archive NgramsState' NgramsStatePatch')
-> Archive NgramsState' NgramsStatePatch'
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int)
-> Archive NgramsState' NgramsStatePatch'
-> Identity (Archive NgramsState' NgramsStatePatch')
forall s1 p. Lens' (Archive s1 p) Int
a_version ((Int -> Identity Int)
 -> Archive NgramsState' NgramsStatePatch'
 -> Identity (Archive NgramsState' NgramsStatePatch'))
-> Int
-> Archive NgramsState' NgramsStatePatch'
-> Archive NgramsState' NgramsStatePatch'
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int
1
             Archive NgramsState' NgramsStatePatch'
-> (Archive NgramsState' NgramsStatePatch'
    -> Archive NgramsState' NgramsStatePatch')
-> Archive NgramsState' NgramsStatePatch'
forall a b. a -> (a -> b) -> b
& (NgramsState' -> Identity NgramsState')
-> Archive NgramsState' NgramsStatePatch'
-> Identity (Archive NgramsState' NgramsStatePatch')
forall s1 p s2. Lens (Archive s1 p) (Archive s2 p) s1 s2
a_state   ((NgramsState' -> Identity NgramsState')
 -> Archive NgramsState' NgramsStatePatch'
 -> Identity (Archive NgramsState' NgramsStatePatch'))
-> (NgramsState' -> NgramsState')
-> Archive NgramsState' NgramsStatePatch'
-> Archive NgramsState' NgramsStatePatch'
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ NgramsStatePatch' -> NgramsState' -> NgramsState'
forall m s. Action m s => m -> s -> s
act NgramsStatePatch'
p'
             Archive NgramsState' NgramsStatePatch'
-> (Archive NgramsState' NgramsStatePatch'
    -> Archive NgramsState' NgramsStatePatch')
-> Archive NgramsState' NgramsStatePatch'
forall a b. a -> (a -> b) -> b
& ([NgramsStatePatch'] -> Identity [NgramsStatePatch'])
-> Archive NgramsState' NgramsStatePatch'
-> Identity (Archive NgramsState' NgramsStatePatch')
forall s1 p p2. Lens (Archive s1 p) (Archive s1 p2) [p] [p2]
a_history (([NgramsStatePatch'] -> Identity [NgramsStatePatch'])
 -> Archive NgramsState' NgramsStatePatch'
 -> Identity (Archive NgramsState' NgramsStatePatch'))
-> ([NgramsStatePatch'] -> [NgramsStatePatch'])
-> Archive NgramsState' NgramsStatePatch'
-> Archive NgramsState' NgramsStatePatch'
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (NgramsStatePatch'
p' NgramsStatePatch' -> [NgramsStatePatch'] -> [NgramsStatePatch']
forall a. a -> [a] -> [a]
:)

    {-
    -- Ideally we would like to check these properties. However:
    -- * They should be checked only to debug the code. The client data
    --   should be able to trigger these.
    -- * What kind of error should they throw (we are in IO here)?
    -- * Should we keep modifyMVar?
    -- * Should we throw the validation in an Exception, catch it around
    --   modifyMVar and throw it back as an Error?
    assertValid $ transformable p q
    assertValid $ applicable p' (r ^. r_state)
    -}
    [Char] -> Int -> IO ()
forall a (m :: * -> *).
(Show a, MonadBase IO m) =>
[Char] -> a -> m ()
printDebug [Char]
"[commitStatePatch] a version" (Archive NgramsState' NgramsStatePatch'
a Archive NgramsState' NgramsStatePatch'
-> ((Int -> Const Int Int)
    -> Archive NgramsState' NgramsStatePatch'
    -> Const Int (Archive NgramsState' NgramsStatePatch'))
-> Int
forall s a. s -> Getting a s a -> a
^. (Int -> Const Int Int)
-> Archive NgramsState' NgramsStatePatch'
-> Const Int (Archive NgramsState' NgramsStatePatch')
forall s1 p. Lens' (Archive s1 p) Int
a_version)
    [Char] -> Int -> IO ()
forall a (m :: * -> *).
(Show a, MonadBase IO m) =>
[Char] -> a -> m ()
printDebug [Char]
"[commitStatePatch] a' version" (Archive NgramsState' NgramsStatePatch'
a' Archive NgramsState' NgramsStatePatch'
-> ((Int -> Const Int Int)
    -> Archive NgramsState' NgramsStatePatch'
    -> Const Int (Archive NgramsState' NgramsStatePatch'))
-> Int
forall s a. s -> Getting a s a -> a
^. (Int -> Const Int Int)
-> Archive NgramsState' NgramsStatePatch'
-> Const Int (Archive NgramsState' NgramsStatePatch')
forall s1 p. Lens' (Archive s1 p) Int
a_version)
    (NodeListStory, Versioned NgramsStatePatch')
-> IO (NodeListStory, Versioned NgramsStatePatch')
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( NodeListStory
ns NodeListStory -> (NodeListStory -> NodeListStory) -> NodeListStory
forall a b. a -> (a -> b) -> b
& (Map NodeId (Archive NgramsState' NgramsStatePatch')
 -> Identity (Map NodeId (Archive NgramsState' NgramsStatePatch')))
-> NodeListStory -> Identity NodeListStory
forall s1 p1 s2 p2.
Iso
  (NodeStory s1 p1)
  (NodeStory s2 p2)
  (Map NodeId (Archive s1 p1))
  (Map NodeId (Archive s2 p2))
unNodeStory ((Map NodeId (Archive NgramsState' NgramsStatePatch')
  -> Identity (Map NodeId (Archive NgramsState' NgramsStatePatch')))
 -> NodeListStory -> Identity NodeListStory)
-> ((Maybe (Archive NgramsState' NgramsStatePatch')
     -> Identity (Maybe (Archive NgramsState' NgramsStatePatch')))
    -> Map NodeId (Archive NgramsState' NgramsStatePatch')
    -> Identity (Map NodeId (Archive NgramsState' NgramsStatePatch')))
-> (Maybe (Archive NgramsState' NgramsStatePatch')
    -> Identity (Maybe (Archive NgramsState' NgramsStatePatch')))
-> NodeListStory
-> Identity NodeListStory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NodeId (Archive NgramsState' NgramsStatePatch'))
-> Lens'
     (Map NodeId (Archive NgramsState' NgramsStatePatch'))
     (Maybe
        (IxValue (Map NodeId (Archive NgramsState' NgramsStatePatch'))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NodeId (Archive NgramsState' NgramsStatePatch'))
NodeId
listId ((Maybe (Archive NgramsState' NgramsStatePatch')
  -> Identity (Maybe (Archive NgramsState' NgramsStatePatch')))
 -> NodeListStory -> Identity NodeListStory)
-> Maybe (Archive NgramsState' NgramsStatePatch')
-> NodeListStory
-> NodeListStory
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Archive NgramsState' NgramsStatePatch'
-> Maybe (Archive NgramsState' NgramsStatePatch')
forall a. a -> Maybe a
Just Archive NgramsState' NgramsStatePatch'
a')
         , Int -> NgramsStatePatch' -> Versioned NgramsStatePatch'
forall a1. Int -> a1 -> Versioned a1
Versioned (Archive NgramsState' NgramsStatePatch'
a' Archive NgramsState' NgramsStatePatch'
-> ((Int -> Const Int Int)
    -> Archive NgramsState' NgramsStatePatch'
    -> Const Int (Archive NgramsState' NgramsStatePatch'))
-> Int
forall s a. s -> Getting a s a -> a
^. (Int -> Const Int Int)
-> Archive NgramsState' NgramsStatePatch'
-> Const Int (Archive NgramsState' NgramsStatePatch')
forall s1 p. Lens' (Archive s1 p) Int
a_version) NgramsStatePatch'
q'
         )
  m ()
forall env (m :: * -> *).
(MonadReader env m, MonadBase IO m, HasNodeStorySaver env) =>
m ()
saveNodeStory
  -- Save new ngrams
  HashMap Text Int
_ <- [Ngrams] -> Cmd err (HashMap Text Int)
forall err. [Ngrams] -> Cmd err (HashMap Text Int)
insertNgrams (NgramsStatePatch' -> [Ngrams]
newNgramsFromNgramsStatePatch NgramsStatePatch'
p)

  Versioned NgramsStatePatch' -> m (Versioned NgramsStatePatch')
forall (f :: * -> *) a. Applicative f => a -> f a
pure Versioned NgramsStatePatch'
vq'



-- This is a special case of tableNgramsPut where the input patch is empty.
tableNgramsPull :: HasNodeStory env err m
                => ListId
                -> TableNgrams.NgramsType
                -> Version
                -> m (Versioned NgramsTablePatch)
tableNgramsPull :: NodeId -> NgramsType -> Int -> m (Versioned NgramsTablePatch)
tableNgramsPull NodeId
listId NgramsType
ngramsType Int
p_version = do
  [Char] -> (NodeId, NgramsType) -> m ()
forall a (m :: * -> *).
(Show a, MonadBase IO m) =>
[Char] -> a -> m ()
printDebug [Char]
"[tableNgramsPull]" (NodeId
listId, NgramsType
ngramsType)
  MVar NodeListStory
var <- [NodeId] -> m (MVar NodeListStory)
forall env err (m :: * -> *).
HasNodeStory env err m =>
[NodeId] -> m (MVar NodeListStory)
getNodeStoryVar [NodeId
listId]
  NodeListStory
r <- IO NodeListStory -> m NodeListStory
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO NodeListStory -> m NodeListStory)
-> IO NodeListStory -> m NodeListStory
forall a b. (a -> b) -> a -> b
$ MVar NodeListStory -> IO NodeListStory
forall a. MVar a -> IO a
readMVar MVar NodeListStory
var

  let
    a :: Archive NgramsState' NgramsStatePatch'
a = NodeListStory
r NodeListStory
-> Getting
     (Archive NgramsState' NgramsStatePatch')
     NodeListStory
     (Archive NgramsState' NgramsStatePatch')
-> Archive NgramsState' NgramsStatePatch'
forall s a. s -> Getting a s a -> a
^. (Map NodeId (Archive NgramsState' NgramsStatePatch')
 -> Const
      (Archive NgramsState' NgramsStatePatch')
      (Map NodeId (Archive NgramsState' NgramsStatePatch')))
-> NodeListStory
-> Const (Archive NgramsState' NgramsStatePatch') NodeListStory
forall s1 p1 s2 p2.
Iso
  (NodeStory s1 p1)
  (NodeStory s2 p2)
  (Map NodeId (Archive s1 p1))
  (Map NodeId (Archive s2 p2))
unNodeStory ((Map NodeId (Archive NgramsState' NgramsStatePatch')
  -> Const
       (Archive NgramsState' NgramsStatePatch')
       (Map NodeId (Archive NgramsState' NgramsStatePatch')))
 -> NodeListStory
 -> Const (Archive NgramsState' NgramsStatePatch') NodeListStory)
-> ((Archive NgramsState' NgramsStatePatch'
     -> Const
          (Archive NgramsState' NgramsStatePatch')
          (Archive NgramsState' NgramsStatePatch'))
    -> Map NodeId (Archive NgramsState' NgramsStatePatch')
    -> Const
         (Archive NgramsState' NgramsStatePatch')
         (Map NodeId (Archive NgramsState' NgramsStatePatch')))
-> Getting
     (Archive NgramsState' NgramsStatePatch')
     NodeListStory
     (Archive NgramsState' NgramsStatePatch')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NodeId (Archive NgramsState' NgramsStatePatch'))
-> Lens'
     (Map NodeId (Archive NgramsState' NgramsStatePatch'))
     (Maybe
        (IxValue (Map NodeId (Archive NgramsState' NgramsStatePatch'))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NodeId (Archive NgramsState' NgramsStatePatch'))
NodeId
listId ((Maybe (Archive NgramsState' NgramsStatePatch')
  -> Const
       (Archive NgramsState' NgramsStatePatch')
       (Maybe (Archive NgramsState' NgramsStatePatch')))
 -> Map NodeId (Archive NgramsState' NgramsStatePatch')
 -> Const
      (Archive NgramsState' NgramsStatePatch')
      (Map NodeId (Archive NgramsState' NgramsStatePatch')))
-> ((Archive NgramsState' NgramsStatePatch'
     -> Const
          (Archive NgramsState' NgramsStatePatch')
          (Archive NgramsState' NgramsStatePatch'))
    -> Maybe (Archive NgramsState' NgramsStatePatch')
    -> Const
         (Archive NgramsState' NgramsStatePatch')
         (Maybe (Archive NgramsState' NgramsStatePatch')))
-> (Archive NgramsState' NgramsStatePatch'
    -> Const
         (Archive NgramsState' NgramsStatePatch')
         (Archive NgramsState' NgramsStatePatch'))
-> Map NodeId (Archive NgramsState' NgramsStatePatch')
-> Const
     (Archive NgramsState' NgramsStatePatch')
     (Map NodeId (Archive NgramsState' NgramsStatePatch'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Archive NgramsState' NgramsStatePatch'
 -> Const
      (Archive NgramsState' NgramsStatePatch')
      (Archive NgramsState' NgramsStatePatch'))
-> Maybe (Archive NgramsState' NgramsStatePatch')
-> Const
     (Archive NgramsState' NgramsStatePatch')
     (Maybe (Archive NgramsState' NgramsStatePatch'))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just
    q :: NgramsStatePatch'
q = [NgramsStatePatch'] -> NgramsStatePatch'
forall a. Monoid a => [a] -> a
mconcat ([NgramsStatePatch'] -> NgramsStatePatch')
-> [NgramsStatePatch'] -> NgramsStatePatch'
forall a b. (a -> b) -> a -> b
$ Int -> [NgramsStatePatch'] -> [NgramsStatePatch']
forall a. Int -> [a] -> [a]
take (Archive NgramsState' NgramsStatePatch'
a Archive NgramsState' NgramsStatePatch'
-> ((Int -> Const Int Int)
    -> Archive NgramsState' NgramsStatePatch'
    -> Const Int (Archive NgramsState' NgramsStatePatch'))
-> Int
forall s a. s -> Getting a s a -> a
^. (Int -> Const Int Int)
-> Archive NgramsState' NgramsStatePatch'
-> Const Int (Archive NgramsState' NgramsStatePatch')
forall s1 p. Lens' (Archive s1 p) Int
a_version Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p_version) (Archive NgramsState' NgramsStatePatch'
a Archive NgramsState' NgramsStatePatch'
-> Getting
     [NgramsStatePatch']
     (Archive NgramsState' NgramsStatePatch')
     [NgramsStatePatch']
-> [NgramsStatePatch']
forall s a. s -> Getting a s a -> a
^. Getting
  [NgramsStatePatch']
  (Archive NgramsState' NgramsStatePatch')
  [NgramsStatePatch']
forall s1 p p2. Lens (Archive s1 p) (Archive s1 p2) [p] [p2]
a_history)
    q_table :: NgramsTablePatch
q_table = NgramsStatePatch'
q NgramsStatePatch'
-> Getting NgramsTablePatch NgramsStatePatch' NgramsTablePatch
-> NgramsTablePatch
forall s a. s -> Getting a s a -> a
^. (Map NgramsType NgramsTablePatch
 -> Const NgramsTablePatch (Map NgramsType NgramsTablePatch))
-> NgramsStatePatch' -> Const NgramsTablePatch NgramsStatePatch'
forall k1 pv1 k2 pv2.
Iso (PatchMap k2 pv2) (PatchMap k1 pv1) (Map k2 pv2) (Map k1 pv1)
_PatchMap ((Map NgramsType NgramsTablePatch
  -> Const NgramsTablePatch (Map NgramsType NgramsTablePatch))
 -> NgramsStatePatch' -> Const NgramsTablePatch NgramsStatePatch')
-> ((NgramsTablePatch -> Const NgramsTablePatch NgramsTablePatch)
    -> Map NgramsType NgramsTablePatch
    -> Const NgramsTablePatch (Map NgramsType NgramsTablePatch))
-> Getting NgramsTablePatch NgramsStatePatch' NgramsTablePatch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NgramsType NgramsTablePatch)
-> Lens'
     (Map NgramsType NgramsTablePatch)
     (Maybe (IxValue (Map NgramsType NgramsTablePatch)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NgramsType NgramsTablePatch)
NgramsType
ngramsType ((Maybe NgramsTablePatch
  -> Const NgramsTablePatch (Maybe NgramsTablePatch))
 -> Map NgramsType NgramsTablePatch
 -> Const NgramsTablePatch (Map NgramsType NgramsTablePatch))
-> ((NgramsTablePatch -> Const NgramsTablePatch NgramsTablePatch)
    -> Maybe NgramsTablePatch
    -> Const NgramsTablePatch (Maybe NgramsTablePatch))
-> (NgramsTablePatch -> Const NgramsTablePatch NgramsTablePatch)
-> Map NgramsType NgramsTablePatch
-> Const NgramsTablePatch (Map NgramsType NgramsTablePatch)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NgramsTablePatch -> Const NgramsTablePatch NgramsTablePatch)
-> Maybe NgramsTablePatch
-> Const NgramsTablePatch (Maybe NgramsTablePatch)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just

  Versioned NgramsTablePatch -> m (Versioned NgramsTablePatch)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> NgramsTablePatch -> Versioned NgramsTablePatch
forall a1. Int -> a1 -> Versioned a1
Versioned (Archive NgramsState' NgramsStatePatch'
a Archive NgramsState' NgramsStatePatch'
-> ((Int -> Const Int Int)
    -> Archive NgramsState' NgramsStatePatch'
    -> Const Int (Archive NgramsState' NgramsStatePatch'))
-> Int
forall s a. s -> Getting a s a -> a
^. (Int -> Const Int Int)
-> Archive NgramsState' NgramsStatePatch'
-> Const Int (Archive NgramsState' NgramsStatePatch')
forall s1 p. Lens' (Archive s1 p) Int
a_version) NgramsTablePatch
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 :: ( HasNodeStory env err m
                  , HasInvalidError err
                  , HasSettings env
                  , HasMail env
                  )
                 => TabType
                 -> ListId
                 -> Versioned NgramsTablePatch
                 -> m (Versioned NgramsTablePatch)
tableNgramsPut :: TabType
-> NodeId
-> Versioned NgramsTablePatch
-> m (Versioned NgramsTablePatch)
tableNgramsPut TabType
tabType NodeId
listId (Versioned Int
p_version NgramsTablePatch
p_table)
  | NgramsTablePatch
p_table NgramsTablePatch -> NgramsTablePatch -> Bool
forall a. Eq a => a -> a -> Bool
== NgramsTablePatch
forall a. Monoid a => a
mempty = do
      [Char] -> Text -> m ()
forall a (m :: * -> *).
(Show a, MonadBase IO m) =>
[Char] -> a -> m ()
printDebug [Char]
"[tableNgramsPut]" (Text
"TableEmpty" :: Text)
      let ngramsType :: NgramsType
ngramsType        = TabType -> NgramsType
ngramsTypeFromTabType TabType
tabType
      NodeId -> NgramsType -> Int -> m (Versioned NgramsTablePatch)
forall env err (m :: * -> *).
HasNodeStory env err m =>
NodeId -> NgramsType -> Int -> m (Versioned NgramsTablePatch)
tableNgramsPull NodeId
listId NgramsType
ngramsType Int
p_version

  | Bool
otherwise         = do
      [Char] -> Text -> m ()
forall a (m :: * -> *).
(Show a, MonadBase IO m) =>
[Char] -> a -> m ()
printDebug [Char]
"[tableNgramsPut]" (Text
"TableNonEmpty" :: Text)
      let ngramsType :: NgramsType
ngramsType        = TabType -> NgramsType
ngramsTypeFromTabType TabType
tabType
          (NgramsStatePatch'
p, Validation
p_validity)   = NgramsType -> NgramsTablePatch -> (NgramsStatePatch', Validation)
forall k pv.
(Ord k, Validity pv, Monoid pv, Eq pv) =>
k -> pv -> (PatchMap k pv, Validation)
PM.singleton NgramsType
ngramsType NgramsTablePatch
p_table

      Validation -> m ()
forall e (m :: * -> *).
(MonadError e m, HasInvalidError e) =>
Validation -> m ()
assertValid Validation
p_validity

      Versioned NgramsTablePatch
ret <- NodeId
-> Versioned NgramsStatePatch' -> m (Versioned NgramsStatePatch')
forall env err (m :: * -> *).
(HasNodeStory env err m, HasMail env) =>
NodeId
-> Versioned NgramsStatePatch' -> m (Versioned NgramsStatePatch')
commitStatePatch NodeId
listId (Int -> NgramsStatePatch' -> Versioned NgramsStatePatch'
forall a1. Int -> a1 -> Versioned a1
Versioned Int
p_version NgramsStatePatch'
p)
        m (Versioned NgramsStatePatch')
-> (Versioned NgramsStatePatch' -> Versioned NgramsTablePatch)
-> m (Versioned NgramsTablePatch)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (NgramsStatePatch' -> Identity NgramsTablePatch)
-> Versioned NgramsStatePatch'
-> Identity (Versioned NgramsTablePatch)
forall a1 a2. Lens (Versioned a1) (Versioned a2) a1 a2
v_data ((NgramsStatePatch' -> Identity NgramsTablePatch)
 -> Versioned NgramsStatePatch'
 -> Identity (Versioned NgramsTablePatch))
-> (NgramsStatePatch' -> NgramsTablePatch)
-> Versioned NgramsStatePatch'
-> Versioned NgramsTablePatch
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Getting NgramsTablePatch NgramsStatePatch' NgramsTablePatch
-> NgramsStatePatch' -> NgramsTablePatch
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Map NgramsType NgramsTablePatch
 -> Const NgramsTablePatch (Map NgramsType NgramsTablePatch))
-> NgramsStatePatch' -> Const NgramsTablePatch NgramsStatePatch'
forall k1 pv1 k2 pv2.
Iso (PatchMap k2 pv2) (PatchMap k1 pv1) (Map k2 pv2) (Map k1 pv1)
_PatchMap ((Map NgramsType NgramsTablePatch
  -> Const NgramsTablePatch (Map NgramsType NgramsTablePatch))
 -> NgramsStatePatch' -> Const NgramsTablePatch NgramsStatePatch')
-> ((NgramsTablePatch -> Const NgramsTablePatch NgramsTablePatch)
    -> Map NgramsType NgramsTablePatch
    -> Const NgramsTablePatch (Map NgramsType NgramsTablePatch))
-> Getting NgramsTablePatch NgramsStatePatch' NgramsTablePatch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NgramsType NgramsTablePatch)
-> Lens'
     (Map NgramsType NgramsTablePatch)
     (Maybe (IxValue (Map NgramsType NgramsTablePatch)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NgramsType NgramsTablePatch)
NgramsType
ngramsType ((Maybe NgramsTablePatch
  -> Const NgramsTablePatch (Maybe NgramsTablePatch))
 -> Map NgramsType NgramsTablePatch
 -> Const NgramsTablePatch (Map NgramsType NgramsTablePatch))
-> ((NgramsTablePatch -> Const NgramsTablePatch NgramsTablePatch)
    -> Maybe NgramsTablePatch
    -> Const NgramsTablePatch (Maybe NgramsTablePatch))
-> (NgramsTablePatch -> Const NgramsTablePatch NgramsTablePatch)
-> Map NgramsType NgramsTablePatch
-> Const NgramsTablePatch (Map NgramsType NgramsTablePatch)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NgramsTablePatch -> Const NgramsTablePatch NgramsTablePatch)
-> Maybe NgramsTablePatch
-> Const NgramsTablePatch (Maybe NgramsTablePatch)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just))

      Versioned NgramsTablePatch -> m (Versioned NgramsTablePatch)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Versioned NgramsTablePatch
ret



tableNgramsPostChartsAsync :: ( HasNodeStory env err m
                              , FlowCmdM     env err m
                              , HasNodeError err
                              , HasSettings env
                              )
                            => UpdateTableNgramsCharts
                            -> (JobLog -> m ())
                            -> m JobLog
tableNgramsPostChartsAsync :: UpdateTableNgramsCharts -> (JobLog -> m ()) -> m JobLog
tableNgramsPostChartsAsync UpdateTableNgramsCharts
utn JobLog -> m ()
logStatus = do
      let tabType :: TabType
tabType = UpdateTableNgramsCharts
utn UpdateTableNgramsCharts
-> Getting TabType UpdateTableNgramsCharts TabType -> TabType
forall s a. s -> Getting a s a -> a
^. Getting TabType UpdateTableNgramsCharts TabType
Lens' UpdateTableNgramsCharts TabType
utn_tab_type
      let listId :: NodeId
listId = UpdateTableNgramsCharts
utn UpdateTableNgramsCharts
-> Getting NodeId UpdateTableNgramsCharts NodeId -> NodeId
forall s a. s -> Getting a s a -> a
^. Getting NodeId UpdateTableNgramsCharts NodeId
Lens' UpdateTableNgramsCharts NodeId
utn_list_id

      Node Value
node <- NodeId -> Cmd err (Node Value)
forall err. HasNodeError err => NodeId -> Cmd err (Node Value)
getNode NodeId
listId
      let nId :: NodeId
nId = Node Value
node Node Value -> Getting NodeId (Node Value) NodeId -> NodeId
forall s a. s -> Getting a s a -> a
^. Getting NodeId (Node Value) NodeId
forall id1 hash_id typename user_id parent_id name date hyperdata
       id2.
Lens
  (NodePoly
     id1 hash_id typename user_id parent_id name date hyperdata)
  (NodePoly
     id2 hash_id typename user_id parent_id name date hyperdata)
  id1
  id2
node_id
          _uId :: Int
_uId = Node Value
node Node Value -> Getting Int (Node Value) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Node Value) Int
forall id1 hash_id typename user_id parent_id name date hyperdata
       user_id2.
Lens
  (NodePoly
     id1 hash_id typename user_id parent_id name date hyperdata)
  (NodePoly
     id1 hash_id typename user_id2 parent_id name date hyperdata)
  user_id
  user_id2
node_user_id
          mCId :: Maybe NodeId
mCId = Node Value
node Node Value
-> Getting (Maybe NodeId) (Node Value) (Maybe NodeId)
-> Maybe NodeId
forall s a. s -> Getting a s a -> a
^. Getting (Maybe NodeId) (Node Value) (Maybe NodeId)
forall id1 hash_id typename user_id parent_id name date hyperdata
       parent_id2.
Lens
  (NodePoly
     id1 hash_id typename user_id parent_id name date hyperdata)
  (NodePoly
     id1 hash_id typename user_id parent_id2 name date hyperdata)
  parent_id
  parent_id2
node_parent_id

      -- printDebug "[tableNgramsPostChartsAsync] tabType" tabType
      -- printDebug "[tableNgramsPostChartsAsync] listId" listId

      case Maybe NodeId
mCId of
        Maybe NodeId
Nothing -> do
          [Char] -> NodeId -> m ()
forall a (m :: * -> *).
(Show a, MonadBase IO m) =>
[Char] -> a -> m ()
printDebug [Char]
"[tableNgramsPostChartsAsync] can't update charts, no parent, nId" NodeId
nId
          JobLog -> m JobLog
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JobLog -> m JobLog) -> JobLog -> m JobLog
forall a b. (a -> b) -> a -> b
$ JobLog -> JobLog
jobLogFail (JobLog -> JobLog) -> JobLog -> JobLog
forall a b. (a -> b) -> a -> b
$ Int -> JobLog
jobLogInit Int
1
        Just NodeId
cId -> do
          case TabType
tabType of
            TabType
Authors -> do
              -- printDebug "[tableNgramsPostChartsAsync] Authors, updating Pie, cId" cId
              (m ()
logRef, m ()
logRefSuccess, m JobLog
getRef) <- Int -> (JobLog -> m ()) -> m (m (), m (), m JobLog)
forall (m :: * -> *).
MonadBase IO m =>
Int -> (JobLog -> m ()) -> m (m (), m (), m JobLog)
runJobLog Int
1 JobLog -> m ()
logStatus
              m ()
logRef
              ()
_ <- NodeId -> Maybe NodeId -> TabType -> Maybe Int -> m ()
forall env err (m :: * -> *).
FlowCmdM env err m =>
NodeId -> Maybe NodeId -> TabType -> Maybe Int -> m ()
Metrics.updatePie NodeId
cId (NodeId -> Maybe NodeId
forall a. a -> Maybe a
Just NodeId
listId) TabType
tabType Maybe Int
forall a. Maybe a
Nothing
              m ()
logRefSuccess

              m JobLog
getRef
            TabType
Institutes -> do
              -- printDebug "[tableNgramsPostChartsAsync] Institutes, updating Tree, cId" cId
              -- printDebug "[tableNgramsPostChartsAsync] updating tree StopTerm, cId" cId
              (m ()
logRef, m ()
logRefSuccess, m JobLog
getRef) <- Int -> (JobLog -> m ()) -> m (m (), m (), m JobLog)
forall (m :: * -> *).
MonadBase IO m =>
Int -> (JobLog -> m ()) -> m (m (), m (), m JobLog)
runJobLog Int
3 JobLog -> m ()
logStatus
              m ()
logRef
              ()
_ <- NodeId -> Maybe NodeId -> TabType -> ListType -> m ()
forall env err (m :: * -> *).
FlowCmdM env err m =>
NodeId -> Maybe NodeId -> TabType -> ListType -> m ()
Metrics.updateTree NodeId
cId (NodeId -> Maybe NodeId
forall a. a -> Maybe a
Just NodeId
listId) TabType
tabType ListType
StopTerm
              -- printDebug "[tableNgramsPostChartsAsync] updating tree CandidateTerm, cId" cId
              m ()
logRefSuccess
              ()
_ <- NodeId -> Maybe NodeId -> TabType -> ListType -> m ()
forall env err (m :: * -> *).
FlowCmdM env err m =>
NodeId -> Maybe NodeId -> TabType -> ListType -> m ()
Metrics.updateTree NodeId
cId (NodeId -> Maybe NodeId
forall a. a -> Maybe a
Just NodeId
listId) TabType
tabType ListType
CandidateTerm
              -- printDebug "[tableNgramsPostChartsAsync] updating tree MapTerm, cId" cId
              m ()
logRefSuccess
              ()
_ <- NodeId -> Maybe NodeId -> TabType -> ListType -> m ()
forall env err (m :: * -> *).
FlowCmdM env err m =>
NodeId -> Maybe NodeId -> TabType -> ListType -> m ()
Metrics.updateTree NodeId
cId (NodeId -> Maybe NodeId
forall a. a -> Maybe a
Just NodeId
listId) TabType
tabType ListType
MapTerm
              m ()
logRefSuccess

              m JobLog
getRef
            TabType
Sources -> do
              -- printDebug "[tableNgramsPostChartsAsync] Sources, updating chart, cId" cId
              (m ()
logRef, m ()
logRefSuccess, m JobLog
getRef) <- Int -> (JobLog -> m ()) -> m (m (), m (), m JobLog)
forall (m :: * -> *).
MonadBase IO m =>
Int -> (JobLog -> m ()) -> m (m (), m (), m JobLog)
runJobLog Int
1 JobLog -> m ()
logStatus
              m ()
logRef
              ()
_ <- NodeId -> Maybe NodeId -> TabType -> Maybe Int -> m ()
forall env err (m :: * -> *).
FlowCmdM env err m =>
NodeId -> Maybe NodeId -> TabType -> Maybe Int -> m ()
Metrics.updatePie NodeId
cId (NodeId -> Maybe NodeId
forall a. a -> Maybe a
Just NodeId
listId) TabType
tabType Maybe Int
forall a. Maybe a
Nothing
              m ()
logRefSuccess

              m JobLog
getRef
            TabType
Terms -> do
              -- printDebug "[tableNgramsPostChartsAsync] Terms, updating Metrics (Histo), cId" cId
              (m ()
logRef, m ()
logRefSuccess, m JobLog
getRef) <- Int -> (JobLog -> m ()) -> m (m (), m (), m JobLog)
forall (m :: * -> *).
MonadBase IO m =>
Int -> (JobLog -> m ()) -> m (m (), m (), m JobLog)
runJobLog Int
6 JobLog -> m ()
logStatus
              m ()
logRef
{-
              _ <- Metrics.updateChart cId (Just listId) tabType Nothing
              logRefSuccess
              _ <- Metrics.updatePie cId (Just listId) tabType Nothing
              logRefSuccess
              _ <- Metrics.updateScatter cId (Just listId) tabType Nothing
              logRefSuccess
              _ <- Metrics.updateTree cId (Just listId) tabType StopTerm
              logRefSuccess
              _ <- Metrics.updateTree cId (Just listId) tabType CandidateTerm
              logRefSuccess
              _ <- Metrics.updateTree cId (Just listId) tabType MapTerm
-}
              m ()
logRefSuccess

              m JobLog
getRef
            TabType
_ -> do
              [Char] -> TabType -> m ()
forall a (m :: * -> *).
(Show a, MonadBase IO m) =>
[Char] -> a -> m ()
printDebug [Char]
"[tableNgramsPostChartsAsync] no update for tabType = " TabType
tabType
              JobLog -> m JobLog
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JobLog -> m JobLog) -> JobLog -> m JobLog
forall a b. (a -> b) -> a -> b
$ JobLog -> JobLog
jobLogFail (JobLog -> JobLog) -> JobLog -> JobLog
forall a b. (a -> b) -> a -> b
$ Int -> JobLog
jobLogInit Int
1

  {-
  { _ne_list        :: ListType
  If we merge the parents/children we can potentially create cycles!
  , _ne_parent      :: Maybe NgramsTerm
  , _ne_children    :: MSet NgramsTerm
  }
  -}

getNgramsTableMap :: HasNodeStory env err m
                  => NodeId
                  -> TableNgrams.NgramsType
                  -> m (Versioned NgramsTableMap)
getNgramsTableMap :: NodeId
-> NgramsType -> m (Versioned (Map NgramsTerm NgramsRepoElement))
getNgramsTableMap NodeId
nodeId NgramsType
ngramsType = do
  MVar NodeListStory
v    <- [NodeId] -> m (MVar NodeListStory)
forall env err (m :: * -> *).
HasNodeStory env err m =>
[NodeId] -> m (MVar NodeListStory)
getNodeStoryVar [NodeId
nodeId]
  NodeListStory
repo <- IO NodeListStory -> m NodeListStory
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO NodeListStory -> m NodeListStory)
-> IO NodeListStory -> m NodeListStory
forall a b. (a -> b) -> a -> b
$ MVar NodeListStory -> IO NodeListStory
forall a. MVar a -> IO a
readMVar MVar NodeListStory
v
  Versioned (Map NgramsTerm NgramsRepoElement)
-> m (Versioned (Map NgramsTerm NgramsRepoElement))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Versioned (Map NgramsTerm NgramsRepoElement)
 -> m (Versioned (Map NgramsTerm NgramsRepoElement)))
-> Versioned (Map NgramsTerm NgramsRepoElement)
-> m (Versioned (Map NgramsTerm NgramsRepoElement))
forall a b. (a -> b) -> a -> b
$ Int
-> Map NgramsTerm NgramsRepoElement
-> Versioned (Map NgramsTerm NgramsRepoElement)
forall a1. Int -> a1 -> Versioned a1
Versioned (NodeListStory
repo NodeListStory -> Getting Int NodeListStory Int -> Int
forall s a. s -> Getting a s a -> a
^. (Map NodeId (Archive NgramsState' NgramsStatePatch')
 -> Const Int (Map NodeId (Archive NgramsState' NgramsStatePatch')))
-> NodeListStory -> Const Int NodeListStory
forall s1 p1 s2 p2.
Iso
  (NodeStory s1 p1)
  (NodeStory s2 p2)
  (Map NodeId (Archive s1 p1))
  (Map NodeId (Archive s2 p2))
unNodeStory ((Map NodeId (Archive NgramsState' NgramsStatePatch')
  -> Const Int (Map NodeId (Archive NgramsState' NgramsStatePatch')))
 -> NodeListStory -> Const Int NodeListStory)
-> ((Int -> Const Int Int)
    -> Map NodeId (Archive NgramsState' NgramsStatePatch')
    -> Const Int (Map NodeId (Archive NgramsState' NgramsStatePatch')))
-> Getting Int NodeListStory Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NodeId (Archive NgramsState' NgramsStatePatch'))
-> Lens'
     (Map NodeId (Archive NgramsState' NgramsStatePatch'))
     (Maybe
        (IxValue (Map NodeId (Archive NgramsState' NgramsStatePatch'))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NodeId (Archive NgramsState' NgramsStatePatch'))
NodeId
nodeId ((Maybe (Archive NgramsState' NgramsStatePatch')
  -> Const Int (Maybe (Archive NgramsState' NgramsStatePatch')))
 -> Map NodeId (Archive NgramsState' NgramsStatePatch')
 -> Const Int (Map NodeId (Archive NgramsState' NgramsStatePatch')))
-> ((Int -> Const Int Int)
    -> Maybe (Archive NgramsState' NgramsStatePatch')
    -> Const Int (Maybe (Archive NgramsState' NgramsStatePatch')))
-> (Int -> Const Int Int)
-> Map NodeId (Archive NgramsState' NgramsStatePatch')
-> Const Int (Map NodeId (Archive NgramsState' NgramsStatePatch'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Archive NgramsState' NgramsStatePatch'
 -> Const Int (Archive NgramsState' NgramsStatePatch'))
-> Maybe (Archive NgramsState' NgramsStatePatch')
-> Const Int (Maybe (Archive NgramsState' NgramsStatePatch'))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Archive NgramsState' NgramsStatePatch'
  -> Const Int (Archive NgramsState' NgramsStatePatch'))
 -> Maybe (Archive NgramsState' NgramsStatePatch')
 -> Const Int (Maybe (Archive NgramsState' NgramsStatePatch')))
-> ((Int -> Const Int Int)
    -> Archive NgramsState' NgramsStatePatch'
    -> Const Int (Archive NgramsState' NgramsStatePatch'))
-> (Int -> Const Int Int)
-> Maybe (Archive NgramsState' NgramsStatePatch')
-> Const Int (Maybe (Archive NgramsState' NgramsStatePatch'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int)
-> Archive NgramsState' NgramsStatePatch'
-> Const Int (Archive NgramsState' NgramsStatePatch')
forall s1 p. Lens' (Archive s1 p) Int
a_version)
                   (NodeListStory
repo NodeListStory
-> Getting
     (Map NgramsTerm NgramsRepoElement)
     NodeListStory
     (Map NgramsTerm NgramsRepoElement)
-> Map NgramsTerm NgramsRepoElement
forall s a. s -> Getting a s a -> a
^. (Map NodeId (Archive NgramsState' NgramsStatePatch')
 -> Const
      (Map NgramsTerm NgramsRepoElement)
      (Map NodeId (Archive NgramsState' NgramsStatePatch')))
-> NodeListStory
-> Const (Map NgramsTerm NgramsRepoElement) NodeListStory
forall s1 p1 s2 p2.
Iso
  (NodeStory s1 p1)
  (NodeStory s2 p2)
  (Map NodeId (Archive s1 p1))
  (Map NodeId (Archive s2 p2))
unNodeStory ((Map NodeId (Archive NgramsState' NgramsStatePatch')
  -> Const
       (Map NgramsTerm NgramsRepoElement)
       (Map NodeId (Archive NgramsState' NgramsStatePatch')))
 -> NodeListStory
 -> Const (Map NgramsTerm NgramsRepoElement) NodeListStory)
-> ((Map NgramsTerm NgramsRepoElement
     -> Const
          (Map NgramsTerm NgramsRepoElement)
          (Map NgramsTerm NgramsRepoElement))
    -> Map NodeId (Archive NgramsState' NgramsStatePatch')
    -> Const
         (Map NgramsTerm NgramsRepoElement)
         (Map NodeId (Archive NgramsState' NgramsStatePatch')))
-> Getting
     (Map NgramsTerm NgramsRepoElement)
     NodeListStory
     (Map NgramsTerm NgramsRepoElement)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NodeId (Archive NgramsState' NgramsStatePatch'))
-> Lens'
     (Map NodeId (Archive NgramsState' NgramsStatePatch'))
     (Maybe
        (IxValue (Map NodeId (Archive NgramsState' NgramsStatePatch'))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NodeId (Archive NgramsState' NgramsStatePatch'))
NodeId
nodeId ((Maybe (Archive NgramsState' NgramsStatePatch')
  -> Const
       (Map NgramsTerm NgramsRepoElement)
       (Maybe (Archive NgramsState' NgramsStatePatch')))
 -> Map NodeId (Archive NgramsState' NgramsStatePatch')
 -> Const
      (Map NgramsTerm NgramsRepoElement)
      (Map NodeId (Archive NgramsState' NgramsStatePatch')))
-> ((Map NgramsTerm NgramsRepoElement
     -> Const
          (Map NgramsTerm NgramsRepoElement)
          (Map NgramsTerm NgramsRepoElement))
    -> Maybe (Archive NgramsState' NgramsStatePatch')
    -> Const
         (Map NgramsTerm NgramsRepoElement)
         (Maybe (Archive NgramsState' NgramsStatePatch')))
-> (Map NgramsTerm NgramsRepoElement
    -> Const
         (Map NgramsTerm NgramsRepoElement)
         (Map NgramsTerm NgramsRepoElement))
-> Map NodeId (Archive NgramsState' NgramsStatePatch')
-> Const
     (Map NgramsTerm NgramsRepoElement)
     (Map NodeId (Archive NgramsState' NgramsStatePatch'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Archive NgramsState' NgramsStatePatch'
 -> Const
      (Map NgramsTerm NgramsRepoElement)
      (Archive NgramsState' NgramsStatePatch'))
-> Maybe (Archive NgramsState' NgramsStatePatch')
-> Const
     (Map NgramsTerm NgramsRepoElement)
     (Maybe (Archive NgramsState' NgramsStatePatch'))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Archive NgramsState' NgramsStatePatch'
  -> Const
       (Map NgramsTerm NgramsRepoElement)
       (Archive NgramsState' NgramsStatePatch'))
 -> Maybe (Archive NgramsState' NgramsStatePatch')
 -> Const
      (Map NgramsTerm NgramsRepoElement)
      (Maybe (Archive NgramsState' NgramsStatePatch')))
-> ((Map NgramsTerm NgramsRepoElement
     -> Const
          (Map NgramsTerm NgramsRepoElement)
          (Map NgramsTerm NgramsRepoElement))
    -> Archive NgramsState' NgramsStatePatch'
    -> Const
         (Map NgramsTerm NgramsRepoElement)
         (Archive NgramsState' NgramsStatePatch'))
-> (Map NgramsTerm NgramsRepoElement
    -> Const
         (Map NgramsTerm NgramsRepoElement)
         (Map NgramsTerm NgramsRepoElement))
-> Maybe (Archive NgramsState' NgramsStatePatch')
-> Const
     (Map NgramsTerm NgramsRepoElement)
     (Maybe (Archive NgramsState' NgramsStatePatch'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NgramsState'
 -> Const (Map NgramsTerm NgramsRepoElement) NgramsState')
-> Archive NgramsState' NgramsStatePatch'
-> Const
     (Map NgramsTerm NgramsRepoElement)
     (Archive NgramsState' NgramsStatePatch')
forall s1 p s2. Lens (Archive s1 p) (Archive s2 p) s1 s2
a_state ((NgramsState'
  -> Const (Map NgramsTerm NgramsRepoElement) NgramsState')
 -> Archive NgramsState' NgramsStatePatch'
 -> Const
      (Map NgramsTerm NgramsRepoElement)
      (Archive NgramsState' NgramsStatePatch'))
-> ((Map NgramsTerm NgramsRepoElement
     -> Const
          (Map NgramsTerm NgramsRepoElement)
          (Map NgramsTerm NgramsRepoElement))
    -> NgramsState'
    -> Const (Map NgramsTerm NgramsRepoElement) NgramsState')
-> (Map NgramsTerm NgramsRepoElement
    -> Const
         (Map NgramsTerm NgramsRepoElement)
         (Map NgramsTerm NgramsRepoElement))
-> Archive NgramsState' NgramsStatePatch'
-> Const
     (Map NgramsTerm NgramsRepoElement)
     (Archive NgramsState' NgramsStatePatch')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index NgramsState'
-> Lens' NgramsState' (Maybe (IxValue NgramsState'))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index NgramsState'
NgramsType
ngramsType ((Maybe (Map NgramsTerm NgramsRepoElement)
  -> Const
       (Map NgramsTerm NgramsRepoElement)
       (Maybe (Map NgramsTerm NgramsRepoElement)))
 -> NgramsState'
 -> Const (Map NgramsTerm NgramsRepoElement) NgramsState')
-> ((Map NgramsTerm NgramsRepoElement
     -> Const
          (Map NgramsTerm NgramsRepoElement)
          (Map NgramsTerm NgramsRepoElement))
    -> Maybe (Map NgramsTerm NgramsRepoElement)
    -> Const
         (Map NgramsTerm NgramsRepoElement)
         (Maybe (Map NgramsTerm NgramsRepoElement)))
-> (Map NgramsTerm NgramsRepoElement
    -> Const
         (Map NgramsTerm NgramsRepoElement)
         (Map NgramsTerm NgramsRepoElement))
-> NgramsState'
-> Const (Map NgramsTerm NgramsRepoElement) NgramsState'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map NgramsTerm NgramsRepoElement
 -> Const
      (Map NgramsTerm NgramsRepoElement)
      (Map NgramsTerm NgramsRepoElement))
-> Maybe (Map NgramsTerm NgramsRepoElement)
-> Const
     (Map NgramsTerm NgramsRepoElement)
     (Maybe (Map NgramsTerm NgramsRepoElement))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just)


dumpJsonTableMap :: HasNodeStory env err m
                 => Text
                 -> NodeId
                 -> TableNgrams.NgramsType
                 -> m ()
dumpJsonTableMap :: Text -> NodeId -> NgramsType -> m ()
dumpJsonTableMap Text
fpath NodeId
nodeId NgramsType
ngramsType = do
  Versioned (Map NgramsTerm NgramsRepoElement)
m <- NodeId
-> NgramsType -> m (Versioned (Map NgramsTerm NgramsRepoElement))
forall env err (m :: * -> *).
HasNodeStory env err m =>
NodeId
-> NgramsType -> m (Versioned (Map NgramsTerm NgramsRepoElement))
getNgramsTableMap NodeId
nodeId NgramsType
ngramsType
  IO () -> m ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text -> IO ()
DTL.writeFile (Text -> [Char]
unpack Text
fpath) (Versioned (Map NgramsTerm NgramsRepoElement) -> Text
forall a. ToJSON a => a -> Text
DAT.encodeToLazyText Versioned (Map NgramsTerm NgramsRepoElement)
m)
  () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()


type MinSize = Int
type MaxSize = Int

-- | TODO Errors management
--  TODO: polymorphic for Annuaire or Corpus or ...
-- | Table of Ngrams is a ListNgrams formatted (sorted and/or cut).
-- TODO: should take only one ListId


getTableNgrams :: forall env err m.
                  (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env, HasMail env)
               => NodeType -> NodeId -> TabType
               -> ListId -> Limit -> Maybe Offset
               -> Maybe ListType
               -> Maybe MinSize -> Maybe MaxSize
               -> Maybe OrderBy
               -> (NgramsTerm -> Bool)
               -> m (VersionedWithCount NgramsTable)
getTableNgrams :: NodeType
-> NodeId
-> TabType
-> NodeId
-> Int
-> Maybe Int
-> Maybe ListType
-> Maybe Int
-> Maybe Int
-> Maybe OrderBy
-> (NgramsTerm -> Bool)
-> m (VersionedWithCount NgramsTable)
getTableNgrams NodeType
_nType NodeId
nId TabType
tabType NodeId
listId Int
limit_ Maybe Int
offset
               Maybe ListType
listType Maybe Int
minSize Maybe Int
maxSize Maybe OrderBy
orderBy NgramsTerm -> Bool
searchQuery = do

  TimeSpec
t0 <- m TimeSpec
forall (m :: * -> *). MonadBase IO m => m TimeSpec
getTime
  -- lIds <- selectNodesWithUsername NodeList userMaster
  let
    ngramsType :: NgramsType
ngramsType = TabType -> NgramsType
ngramsTypeFromTabType TabType
tabType
    offset' :: Int
offset'  = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Int -> Int
forall a. a -> a
identity Maybe Int
offset
    listType' :: ListType -> Bool
listType' = (ListType -> Bool)
-> (ListType -> ListType -> Bool)
-> Maybe ListType
-> ListType
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> ListType -> Bool
forall a b. a -> b -> a
const Bool
True) ListType -> ListType -> Bool
forall a. Eq a => a -> a -> Bool
(==) Maybe ListType
listType
    minSize' :: Int -> Bool
minSize'  = (Int -> Bool) -> (Int -> Int -> Bool) -> Maybe Int -> Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> Int -> Bool
forall a b. a -> b -> a
const Bool
True) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<=) Maybe Int
minSize
    maxSize' :: Int -> Bool
maxSize'  = (Int -> Bool) -> (Int -> Int -> Bool) -> Maybe Int -> Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> Int -> Bool
forall a b. a -> b -> a
const Bool
True) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>=) Maybe Int
maxSize

    selected_node :: NgramsElement -> Bool
selected_node NgramsElement
n = Int -> Bool
minSize'     Int
s
                   Bool -> Bool -> Bool
&& Int -> Bool
maxSize'     Int
s
                   Bool -> Bool -> Bool
&& NgramsTerm -> Bool
searchQuery  (NgramsElement
n NgramsElement
-> Getting NgramsTerm NgramsElement NgramsTerm -> NgramsTerm
forall s a. s -> Getting a s a -> a
^. Getting NgramsTerm NgramsElement NgramsTerm
Lens' NgramsElement NgramsTerm
ne_ngrams)
                   Bool -> Bool -> Bool
&& ListType -> Bool
listType'    (NgramsElement
n NgramsElement
-> Getting ListType NgramsElement ListType -> ListType
forall s a. s -> Getting a s a -> a
^. Getting ListType NgramsElement ListType
Lens' NgramsElement ListType
ne_list)
      where
        s :: Int
s = NgramsElement
n NgramsElement -> Getting Int NgramsElement Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int NgramsElement Int
Lens' NgramsElement Int
ne_size

    selected_inner :: Set NgramsTerm -> NgramsElement -> Bool
selected_inner Set NgramsTerm
roots NgramsElement
n = Bool -> (NgramsTerm -> Bool) -> Maybe NgramsTerm -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (NgramsTerm -> Set NgramsTerm -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set NgramsTerm
roots) (NgramsElement
n NgramsElement
-> Getting (Maybe NgramsTerm) NgramsElement (Maybe NgramsTerm)
-> Maybe NgramsTerm
forall s a. s -> Getting a s a -> a
^. Getting (Maybe NgramsTerm) NgramsElement (Maybe NgramsTerm)
Lens' NgramsElement (Maybe NgramsTerm)
ne_root)

    ---------------------------------------
    sortOnOrder :: Maybe OrderBy -> [NgramsElement] -> [NgramsElement]
sortOnOrder Maybe OrderBy
Nothing = [NgramsElement] -> [NgramsElement]
forall a. a -> a
identity
    sortOnOrder (Just OrderBy
TermAsc)   = (NgramsElement -> NgramsTerm) -> [NgramsElement] -> [NgramsElement]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn ((NgramsElement -> NgramsTerm)
 -> [NgramsElement] -> [NgramsElement])
-> (NgramsElement -> NgramsTerm)
-> [NgramsElement]
-> [NgramsElement]
forall a b. (a -> b) -> a -> b
$ Getting NgramsTerm NgramsElement NgramsTerm
-> NgramsElement -> NgramsTerm
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting NgramsTerm NgramsElement NgramsTerm
Lens' NgramsElement NgramsTerm
ne_ngrams
    sortOnOrder (Just OrderBy
TermDesc)  = (NgramsElement -> Down NgramsTerm)
-> [NgramsElement] -> [NgramsElement]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn ((NgramsElement -> Down NgramsTerm)
 -> [NgramsElement] -> [NgramsElement])
-> (NgramsElement -> Down NgramsTerm)
-> [NgramsElement]
-> [NgramsElement]
forall a b. (a -> b) -> a -> b
$ NgramsTerm -> Down NgramsTerm
forall a. a -> Down a
Down (NgramsTerm -> Down NgramsTerm)
-> (NgramsElement -> NgramsTerm)
-> NgramsElement
-> Down NgramsTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting NgramsTerm NgramsElement NgramsTerm
-> NgramsElement -> NgramsTerm
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting NgramsTerm NgramsElement NgramsTerm
Lens' NgramsElement NgramsTerm
ne_ngrams
    sortOnOrder (Just OrderBy
ScoreAsc)  = (NgramsElement -> Int) -> [NgramsElement] -> [NgramsElement]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn ((NgramsElement -> Int) -> [NgramsElement] -> [NgramsElement])
-> (NgramsElement -> Int) -> [NgramsElement] -> [NgramsElement]
forall a b. (a -> b) -> a -> b
$ Getting Int NgramsElement Int -> NgramsElement -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int NgramsElement Int
Lens' NgramsElement Int
ne_occurrences
    sortOnOrder (Just OrderBy
ScoreDesc) = (NgramsElement -> Down Int) -> [NgramsElement] -> [NgramsElement]
forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn ((NgramsElement -> Down Int) -> [NgramsElement] -> [NgramsElement])
-> (NgramsElement -> Down Int)
-> [NgramsElement]
-> [NgramsElement]
forall a b. (a -> b) -> a -> b
$ Int -> Down Int
forall a. a -> Down a
Down (Int -> Down Int)
-> (NgramsElement -> Int) -> NgramsElement -> Down Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Int NgramsElement Int -> NgramsElement -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int NgramsElement Int
Lens' NgramsElement Int
ne_occurrences

    ---------------------------------------

    filteredNodes :: Map NgramsTerm NgramsElement -> [NgramsElement]
    filteredNodes :: Map NgramsTerm NgramsElement -> [NgramsElement]
filteredNodes Map NgramsTerm NgramsElement
tableMap = NgramsElement -> NgramsElement
rootOf (NgramsElement -> NgramsElement)
-> [NgramsElement] -> [NgramsElement]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NgramsElement]
list [NgramsElement]
-> ([NgramsElement] -> [NgramsElement]) -> [NgramsElement]
forall a b. a -> (a -> b) -> b
& (NgramsElement -> Bool) -> [NgramsElement] -> [NgramsElement]
forall a. (a -> Bool) -> [a] -> [a]
filter NgramsElement -> Bool
selected_node
      where
        rootOf :: NgramsElement -> NgramsElement
rootOf NgramsElement
ne = NgramsElement
-> (NgramsTerm -> NgramsElement)
-> Maybe NgramsTerm
-> NgramsElement
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NgramsElement
ne (\NgramsTerm
r -> NgramsElement -> Maybe NgramsElement -> NgramsElement
forall a. a -> Maybe a -> a
fromMaybe (Text -> NgramsElement
forall a. HasCallStack => Text -> a
panic Text
"getTableNgrams: invalid root")
                                              (Map NgramsTerm NgramsElement
tableMap Map NgramsTerm NgramsElement
-> Getting
     (Maybe NgramsElement)
     (Map NgramsTerm NgramsElement)
     (Maybe NgramsElement)
-> Maybe NgramsElement
forall s a. s -> Getting a s a -> a
^. Index (Map NgramsTerm NgramsElement)
-> Lens'
     (Map NgramsTerm NgramsElement)
     (Maybe (IxValue (Map NgramsTerm NgramsElement)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NgramsTerm NgramsElement)
NgramsTerm
r)
                             )
                             (NgramsElement
ne NgramsElement
-> Getting (Maybe NgramsTerm) NgramsElement (Maybe NgramsTerm)
-> Maybe NgramsTerm
forall s a. s -> Getting a s a -> a
^. Getting (Maybe NgramsTerm) NgramsElement (Maybe NgramsTerm)
Lens' NgramsElement (Maybe NgramsTerm)
ne_root)
        list :: [NgramsElement]
list = Map NgramsTerm NgramsElement
tableMap Map NgramsTerm NgramsElement
-> Getting
     (Endo [NgramsElement]) (Map NgramsTerm NgramsElement) NgramsElement
-> [NgramsElement]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting
  (Endo [NgramsElement]) (Map NgramsTerm NgramsElement) NgramsElement
forall s t a b. Each s t a b => Traversal s t a b
each

    ---------------------------------------
    selectAndPaginate :: Map NgramsTerm NgramsElement -> [NgramsElement]
    selectAndPaginate :: Map NgramsTerm NgramsElement -> [NgramsElement]
selectAndPaginate Map NgramsTerm NgramsElement
tableMap = [NgramsElement]
roots [NgramsElement] -> [NgramsElement] -> [NgramsElement]
forall a. Semigroup a => a -> a -> a
<> [NgramsElement]
inners
      where
        list :: [NgramsElement]
list = Map NgramsTerm NgramsElement
tableMap Map NgramsTerm NgramsElement
-> Getting
     (Endo [NgramsElement]) (Map NgramsTerm NgramsElement) NgramsElement
-> [NgramsElement]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting
  (Endo [NgramsElement]) (Map NgramsTerm NgramsElement) NgramsElement
forall s t a b. Each s t a b => Traversal s t a b
each
        rootOf :: NgramsElement -> NgramsElement
rootOf NgramsElement
ne = NgramsElement
-> (NgramsTerm -> NgramsElement)
-> Maybe NgramsTerm
-> NgramsElement
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NgramsElement
ne (\NgramsTerm
r -> NgramsElement -> Maybe NgramsElement -> NgramsElement
forall a. a -> Maybe a -> a
fromMaybe (Text -> NgramsElement
forall a. HasCallStack => Text -> a
panic Text
"getTableNgrams: invalid root")
                                              (Map NgramsTerm NgramsElement
tableMap Map NgramsTerm NgramsElement
-> Getting
     (Maybe NgramsElement)
     (Map NgramsTerm NgramsElement)
     (Maybe NgramsElement)
-> Maybe NgramsElement
forall s a. s -> Getting a s a -> a
^. Index (Map NgramsTerm NgramsElement)
-> Lens'
     (Map NgramsTerm NgramsElement)
     (Maybe (IxValue (Map NgramsTerm NgramsElement)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map NgramsTerm NgramsElement)
NgramsTerm
r)
                             )
                             (NgramsElement
ne NgramsElement
-> Getting (Maybe NgramsTerm) NgramsElement (Maybe NgramsTerm)
-> Maybe NgramsTerm
forall s a. s -> Getting a s a -> a
^. Getting (Maybe NgramsTerm) NgramsElement (Maybe NgramsTerm)
Lens' NgramsElement (Maybe NgramsTerm)
ne_root)
        selected_nodes :: [NgramsElement]
selected_nodes = [NgramsElement]
list [NgramsElement]
-> ([NgramsElement] -> [NgramsElement]) -> [NgramsElement]
forall a b. a -> (a -> b) -> b
& Int -> [NgramsElement] -> [NgramsElement]
forall a. Int -> [a] -> [a]
take Int
limit_
                              ([NgramsElement] -> [NgramsElement])
-> ([NgramsElement] -> [NgramsElement])
-> [NgramsElement]
-> [NgramsElement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [NgramsElement] -> [NgramsElement]
forall a. Int -> [a] -> [a]
drop Int
offset'
                              ([NgramsElement] -> [NgramsElement])
-> ([NgramsElement] -> [NgramsElement])
-> [NgramsElement]
-> [NgramsElement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NgramsElement -> Bool) -> [NgramsElement] -> [NgramsElement]
forall a. (a -> Bool) -> [a] -> [a]
filter NgramsElement -> Bool
selected_node
                              ([NgramsElement] -> [NgramsElement])
-> ([NgramsElement] -> [NgramsElement])
-> [NgramsElement]
-> [NgramsElement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe OrderBy -> [NgramsElement] -> [NgramsElement]
sortOnOrder Maybe OrderBy
orderBy
        roots :: [NgramsElement]
roots = NgramsElement -> NgramsElement
rootOf (NgramsElement -> NgramsElement)
-> [NgramsElement] -> [NgramsElement]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NgramsElement]
selected_nodes
        rootsSet :: Set NgramsTerm
rootsSet = [NgramsTerm] -> Set NgramsTerm
forall a. Ord a => [a] -> Set a
Set.fromList (NgramsElement -> NgramsTerm
_ne_ngrams (NgramsElement -> NgramsTerm) -> [NgramsElement] -> [NgramsTerm]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NgramsElement]
roots)
        inners :: [NgramsElement]
inners = [NgramsElement]
list [NgramsElement]
-> ([NgramsElement] -> [NgramsElement]) -> [NgramsElement]
forall a b. a -> (a -> b) -> b
& (NgramsElement -> Bool) -> [NgramsElement] -> [NgramsElement]
forall a. (a -> Bool) -> [a] -> [a]
filter (Set NgramsTerm -> NgramsElement -> Bool
selected_inner Set NgramsTerm
rootsSet)

    ---------------------------------------
    setScores :: forall t. Each t t NgramsElement NgramsElement => Bool -> t -> m t
    setScores :: Bool -> t -> m t
setScores Bool
False t
table = t -> m t
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
table
    setScores Bool
True  t
table = do
      let ngrams_terms :: [NgramsTerm]
ngrams_terms = t
table t -> Getting (Endo [NgramsTerm]) t NgramsTerm -> [NgramsTerm]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (NgramsElement -> Const (Endo [NgramsTerm]) NgramsElement)
-> t -> Const (Endo [NgramsTerm]) t
forall s t a b. Each s t a b => Traversal s t a b
each ((NgramsElement -> Const (Endo [NgramsTerm]) NgramsElement)
 -> t -> Const (Endo [NgramsTerm]) t)
-> ((NgramsTerm -> Const (Endo [NgramsTerm]) NgramsTerm)
    -> NgramsElement -> Const (Endo [NgramsTerm]) NgramsElement)
-> Getting (Endo [NgramsTerm]) t NgramsTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NgramsTerm -> Const (Endo [NgramsTerm]) NgramsTerm)
-> NgramsElement -> Const (Endo [NgramsTerm]) NgramsElement
Lens' NgramsElement NgramsTerm
ne_ngrams
      TimeSpec
t1 <- m TimeSpec
forall (m :: * -> *). MonadBase IO m => m TimeSpec
getTime
      HashMap NgramsTerm Int
occurrences <- NodeId
-> NodeId
-> NgramsType
-> [NgramsTerm]
-> Cmd err (HashMap NgramsTerm Int)
forall err.
NodeId
-> NodeId
-> NgramsType
-> [NgramsTerm]
-> Cmd err (HashMap NgramsTerm Int)
getOccByNgramsOnlyFast' NodeId
nId
                                             NodeId
listId
                                            NgramsType
ngramsType
                                            [NgramsTerm]
ngrams_terms
      TimeSpec
t2 <- m TimeSpec
forall (m :: * -> *). MonadBase IO m => m TimeSpec
getTime
      IO () -> m ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle
-> Format (IO ()) (Int -> TimeSpec -> TimeSpec -> IO ())
-> Int
-> TimeSpec
-> TimeSpec
-> IO ()
forall a. Handle -> Format (IO ()) a -> a
hprint Handle
stderr
        (Format
  (Int -> TimeSpec -> TimeSpec -> IO ())
  (Int -> TimeSpec -> TimeSpec -> IO ())
"getTableNgrams/setScores #ngrams=" Format
  (Int -> TimeSpec -> TimeSpec -> IO ())
  (Int -> TimeSpec -> TimeSpec -> IO ())
-> Format (IO ()) (Int -> TimeSpec -> TimeSpec -> IO ())
-> Format (IO ()) (Int -> TimeSpec -> TimeSpec -> IO ())
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format
  (TimeSpec -> TimeSpec -> IO ())
  (Int -> TimeSpec -> TimeSpec -> IO ())
forall a r. Integral a => Format r (a -> r)
int Format
  (TimeSpec -> TimeSpec -> IO ())
  (Int -> TimeSpec -> TimeSpec -> IO ())
-> Format (IO ()) (TimeSpec -> TimeSpec -> IO ())
-> Format (IO ()) (Int -> TimeSpec -> TimeSpec -> IO ())
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format
  (TimeSpec -> TimeSpec -> IO ()) (TimeSpec -> TimeSpec -> IO ())
" time=" Format
  (TimeSpec -> TimeSpec -> IO ()) (TimeSpec -> TimeSpec -> IO ())
-> Format (IO ()) (TimeSpec -> TimeSpec -> IO ())
-> Format (IO ()) (TimeSpec -> TimeSpec -> IO ())
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (IO ()) (TimeSpec -> TimeSpec -> IO ())
forall r. Format r (TimeSpec -> TimeSpec -> r)
hasTime Format (IO ()) (TimeSpec -> TimeSpec -> IO ())
-> Format (IO ()) (IO ())
-> Format (IO ()) (TimeSpec -> TimeSpec -> IO ())
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (IO ()) (IO ())
"\n")
        ([NgramsTerm] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NgramsTerm]
ngrams_terms) TimeSpec
t1 TimeSpec
t2
      {-
      occurrences <- getOccByNgramsOnlySlow nType nId
                                            (lIds <> [listId])
                                            ngramsType
                                            ngrams_terms
      -}
      let
        setOcc :: NgramsElement -> NgramsElement
setOcc NgramsElement
ne = NgramsElement
ne NgramsElement -> (NgramsElement -> NgramsElement) -> NgramsElement
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> NgramsElement -> Identity NgramsElement
Lens' NgramsElement Int
ne_occurrences ((Int -> Identity Int) -> NgramsElement -> Identity NgramsElement)
-> Int -> NgramsElement -> NgramsElement
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Getting (Endo (Endo Int)) (HashMap NgramsTerm Int) Int
-> HashMap NgramsTerm Int -> Int
forall a s. Num a => Getting (Endo (Endo a)) s a -> s -> a
sumOf (Index (HashMap NgramsTerm Int)
-> Lens'
     (HashMap NgramsTerm Int) (Maybe (IxValue (HashMap NgramsTerm Int)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (NgramsElement
ne NgramsElement
-> Getting NgramsTerm NgramsElement NgramsTerm -> NgramsTerm
forall s a. s -> Getting a s a -> a
^. Getting NgramsTerm NgramsElement NgramsTerm
Lens' NgramsElement NgramsTerm
ne_ngrams) ((Maybe Int -> Const (Endo (Endo Int)) (Maybe Int))
 -> HashMap NgramsTerm Int
 -> Const (Endo (Endo Int)) (HashMap NgramsTerm Int))
-> ((Int -> Const (Endo (Endo Int)) Int)
    -> Maybe Int -> Const (Endo (Endo Int)) (Maybe Int))
-> Getting (Endo (Endo Int)) (HashMap NgramsTerm Int) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const (Endo (Endo Int)) Int)
-> Maybe Int -> Const (Endo (Endo Int)) (Maybe Int)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just) HashMap NgramsTerm Int
occurrences

      t -> m t
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> m t) -> t -> m t
forall a b. (a -> b) -> a -> b
$ t
table t -> (t -> t) -> t
forall a b. a -> (a -> b) -> b
& (NgramsElement -> Identity NgramsElement) -> t -> Identity t
forall s t a b. Each s t a b => Traversal s t a b
each ((NgramsElement -> Identity NgramsElement) -> t -> Identity t)
-> (NgramsElement -> NgramsElement) -> t -> t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ NgramsElement -> NgramsElement
setOcc
    ---------------------------------------

  -- lists <- catMaybes <$> listsWith userMaster
  -- trace (show lists) $
  -- getNgramsTableMap ({-lists <>-} listIds) ngramsType


  let scoresNeeded :: Bool
scoresNeeded = Maybe OrderBy -> Bool
needsScores Maybe OrderBy
orderBy
  Versioned (Map NgramsTerm NgramsRepoElement)
tableMap1 <- NodeId
-> NgramsType -> m (Versioned (Map NgramsTerm NgramsRepoElement))
forall env err (m :: * -> *).
HasNodeStory env err m =>
NodeId
-> NgramsType -> m (Versioned (Map NgramsTerm NgramsRepoElement))
getNgramsTableMap NodeId
listId NgramsType
ngramsType
  TimeSpec
t1 <- m TimeSpec
forall (m :: * -> *). MonadBase IO m => m TimeSpec
getTime
  Versioned (Map NgramsTerm NgramsElement)
tableMap2 <- Versioned (Map NgramsTerm NgramsRepoElement)
tableMap1 Versioned (Map NgramsTerm NgramsRepoElement)
-> (Versioned (Map NgramsTerm NgramsRepoElement)
    -> m (Versioned (Map NgramsTerm NgramsElement)))
-> m (Versioned (Map NgramsTerm NgramsElement))
forall a b. a -> (a -> b) -> b
& (Map NgramsTerm NgramsRepoElement
 -> m (Map NgramsTerm NgramsElement))
-> Versioned (Map NgramsTerm NgramsRepoElement)
-> m (Versioned (Map NgramsTerm NgramsElement))
forall a1 a2. Lens (Versioned a1) (Versioned a2) a1 a2
v_data ((Map NgramsTerm NgramsRepoElement
  -> m (Map NgramsTerm NgramsElement))
 -> Versioned (Map NgramsTerm NgramsRepoElement)
 -> m (Versioned (Map NgramsTerm NgramsElement)))
-> (Map NgramsTerm NgramsRepoElement
    -> m (Map NgramsTerm NgramsElement))
-> Versioned (Map NgramsTerm NgramsRepoElement)
-> m (Versioned (Map NgramsTerm NgramsElement))
forall k (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ Bool
-> Map NgramsTerm NgramsElement -> m (Map NgramsTerm NgramsElement)
forall t. Each t t NgramsElement NgramsElement => Bool -> t -> m t
setScores Bool
scoresNeeded
                                    (Map NgramsTerm NgramsElement -> m (Map NgramsTerm NgramsElement))
-> (Map NgramsTerm NgramsRepoElement
    -> Map NgramsTerm NgramsElement)
-> Map NgramsTerm NgramsRepoElement
-> m (Map NgramsTerm NgramsElement)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NgramsTerm -> NgramsRepoElement -> NgramsElement)
-> Map NgramsTerm NgramsRepoElement -> Map NgramsTerm NgramsElement
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey NgramsTerm -> NgramsRepoElement -> NgramsElement
ngramsElementFromRepo

  Versioned NgramsTable
fltr <- Versioned (Map NgramsTerm NgramsElement)
tableMap2 Versioned (Map NgramsTerm NgramsElement)
-> (Versioned (Map NgramsTerm NgramsElement)
    -> m (Versioned NgramsTable))
-> m (Versioned NgramsTable)
forall a b. a -> (a -> b) -> b
& (Map NgramsTerm NgramsElement -> m NgramsTable)
-> Versioned (Map NgramsTerm NgramsElement)
-> m (Versioned NgramsTable)
forall a1 a2. Lens (Versioned a1) (Versioned a2) a1 a2
v_data ((Map NgramsTerm NgramsElement -> m NgramsTable)
 -> Versioned (Map NgramsTerm NgramsElement)
 -> m (Versioned NgramsTable))
-> (Map NgramsTerm NgramsElement -> m NgramsTable)
-> Versioned (Map NgramsTerm NgramsElement)
-> m (Versioned NgramsTable)
forall k (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ ([NgramsElement] -> NgramsTable)
-> m [NgramsElement] -> m NgramsTable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [NgramsElement] -> NgramsTable
NgramsTable (m [NgramsElement] -> m NgramsTable)
-> (Map NgramsTerm NgramsElement -> m [NgramsElement])
-> Map NgramsTerm NgramsElement
-> m NgramsTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [NgramsElement] -> m [NgramsElement]
forall t. Each t t NgramsElement NgramsElement => Bool -> t -> m t
setScores (Bool -> Bool
not Bool
scoresNeeded)
                                                  ([NgramsElement] -> m [NgramsElement])
-> (Map NgramsTerm NgramsElement -> [NgramsElement])
-> Map NgramsTerm NgramsElement
-> m [NgramsElement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map NgramsTerm NgramsElement -> [NgramsElement]
filteredNodes
  let fltrCount :: Int
fltrCount = [NgramsElement] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([NgramsElement] -> Int) -> [NgramsElement] -> Int
forall a b. (a -> b) -> a -> b
$ Versioned NgramsTable
fltr Versioned NgramsTable
-> Getting [NgramsElement] (Versioned NgramsTable) [NgramsElement]
-> [NgramsElement]
forall s a. s -> Getting a s a -> a
^. (NgramsTable -> Const [NgramsElement] NgramsTable)
-> Versioned NgramsTable
-> Const [NgramsElement] (Versioned NgramsTable)
forall a1 a2. Lens (Versioned a1) (Versioned a2) a1 a2
v_data ((NgramsTable -> Const [NgramsElement] NgramsTable)
 -> Versioned NgramsTable
 -> Const [NgramsElement] (Versioned NgramsTable))
-> (([NgramsElement] -> Const [NgramsElement] [NgramsElement])
    -> NgramsTable -> Const [NgramsElement] NgramsTable)
-> Getting [NgramsElement] (Versioned NgramsTable) [NgramsElement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([NgramsElement] -> Const [NgramsElement] [NgramsElement])
-> NgramsTable -> Const [NgramsElement] NgramsTable
Iso' NgramsTable [NgramsElement]
_NgramsTable

  TimeSpec
t2 <- m TimeSpec
forall (m :: * -> *). MonadBase IO m => m TimeSpec
getTime
  Versioned NgramsTable
tableMap3 <- Versioned (Map NgramsTerm NgramsElement)
tableMap2 Versioned (Map NgramsTerm NgramsElement)
-> (Versioned (Map NgramsTerm NgramsElement)
    -> m (Versioned NgramsTable))
-> m (Versioned NgramsTable)
forall a b. a -> (a -> b) -> b
& (Map NgramsTerm NgramsElement -> m NgramsTable)
-> Versioned (Map NgramsTerm NgramsElement)
-> m (Versioned NgramsTable)
forall a1 a2. Lens (Versioned a1) (Versioned a2) a1 a2
v_data ((Map NgramsTerm NgramsElement -> m NgramsTable)
 -> Versioned (Map NgramsTerm NgramsElement)
 -> m (Versioned NgramsTable))
-> (Map NgramsTerm NgramsElement -> m NgramsTable)
-> Versioned (Map NgramsTerm NgramsElement)
-> m (Versioned NgramsTable)
forall k (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ ([NgramsElement] -> NgramsTable)
-> m [NgramsElement] -> m NgramsTable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [NgramsElement] -> NgramsTable
NgramsTable
                                    (m [NgramsElement] -> m NgramsTable)
-> (Map NgramsTerm NgramsElement -> m [NgramsElement])
-> Map NgramsTerm NgramsElement
-> m NgramsTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [NgramsElement] -> m [NgramsElement]
forall t. Each t t NgramsElement NgramsElement => Bool -> t -> m t
setScores (Bool -> Bool
not Bool
scoresNeeded)
                                    ([NgramsElement] -> m [NgramsElement])
-> (Map NgramsTerm NgramsElement -> [NgramsElement])
-> Map NgramsTerm NgramsElement
-> m [NgramsElement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map NgramsTerm NgramsElement -> [NgramsElement]
selectAndPaginate
  TimeSpec
t3 <- m TimeSpec
forall (m :: * -> *). MonadBase IO m => m TimeSpec
getTime
  IO () -> m ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle
-> Format
     (IO ())
     (TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> IO ())
-> TimeSpec
-> TimeSpec
-> TimeSpec
-> TimeSpec
-> TimeSpec
-> TimeSpec
-> TimeSpec
-> TimeSpec
-> IO ()
forall a. Handle -> Format (IO ()) a -> a
hprint Handle
stderr
            (Format
  (TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> IO ())
  (TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> IO ())
"getTableNgrams total=" Format
  (TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> IO ())
  (TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> IO ())
-> Format
     (IO ())
     (TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> IO ())
-> Format
     (IO ())
     (TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> IO ())
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format
  (TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> IO ())
  (TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> IO ())
forall r. Format r (TimeSpec -> TimeSpec -> r)
hasTime
                          Format
  (TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> IO ())
  (TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> IO ())
-> Format
     (IO ())
     (TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> IO ())
-> Format
     (IO ())
     (TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> IO ())
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format
  (TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> IO ())
  (TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> IO ())
" map1=" Format
  (TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> IO ())
  (TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> IO ())
-> Format
     (IO ())
     (TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> IO ())
-> Format
     (IO ())
     (TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> IO ())
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format
  (TimeSpec -> TimeSpec -> TimeSpec -> TimeSpec -> IO ())
  (TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> IO ())
forall r. Format r (TimeSpec -> TimeSpec -> r)
hasTime
                          Format
  (TimeSpec -> TimeSpec -> TimeSpec -> TimeSpec -> IO ())
  (TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> TimeSpec
   -> IO ())
-> Format
     (IO ()) (TimeSpec -> TimeSpec -> TimeSpec -> TimeSpec -> IO ())
-> Format
     (IO ())
     (TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> TimeSpec
      -> IO ())
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format
  (TimeSpec -> TimeSpec -> TimeSpec -> TimeSpec -> IO ())
  (TimeSpec -> TimeSpec -> TimeSpec -> TimeSpec -> IO ())
" map2=" Format
  (TimeSpec -> TimeSpec -> TimeSpec -> TimeSpec -> IO ())
  (TimeSpec -> TimeSpec -> TimeSpec -> TimeSpec -> IO ())
-> Format
     (IO ()) (TimeSpec -> TimeSpec -> TimeSpec -> TimeSpec -> IO ())
-> Format
     (IO ()) (TimeSpec -> TimeSpec -> TimeSpec -> TimeSpec -> IO ())
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format
  (TimeSpec -> TimeSpec -> IO ())
  (TimeSpec -> TimeSpec -> TimeSpec -> TimeSpec -> IO ())
forall r. Format r (TimeSpec -> TimeSpec -> r)
hasTime
                          Format
  (TimeSpec -> TimeSpec -> IO ())
  (TimeSpec -> TimeSpec -> TimeSpec -> TimeSpec -> IO ())
-> Format (IO ()) (TimeSpec -> TimeSpec -> IO ())
-> Format
     (IO ()) (TimeSpec -> TimeSpec -> TimeSpec -> TimeSpec -> IO ())
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format
  (TimeSpec -> TimeSpec -> IO ()) (TimeSpec -> TimeSpec -> IO ())
" map3=" Format
  (TimeSpec -> TimeSpec -> IO ()) (TimeSpec -> TimeSpec -> IO ())
-> Format (IO ()) (TimeSpec -> TimeSpec -> IO ())
-> Format (IO ()) (TimeSpec -> TimeSpec -> IO ())
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (IO ()) (TimeSpec -> TimeSpec -> IO ())
forall r. Format r (TimeSpec -> TimeSpec -> r)
hasTime
                          Format (IO ()) (TimeSpec -> TimeSpec -> IO ())
-> Format (IO ()) (IO ())
-> Format (IO ()) (TimeSpec -> TimeSpec -> IO ())
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (IO ()) (IO ())
" sql="  Format (IO ()) (IO ())
-> Format (IO ()) (IO ()) -> Format (IO ()) (IO ())
forall r a r'. Format r a -> Format r' r -> Format r' a
% (if Bool
scoresNeeded then Format (IO ()) (IO ())
"map2" else Format (IO ()) (IO ())
"map3")
                          Format (IO ()) (IO ())
-> Format (IO ()) (IO ()) -> Format (IO ()) (IO ())
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (IO ()) (IO ())
"\n"
            ) TimeSpec
t0 TimeSpec
t3 TimeSpec
t0 TimeSpec
t1 TimeSpec
t1 TimeSpec
t2 TimeSpec
t2 TimeSpec
t3
  VersionedWithCount NgramsTable
-> m (VersionedWithCount NgramsTable)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VersionedWithCount NgramsTable
 -> m (VersionedWithCount NgramsTable))
-> VersionedWithCount NgramsTable
-> m (VersionedWithCount NgramsTable)
forall a b. (a -> b) -> a -> b
$ Int -> Versioned NgramsTable -> VersionedWithCount NgramsTable
forall a. Int -> Versioned a -> VersionedWithCount a
toVersionedWithCount Int
fltrCount Versioned NgramsTable
tableMap3



scoresRecomputeTableNgrams :: forall env err m.
  (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env, HasMail env)
  => NodeId -> TabType -> ListId -> m Int
scoresRecomputeTableNgrams :: NodeId -> TabType -> NodeId -> m Int
scoresRecomputeTableNgrams NodeId
nId TabType
tabType NodeId
listId = do
  Versioned (Map NgramsTerm NgramsRepoElement)
tableMap <- NodeId
-> NgramsType -> m (Versioned (Map NgramsTerm NgramsRepoElement))
forall env err (m :: * -> *).
HasNodeStory env err m =>
NodeId
-> NgramsType -> m (Versioned (Map NgramsTerm NgramsRepoElement))
getNgramsTableMap NodeId
listId NgramsType
ngramsType
  Versioned (Map NgramsTerm NgramsElement)
_ <- Versioned (Map NgramsTerm NgramsRepoElement)
tableMap Versioned (Map NgramsTerm NgramsRepoElement)
-> (Versioned (Map NgramsTerm NgramsRepoElement)
    -> m (Versioned (Map NgramsTerm NgramsElement)))
-> m (Versioned (Map NgramsTerm NgramsElement))
forall a b. a -> (a -> b) -> b
& (Map NgramsTerm NgramsRepoElement
 -> m (Map NgramsTerm NgramsElement))
-> Versioned (Map NgramsTerm NgramsRepoElement)
-> m (Versioned (Map NgramsTerm NgramsElement))
forall a1 a2. Lens (Versioned a1) (Versioned a2) a1 a2
v_data ((Map NgramsTerm NgramsRepoElement
  -> m (Map NgramsTerm NgramsElement))
 -> Versioned (Map NgramsTerm NgramsRepoElement)
 -> m (Versioned (Map NgramsTerm NgramsElement)))
-> (Map NgramsTerm NgramsRepoElement
    -> m (Map NgramsTerm NgramsElement))
-> Versioned (Map NgramsTerm NgramsRepoElement)
-> m (Versioned (Map NgramsTerm NgramsElement))
forall k (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ Map NgramsTerm NgramsElement -> m (Map NgramsTerm NgramsElement)
forall t. Each t t NgramsElement NgramsElement => t -> m t
setScores
                           (Map NgramsTerm NgramsElement -> m (Map NgramsTerm NgramsElement))
-> (Map NgramsTerm NgramsRepoElement
    -> Map NgramsTerm NgramsElement)
-> Map NgramsTerm NgramsRepoElement
-> m (Map NgramsTerm NgramsElement)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NgramsTerm -> NgramsRepoElement -> NgramsElement)
-> Map NgramsTerm NgramsRepoElement -> Map NgramsTerm NgramsElement
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey NgramsTerm -> NgramsRepoElement -> NgramsElement
ngramsElementFromRepo

  Int -> m Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$ Int
1
  where
    ngramsType :: NgramsType
ngramsType = TabType -> NgramsType
ngramsTypeFromTabType TabType
tabType

    setScores :: forall t. Each t t NgramsElement NgramsElement => t -> m t
    setScores :: t -> m t
setScores t
table = do
      let ngrams_terms :: [NgramsTerm]
ngrams_terms = t
table t -> Getting (Endo [NgramsTerm]) t NgramsTerm -> [NgramsTerm]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (NgramsElement -> Const (Endo [NgramsTerm]) NgramsElement)
-> t -> Const (Endo [NgramsTerm]) t
forall s t a b. Each s t a b => Traversal s t a b
each ((NgramsElement -> Const (Endo [NgramsTerm]) NgramsElement)
 -> t -> Const (Endo [NgramsTerm]) t)
-> ((NgramsTerm -> Const (Endo [NgramsTerm]) NgramsTerm)
    -> NgramsElement -> Const (Endo [NgramsTerm]) NgramsElement)
-> Getting (Endo [NgramsTerm]) t NgramsTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NgramsTerm -> Const (Endo [NgramsTerm]) NgramsTerm)
-> NgramsElement -> Const (Endo [NgramsTerm]) NgramsElement
Lens' NgramsElement NgramsTerm
ne_ngrams
      HashMap NgramsTerm Int
occurrences <- NodeId
-> NodeId
-> NgramsType
-> [NgramsTerm]
-> Cmd err (HashMap NgramsTerm Int)
forall err.
NodeId
-> NodeId
-> NgramsType
-> [NgramsTerm]
-> Cmd err (HashMap NgramsTerm Int)
getOccByNgramsOnlyFast' NodeId
nId
                                             NodeId
listId
                                            NgramsType
ngramsType
                                            [NgramsTerm]
ngrams_terms
      let
        setOcc :: NgramsElement -> NgramsElement
setOcc NgramsElement
ne = NgramsElement
ne NgramsElement -> (NgramsElement -> NgramsElement) -> NgramsElement
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> NgramsElement -> Identity NgramsElement
Lens' NgramsElement Int
ne_occurrences ((Int -> Identity Int) -> NgramsElement -> Identity NgramsElement)
-> Int -> NgramsElement -> NgramsElement
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Getting (Endo (Endo Int)) (HashMap NgramsTerm Int) Int
-> HashMap NgramsTerm Int -> Int
forall a s. Num a => Getting (Endo (Endo a)) s a -> s -> a
sumOf (Index (HashMap NgramsTerm Int)
-> Lens'
     (HashMap NgramsTerm Int) (Maybe (IxValue (HashMap NgramsTerm Int)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (NgramsElement
ne NgramsElement
-> Getting NgramsTerm NgramsElement NgramsTerm -> NgramsTerm
forall s a. s -> Getting a s a -> a
^. Getting NgramsTerm NgramsElement NgramsTerm
Lens' NgramsElement NgramsTerm
ne_ngrams) ((Maybe Int -> Const (Endo (Endo Int)) (Maybe Int))
 -> HashMap NgramsTerm Int
 -> Const (Endo (Endo Int)) (HashMap NgramsTerm Int))
-> ((Int -> Const (Endo (Endo Int)) Int)
    -> Maybe Int -> Const (Endo (Endo Int)) (Maybe Int))
-> Getting (Endo (Endo Int)) (HashMap NgramsTerm Int) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const (Endo (Endo Int)) Int)
-> Maybe Int -> Const (Endo (Endo Int)) (Maybe Int)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just) HashMap NgramsTerm Int
occurrences

      t -> m t
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> m t) -> t -> m t
forall a b. (a -> b) -> a -> b
$ t
table t -> (t -> t) -> t
forall a b. a -> (a -> b) -> b
& (NgramsElement -> Identity NgramsElement) -> t -> Identity t
forall s t a b. Each s t a b => Traversal s t a b
each ((NgramsElement -> Identity NgramsElement) -> t -> Identity t)
-> (NgramsElement -> NgramsElement) -> t -> t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ NgramsElement -> NgramsElement
setOcc




-- APIs

-- TODO: find a better place for the code above, All APIs stay here

data OrderBy = TermAsc | TermDesc | ScoreAsc | ScoreDesc
             deriving ((forall x. OrderBy -> Rep OrderBy x)
-> (forall x. Rep OrderBy x -> OrderBy) -> Generic OrderBy
forall x. Rep OrderBy x -> OrderBy
forall x. OrderBy -> Rep OrderBy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OrderBy x -> OrderBy
$cfrom :: forall x. OrderBy -> Rep OrderBy x
Generic, Int -> OrderBy
OrderBy -> Int
OrderBy -> [OrderBy]
OrderBy -> OrderBy
OrderBy -> OrderBy -> [OrderBy]
OrderBy -> OrderBy -> OrderBy -> [OrderBy]
(OrderBy -> OrderBy)
-> (OrderBy -> OrderBy)
-> (Int -> OrderBy)
-> (OrderBy -> Int)
-> (OrderBy -> [OrderBy])
-> (OrderBy -> OrderBy -> [OrderBy])
-> (OrderBy -> OrderBy -> [OrderBy])
-> (OrderBy -> OrderBy -> OrderBy -> [OrderBy])
-> Enum OrderBy
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: OrderBy -> OrderBy -> OrderBy -> [OrderBy]
$cenumFromThenTo :: OrderBy -> OrderBy -> OrderBy -> [OrderBy]
enumFromTo :: OrderBy -> OrderBy -> [OrderBy]
$cenumFromTo :: OrderBy -> OrderBy -> [OrderBy]
enumFromThen :: OrderBy -> OrderBy -> [OrderBy]
$cenumFromThen :: OrderBy -> OrderBy -> [OrderBy]
enumFrom :: OrderBy -> [OrderBy]
$cenumFrom :: OrderBy -> [OrderBy]
fromEnum :: OrderBy -> Int
$cfromEnum :: OrderBy -> Int
toEnum :: Int -> OrderBy
$ctoEnum :: Int -> OrderBy
pred :: OrderBy -> OrderBy
$cpred :: OrderBy -> OrderBy
succ :: OrderBy -> OrderBy
$csucc :: OrderBy -> OrderBy
Enum, OrderBy
OrderBy -> OrderBy -> Bounded OrderBy
forall a. a -> a -> Bounded a
maxBound :: OrderBy
$cmaxBound :: OrderBy
minBound :: OrderBy
$cminBound :: OrderBy
Bounded, ReadPrec [OrderBy]
ReadPrec OrderBy
Int -> ReadS OrderBy
ReadS [OrderBy]
(Int -> ReadS OrderBy)
-> ReadS [OrderBy]
-> ReadPrec OrderBy
-> ReadPrec [OrderBy]
-> Read OrderBy
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OrderBy]
$creadListPrec :: ReadPrec [OrderBy]
readPrec :: ReadPrec OrderBy
$creadPrec :: ReadPrec OrderBy
readList :: ReadS [OrderBy]
$creadList :: ReadS [OrderBy]
readsPrec :: Int -> ReadS OrderBy
$creadsPrec :: Int -> ReadS OrderBy
Read, Int -> OrderBy -> ShowS
[OrderBy] -> ShowS
OrderBy -> [Char]
(Int -> OrderBy -> ShowS)
-> (OrderBy -> [Char]) -> ([OrderBy] -> ShowS) -> Show OrderBy
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [OrderBy] -> ShowS
$cshowList :: [OrderBy] -> ShowS
show :: OrderBy -> [Char]
$cshow :: OrderBy -> [Char]
showsPrec :: Int -> OrderBy -> ShowS
$cshowsPrec :: Int -> OrderBy -> ShowS
Show)

instance FromHttpApiData OrderBy
  where
    parseUrlPiece :: Text -> Either Text OrderBy
parseUrlPiece Text
"TermAsc"   = OrderBy -> Either Text OrderBy
forall (f :: * -> *) a. Applicative f => a -> f a
pure OrderBy
TermAsc
    parseUrlPiece Text
"TermDesc"  = OrderBy -> Either Text OrderBy
forall (f :: * -> *) a. Applicative f => a -> f a
pure OrderBy
TermDesc
    parseUrlPiece Text
"ScoreAsc"  = OrderBy -> Either Text OrderBy
forall (f :: * -> *) a. Applicative f => a -> f a
pure OrderBy
ScoreAsc
    parseUrlPiece Text
"ScoreDesc" = OrderBy -> Either Text OrderBy
forall (f :: * -> *) a. Applicative f => a -> f a
pure OrderBy
ScoreDesc
    parseUrlPiece Text
_           = Text -> Either Text OrderBy
forall a b. a -> Either a b
Left Text
"Unexpected value of OrderBy"


instance ToParamSchema OrderBy
instance FromJSON  OrderBy
instance ToJSON    OrderBy
instance ToSchema  OrderBy
instance Arbitrary OrderBy
  where
    arbitrary :: Gen OrderBy
arbitrary = [OrderBy] -> Gen OrderBy
forall a. [a] -> Gen a
elements [OrderBy
forall a. Bounded a => a
minBound..OrderBy
forall a. Bounded a => a
maxBound]

needsScores :: Maybe OrderBy -> Bool
needsScores :: Maybe OrderBy -> Bool
needsScores (Just OrderBy
ScoreAsc)  = Bool
True
needsScores (Just OrderBy
ScoreDesc) = Bool
True
needsScores Maybe OrderBy
_ = Bool
False

type TableNgramsApiGet = Summary " Table Ngrams API Get"
                      :> QueryParamR "ngramsType"  TabType
                      :> QueryParamR "list"        ListId
                      :> QueryParamR "limit"       Limit
                      :> QueryParam  "offset"      Offset
                      :> QueryParam  "listType"    ListType
                      :> QueryParam  "minTermSize" MinSize
                      :> QueryParam  "maxTermSize" MaxSize
                      :> QueryParam  "orderBy"     OrderBy
                      :> QueryParam  "search"      Text
                      :> Get    '[JSON] (VersionedWithCount NgramsTable)

type TableNgramsApiPut = Summary " Table Ngrams API Change"
                       :> QueryParamR "ngramsType" TabType
                       :> QueryParamR "list"       ListId
                       :> ReqBody '[JSON] (Versioned NgramsTablePatch)
                       :> Put     '[JSON] (Versioned NgramsTablePatch)

type RecomputeScoresNgramsApiGet = Summary " Recompute scores for ngrams table"
                       :> QueryParamR "ngramsType"  TabType
                       :> QueryParamR "list"        ListId
                       :> "recompute" :> Post '[JSON] Int

type TableNgramsApiGetVersion = Summary " Table Ngrams API Get Version"
                      :> QueryParamR "ngramsType"  TabType
                      :> QueryParamR "list"        ListId
                      :> Get    '[JSON] Version

type TableNgramsApi =  TableNgramsApiGet
                  :<|> TableNgramsApiPut
                  :<|> RecomputeScoresNgramsApiGet
                  :<|> "version" :> TableNgramsApiGetVersion
                  :<|> TableNgramsAsyncApi

type TableNgramsAsyncApi = Summary "Table Ngrams Async API"
                           :> "async"
                           :> "charts"
                           :> "update"
                           :> AsyncJobs JobLog '[JSON] UpdateTableNgramsCharts JobLog

getTableNgramsCorpus :: (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env, HasMail env)
               => NodeId
               -> TabType
               -> ListId
               -> Limit
               -> Maybe Offset
               -> Maybe ListType
               -> Maybe MinSize -> Maybe MaxSize
               -> Maybe OrderBy
               -> Maybe Text -- full text search
               -> m (VersionedWithCount NgramsTable)
getTableNgramsCorpus :: NodeId
-> TabType
-> NodeId
-> Int
-> Maybe Int
-> Maybe ListType
-> Maybe Int
-> Maybe Int
-> Maybe OrderBy
-> Maybe Text
-> m (VersionedWithCount NgramsTable)
getTableNgramsCorpus NodeId
nId TabType
tabType NodeId
listId Int
limit_ Maybe Int
offset Maybe ListType
listType Maybe Int
minSize Maybe Int
maxSize Maybe OrderBy
orderBy Maybe Text
mt =
  NodeType
-> NodeId
-> TabType
-> NodeId
-> Int
-> Maybe Int
-> Maybe ListType
-> Maybe Int
-> Maybe Int
-> Maybe OrderBy
-> (NgramsTerm -> Bool)
-> m (VersionedWithCount NgramsTable)
forall env err (m :: * -> *).
(HasNodeStory env err m, HasNodeError err, HasConnectionPool env,
 HasConfig env, HasMail env) =>
NodeType
-> NodeId
-> TabType
-> NodeId
-> Int
-> Maybe Int
-> Maybe ListType
-> Maybe Int
-> Maybe Int
-> Maybe OrderBy
-> (NgramsTerm -> Bool)
-> m (VersionedWithCount NgramsTable)
getTableNgrams NodeType
NodeCorpus NodeId
nId TabType
tabType NodeId
listId Int
limit_ Maybe Int
offset Maybe ListType
listType Maybe Int
minSize Maybe Int
maxSize Maybe OrderBy
orderBy NgramsTerm -> Bool
searchQuery
    where
      searchQuery :: NgramsTerm -> Bool
searchQuery (NgramsTerm Text
nt) = (Text -> Bool)
-> (Text -> Text -> Bool) -> Maybe Text -> Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
True) Text -> Text -> Bool
isInfixOf Maybe Text
mt Text
nt



getTableNgramsVersion :: (HasNodeStory env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
               => NodeId
               -> TabType
               -> ListId
               -> m Version
getTableNgramsVersion :: NodeId -> TabType -> NodeId -> m Int
getTableNgramsVersion NodeId
_nId TabType
_tabType NodeId
listId = NodeId -> m Int
forall env err (m :: * -> *).
HasNodeStory env err m =>
NodeId -> m Int
currentVersion NodeId
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.
  -- See the comment about listNgramsChangedSince.


-- | Text search is deactivated for now for ngrams by doc only
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 (VersionedWithCount NgramsTable)
getTableNgramsDoc :: NodeId
-> TabType
-> NodeId
-> Int
-> Maybe Int
-> Maybe ListType
-> Maybe Int
-> Maybe Int
-> Maybe OrderBy
-> Maybe Text
-> m (VersionedWithCount NgramsTable)
getTableNgramsDoc NodeId
dId TabType
tabType NodeId
listId Int
limit_ Maybe Int
offset Maybe ListType
listType Maybe Int
minSize Maybe Int
maxSize Maybe OrderBy
orderBy Maybe Text
_mt = do
  [NodeId]
ns <- NodeType -> Text -> Cmd err [NodeId]
forall err.
HasDBid NodeType =>
NodeType -> Text -> Cmd err [NodeId]
selectNodesWithUsername NodeType
NodeList Text
userMaster
  let ngramsType :: NgramsType
ngramsType = TabType -> NgramsType
ngramsTypeFromTabType TabType
tabType
  [Text]
ngs <- [NodeId] -> NodeId -> NgramsType -> Cmd err [Text]
forall err. [NodeId] -> NodeId -> NgramsType -> Cmd err [Text]
selectNgramsByDoc ([NodeId]
ns [NodeId] -> [NodeId] -> [NodeId]
forall a. Semigroup a => a -> a -> a
<> [NodeId
listId]) NodeId
dId NgramsType
ngramsType
  let searchQuery :: NgramsTerm -> Bool
searchQuery (NgramsTerm Text
nt) = (Text -> Set Text -> Bool) -> Set Text -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member ([Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList [Text]
ngs) Text
nt
  NodeType
-> NodeId
-> TabType
-> NodeId
-> Int
-> Maybe Int
-> Maybe ListType
-> Maybe Int
-> Maybe Int
-> Maybe OrderBy
-> (NgramsTerm -> Bool)
-> m (VersionedWithCount NgramsTable)
forall env err (m :: * -> *).
(HasNodeStory env err m, HasNodeError err, HasConnectionPool env,
 HasConfig env, HasMail env) =>
NodeType
-> NodeId
-> TabType
-> NodeId
-> Int
-> Maybe Int
-> Maybe ListType
-> Maybe Int
-> Maybe Int
-> Maybe OrderBy
-> (NgramsTerm -> Bool)
-> m (VersionedWithCount NgramsTable)
getTableNgrams NodeType
NodeDocument NodeId
dId TabType
tabType NodeId
listId Int
limit_ Maybe Int
offset Maybe ListType
listType Maybe Int
minSize Maybe Int
maxSize Maybe OrderBy
orderBy NgramsTerm -> Bool
searchQuery



apiNgramsTableCorpus :: ( GargServerC env err m
                        )
                     => NodeId -> ServerT TableNgramsApi m
apiNgramsTableCorpus :: NodeId -> ServerT TableNgramsApi m
apiNgramsTableCorpus NodeId
cId =  NodeId
-> TabType
-> NodeId
-> Int
-> Maybe Int
-> Maybe ListType
-> Maybe Int
-> Maybe Int
-> Maybe OrderBy
-> Maybe Text
-> m (VersionedWithCount NgramsTable)
forall env err (m :: * -> *).
(HasNodeStory env err m, HasNodeError err, HasConnectionPool env,
 HasConfig env, HasMail env) =>
NodeId
-> TabType
-> NodeId
-> Int
-> Maybe Int
-> Maybe ListType
-> Maybe Int
-> Maybe Int
-> Maybe OrderBy
-> Maybe Text
-> m (VersionedWithCount NgramsTable)
getTableNgramsCorpus       NodeId
cId
                       (TabType
 -> NodeId
 -> Int
 -> Maybe Int
 -> Maybe ListType
 -> Maybe Int
 -> Maybe Int
 -> Maybe OrderBy
 -> Maybe Text
 -> m (VersionedWithCount NgramsTable))
-> ((TabType
     -> NodeId
     -> Versioned NgramsTablePatch
     -> m (Versioned NgramsTablePatch))
    :<|> ((TabType -> NodeId -> m Int)
          :<|> ((TabType -> NodeId -> m Int)
                :<|> (m (JobStatus 'Safe JobLog)
                      :<|> ((JobInput Maybe UpdateTableNgramsCharts
                             -> m (JobStatus 'Safe JobLog))
                            :<|> (ID 'Unsafe "job"
                                  -> (Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                                     :<|> ((Maybe Limit
                                            -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                                           :<|> m (JobOutput JobLog))))))))
-> (TabType
    -> NodeId
    -> Int
    -> Maybe Int
    -> Maybe ListType
    -> Maybe Int
    -> Maybe Int
    -> Maybe OrderBy
    -> Maybe Text
    -> m (VersionedWithCount NgramsTable))
   :<|> ((TabType
          -> NodeId
          -> Versioned NgramsTablePatch
          -> m (Versioned NgramsTablePatch))
         :<|> ((TabType -> NodeId -> m Int)
               :<|> ((TabType -> NodeId -> m Int)
                     :<|> (m (JobStatus 'Safe JobLog)
                           :<|> ((JobInput Maybe UpdateTableNgramsCharts
                                  -> m (JobStatus 'Safe JobLog))
                                 :<|> (ID 'Unsafe "job"
                                       -> (Maybe Limit
                                           -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                                          :<|> ((Maybe Limit
                                                 -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                                                :<|> m (JobOutput JobLog))))))))
forall a b. a -> b -> a :<|> b
:<|> TabType
-> NodeId
-> Versioned NgramsTablePatch
-> m (Versioned NgramsTablePatch)
forall env err (m :: * -> *).
(HasNodeStory env err m, HasInvalidError err, HasSettings env,
 HasMail env) =>
TabType
-> NodeId
-> Versioned NgramsTablePatch
-> m (Versioned NgramsTablePatch)
tableNgramsPut
                       (TabType
 -> NodeId
 -> Versioned NgramsTablePatch
 -> m (Versioned NgramsTablePatch))
-> ((TabType -> NodeId -> m Int)
    :<|> ((TabType -> NodeId -> m Int)
          :<|> (m (JobStatus 'Safe JobLog)
                :<|> ((JobInput Maybe UpdateTableNgramsCharts
                       -> m (JobStatus 'Safe JobLog))
                      :<|> (ID 'Unsafe "job"
                            -> (Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                               :<|> ((Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                                     :<|> m (JobOutput JobLog)))))))
-> (TabType
    -> NodeId
    -> Versioned NgramsTablePatch
    -> m (Versioned NgramsTablePatch))
   :<|> ((TabType -> NodeId -> m Int)
         :<|> ((TabType -> NodeId -> m Int)
               :<|> (m (JobStatus 'Safe JobLog)
                     :<|> ((JobInput Maybe UpdateTableNgramsCharts
                            -> m (JobStatus 'Safe JobLog))
                           :<|> (ID 'Unsafe "job"
                                 -> (Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                                    :<|> ((Maybe Limit
                                           -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                                          :<|> m (JobOutput JobLog)))))))
forall a b. a -> b -> a :<|> b
:<|> NodeId -> TabType -> NodeId -> m Int
forall env err (m :: * -> *).
(HasNodeStory env err m, HasNodeError err, HasConnectionPool env,
 HasConfig env, HasMail env) =>
NodeId -> TabType -> NodeId -> m Int
scoresRecomputeTableNgrams NodeId
cId
                       (TabType -> NodeId -> m Int)
-> ((TabType -> NodeId -> m Int)
    :<|> (m (JobStatus 'Safe JobLog)
          :<|> ((JobInput Maybe UpdateTableNgramsCharts
                 -> m (JobStatus 'Safe JobLog))
                :<|> (ID 'Unsafe "job"
                      -> (Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                         :<|> ((Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                               :<|> m (JobOutput JobLog))))))
-> (TabType -> NodeId -> m Int)
   :<|> ((TabType -> NodeId -> m Int)
         :<|> (m (JobStatus 'Safe JobLog)
               :<|> ((JobInput Maybe UpdateTableNgramsCharts
                      -> m (JobStatus 'Safe JobLog))
                     :<|> (ID 'Unsafe "job"
                           -> (Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                              :<|> ((Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                                    :<|> m (JobOutput JobLog))))))
forall a b. a -> b -> a :<|> b
:<|> NodeId -> TabType -> NodeId -> m Int
forall env err (m :: * -> *).
(HasNodeStory env err m, HasNodeError err, HasConnectionPool env,
 HasConfig env) =>
NodeId -> TabType -> NodeId -> m Int
getTableNgramsVersion      NodeId
cId
                       (TabType -> NodeId -> m Int)
-> (m (JobStatus 'Safe JobLog)
    :<|> ((JobInput Maybe UpdateTableNgramsCharts
           -> m (JobStatus 'Safe JobLog))
          :<|> (ID 'Unsafe "job"
                -> (Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                   :<|> ((Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                         :<|> m (JobOutput JobLog)))))
-> (TabType -> NodeId -> m Int)
   :<|> (m (JobStatus 'Safe JobLog)
         :<|> ((JobInput Maybe UpdateTableNgramsCharts
                -> m (JobStatus 'Safe JobLog))
               :<|> (ID 'Unsafe "job"
                     -> (Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                        :<|> ((Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                              :<|> m (JobOutput JobLog)))))
forall a b. a -> b -> a :<|> b
:<|> NodeId -> GargServer TableNgramsAsyncApi
apiNgramsAsync             NodeId
cId

apiNgramsTableDoc :: ( GargServerC env err m
                     )
                  => DocId -> ServerT TableNgramsApi m
apiNgramsTableDoc :: NodeId -> ServerT TableNgramsApi m
apiNgramsTableDoc NodeId
dId =  NodeId
-> TabType
-> NodeId
-> Int
-> Maybe Int
-> Maybe ListType
-> Maybe Int
-> Maybe Int
-> Maybe OrderBy
-> Maybe Text
-> m (VersionedWithCount NgramsTable)
forall env err (m :: * -> *).
(HasNodeStory env err m, HasNodeError err, HasConnectionPool env,
 HasConfig env, HasMail env) =>
NodeId
-> TabType
-> NodeId
-> Int
-> Maybe Int
-> Maybe ListType
-> Maybe Int
-> Maybe Int
-> Maybe OrderBy
-> Maybe Text
-> m (VersionedWithCount NgramsTable)
getTableNgramsDoc          NodeId
dId
                    (TabType
 -> NodeId
 -> Int
 -> Maybe Int
 -> Maybe ListType
 -> Maybe Int
 -> Maybe Int
 -> Maybe OrderBy
 -> Maybe Text
 -> m (VersionedWithCount NgramsTable))
-> ((TabType
     -> NodeId
     -> Versioned NgramsTablePatch
     -> m (Versioned NgramsTablePatch))
    :<|> ((TabType -> NodeId -> m Int)
          :<|> ((TabType -> NodeId -> m Int)
                :<|> (m (JobStatus 'Safe JobLog)
                      :<|> ((JobInput Maybe UpdateTableNgramsCharts
                             -> m (JobStatus 'Safe JobLog))
                            :<|> (ID 'Unsafe "job"
                                  -> (Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                                     :<|> ((Maybe Limit
                                            -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                                           :<|> m (JobOutput JobLog))))))))
-> (TabType
    -> NodeId
    -> Int
    -> Maybe Int
    -> Maybe ListType
    -> Maybe Int
    -> Maybe Int
    -> Maybe OrderBy
    -> Maybe Text
    -> m (VersionedWithCount NgramsTable))
   :<|> ((TabType
          -> NodeId
          -> Versioned NgramsTablePatch
          -> m (Versioned NgramsTablePatch))
         :<|> ((TabType -> NodeId -> m Int)
               :<|> ((TabType -> NodeId -> m Int)
                     :<|> (m (JobStatus 'Safe JobLog)
                           :<|> ((JobInput Maybe UpdateTableNgramsCharts
                                  -> m (JobStatus 'Safe JobLog))
                                 :<|> (ID 'Unsafe "job"
                                       -> (Maybe Limit
                                           -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                                          :<|> ((Maybe Limit
                                                 -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                                                :<|> m (JobOutput JobLog))))))))
forall a b. a -> b -> a :<|> b
:<|> TabType
-> NodeId
-> Versioned NgramsTablePatch
-> m (Versioned NgramsTablePatch)
forall env err (m :: * -> *).
(HasNodeStory env err m, HasInvalidError err, HasSettings env,
 HasMail env) =>
TabType
-> NodeId
-> Versioned NgramsTablePatch
-> m (Versioned NgramsTablePatch)
tableNgramsPut
                    (TabType
 -> NodeId
 -> Versioned NgramsTablePatch
 -> m (Versioned NgramsTablePatch))
-> ((TabType -> NodeId -> m Int)
    :<|> ((TabType -> NodeId -> m Int)
          :<|> (m (JobStatus 'Safe JobLog)
                :<|> ((JobInput Maybe UpdateTableNgramsCharts
                       -> m (JobStatus 'Safe JobLog))
                      :<|> (ID 'Unsafe "job"
                            -> (Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                               :<|> ((Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                                     :<|> m (JobOutput JobLog)))))))
-> (TabType
    -> NodeId
    -> Versioned NgramsTablePatch
    -> m (Versioned NgramsTablePatch))
   :<|> ((TabType -> NodeId -> m Int)
         :<|> ((TabType -> NodeId -> m Int)
               :<|> (m (JobStatus 'Safe JobLog)
                     :<|> ((JobInput Maybe UpdateTableNgramsCharts
                            -> m (JobStatus 'Safe JobLog))
                           :<|> (ID 'Unsafe "job"
                                 -> (Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                                    :<|> ((Maybe Limit
                                           -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                                          :<|> m (JobOutput JobLog)))))))
forall a b. a -> b -> a :<|> b
:<|> NodeId -> TabType -> NodeId -> m Int
forall env err (m :: * -> *).
(HasNodeStory env err m, HasNodeError err, HasConnectionPool env,
 HasConfig env, HasMail env) =>
NodeId -> TabType -> NodeId -> m Int
scoresRecomputeTableNgrams NodeId
dId
                    (TabType -> NodeId -> m Int)
-> ((TabType -> NodeId -> m Int)
    :<|> (m (JobStatus 'Safe JobLog)
          :<|> ((JobInput Maybe UpdateTableNgramsCharts
                 -> m (JobStatus 'Safe JobLog))
                :<|> (ID 'Unsafe "job"
                      -> (Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                         :<|> ((Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                               :<|> m (JobOutput JobLog))))))
-> (TabType -> NodeId -> m Int)
   :<|> ((TabType -> NodeId -> m Int)
         :<|> (m (JobStatus 'Safe JobLog)
               :<|> ((JobInput Maybe UpdateTableNgramsCharts
                      -> m (JobStatus 'Safe JobLog))
                     :<|> (ID 'Unsafe "job"
                           -> (Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                              :<|> ((Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                                    :<|> m (JobOutput JobLog))))))
forall a b. a -> b -> a :<|> b
:<|> NodeId -> TabType -> NodeId -> m Int
forall env err (m :: * -> *).
(HasNodeStory env err m, HasNodeError err, HasConnectionPool env,
 HasConfig env) =>
NodeId -> TabType -> NodeId -> m Int
getTableNgramsVersion      NodeId
dId
                    (TabType -> NodeId -> m Int)
-> (m (JobStatus 'Safe JobLog)
    :<|> ((JobInput Maybe UpdateTableNgramsCharts
           -> m (JobStatus 'Safe JobLog))
          :<|> (ID 'Unsafe "job"
                -> (Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                   :<|> ((Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                         :<|> m (JobOutput JobLog)))))
-> (TabType -> NodeId -> m Int)
   :<|> (m (JobStatus 'Safe JobLog)
         :<|> ((JobInput Maybe UpdateTableNgramsCharts
                -> m (JobStatus 'Safe JobLog))
               :<|> (ID 'Unsafe "job"
                     -> (Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                        :<|> ((Maybe Limit -> Maybe Offset -> m (JobStatus 'Safe JobLog))
                              :<|> m (JobOutput JobLog)))))
forall a b. a -> b -> a :<|> b
:<|> NodeId -> GargServer TableNgramsAsyncApi
apiNgramsAsync             NodeId
dId

apiNgramsAsync :: NodeId -> GargServer TableNgramsAsyncApi
apiNgramsAsync :: NodeId -> GargServer TableNgramsAsyncApi
apiNgramsAsync NodeId
_dId =
  JobFunction env err JobLog UpdateTableNgramsCharts JobLog
-> AsyncJobsServerT'
     Any Any Maybe JobLog UpdateTableNgramsCharts JobLog m
forall (callbacks :: * -> *) env err (m :: * -> *) event input
       output (ctI :: [*]) (ctO :: [*]).
(MonadAsyncJobs' callbacks env err event output m,
 MimeRender JSON input) =>
JobFunction env err event input output
-> AsyncJobsServerT' ctI ctO callbacks event input output m
serveJobsAPI (JobFunction env err JobLog UpdateTableNgramsCharts JobLog
 -> AsyncJobsServerT'
      Any Any Maybe JobLog UpdateTableNgramsCharts JobLog m)
-> JobFunction env err JobLog UpdateTableNgramsCharts JobLog
-> AsyncJobsServerT'
     Any Any Maybe JobLog UpdateTableNgramsCharts JobLog m
forall a b. (a -> b) -> a -> b
$
    (forall (m :: * -> *).
 (MonadReader env m, MonadError err m, MonadBaseControl IO m) =>
 UpdateTableNgramsCharts -> (JobLog -> IO ()) -> m JobLog)
-> JobFunction env err JobLog UpdateTableNgramsCharts JobLog
forall env err event input output.
(forall (m :: * -> *).
 (MonadReader env m, MonadError err m, MonadBaseControl IO m) =>
 input -> (event -> IO ()) -> m output)
-> JobFunction env err event input output
JobFunction ((forall (m :: * -> *).
  (MonadReader env m, MonadError err m, MonadBaseControl IO m) =>
  UpdateTableNgramsCharts -> (JobLog -> IO ()) -> m JobLog)
 -> JobFunction env err JobLog UpdateTableNgramsCharts JobLog)
-> (forall (m :: * -> *).
    (MonadReader env m, MonadError err m, MonadBaseControl IO m) =>
    UpdateTableNgramsCharts -> (JobLog -> IO ()) -> m JobLog)
-> JobFunction env err JobLog UpdateTableNgramsCharts JobLog
forall a b. (a -> b) -> a -> b
$ \UpdateTableNgramsCharts
i JobLog -> IO ()
log ->
      let
        log' :: JobLog -> m ()
log' JobLog
x = do
          [Char] -> JobLog -> m ()
forall a (m :: * -> *).
(Show a, MonadBase IO m) =>
[Char] -> a -> m ()
printDebug [Char]
"tableNgramsPostChartsAsync" JobLog
x
          IO () -> m ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ JobLog -> IO ()
log JobLog
x
      in UpdateTableNgramsCharts -> (JobLog -> m ()) -> m JobLog
forall env err (m :: * -> *).
(HasNodeStory env err m, FlowCmdM env err m, HasNodeError err,
 HasSettings env) =>
UpdateTableNgramsCharts -> (JobLog -> m ()) -> m JobLog
tableNgramsPostChartsAsync UpdateTableNgramsCharts
i JobLog -> m ()
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
-- latest version.
-- If the given version is negative then one simply receive the latest version and True.
-- Using this function is more precise than simply comparing the latest version number
-- with the local version number. Indeed there might be no change to this particular list
-- and still the version number has changed because of other lists.
--
-- Here the added value is to make a compromise between precision, computation, and bandwidth:
-- * 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 :: HasNodeStory env err m
                       => ListId -> TableNgrams.NgramsType -> Version -> m (Versioned Bool)
listNgramsChangedSince :: NodeId -> NgramsType -> Int -> m (Versioned Bool)
listNgramsChangedSince NodeId
listId NgramsType
ngramsType Int
version
  | Int
version Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 =
      Int -> Bool -> Versioned Bool
forall a1. Int -> a1 -> Versioned a1
Versioned (Int -> Bool -> Versioned Bool)
-> m Int -> m (Bool -> Versioned Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NodeId -> m Int
forall env err (m :: * -> *).
HasNodeStory env err m =>
NodeId -> m Int
currentVersion NodeId
listId m (Bool -> Versioned Bool) -> m Bool -> m (Versioned Bool)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
  | Bool
otherwise   =
      NodeId -> NgramsType -> Int -> m (Versioned NgramsTablePatch)
forall env err (m :: * -> *).
HasNodeStory env err m =>
NodeId -> NgramsType -> Int -> m (Versioned NgramsTablePatch)
tableNgramsPull NodeId
listId NgramsType
ngramsType Int
version m (Versioned NgramsTablePatch)
-> (m (Versioned NgramsTablePatch) -> m (Versioned Bool))
-> m (Versioned Bool)
forall a b. a -> (a -> b) -> b
& (Versioned NgramsTablePatch -> Identity (Versioned Bool))
-> m (Versioned NgramsTablePatch) -> Identity (m (Versioned Bool))
forall (f :: * -> *) a b. Functor f => Setter (f a) (f b) a b
mapped ((Versioned NgramsTablePatch -> Identity (Versioned Bool))
 -> m (Versioned NgramsTablePatch) -> Identity (m (Versioned Bool)))
-> ((NgramsTablePatch -> Identity Bool)
    -> Versioned NgramsTablePatch -> Identity (Versioned Bool))
-> (NgramsTablePatch -> Identity Bool)
-> m (Versioned NgramsTablePatch)
-> Identity (m (Versioned Bool))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NgramsTablePatch -> Identity Bool)
-> Versioned NgramsTablePatch -> Identity (Versioned Bool)
forall a1 a2. Lens (Versioned a1) (Versioned a2) a1 a2
v_data ((NgramsTablePatch -> Identity Bool)
 -> m (Versioned NgramsTablePatch) -> Identity (m (Versioned Bool)))
-> (NgramsTablePatch -> Bool)
-> m (Versioned NgramsTablePatch)
-> m (Versioned Bool)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (NgramsTablePatch -> NgramsTablePatch -> Bool
forall a. Eq a => a -> a -> Bool
== NgramsTablePatch
forall a. Monoid a => a
mempty)