Merge branch 'dev-phylo' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell-gargantex...
[gargantext.git] / src / Gargantext / API / Ngrams.hs
index 2d9802587534b84616caf4f3f3341e6486179567..18f937e7b2cd0c872da807f9809843bb18b4fcc9 100644 (file)
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
 {-|
 Module      : Gargantext.API.Ngrams
 Description : Server API
@@ -15,236 +16,129 @@ add get
 
 -}
 
-{-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ConstraintKinds   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE TypeOperators     #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE RankNTypes        #-}
-{-# OPTIONS -fno-warn-orphans #-}
+{-# LANGUAGE TypeFamilies      #-}
 
 module Gargantext.API.Ngrams
+  ( TableNgramsApi
+  , TableNgramsApiGet
+  , TableNgramsApiPut
+
+  , getTableNgrams
+  , setListNgrams
+  --, rmListNgrams TODO fix before exporting
+  , apiNgramsTableCorpus
+  , apiNgramsTableDoc
+
+  , NgramsStatePatch
+  , NgramsTablePatch
+  , NgramsTableMap
+
+  , NgramsTerm(..)
+
+  , NgramsElement(..)
+  , mkNgramsElement
+
+  , RootParent(..)
+
+  , MSet
+  , mSetFromList
+  , mSetToList
+
+  , Repo(..)
+  , r_version
+  , r_state
+  , r_history
+  , NgramsRepo
+  , NgramsRepoElement(..)
+  , saveRepo
+  , initRepo
+
+  , RepoEnv(..)
+  , renv_var
+  , renv_lock
+
+  , TabType(..)
+
+  , HasRepoVar(..)
+  , HasRepoSaver(..)
+  , HasRepo(..)
+  , RepoCmdM
+  , QueryParamR
+  , TODO
+
+  -- Internals
+  , getNgramsTableMap
+  , dumpJsonTableMap
+  , tableNgramsPull
+  , tableNgramsPut
+
+  , Version
+  , Versioned(..)
+  , currentVersion
+  , listNgramsChangedSince
+  )
   where
 
-import Prelude (round)
--- import Gargantext.Database.Schema.User  (UserId)
-import Data.Functor (($>))
-import Data.Patch.Class (Replace, replace, new)
---import qualified Data.Map.Strict.Patch as PM
+import Control.Concurrent
+import Control.Lens ((.~), view, (^.), (^..), (+~), (%~), (.~), sumOf, at, _Just, Each(..), (%%~), mapped)
+import Control.Monad.Reader
+import Data.Aeson hiding ((.=))
+import qualified Data.Aeson.Text as DAT
+import Data.Either (Either(..))
+import Data.Foldable
+import qualified Data.List as List
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import qualified Data.Map.Strict.Patch as PM
+import Data.Maybe (fromMaybe)
 import Data.Monoid
---import Data.Semigroup
-import Data.Set (Set)
+import Data.Ord (Down(..))
+import Data.Patch.Class (Action(act), Transformable(..), ours)
+import qualified Data.Set as S
 import qualified Data.Set as Set
-import Data.Maybe (isJust)
-import Data.Tuple.Extra (first)
--- import qualified Data.Map.Strict as DM
-import Data.Map.Strict (Map, mapKeys, fromListWith)
---import qualified Data.Set as Set
-import Control.Lens (makeLenses, Prism', prism', (^..), (.~), (#), to, withIndex, folded, ifolded)
-import Control.Monad (guard)
-import Control.Monad.Error.Class (MonadError, throwError)
-import Data.Aeson
-import Data.Aeson.TH (deriveJSON)
-import Data.Either(Either(Left))
-import Data.Map (lookup)
-import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
 import Data.Swagger hiding (version, patch)
-import Data.Text (Text)
+import Data.Text (Text, isInfixOf, unpack)
+import Data.Text.Lazy.IO as DTL
+import Formatting (hprint, int, (%))
+import Formatting.Clock (timeSpecs)
 import GHC.Generics (Generic)
-import Gargantext.Core.Utils.Prefix (unPrefix)
-import Gargantext.Database.Types.Node (NodeType(..))
-import Gargantext.Database.Schema.Node (defaultList, HasNodeError)
-import Gargantext.Database.Schema.Ngrams (NgramsType, NgramsTypeId, ngramsTypeId, NgramsTableData'(..))
-import qualified Gargantext.Database.Schema.Ngrams as Ngrams
-import Gargantext.Database.Schema.NodeNgram
-import Gargantext.Database.Schema.NodeNgramsNgrams
-import Gargantext.Database.Utils (Cmd)
-import Gargantext.Prelude
-import Gargantext.Core.Types (ListType(..), ListTypeId, ListId, CorpusId, Limit, Offset, listTypeId)
-import Prelude (Enum, Bounded, minBound, maxBound)
 import Servant hiding (Patch)
+import System.Clock (getTime, TimeSpec, Clock(..))
+import System.IO (stderr)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
-------------------------------------------------------------------------
---data FacetFormat = Table | Chart
-data TabType   = Docs     | Terms  | Sources | Authors | Institutes | Trash
-               | Contacts
-  deriving (Generic, Enum, Bounded)
-
-instance FromHttpApiData TabType
-  where
-    parseUrlPiece "Docs"       = pure Docs
-    parseUrlPiece "Terms"      = pure Terms
-    parseUrlPiece "Sources"    = pure Sources
-    parseUrlPiece "Institutes" = pure Institutes
-    parseUrlPiece "Authors"    = pure Authors
-    parseUrlPiece "Trash"      = pure Trash
-    
-    parseUrlPiece "Contacts"   = pure Contacts
-    
-    parseUrlPiece _            = Left "Unexpected value of TabType"
-
-instance ToParamSchema   TabType
-instance ToJSON    TabType
-instance FromJSON  TabType
-instance ToSchema  TabType
-instance Arbitrary TabType
-  where
-    arbitrary = elements [minBound .. maxBound]
-
-------------------------------------------------------------------------
-type NgramsTerm = Text
-
-data NgramsElement =
-     NgramsElement { _ne_ngrams      :: NgramsTerm
-                   , _ne_list        :: ListType
-                   , _ne_occurrences :: Int
-                   , _ne_parent      :: Maybe NgramsTerm
-                   , _ne_children    :: Set NgramsTerm
-                   }
-      deriving (Ord, Eq, Show, Generic)
-
-deriveJSON (unPrefix "_ne_") ''NgramsElement
-makeLenses ''NgramsElement
-
-instance ToSchema NgramsElement
-instance Arbitrary NgramsElement where
-  arbitrary = elements [NgramsElement "sport" GraphList 1 Nothing mempty]
-
-------------------------------------------------------------------------
-newtype NgramsTable = NgramsTable { _ngramsTable :: [NgramsElement] }
-  deriving (Ord, Eq, Generic, ToJSON, FromJSON, Show)
-
--- | TODO Check N and Weight
-toNgramsElement :: [NgramsTableData'] -> [NgramsElement]
-toNgramsElement ns = map toNgramsElement' ns
-    where
-      toNgramsElement' (NgramsTableData' _ p t _ lt w) = NgramsElement t lt' (round w) p' c'
-        where
-          p' = case p of
-                 Nothing -> Nothing
-                 Just x  -> lookup x mapParent
-          c' = maybe mempty identity $ lookup t mapChildren
-          lt' = maybe (panic "API.Ngrams: listypeId") identity lt
-      
-      mapParent :: Map Int Text
-      mapParent   = fromListWith (<>) $ map (\(NgramsTableData' i _ t _ _ _) -> (i,t)) ns
-      
-      mapChildren :: Map Text (Set Text)
-      mapChildren = mapKeys (\i -> (maybe (panic "API.Ngrams.mapChildren: ParentId with no Terms: Impossible") identity $ lookup i mapParent))
-                  $ fromListWith (<>)
-                  $ map (first fromJust)
-                  $ filter (isJust . fst)
-                  $ map (\(NgramsTableData' _ p t _ _ _) -> (p, Set.singleton t)) ns
-
-
-instance Arbitrary NgramsTable where
-  arbitrary = elements
-              [ NgramsTable
-                [ NgramsElement "animal"  GraphList     1  Nothing       (Set.fromList ["dog", "cat"])
-                , NgramsElement "cat"     GraphList     1 (Just "animal") mempty
-                , NgramsElement "cats"    StopList      4  Nothing        mempty
-                , NgramsElement "dog"     GraphList     3 (Just "animal")(Set.fromList ["dogs"])
-                , NgramsElement "dogs"    StopList      4 (Just "dog")    mempty
-                , NgramsElement "fox"     GraphList     1  Nothing        mempty
-                , NgramsElement "object"  CandidateList 2  Nothing        mempty
-                , NgramsElement "nothing" StopList      4  Nothing        mempty
-                , NgramsElement "organic" GraphList     3  Nothing        (Set.singleton "flower")
-                , NgramsElement "flower"  GraphList     3 (Just "organic") mempty
-                , NgramsElement "moon"    CandidateList 1  Nothing         mempty
-                , NgramsElement "sky"     StopList      1  Nothing         mempty
-                ]
-              ]
-instance ToSchema NgramsTable
-
-------------------------------------------------------------------------
--- On the Client side:
---data Action = InGroup     NgramsId NgramsId
---            | OutGroup    NgramsId NgramsId
---            | SetListType NgramsId ListType
-
-data PatchSet a = PatchSet
-  { _rem :: Set a
-  , _add :: Set a
-  }
-  deriving (Eq, Ord, Show, Generic)
-
-instance (Ord a, Arbitrary a) => Arbitrary (PatchSet a) where
-  arbitrary = PatchSet <$> arbitrary <*> arbitrary
-
-instance ToJSON a => ToJSON (PatchSet a) where
-  toJSON     = genericToJSON     $ unPrefix "_"
-  toEncoding = genericToEncoding $ unPrefix "_"
-
-instance (Ord a, FromJSON a) => FromJSON (PatchSet a) where
-  parseJSON = genericParseJSON $ unPrefix "_"
-
-instance ToSchema a => ToSchema (PatchSet a)
-
-instance ToSchema a => ToSchema (Replace a) where
-  declareNamedSchema (_ :: proxy (Replace a)) = do
-    -- TODO Keep constructor is not supported here.
-    aSchema <- declareSchemaRef (Proxy :: Proxy a)
-    return $ NamedSchema (Just "Replace") $ mempty
-      & type_ .~ SwaggerObject
-      & properties .~
-          InsOrdHashMap.fromList
-          [ ("old", aSchema)
-          , ("new", aSchema)
-          ]
-      & required .~ [ "old", "new" ]
-
-data NgramsPatch =
-     NgramsPatch { _patch_children :: PatchSet NgramsTerm
-                 , _patch_list     :: Replace ListType   -- TODO Map UserId ListType
-                 }
-      deriving (Ord, Eq, Show, Generic)
-deriveJSON (unPrefix "_") ''NgramsPatch
-makeLenses ''NgramsPatch
-
--- instance Semigroup NgramsPatch where
-
-instance ToSchema  NgramsPatch
-
-instance Arbitrary NgramsPatch where
-  arbitrary = NgramsPatch <$> arbitrary <*> (replace <$> arbitrary <*> arbitrary)
-
-newtype NgramsTablePatch =
-     NgramsTablePatch { _ntp_ngrams_patches :: Map NgramsTerm NgramsPatch }
-      deriving (Ord, Eq, Show, Generic, Arbitrary, ToJSON, FromJSON)
-makeLenses ''NgramsTablePatch
-instance ToSchema  NgramsTablePatch
-
--- TODO: replace by mempty once we have the Monoid instance
-emptyNgramsTablePatch :: NgramsTablePatch
-emptyNgramsTablePatch = NgramsTablePatch mempty
-
-------------------------------------------------------------------------
-------------------------------------------------------------------------
-type Version = Int
+import Prelude (error)
+import Gargantext.Prelude
 
-data Versioned a = Versioned
-  { _v_version :: Version
-  , _v_data    :: a
-  }
-  deriving (Generic)
-deriveJSON (unPrefix "_v_") ''Versioned
-makeLenses ''Versioned
-instance ToSchema a => ToSchema (Versioned a)
-instance Arbitrary a => Arbitrary (Versioned a) where
-  arbitrary = Versioned 1 <$> arbitrary -- TODO 1 is constant so far
+import Gargantext.API.Admin.Types (HasSettings)
+import qualified Gargantext.API.Metrics as Metrics
+import Gargantext.API.Ngrams.Types
+import Gargantext.Core.Types (ListType(..), NodeId, ListId, DocId, Limit, Offset, HasInvalidError, TODO, assertValid)
+import Gargantext.Core.Utils (something)
+-- import Gargantext.Core.Viz.Graph.API (recomputeGraph)
+-- import Gargantext.Core.Viz.Graph.Distances (Distance(Conditional))
+import Gargantext.Database.Action.Metrics.NgramsByNode (getOccByNgramsOnlyFast')
+import Gargantext.Database.Query.Table.Node.Select
+import Gargantext.Database.Query.Table.Ngrams hiding (NgramsType(..), ngrams, ngramsType, ngrams_terms)
+import Gargantext.Database.Admin.Config (userMaster)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
+import Gargantext.Database.Admin.Types.Node (NodeType(..))
+import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
+import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
+import Gargantext.Database.Query.Table.Node (getNode)
+import Gargantext.Database.Schema.Node (node_id, node_parentId, node_userId)
 
 {-
--- TODO sequencs of modifications (Patchs)
+-- TODO sequences of modifications (Patchs)
 type NgramsIdPatch = Patch NgramsId NgramsPatch
 
 ngramsPatch :: Int -> NgramsPatch
-ngramsPatch n = NgramsPatch (DM.fromList [(1, StopList)]) (Set.fromList [n]) Set.empty
+ngramsPatch n = NgramsPatch (DM.fromList [(1, StopTerm)]) (Set.fromList [n]) Set.empty
 
 toEdit :: NgramsId -> NgramsPatch -> Edit NgramsId NgramsPatch
 toEdit n p = Edit n p
@@ -261,107 +155,562 @@ ngramsIdPatch = fromList $ catMaybes $ reverse [ replace (1::NgramsId) (Just $ n
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
 
-type TableNgramsApiGet = Summary " Table Ngrams API Get"
-                      :> QueryParam "ngramsType"   TabType
-                      :> QueryParam "list"   ListId
-                      :> QueryParam "limit"  Limit
-                      :> QueryParam "offset" Offset
-                      :> Get    '[JSON] (Versioned NgramsTable)
-
-type TableNgramsApi = Summary " Table Ngrams API Change"
-                      :> QueryParam "ngramsType"   TabType
-                      :> QueryParam "list"   ListId
-                      :> ReqBody '[JSON] (Versioned NgramsTablePatch)
-                      :> Put     '[JSON] (Versioned NgramsTablePatch)
-
-data NgramError = UnsupportedVersion
-  deriving (Show)
-
-class HasNgramError e where
-  _NgramError :: Prism' e NgramError
-
-instance HasNgramError ServantErr where
-  _NgramError = prism' make match
-    where
-      err = err500 { errBody = "NgramError: Unsupported version" }
-      make UnsupportedVersion = err
-      match e = guard (e == err) $> UnsupportedVersion
-
-ngramError :: (MonadError e m, HasNgramError e) => NgramError -> m a
-ngramError nne = throwError $ _NgramError # nne
-
+{-
 -- TODO: Replace.old is ignored which means that if the current list
--- `GraphList` and that the patch is `Replace CandidateList StopList` then
--- the list is going to be `StopList` while it should keep `GraphList`.
+-- `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 :: ListId -> NgramsType -> NgramsTablePatch -> [(ListId, NgramsTypeId, NgramsTerm, ListTypeId)]
-mkListsUpdate lId nt patches =
-  [ (lId, ngramsTypeId nt, ng, listTypeId lt)
+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 :: ListId -> NgramsType
-                 -> (PatchSet NgramsTerm -> Set NgramsTerm)
+mkChildrenGroups :: (PatchSet NgramsTerm -> Set NgramsTerm)
+                 -> NgramsType
                  -> NgramsTablePatch
-                 -> [(ListId, NgramsTypeId, NgramsParent, NgramsChild)]
-mkChildrenGroups lId nt addOrRem patches =
-  [ (lId, ngramsTypeId nt, parent, child)
+                 -> [(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
   ]
+-}
+
+------------------------------------------------------------------------
+
+saveRepo :: ( MonadReader env m, MonadBase IO m, HasRepoSaver env )
+         => m ()
+saveRepo = liftBase =<< view repoSaver
+
+listTypeConflictResolution :: ListType -> ListType -> ListType
+listTypeConflictResolution _ _ = undefined -- TODO Use Map User ListType
+
+ngramsStatePatchConflictResolution
+  :: TableNgrams.NgramsType
+  -> NodeId
+  -> NgramsTerm
+  -> ConflictResolutionNgramsPatch
+ngramsStatePatchConflictResolution _ngramsType _nodeId _ngramsTerm
+  = (ours, (const ours, ours), (False, False))
+                             -- (False, False) mean here that Mod has always priority.
+                             -- (True, False) <- would mean priority to the left (same as ours).
+
+  -- undefined {- TODO think this through -}, listTypeConflictResolution)
+
+-- Current state:
+--   Insertions are not considered as patches,
+--   they do not extend history,
+--   they do not bump version.
+insertNewOnly :: a -> Maybe b -> a
+insertNewOnly m = maybe m (const $ error "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))
+  saveRepo
+  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)
+  saveRepo
+  where
+    m = Map.fromList $ (\n -> (n ^. ne_ngrams, n)) <$> nes
+-}
 
-ngramsTypeFromTabType :: Maybe TabType -> NgramsType
-ngramsTypeFromTabType maybeTabType =
-  let lieu = "Garg.API.Ngrams: " :: Text in
-    case maybeTabType of
-          Nothing  -> panic (lieu <> "Indicate the Table")
-          Just tab -> case tab of
-              Sources    -> Ngrams.Sources
-              Authors    -> Ngrams.Authors
-              Institutes -> Ngrams.Institutes
-              Terms      -> Ngrams.NgramsTerms
-              _          -> panic $ lieu <> "No Ngrams for this tab"
+-- UNSAFE
+rmListNgrams ::  RepoCmdM env err m
+              => ListId
+              -> TableNgrams.NgramsType
+              -> m ()
+rmListNgrams l nt = setListNgrams l nt mempty
+
+-- | TODO: incr the Version number
+-- && should use patch
+-- UNSAFE
+setListNgrams ::  RepoCmdM env err m
+              => NodeId
+              -> TableNgrams.NgramsType
+              -> Map NgramsTerm NgramsRepoElement
+              -> m ()
+setListNgrams listId ngramsType ns = do
+  var <- view repoVar
+  liftBase $ modifyMVar_ var $
+    pure . ( r_state
+           . at ngramsType %~
+             (Just .
+               (at listId .~ ( Just ns))
+               . something
+             )
+           )
+  saveRepo
+
+
+currentVersion :: RepoCmdM env err m
+               => m Version
+currentVersion = do
+  var <- view repoVar
+  r   <- liftBase $ readMVar var
+  pure $ r ^. r_version
+
+
+-- tableNgramsPut :: (HasInvalidError err, RepoCmdM env err m)
+commitStatePatch :: RepoCmdM env err m => Versioned NgramsStatePatch -> m (Versioned NgramsStatePatch)
+commitStatePatch (Versioned p_version p) = do
+  var <- view repoVar
+  vq' <- liftBase $ modifyMVar var $ \r -> do
+    let
+      q = mconcat $ take (r ^. r_version - p_version) (r ^. r_history)
+      (p', q') = transformWith ngramsStatePatchConflictResolution p q
+      r' = r & r_version +~ 1
+             & r_state   %~ act p'
+             & r_history %~ (p' :)
+    {-
+    -- 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)
+    -}
+    pure (r', Versioned (r' ^. r_version) q')
+
+  saveRepo
+  pure vq'
+
+-- This is a special case of tableNgramsPut where the input patch is empty.
+tableNgramsPull :: RepoCmdM env err m
+                => ListId
+                -> TableNgrams.NgramsType
+                -> Version
+                -> m (Versioned NgramsTablePatch)
+tableNgramsPull listId ngramsType p_version = do
+  var <- view repoVar
+  r <- liftBase $ readMVar var
 
+  let
+    q = mconcat $ take (r ^. r_version - p_version) (r ^. r_history)
+    q_table = q ^. _PatchMap . at ngramsType . _Just . _PatchMap . at listId . _Just
+
+  pure (Versioned (r ^. r_version) q_table)
 
 -- Apply the given patch to the DB and returns the patch to be applied on the
--- cilent.
--- TODO:
--- In this perliminary version the OT aspect is missing, therefore the version
--- number is always 1 and the returned patch is always empty.
-tableNgramsPatch :: (HasNgramError err, HasNodeError err)
-                 => CorpusId -> Maybe TabType -> Maybe ListId
+-- client.
+-- TODO-ACCESS check
+tableNgramsPut :: (HasNodeError err,
+                   HasInvalidError err,
+                   HasConfig env,
+                   HasConnectionPool env,
+                   HasSettings env,
+                   RepoCmdM env err m)
+                 => TabType
+                 -> ListId
                  -> Versioned NgramsTablePatch
-                 -> Cmd err (Versioned NgramsTablePatch)
-tableNgramsPatch corpusId maybeTabType maybeList (Versioned version patch) = do
-  when (version /= 1) $ ngramError UnsupportedVersion
-  let ngramsType = ngramsTypeFromTabType maybeTabType
-  listId <- maybe (defaultList corpusId) pure maybeList
-  updateNodeNgrams $ NodeNgramsUpdate
-    { _nnu_lists_update = mkListsUpdate listId ngramsType patch
-    , _nnu_rem_children = mkChildrenGroups listId ngramsType _rem patch
-    , _nnu_add_children = mkChildrenGroups listId ngramsType _add patch
-    }
-  pure $ Versioned 1 emptyNgramsTablePatch
+                 -> m (Versioned NgramsTablePatch)
+tableNgramsPut tabType listId (Versioned p_version p_table)
+  | p_table == mempty = do
+      let ngramsType        = ngramsTypeFromTabType tabType
+      tableNgramsPull listId ngramsType p_version
+
+  | otherwise         = do
+      let ngramsType        = ngramsTypeFromTabType tabType
+          (p0, p0_validity) = PM.singleton listId p_table
+          (p, p_validity)   = PM.singleton ngramsType p0
+
+      assertValid p0_validity
+      assertValid p_validity
+
+      ret <- commitStatePatch (Versioned p_version p)
+        <&> v_data %~ (view (_PatchMap . at ngramsType . _Just . _PatchMap . at listId . _Just))
+
+      node <- getNode listId
+      let nId = node ^. node_id
+          _uId = node ^. node_userId
+          mCId = node ^. node_parentId
+      -- printDebug "[tableNgramsPut] updating graph with nId" nId
+      -- printDebug "[tableNgramsPut] updating graph with uId" uId
+      -- _ <- recomputeGraph uId nId Conditional
+
+      printDebug "[tableNgramsPut] tabType" tabType
+      printDebug "[tableNgramsPut] listId" listId
+
+      _ <- case mCId of
+        Nothing -> do
+          printDebug "[tableNgramsPut] can't update charts, no parent, nId" nId
+          pure ()
+        Just cId -> do
+          case tabType of
+            Authors -> do
+              -- printDebug "[tableNgramsPut] Authors, updating Pie, cId" cId
+              _ <- Metrics.updatePie cId (Just listId) tabType Nothing
+              pure ()
+            Institutes -> do
+              -- printDebug "[tableNgramsPut] Institutes, updating Tree, cId" cId
+              -- printDebug "[tableNgramsPut] updating tree StopTerm, cId" cId
+              _ <- Metrics.updateTree cId (Just listId) tabType StopTerm
+              -- printDebug "[tableNgramsPut] updating tree CandidateTerm, cId" cId
+              _ <- Metrics.updateTree cId (Just listId) tabType CandidateTerm
+              -- printDebug "[tableNgramsPut] updating tree MapTerm, cId" cId
+              _ <- Metrics.updateTree cId (Just listId) tabType MapTerm
+              pure ()
+            Sources -> do
+              -- printDebug "[tableNgramsPut] Sources, updating chart, cId" cId
+              _ <- Metrics.updateChart cId (Just listId) tabType Nothing
+              pure ()
+            Terms -> do
+              -- printDebug "[tableNgramsPut] Terms, updating Metrics (Histo), cId" cId
+              _ <- Metrics.updateChart cId (Just listId) tabType Nothing
+              _ <- Metrics.updatePie cId (Just listId) tabType Nothing
+              _ <- Metrics.updateScatter cId (Just listId) tabType Nothing
+              _ <- Metrics.updateTree cId (Just listId) tabType StopTerm
+              _ <- Metrics.updateTree cId (Just listId) tabType CandidateTerm
+              _ <- Metrics.updateTree cId (Just listId) tabType MapTerm
+              pure ()
+            _ -> do
+              printDebug "[tableNgramsPut] no update for tabType = " tabType
+              pure ()
+          pure ()
+      pure ret
+     
+  {-
+  { _ne_list        :: ListType
+  If we merge the parents/children we can potentially create cycles!
+  , _ne_parent      :: Maybe NgramsTerm
+  , _ne_children    :: MSet NgramsTerm
+  }
+  -}
+
+getNgramsTableMap :: RepoCmdM env err m
+                  => NodeId
+                  -> TableNgrams.NgramsType
+                  -> m (Versioned NgramsTableMap)
+getNgramsTableMap nodeId ngramsType = do
+  v    <- view repoVar
+  repo <- liftBase $ readMVar v
+  pure $ Versioned (repo ^. r_version)
+                   (repo ^. r_state . at ngramsType . _Just . at nodeId . _Just)
+
+dumpJsonTableMap :: RepoCmdM env err m
+                 => Text
+                 -> NodeId
+                 -> TableNgrams.NgramsType
+                 -> m ()
+dumpJsonTableMap fpath nodeId ngramsType = do
+  m <- getNgramsTableMap nodeId ngramsType
+  liftBase $ DTL.writeFile (unpack fpath) (DAT.encodeToLazyText m)
+  pure ()
+
+type MinSize = Int
+type MaxSize = Int
 
 -- | TODO Errors management
 --  TODO: polymorphic for Annuaire or Corpus or ...
-getTableNgrams :: HasNodeError err
-               => CorpusId -> Maybe TabType
-               -> Maybe ListId -> Maybe Limit -> Maybe Offset
-               -> Cmd err (Versioned NgramsTable)
-getTableNgrams cId maybeTabType maybeListId mlimit moffset = do
-  let ngramsType = ngramsTypeFromTabType maybeTabType
-  listId <- maybe (defaultList cId) pure maybeListId
-
+-- | Table of Ngrams is a ListNgrams formatted (sorted and/or cut).
+-- TODO: should take only one ListId
+
+getTime' :: MonadBase IO m => m TimeSpec
+getTime' = liftBase $ getTime ProcessCPUTime
+
+
+getTableNgrams :: forall env err m.
+                  (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
+               => NodeType -> NodeId -> TabType
+               -> ListId -> Limit -> Maybe Offset
+               -> Maybe ListType
+               -> Maybe MinSize -> Maybe MaxSize
+               -> Maybe OrderBy
+               -> (NgramsTerm -> Bool)
+               -> m (Versioned NgramsTable)
+getTableNgrams _nType nId tabType listId limit_ offset
+               listType minSize maxSize orderBy searchQuery = do
+
+  t0 <- getTime'
+  -- lIds <- selectNodesWithUsername NodeList userMaster
   let
-    defaultLimit = 10 -- TODO
-    limit_  = maybe defaultLimit identity mlimit
-    offset_ = maybe 0 identity moffset
+    ngramsType = ngramsTypeFromTabType tabType
+    offset'  = maybe 0 identity offset
+    listType' = maybe (const True) (==) listType
+    minSize'  = maybe (const True) (<=) minSize
+    maxSize'  = maybe (const True) (>=) maxSize
+
+    selected_node n = minSize'     s
+                   && maxSize'     s
+                   && searchQuery  (n ^. ne_ngrams)
+                   && listType'    (n ^. ne_list)
+      where
+        s = n ^. ne_size
+
+    selected_inner roots n = maybe False (`Set.member` roots) (n ^. ne_root)
+
+    ---------------------------------------
+    sortOnOrder Nothing = identity
+    sortOnOrder (Just TermAsc)   = List.sortOn $ view ne_ngrams
+    sortOnOrder (Just TermDesc)  = List.sortOn $ Down . view ne_ngrams
+    sortOnOrder (Just ScoreAsc)  = List.sortOn $ view ne_occurrences
+    sortOnOrder (Just ScoreDesc) = List.sortOn $ Down . view ne_occurrences
+
+    ---------------------------------------
+    selectAndPaginate :: Map NgramsTerm NgramsElement -> [NgramsElement]
+    selectAndPaginate tableMap = roots <> inners
+      where
+        list = tableMap ^.. each
+        rootOf ne = maybe ne (\r -> fromMaybe (panic "getTableNgrams: invalid root") (tableMap ^. at r))
+                             (ne ^. ne_root)
+        selected_nodes = list & take limit_
+                              . drop offset'
+                              . filter selected_node
+                              . sortOnOrder orderBy
+        roots = rootOf <$> selected_nodes
+        rootsSet = Set.fromList (_ne_ngrams <$> roots)
+        inners = list & filter (selected_inner rootsSet)
+
+    ---------------------------------------
+    setScores :: forall t. Each t t NgramsElement NgramsElement => Bool -> t -> m t
+    setScores False table = pure table
+    setScores True  table = do
+      let ngrams_terms = unNgramsTerm <$> (table ^.. each . ne_ngrams)
+      t1 <- getTime'
+      occurrences <- getOccByNgramsOnlyFast' nId
+                                             listId
+                                            ngramsType
+                                            ngrams_terms
+      t2 <- getTime'
+      liftBase $ hprint stderr
+        ("getTableNgrams/setScores #ngrams=" % int % " time=" % timeSpecs % "\n")
+        (length ngrams_terms) t1 t2
+      {-
+      occurrences <- getOccByNgramsOnlySlow nType nId
+                                            (lIds <> [listId])
+                                            ngramsType
+                                            ngrams_terms
+      -}
+      let
+        setOcc ne = ne & ne_occurrences .~ sumOf (at (unNgramsTerm (ne ^. ne_ngrams)) . _Just) occurrences
+
+      pure $ table & each %~ setOcc
+    ---------------------------------------
+
+  -- lists <- catMaybes <$> listsWith userMaster
+  -- trace (show lists) $
+  -- getNgramsTableMap ({-lists <>-} listIds) ngramsType
+
+  let scoresNeeded = needsScores orderBy
+  tableMap1 <- getNgramsTableMap listId ngramsType
+  t1 <- getTime'
+  tableMap2 <- tableMap1 & v_data %%~ setScores scoresNeeded
+                                    . Map.mapWithKey ngramsElementFromRepo
+  t2 <- getTime'
+  tableMap3 <- tableMap2 & v_data %%~ fmap NgramsTable
+                                    . setScores (not scoresNeeded)
+                                    . selectAndPaginate
+  t3 <- getTime'
+  liftBase $ hprint stderr
+            ("getTableNgrams total=" % timeSpecs
+                          % " map1=" % timeSpecs
+                          % " map2=" % timeSpecs
+                          % " map3=" % timeSpecs
+                          % " sql="  % (if scoresNeeded then "map2" else "map3")
+                          % "\n"
+            ) t0 t3 t0 t1 t1 t2 t2 t3
+  pure tableMap3
+
+
+scoresRecomputeTableNgrams :: forall env err m. (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env) => NodeId -> TabType -> ListId -> m Int
+scoresRecomputeTableNgrams nId tabType listId = do
+  tableMap <- getNgramsTableMap listId ngramsType
+  _ <- tableMap & v_data %%~ setScores
+                           . Map.mapWithKey ngramsElementFromRepo
+
+  pure $ 1
+  where
+    ngramsType = ngramsTypeFromTabType tabType
+
+    setScores :: forall t. Each t t NgramsElement NgramsElement => t -> m t
+    setScores table = do
+      let ngrams_terms = unNgramsTerm <$> (table ^.. each . ne_ngrams)
+      occurrences <- getOccByNgramsOnlyFast' nId
+                                             listId
+                                            ngramsType
+                                            ngrams_terms
+      let
+        setOcc ne = ne & ne_occurrences .~ sumOf (at (unNgramsTerm (ne ^. ne_ngrams)) . _Just) occurrences
+
+      pure $ table & each %~ setOcc
+
+
+
+-- APIs
+
+-- TODO: find a better place for the code above, All APIs stay here
 
-  ngramsTableDatas <-
-    Ngrams.getNgramsTableDb NodeDocument ngramsType (Ngrams.NgramsTableParam listId cId) limit_ offset_
+data OrderBy = TermAsc | TermDesc | ScoreAsc | ScoreDesc
+             deriving (Generic, Enum, Bounded, Read, Show)
 
-  -- printDebug "ngramsTableDatas" ngramsTableDatas
+instance FromHttpApiData OrderBy
+  where
+    parseUrlPiece "TermAsc"   = pure TermAsc
+    parseUrlPiece "TermDesc"  = pure TermDesc
+    parseUrlPiece "ScoreAsc"  = pure ScoreAsc
+    parseUrlPiece "ScoreDesc" = pure ScoreDesc
+    parseUrlPiece _           = Left "Unexpected value of OrderBy"
+
+
+instance ToParamSchema OrderBy
+instance FromJSON  OrderBy
+instance ToJSON    OrderBy
+instance ToSchema  OrderBy
+instance Arbitrary OrderBy
+  where
+    arbitrary = elements [minBound..maxBound]
 
-  pure $ Versioned 1 $ NgramsTable (toNgramsElement ngramsTableDatas)
+needsScores :: Maybe OrderBy -> Bool
+needsScores (Just ScoreAsc)  = True
+needsScores (Just ScoreDesc) = True
+needsScores _ = 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] (Versioned 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
+
+getTableNgramsCorpus :: (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
+               => NodeId
+               -> TabType
+               -> ListId
+               -> Limit
+               -> Maybe Offset
+               -> Maybe ListType
+               -> Maybe MinSize -> Maybe MaxSize
+               -> Maybe OrderBy
+               -> Maybe Text -- full text search
+               -> m (Versioned NgramsTable)
+getTableNgramsCorpus nId tabType listId limit_ offset listType minSize maxSize orderBy mt =
+  getTableNgrams NodeCorpus nId tabType listId limit_ offset listType minSize maxSize orderBy searchQuery
+    where
+      searchQuery (NgramsTerm nt) = maybe (const True) isInfixOf mt nt
+
+getTableNgramsVersion :: (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
+               => NodeId
+               -> TabType
+               -> ListId
+               -> m Version
+getTableNgramsVersion _nId _tabType _listId = currentVersion
+  -- 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 :: (RepoCmdM env err m, HasNodeError err, HasConnectionPool env, HasConfig env)
+               => DocId -> TabType
+               -> ListId -> Limit -> Maybe Offset
+               -> Maybe ListType
+               -> Maybe MinSize -> Maybe MaxSize
+               -> Maybe OrderBy
+               -> Maybe Text -- full text search
+               -> m (Versioned NgramsTable)
+getTableNgramsDoc dId tabType listId limit_ offset listType minSize maxSize orderBy _mt = do
+  ns <- selectNodesWithUsername NodeList userMaster
+  let ngramsType = ngramsTypeFromTabType tabType
+  ngs <- selectNgramsByDoc (ns <> [listId]) dId ngramsType
+  let searchQuery (NgramsTerm nt) = flip S.member (S.fromList ngs) nt
+  getTableNgrams NodeDocument dId tabType listId limit_ offset listType minSize maxSize orderBy searchQuery
+
+
+
+apiNgramsTableCorpus :: ( RepoCmdM env err m
+                        , HasNodeError err
+                        , HasInvalidError err
+                        , HasConnectionPool env
+                        , HasConfig         env
+                        , HasSettings       env
+                        )
+                     => NodeId -> ServerT TableNgramsApi m
+apiNgramsTableCorpus cId =  getTableNgramsCorpus cId
+                       :<|> tableNgramsPut
+                       :<|> scoresRecomputeTableNgrams cId
+                       :<|> getTableNgramsVersion cId
+
+apiNgramsTableDoc :: ( RepoCmdM env err m
+                     , HasNodeError err
+                     , HasInvalidError err
+                     , HasConnectionPool env
+                     , HasConfig         env
+                     , HasSettings       env
+                     )
+                  => DocId -> ServerT TableNgramsApi m
+apiNgramsTableDoc dId =  getTableNgramsDoc dId
+                    :<|> tableNgramsPut
+                    :<|> scoresRecomputeTableNgrams dId
+                    :<|> getTableNgramsVersion dId
+                    -- > index all the corpus accordingly (TODO AD)
+
+-- 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 :: RepoCmdM env err m
+                       => ListId -> TableNgrams.NgramsType -> Version -> m (Versioned Bool)
+listNgramsChangedSince listId ngramsType version
+  | version < 0 =
+      Versioned <$> currentVersion <*> pure True
+  | otherwise   =
+      tableNgramsPull listId ngramsType version & mapped . v_data %~ (== mempty)