src/Gargantext/API/Ngrams.hs

   1 {-|
   2 Module      : Gargantext.API.Ngrams
   3 Description : Server API
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 Ngrams API
  11
  12 -- | TODO
  13 get ngrams filtered by NgramsType
  14 add get
  15
  16 -}
  17
  18 {-# LANGUAGE ConstraintKinds   #-}
  19 {-# LANGUAGE DataKinds         #-}
  20 {-# LANGUAGE DeriveGeneric     #-}
  21 {-# LANGUAGE NoImplicitPrelude #-}
  22 {-# LANGUAGE OverloadedStrings #-}
  23 {-# LANGUAGE ScopedTypeVariables #-}
  24 {-# LANGUAGE TemplateHaskell   #-}
  25 {-# LANGUAGE TypeOperators     #-}
  26 {-# LANGUAGE FlexibleContexts  #-}
  27 {-# LANGUAGE FlexibleInstances #-}
  28 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  29 {-# LANGUAGE MultiParamTypeClasses #-}
  30 {-# LANGUAGE RankNTypes        #-}
  31 {-# LANGUAGE TypeFamilies      #-}
  32 {-# OPTIONS -fno-warn-orphans #-}
  33
  34 module Gargantext.API.Ngrams
  35   where
  36
  37 -- import Debug.Trace (trace)
  38 import Prelude (Enum, Bounded, Semigroup(..), minBound, maxBound {-, round-}, error)
  39 -- import Gargantext.Database.Schema.User  (UserId)
  40 import Data.Patch.Class (Replace, replace, Action(act), Applicable(..),
  41                          Composable(..), Transformable(..),
  42                          PairPatch(..), Patched, ConflictResolution,
  43                          ConflictResolutionReplace, ours)
  44 import qualified Data.Map.Strict.Patch as PM
  45 import Data.Monoid
  46 import Data.Ord (Down(..))
  47 import Data.Foldable
  48 --import Data.Semigroup
  49 import Data.Set (Set)
  50 import qualified Data.Set as S
  51 import qualified Data.List as List
  52 import Data.Maybe (fromMaybe)
  53 -- import Data.Tuple.Extra (first)
  54 import qualified Data.Map.Strict as Map
  55 import Data.Map.Strict (Map)
  56 import qualified Data.Set as Set
  57 import Control.Category ((>>>))
  58 import Control.Concurrent
  59 import Control.Lens (makeLenses, makePrisms, Getter, Iso', iso, from, (.~), (?=), (#), to, folded, {-withIndex, ifolded,-} view, use, (^.), (^..), (^?), (+~), (%~), (%=), sumOf, at, _Just, Each(..), itraverse_, both, forOf_, (%%~))
  60 import Control.Monad.Error.Class (MonadError)
  61 import Control.Monad.Reader
  62 import Control.Monad.State
  63 import Data.Aeson hiding ((.=))
  64 import Data.Aeson.TH (deriveJSON)
  65 import Data.Either(Either(Left))
  66 -- import Data.Map (lookup)
  67 import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
  68 import Data.Swagger hiding (version, patch)
  69 import Data.Text (Text, isInfixOf, count)
  70 import Data.Validity
  71 import GHC.Generics (Generic)
  72 import Gargantext.Core.Utils.Prefix (unPrefix)
  73 -- import Gargantext.Database.Schema.Ngrams (NgramsTypeId, ngramsTypeId, NgramsTableData(..))
  74 import Gargantext.Database.Config (userMaster)
  75 import Gargantext.Database.Metrics.NgramsByNode (getOccByNgramsOnlyFast)
  76 import Gargantext.Database.Schema.Ngrams (NgramsType)
  77 import Gargantext.Database.Types.Node (NodeType(..))
  78 import Gargantext.Database.Utils (fromField', HasConnection)
  79 import Gargantext.Database.Node.Select
  80 import Gargantext.Database.Ngrams
  81 --import Gargantext.Database.Lists (listsWith)
  82 import Gargantext.Database.Schema.Node (HasNodeError)
  83 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
  84 import qualified Gargantext.Database.Schema.Ngrams as Ngrams
  85 -- import Gargantext.Database.Schema.NodeNgram hiding (Action)
  86 import Gargantext.Prelude
  87 -- import Gargantext.Core.Types (ListTypeId, listTypeId)
  88 import Gargantext.Core.Types (ListType(..), NodeId, ListId, DocId, Limit, Offset, HasInvalidError, assertValid)
  89 import Servant hiding (Patch)
  90 import System.FileLock (FileLock)
  91 import Test.QuickCheck (elements)
  92 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  93
  94 data TODO = TODO
  95   deriving (Generic)
  96
  97 instance ToSchema TODO where
  98 instance ToParamSchema TODO where
  99
 100 ------------------------------------------------------------------------
 101 --data FacetFormat = Table | Chart
 102 data TabType   = Docs   | Trash   | MoreFav | MoreTrash
 103                | Terms  | Sources | Authors | Institutes
 104                | Contacts
 105   deriving (Generic, Enum, Bounded)
 106
 107 instance FromHttpApiData TabType
 108   where
 109     parseUrlPiece "Docs"       = pure Docs
 110     parseUrlPiece "Trash"      = pure Trash
 111     parseUrlPiece "MoreFav"    = pure MoreFav
 112     parseUrlPiece "MoreTrash"  = pure MoreTrash
 113
 114     parseUrlPiece "Terms"      = pure Terms
 115     parseUrlPiece "Sources"    = pure Sources
 116     parseUrlPiece "Institutes" = pure Institutes
 117     parseUrlPiece "Authors"    = pure Authors
 118
 119     parseUrlPiece "Contacts"   = pure Contacts
 120
 121     parseUrlPiece _            = Left "Unexpected value of TabType"
 122
 123 instance ToParamSchema   TabType
 124 instance ToJSON    TabType
 125 instance FromJSON  TabType
 126 instance ToSchema  TabType
 127 instance Arbitrary TabType
 128   where
 129     arbitrary = elements [minBound .. maxBound]
 130
 131 newtype MSet a = MSet (Map a ())
 132   deriving (Eq, Ord, Show, Generic, Arbitrary, Semigroup, Monoid)
 133
 134 instance ToJSON a => ToJSON (MSet a) where
 135   toJSON     (MSet m) = toJSON     (Map.keys m)
 136   toEncoding (MSet m) = toEncoding (Map.keys m)
 137
 138 mSetFromSet :: Set a -> MSet a
 139 mSetFromSet = MSet . Map.fromSet (const ())
 140
 141 mSetFromList :: Ord a => [a] -> MSet a
 142 mSetFromList = MSet . Map.fromList . map (\x -> (x, ()))
 143
 144 -- mSetToSet :: Ord a => MSet a -> Set a
 145 -- mSetToSet (MSet a) = Set.fromList ( Map.keys a)
 146 mSetToSet :: Ord a => MSet a -> Set a
 147 mSetToSet = Set.fromList . mSetToList
 148
 149 mSetToList :: MSet a -> [a]
 150 mSetToList (MSet a) = Map.keys a
 151
 152 instance Foldable MSet where
 153   foldMap f (MSet m) = Map.foldMapWithKey (\k _ -> f k) m
 154
 155 instance (Ord a, FromJSON a) => FromJSON (MSet a) where
 156   parseJSON = fmap mSetFromList . parseJSON
 157
 158 instance (ToJSONKey a, ToSchema a) => ToSchema (MSet a) where
 159   -- TODO
 160   declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
 161
 162 ------------------------------------------------------------------------
 163 type NgramsTerm = Text
 164
 165 data RootParent = RootParent
 166   { _rp_root   :: NgramsTerm
 167   , _rp_parent :: NgramsTerm
 168   }
 169   deriving (Ord, Eq, Show, Generic)
 170
 171 deriveJSON (unPrefix "_rp_") ''RootParent
 172 makeLenses ''RootParent
 173
 174 data NgramsRepoElement = NgramsRepoElement
 175   { _nre_size        :: Int
 176   , _nre_list        :: ListType
 177 --, _nre_root_parent :: Maybe RootParent
 178   , _nre_root        :: Maybe NgramsTerm
 179   , _nre_parent      :: Maybe NgramsTerm
 180   , _nre_children    :: MSet NgramsTerm
 181   }
 182   deriving (Ord, Eq, Show, Generic)
 183
 184 deriveJSON (unPrefix "_nre_") ''NgramsRepoElement
 185 makeLenses ''NgramsRepoElement
 186
 187 data NgramsElement =
 188      NgramsElement { _ne_ngrams      :: NgramsTerm
 189                    , _ne_size        :: Int
 190                    , _ne_list        :: ListType
 191                    , _ne_occurrences :: Int
 192                    , _ne_root        :: Maybe NgramsTerm
 193                    , _ne_parent      :: Maybe NgramsTerm
 194                    , _ne_children    :: MSet NgramsTerm
 195                    }
 196       deriving (Ord, Eq, Show, Generic)
 197
 198 deriveJSON (unPrefix "_ne_") ''NgramsElement
 199 makeLenses ''NgramsElement
 200
 201 mkNgramsElement :: NgramsTerm -> ListType -> Maybe RootParent -> MSet NgramsTerm -> NgramsElement
 202 mkNgramsElement ngrams list rp children =
 203   NgramsElement ngrams size list 1 (_rp_root <$> rp) (_rp_parent <$> rp) children
 204   where
 205     -- TODO review
 206     size = 1 + count " " ngrams
 207
 208 newNgramsElement :: Maybe ListType -> NgramsTerm -> NgramsElement
 209 newNgramsElement mayList ngrams = mkNgramsElement ngrams (fromMaybe GraphTerm mayList) Nothing mempty
 210
 211 instance ToSchema NgramsElement
 212 instance Arbitrary NgramsElement where
 213   arbitrary = elements [newNgramsElement Nothing "sport"]
 214
 215 ngramsElementToRepo :: NgramsElement -> NgramsRepoElement
 216 ngramsElementToRepo
 217   (NgramsElement { _ne_size = s
 218                  , _ne_list = l
 219                  , _ne_root = r
 220                  , _ne_parent = p
 221                  , _ne_children = c
 222                  }) =
 223   NgramsRepoElement
 224     { _nre_size = s
 225     , _nre_list = l
 226     , _nre_parent = p
 227     , _nre_root   = r
 228     , _nre_children = c
 229     }
 230
 231 ngramsElementFromRepo :: NgramsTerm -> NgramsRepoElement -> NgramsElement
 232 ngramsElementFromRepo
 233   ngrams
 234   (NgramsRepoElement
 235       { _nre_size = s
 236       , _nre_list = l
 237       , _nre_parent = p
 238       , _nre_root = r
 239       , _nre_children = c
 240       }) =
 241   NgramsElement { _ne_size = s
 242                 , _ne_list = l
 243                 , _ne_root = r
 244                 , _ne_parent = p
 245                 , _ne_children = c
 246                 , _ne_ngrams = ngrams
 247                 , _ne_occurrences = panic $ "API.Ngrams._ne_occurrences"
 248                 {-
 249                 -- Here we could use 0 if we want to avoid any `panic`.
 250                 -- It will not happen using getTableNgrams if
 251                 -- getOccByNgramsOnly provides a count of occurrences for
 252                 -- all the ngrams given.
 253                 -}
 254                 }
 255
 256 ------------------------------------------------------------------------
 257 newtype NgramsTable = NgramsTable [NgramsElement]
 258   deriving (Ord, Eq, Generic, ToJSON, FromJSON, Show)
 259
 260 type ListNgrams = NgramsTable
 261
 262 makePrisms ''NgramsTable
 263
 264 -- | Question: why these repetition of Type in this instance
 265 -- may you document it please ?
 266 instance Each NgramsTable NgramsTable NgramsElement NgramsElement where
 267   each = _NgramsTable . each
 268
 269 -- TODO discuss
 270 -- | TODO Check N and Weight
 271 {-
 272 toNgramsElement :: [NgramsTableData] -> [NgramsElement]
 273 toNgramsElement ns = map toNgramsElement' ns
 274     where
 275       toNgramsElement' (NgramsTableData _ p t _ lt w) = NgramsElement t lt' (round w) p' c'
 276         where
 277           p' = case p of
 278                  Nothing -> Nothing
 279                  Just x  -> lookup x mapParent
 280           c' = maybe mempty identity $ lookup t mapChildren
 281           lt' = maybe (panic "API.Ngrams: listypeId") identity lt
 282
 283       mapParent :: Map Int Text
 284       mapParent   = Map.fromListWith (<>) $ map (\(NgramsTableData i _ t _ _ _) -> (i,t)) ns
 285
 286       mapChildren :: Map Text (Set Text)
 287       mapChildren = Map.mapKeys (\i -> (maybe (panic "API.Ngrams.mapChildren: ParentId with no Terms: Impossible") identity $ lookup i mapParent))
 288                   $ Map.fromListWith (<>)
 289                   $ map (first fromJust)
 290                   $ filter (isJust . fst)
 291                   $ map (\(NgramsTableData _ p t _ _ _) -> (p, Set.singleton t)) ns
 292 -}
 293
 294 mockTable :: NgramsTable
 295 mockTable = NgramsTable
 296   [ mkNgramsElement "animal"  GraphTerm      Nothing       (mSetFromList ["dog", "cat"])
 297   , mkNgramsElement "cat"     GraphTerm     (rp "animal")  mempty
 298   , mkNgramsElement "cats"    StopTerm       Nothing       mempty
 299   , mkNgramsElement "dog"     GraphTerm     (rp "animal")  (mSetFromList ["dogs"])
 300   , mkNgramsElement "dogs"    StopTerm      (rp "dog")     mempty
 301   , mkNgramsElement "fox"     GraphTerm      Nothing       mempty
 302   , mkNgramsElement "object"  CandidateTerm  Nothing       mempty
 303   , mkNgramsElement "nothing" StopTerm       Nothing       mempty
 304   , mkNgramsElement "organic" GraphTerm      Nothing       (mSetFromList ["flower"])
 305   , mkNgramsElement "flower"  GraphTerm     (rp "organic") mempty
 306   , mkNgramsElement "moon"    CandidateTerm  Nothing       mempty
 307   , mkNgramsElement "sky"     StopTerm       Nothing       mempty
 308   ]
 309   where
 310     rp n = Just $ RootParent n n
 311
 312 instance Arbitrary NgramsTable where
 313   arbitrary = pure mockTable
 314
 315 instance ToSchema NgramsTable
 316
 317 ------------------------------------------------------------------------
 318 type NgramsTableMap = Map NgramsTerm NgramsRepoElement
 319
 320 ------------------------------------------------------------------------
 321 -- On the Client side:
 322 --data Action = InGroup     NgramsId NgramsId
 323 --            | OutGroup    NgramsId NgramsId
 324 --            | SetListType NgramsId ListType
 325
 326 data PatchSet a = PatchSet
 327   { _rem :: Set a
 328   , _add :: Set a
 329   }
 330   deriving (Eq, Ord, Show, Generic)
 331
 332 makeLenses ''PatchSet
 333 makePrisms ''PatchSet
 334
 335 instance ToJSON a => ToJSON (PatchSet a) where
 336   toJSON     = genericToJSON     $ unPrefix "_"
 337   toEncoding = genericToEncoding $ unPrefix "_"
 338
 339 instance (Ord a, FromJSON a) => FromJSON (PatchSet a) where
 340   parseJSON = genericParseJSON $ unPrefix "_"
 341
 342 {-
 343 instance (Ord a, Arbitrary a) => Arbitrary (PatchSet a) where
 344   arbitrary = PatchSet <$> arbitrary <*> arbitrary
 345
 346 type instance Patched (PatchSet a) = Set a
 347
 348 type ConflictResolutionPatchSet a = SimpleConflictResolution' (Set a)
 349 type instance ConflictResolution (PatchSet a) = ConflictResolutionPatchSet a
 350
 351 instance Ord a => Semigroup (PatchSet a) where
 352   p <> q = PatchSet { _rem = (q ^. rem) `Set.difference` (p ^. add) <> p ^. rem
 353                     , _add = (q ^. add) `Set.difference` (p ^. rem) <> p ^. add
 354                     } -- TODO Review
 355
 356 instance Ord a => Monoid (PatchSet a) where
 357   mempty = PatchSet mempty mempty
 358
 359 instance Ord a => Group (PatchSet a) where
 360   invert (PatchSet r a) = PatchSet a r
 361
 362 instance Ord a => Composable (PatchSet a) where
 363   composable _ _ = undefined
 364
 365 instance Ord a => Action (PatchSet a) (Set a) where
 366   act p source = (source `Set.difference` (p ^. rem)) <> p ^. add
 367
 368 instance Applicable (PatchSet a) (Set a) where
 369   applicable _ _ = mempty
 370
 371 instance Ord a => Validity (PatchSet a) where
 372   validate p = check (Set.disjoint (p ^. rem) (p ^. add)) "_rem and _add should be dijoint"
 373
 374 instance Ord a => Transformable (PatchSet a) where
 375   transformable = undefined
 376
 377   conflicts _p _q = undefined
 378
 379   transformWith conflict p q = undefined conflict p q
 380
 381 instance ToSchema a => ToSchema (PatchSet a)
 382 -}
 383
 384 type AddRem = Replace (Maybe ())
 385
 386 remPatch, addPatch :: AddRem
 387 remPatch = replace (Just ()) Nothing
 388 addPatch = replace Nothing (Just ())
 389
 390 isRem :: Replace (Maybe ()) -> Bool
 391 isRem = (== remPatch)
 392
 393 type PatchMap = PM.PatchMap
 394
 395 newtype PatchMSet a = PatchMSet (PatchMap a AddRem)
 396   deriving (Eq, Show, Generic, Validity, Semigroup, Monoid,
 397             Transformable, Composable)
 398
 399 type ConflictResolutionPatchMSet a = a -> ConflictResolutionReplace (Maybe ())
 400 type instance ConflictResolution (PatchMSet a) = ConflictResolutionPatchMSet a
 401
 402 -- TODO this breaks module abstraction
 403 makePrisms ''PM.PatchMap
 404
 405 makePrisms ''PatchMSet
 406
 407 _PatchMSetIso :: Ord a => Iso' (PatchMSet a) (PatchSet a)
 408 _PatchMSetIso = _PatchMSet . _PatchMap . iso f g . from _PatchSet
 409   where
 410     f :: Ord a => Map a (Replace (Maybe ())) -> (Set a, Set a)
 411     f = Map.partition isRem >>> both %~ Map.keysSet
 412
 413     g :: Ord a => (Set a, Set a) -> Map a (Replace (Maybe ()))
 414     g (rems, adds) = Map.fromSet (const remPatch) rems
 415                   <> Map.fromSet (const addPatch) adds
 416
 417 instance Ord a => Action (PatchMSet a) (MSet a) where
 418   act (PatchMSet p) (MSet m) = MSet $ act p m
 419
 420 instance Ord a => Applicable (PatchMSet a) (MSet a) where
 421   applicable (PatchMSet p) (MSet m) = applicable p m
 422
 423 instance (Ord a, ToJSON a) => ToJSON (PatchMSet a) where
 424   toJSON     = toJSON . view _PatchMSetIso
 425   toEncoding = toEncoding . view _PatchMSetIso
 426
 427 instance (Ord a, FromJSON a) => FromJSON (PatchMSet a) where
 428   parseJSON = fmap (_PatchMSetIso #) . parseJSON
 429
 430 instance (Ord a, Arbitrary a) => Arbitrary (PatchMSet a) where
 431   arbitrary = (PatchMSet . PM.fromMap) <$> arbitrary
 432
 433 instance ToSchema a => ToSchema (PatchMSet a) where
 434   -- TODO
 435   declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
 436
 437 type instance Patched (PatchMSet a) = MSet a
 438
 439 instance (Eq a, Arbitrary a) => Arbitrary (Replace a) where
 440   arbitrary = uncurry replace <$> arbitrary
 441     -- If they happen to be equal then the patch is Keep.
 442
 443 instance ToSchema a => ToSchema (Replace a) where
 444   declareNamedSchema (_ :: proxy (Replace a)) = do
 445     -- TODO Keep constructor is not supported here.
 446     aSchema <- declareSchemaRef (Proxy :: Proxy a)
 447     return $ NamedSchema (Just "Replace") $ mempty
 448       & type_ .~ SwaggerObject
 449       & properties .~
 450           InsOrdHashMap.fromList
 451           [ ("old", aSchema)
 452           , ("new", aSchema)
 453           ]
 454       & required .~ [ "old", "new" ]
 455
 456 data NgramsPatch =
 457      NgramsPatch { _patch_children :: PatchMSet NgramsTerm
 458                  , _patch_list     :: Replace ListType   -- TODO Map UserId ListType
 459                  }
 460       deriving (Eq, Show, Generic)
 461
 462 deriveJSON (unPrefix "_") ''NgramsPatch
 463 makeLenses ''NgramsPatch
 464
 465 instance ToSchema  NgramsPatch
 466
 467 instance Arbitrary NgramsPatch where
 468   arbitrary = NgramsPatch <$> arbitrary <*> (replace <$> arbitrary <*> arbitrary)
 469
 470 type NgramsPatchIso = PairPatch (PatchMSet NgramsTerm) (Replace ListType)
 471
 472 _NgramsPatch :: Iso' NgramsPatch NgramsPatchIso
 473 _NgramsPatch = iso (\(NgramsPatch c l) -> c :*: l) (\(c :*: l) -> NgramsPatch c l)
 474
 475 instance Semigroup NgramsPatch where
 476   p <> q = _NgramsPatch # (p ^. _NgramsPatch <> q ^. _NgramsPatch)
 477
 478 instance Monoid NgramsPatch where
 479   mempty = _NgramsPatch # mempty
 480
 481 instance Validity NgramsPatch where
 482   validate p = p ^. _NgramsPatch . to validate
 483
 484 instance Transformable NgramsPatch where
 485   transformable p q = transformable (p ^. _NgramsPatch) (q ^. _NgramsPatch)
 486
 487   conflicts p q = conflicts (p ^. _NgramsPatch) (q ^. _NgramsPatch)
 488
 489   transformWith conflict p q = (_NgramsPatch # p', _NgramsPatch # q')
 490     where
 491       (p', q') = transformWith conflict (p ^. _NgramsPatch) (q ^. _NgramsPatch)
 492
 493 type ConflictResolutionNgramsPatch =
 494   ( ConflictResolutionPatchMSet NgramsTerm
 495   , ConflictResolutionReplace ListType
 496   )
 497 type instance ConflictResolution NgramsPatch =
 498   ConflictResolutionNgramsPatch
 499
 500 type PatchedNgramsPatch = (Set NgramsTerm, ListType)
 501   -- ~ Patched NgramsPatchIso
 502 type instance Patched NgramsPatch = PatchedNgramsPatch
 503
 504 instance Applicable NgramsPatch (Maybe NgramsRepoElement) where
 505   applicable p Nothing   = check (p == mempty) "NgramsPatch should be empty here"
 506   applicable p (Just nre) =
 507     applicable (p ^. patch_children) (nre ^. nre_children) <>
 508     applicable (p ^. patch_list)     (nre ^. nre_list)
 509
 510 instance Action NgramsPatch NgramsRepoElement where
 511   act p = (nre_children %~ act (p ^. patch_children))
 512         . (nre_list     %~ act (p ^. patch_list))
 513
 514 instance Action NgramsPatch (Maybe NgramsRepoElement) where
 515   act = fmap . act
 516
 517 newtype NgramsTablePatch = NgramsTablePatch (PatchMap NgramsTerm NgramsPatch)
 518   deriving (Eq, Show, Generic, ToJSON, FromJSON, Semigroup, Monoid, Validity, Transformable)
 519
 520 instance FromField NgramsTablePatch
 521   where
 522     fromField = fromField'
 523
 524 instance FromField (PatchMap NgramsType (PatchMap NodeId NgramsTablePatch))
 525   where
 526     fromField = fromField'
 527
 528 --instance (Ord k, Action pv (Maybe v)) => Action (PatchMap k pv) (Map k v) where
 529 --
 530 type instance ConflictResolution NgramsTablePatch =
 531   NgramsTerm -> ConflictResolutionNgramsPatch
 532
 533 type PatchedNgramsTablePatch = Map NgramsTerm PatchedNgramsPatch
 534   -- ~ Patched (PatchMap NgramsTerm NgramsPatch)
 535 type instance Patched NgramsTablePatch = PatchedNgramsTablePatch
 536
 537 makePrisms ''NgramsTablePatch
 538 instance ToSchema  (PatchMap NgramsTerm NgramsPatch)
 539 instance ToSchema  NgramsTablePatch
 540
 541 instance Applicable NgramsTablePatch (Maybe NgramsTableMap) where
 542   applicable p = applicable (p ^. _NgramsTablePatch)
 543
 544 instance Action NgramsTablePatch (Maybe NgramsTableMap) where
 545   act p =
 546     fmap (execState (reParentNgramsTablePatch p)) .
 547     act (p ^. _NgramsTablePatch)
 548
 549 instance Arbitrary NgramsTablePatch where
 550   arbitrary = NgramsTablePatch <$> PM.fromMap <$> arbitrary
 551
 552 -- Should it be less than an Lens' to preserve PatchMap's abstraction.
 553 -- ntp_ngrams_patches :: Lens' NgramsTablePatch (Map NgramsTerm NgramsPatch)
 554 -- ntp_ngrams_patches = _NgramsTablePatch .  undefined
 555
 556 type ReParent a = forall m. MonadState NgramsTableMap m => a -> m ()
 557
 558 reRootChildren :: NgramsTerm -> ReParent NgramsTerm
 559 reRootChildren root ngram = do
 560   nre <- use $ at ngram
 561   forOf_ (_Just . nre_children . folded) nre $ \child -> do
 562     at child . _Just . nre_root ?= root
 563     reRootChildren root child
 564
 565 reParent :: Maybe RootParent -> ReParent NgramsTerm
 566 reParent rp child = do
 567   at child . _Just %= ( (nre_parent .~ (_rp_parent <$> rp))
 568                       . (nre_root   .~ (_rp_root   <$> rp))
 569                       )
 570   reRootChildren (fromMaybe child (rp ^? _Just . rp_root)) child
 571
 572 reParentAddRem :: RootParent -> NgramsTerm -> ReParent AddRem
 573 reParentAddRem rp child p =
 574   reParent (if isRem p then Nothing else Just rp) child
 575
 576 reParentNgramsPatch :: NgramsTerm -> ReParent NgramsPatch
 577 reParentNgramsPatch parent ngramsPatch = do
 578   root_of_parent <- use (at parent . _Just . nre_root)
 579   let
 580     root = fromMaybe parent root_of_parent
 581     rp   = RootParent { _rp_root = root, _rp_parent = parent }
 582   itraverse_ (reParentAddRem rp) (ngramsPatch ^. patch_children . _PatchMSet . _PatchMap)
 583   -- TODO FoldableWithIndex/TraversableWithIndex for PatchMap
 584
 585 reParentNgramsTablePatch :: ReParent NgramsTablePatch
 586 reParentNgramsTablePatch p = itraverse_ reParentNgramsPatch (p ^. _NgramsTablePatch. _PatchMap)
 587   -- TODO FoldableWithIndex/TraversableWithIndex for PatchMap
 588
 589 ------------------------------------------------------------------------
 590 ------------------------------------------------------------------------
 591 type Version = Int
 592
 593 data Versioned a = Versioned
 594   { _v_version :: Version
 595   , _v_data    :: a
 596   }
 597   deriving (Generic, Show)
 598 deriveJSON (unPrefix "_v_") ''Versioned
 599 makeLenses ''Versioned
 600 instance ToSchema a => ToSchema (Versioned a)
 601 instance Arbitrary a => Arbitrary (Versioned a) where
 602   arbitrary = Versioned 1 <$> arbitrary -- TODO 1 is constant so far
 603
 604 {-
 605 -- TODO sequencs of modifications (Patchs)
 606 type NgramsIdPatch = Patch NgramsId NgramsPatch
 607
 608 ngramsPatch :: Int -> NgramsPatch
 609 ngramsPatch n = NgramsPatch (DM.fromList [(1, StopTerm)]) (Set.fromList [n]) Set.empty
 610
 611 toEdit :: NgramsId -> NgramsPatch -> Edit NgramsId NgramsPatch
 612 toEdit n p = Edit n p
 613 ngramsIdPatch :: Patch NgramsId NgramsPatch
 614 ngramsIdPatch = fromList $ catMaybes $ reverse [ replace (1::NgramsId) (Just $ ngramsPatch 1) Nothing
 615                                        , replace (1::NgramsId) Nothing (Just $ ngramsPatch 2)
 616                                        , replace (2::NgramsId) Nothing (Just $ ngramsPatch 2)
 617                                        ]
 618
 619 -- applyPatchBack :: Patch -> IO Patch
 620 -- isEmptyPatch = Map.all (\x -> Set.isEmpty (add_children x) && Set.isEmpty ... )
 621 -}
 622 ------------------------------------------------------------------------
 623 ------------------------------------------------------------------------
 624 ------------------------------------------------------------------------
 625
 626 {-
 627 -- TODO: Replace.old is ignored which means that if the current list
 628 -- `GraphTerm` and that the patch is `Replace CandidateTerm StopTerm` then
 629 -- the list is going to be `StopTerm` while it should keep `GraphTerm`.
 630 -- However this should not happen in non conflicting situations.
 631 mkListsUpdate :: NgramsType -> NgramsTablePatch -> [(NgramsTypeId, NgramsTerm, ListTypeId)]
 632 mkListsUpdate nt patches =
 633   [ (ngramsTypeId nt, ng, listTypeId lt)
 634   | (ng, patch) <- patches ^.. ntp_ngrams_patches . ifolded . withIndex
 635   , lt <- patch ^.. patch_list . new
 636   ]
 637
 638 mkChildrenGroups :: (PatchSet NgramsTerm -> Set NgramsTerm)
 639                  -> NgramsType
 640                  -> NgramsTablePatch
 641                  -> [(NgramsTypeId, NgramsParent, NgramsChild)]
 642 mkChildrenGroups addOrRem nt patches =
 643   [ (ngramsTypeId nt, parent, child)
 644   | (parent, patch) <- patches ^.. ntp_ngrams_patches . ifolded . withIndex
 645   , child <- patch ^.. patch_children . to addOrRem . folded
 646   ]
 647 -}
 648
 649 ngramsTypeFromTabType :: TabType -> NgramsType
 650 ngramsTypeFromTabType tabType =
 651   let lieu = "Garg.API.Ngrams: " :: Text in
 652     case tabType of
 653       Sources    -> Ngrams.Sources
 654       Authors    -> Ngrams.Authors
 655       Institutes -> Ngrams.Institutes
 656       Terms      -> Ngrams.NgramsTerms
 657       _          -> panic $ lieu <> "No Ngrams for this tab"
 658       -- TODO: This `panic` would disapear with custom NgramsType.
 659
 660 ------------------------------------------------------------------------
 661 data Repo s p = Repo
 662   { _r_version :: Version
 663   , _r_state   :: s
 664   , _r_history :: [p]
 665     -- first patch in the list is the most recent
 666   }
 667   deriving (Generic)
 668
 669 instance (FromJSON s, FromJSON p) => FromJSON (Repo s p) where
 670   parseJSON = genericParseJSON $ unPrefix "_r_"
 671
 672 instance (ToJSON s, ToJSON p) => ToJSON (Repo s p) where
 673   toJSON     = genericToJSON     $ unPrefix "_r_"
 674   toEncoding = genericToEncoding $ unPrefix "_r_"
 675
 676 makeLenses ''Repo
 677
 678 initRepo :: Monoid s => Repo s p
 679 initRepo = Repo 1 mempty []
 680
 681 type NgramsRepo       = Repo NgramsState NgramsStatePatch
 682 type NgramsState      = Map NgramsType (Map NodeId NgramsTableMap)
 683 type NgramsStatePatch = PatchMap NgramsType (PatchMap NodeId NgramsTablePatch)
 684
 685 initMockRepo :: NgramsRepo
 686 initMockRepo = Repo 1 s []
 687   where
 688     s = Map.singleton Ngrams.NgramsTerms
 689       $ Map.singleton 47254
 690       $ Map.fromList
 691       [ (n ^. ne_ngrams, ngramsElementToRepo n) | n <- mockTable ^. _NgramsTable ]
 692
 693 data RepoEnv = RepoEnv
 694   { _renv_var   :: !(MVar NgramsRepo)
 695   , _renv_saver :: !(IO ())
 696   , _renv_lock  :: !FileLock
 697   }
 698   deriving (Generic)
 699
 700 makeLenses ''RepoEnv
 701
 702 class HasRepoVar env where
 703   repoVar :: Getter env (MVar NgramsRepo)
 704
 705 instance HasRepoVar (MVar NgramsRepo) where
 706   repoVar = identity
 707
 708 class HasRepoSaver env where
 709   repoSaver :: Getter env (IO ())
 710
 711 class (HasRepoVar env, HasRepoSaver env) => HasRepo env where
 712   repoEnv :: Getter env RepoEnv
 713
 714 instance HasRepo RepoEnv where
 715   repoEnv = identity
 716
 717 instance HasRepoVar RepoEnv where
 718   repoVar = renv_var
 719
 720 instance HasRepoSaver RepoEnv where
 721   repoSaver = renv_saver
 722
 723 type RepoCmdM env err m =
 724   ( MonadReader env m
 725   , MonadError err m
 726   , MonadIO m
 727   , HasRepo env
 728   )
 729 ------------------------------------------------------------------------
 730
 731 saveRepo :: ( MonadReader env m, MonadIO m, HasRepoSaver env )
 732          => m ()
 733 saveRepo = liftIO =<< view repoSaver
 734
 735 listTypeConflictResolution :: ListType -> ListType -> ListType
 736 listTypeConflictResolution _ _ = undefined -- TODO Use Map User ListType
 737
 738 ngramsStatePatchConflictResolution
 739   :: NgramsType -> NodeId -> NgramsTerm
 740   -> ConflictResolutionNgramsPatch
 741 ngramsStatePatchConflictResolution _ngramsType _nodeId _ngramsTerm
 742   = (const ours, ours)
 743   -- undefined {- TODO think this through -}, listTypeConflictResolution)
 744
 745 -- Current state:
 746 --   Insertions are not considered as patches,
 747 --   they do not extend history,
 748 --   they do not bump version.
 749 insertNewOnly :: a -> Maybe b -> a
 750 insertNewOnly m = maybe m (const $ error "insertNewOnly: impossible")
 751   -- TODO error handling
 752
 753 something :: Monoid a => Maybe a -> a
 754 something Nothing  = mempty
 755 something (Just a) = a
 756
 757 {- unused
 758 -- TODO refactor with putListNgrams
 759 copyListNgrams :: RepoCmdM env err m
 760                => NodeId -> NodeId -> NgramsType
 761                -> m ()
 762 copyListNgrams srcListId dstListId ngramsType = do
 763   var <- view repoVar
 764   liftIO $ modifyMVar_ var $
 765     pure . (r_state . at ngramsType %~ (Just . f . something))
 766   saveRepo
 767   where
 768     f :: Map NodeId NgramsTableMap -> Map NodeId NgramsTableMap
 769     f m = m & at dstListId %~ insertNewOnly (m ^. at srcListId)
 770
 771 -- TODO refactor with putListNgrams
 772 -- The list must be non-empty!
 773 -- The added ngrams must be non-existent!
 774 addListNgrams :: RepoCmdM env err m
 775               => NodeId -> NgramsType
 776               -> [NgramsElement] -> m ()
 777 addListNgrams listId ngramsType nes = do
 778   var <- view repoVar
 779   liftIO $ modifyMVar_ var $
 780     pure . (r_state . at ngramsType . _Just . at listId . _Just <>~ m)
 781   saveRepo
 782   where
 783     m = Map.fromList $ (\n -> (n ^. ne_ngrams, n)) <$> nes
 784 -}
 785
 786 -- If the given list of ngrams elements contains ngrams already in
 787 -- the repo, they will be ignored.
 788 putListNgrams :: RepoCmdM env err m
 789               => NodeId -> NgramsType
 790               -> [NgramsElement] -> m ()
 791 putListNgrams _ _ [] = pure ()
 792 putListNgrams listId ngramsType nes = do
 793   -- printDebug "putListNgrams" (length nes)
 794   var <- view repoVar
 795   liftIO $ modifyMVar_ var $
 796     pure . (r_state . at ngramsType %~ (Just . (at listId %~ (Just . (<> m) . something)) . something))
 797   saveRepo
 798   where
 799     m = Map.fromList $ (\n -> (n ^. ne_ngrams, ngramsElementToRepo n)) <$> nes
 800
 801 tableNgramsPost :: RepoCmdM env err m => TabType -> NodeId -> Maybe ListType -> [NgramsTerm] -> m ()
 802 tableNgramsPost tabType listId mayList =
 803   putListNgrams listId (ngramsTypeFromTabType tabType) . fmap (newNgramsElement mayList)
 804
 805 -- Apply the given patch to the DB and returns the patch to be applied on the
 806 -- client.
 807 tableNgramsPut :: (HasInvalidError err, RepoCmdM env err m)
 808                  => TabType -> ListId
 809                  -> Versioned NgramsTablePatch
 810                  -> m (Versioned NgramsTablePatch)
 811 tableNgramsPut tabType listId (Versioned p_version p_table)
 812   | p_table == mempty = do
 813       let ngramsType        = ngramsTypeFromTabType tabType
 814
 815       var <- view repoVar
 816       r <- liftIO $ readMVar var
 817
 818       let
 819         q = mconcat $ take (r ^. r_version - p_version) (r ^. r_history)
 820         q_table = q ^. _PatchMap . at ngramsType . _Just . _PatchMap . at listId . _Just
 821
 822       pure (Versioned (r ^. r_version) q_table)
 823
 824   | otherwise         = do
 825       let ngramsType        = ngramsTypeFromTabType tabType
 826           (p0, p0_validity) = PM.singleton listId p_table
 827           (p, p_validity)   = PM.singleton ngramsType p0
 828
 829       assertValid p0_validity
 830       assertValid p_validity
 831
 832       var <- view repoVar
 833       vq' <- liftIO $ modifyMVar var $ \r -> do
 834         let
 835           q = mconcat $ take (r ^. r_version - p_version) (r ^. r_history)
 836           (p', q') = transformWith ngramsStatePatchConflictResolution p q
 837           r' = r & r_version +~ 1
 838                 & r_state   %~ act p'
 839                 & r_history %~ (p' :)
 840           q'_table = q' ^. _PatchMap . at ngramsType . _Just . _PatchMap . at listId . _Just
 841         {-
 842         -- Ideally we would like to check these properties. However:
 843         -- * They should be checked only to debug the code. The client data
 844         --   should be able to trigger these.
 845         -- * What kind of error should they throw (we are in IO here)?
 846         -- * Should we keep modifyMVar?
 847         -- * Should we throw the validation in an Exception, catch it around
 848         --   modifyMVar and throw it back as an Error?
 849         assertValid $ transformable p q
 850         assertValid $ applicable p' (r ^. r_state)
 851         -}
 852         pure (r', Versioned (r' ^. r_version) q'_table)
 853
 854       saveRepo
 855       pure vq'
 856
 857 mergeNgramsElement :: NgramsRepoElement -> NgramsRepoElement -> NgramsRepoElement
 858 mergeNgramsElement _neOld neNew = neNew
 859   {-
 860   { _ne_list        :: ListType
 861   If we merge the parents/children we can potentially create cycles!
 862   , _ne_parent      :: Maybe NgramsTerm
 863   , _ne_children    :: MSet NgramsTerm
 864   }
 865   -}
 866
 867 getNgramsTableMap :: RepoCmdM env err m
 868                   => NodeId -> NgramsType -> m (Versioned NgramsTableMap)
 869 getNgramsTableMap nodeId ngramsType = do
 870   v    <- view repoVar
 871   repo <- liftIO $ readMVar v
 872   pure $ Versioned (repo ^. r_version)
 873                    (repo ^. r_state . at ngramsType . _Just . at nodeId . _Just)
 874
 875 type MinSize = Int
 876 type MaxSize = Int
 877
 878 -- | TODO Errors management
 879 --  TODO: polymorphic for Annuaire or Corpus or ...
 880 -- | Table of Ngrams is a ListNgrams formatted (sorted and/or cut).
 881 -- TODO: should take only one ListId
 882
 883
 884
 885
 886 getTableNgrams :: forall env err m.
 887                   (RepoCmdM env err m, HasNodeError err, HasConnection env)
 888                => NodeType -> NodeId -> TabType
 889                -> ListId -> Limit -> Maybe Offset
 890                -> Maybe ListType
 891                -> Maybe MinSize -> Maybe MaxSize
 892                -> Maybe OrderBy
 893                -> (NgramsTerm -> Bool)
 894                -> m (Versioned NgramsTable)
 895 getTableNgrams _nType nId tabType listId limit_ offset
 896                listType minSize maxSize orderBy searchQuery = do
 897
 898   _lIds <- selectNodesWithUsername NodeList userMaster
 899   let
 900     ngramsType = ngramsTypeFromTabType tabType
 901     offset'  = maybe 0 identity offset
 902     listType' = maybe (const True) (==) listType
 903     minSize'  = maybe (const True) (<=) minSize
 904     maxSize'  = maybe (const True) (>=) maxSize
 905
 906     selected_node n = minSize'     s
 907                    && maxSize'     s
 908                    && searchQuery  (n ^. ne_ngrams)
 909                    && listType'    (n ^. ne_list)
 910       where
 911         s = n ^. ne_size
 912
 913     selected_inner roots n = maybe False (`Set.member` roots) (n ^. ne_root)
 914
 915     ---------------------------------------
 916     sortOnOrder Nothing = identity
 917     sortOnOrder (Just TermAsc)   = List.sortOn $ view ne_ngrams
 918     sortOnOrder (Just TermDesc)  = List.sortOn $ Down . view ne_ngrams
 919     sortOnOrder (Just ScoreAsc)  = List.sortOn $ view ne_occurrences
 920     sortOnOrder (Just ScoreDesc) = List.sortOn $ Down . view ne_occurrences
 921
 922     ---------------------------------------
 923     selectAndPaginate :: Map NgramsTerm NgramsElement -> [NgramsElement]
 924     selectAndPaginate tableMap = roots <> inners
 925       where
 926         list = tableMap ^.. each
 927         rootOf ne = maybe ne (\r -> fromMaybe (panic "getTableNgrams: invalid root") (tableMap ^. at r))
 928                              (ne ^. ne_root)
 929         selected_nodes = list & take limit_
 930                               . drop offset'
 931                               . filter selected_node
 932                               . sortOnOrder orderBy
 933         roots = rootOf <$> selected_nodes
 934         rootsSet = Set.fromList (_ne_ngrams <$> roots)
 935         inners = list & filter (selected_inner rootsSet)
 936
 937     ---------------------------------------
 938     setScores :: forall t. Each t t NgramsElement NgramsElement => Bool -> t -> m t
 939     setScores False table = pure table
 940     setScores True  table = do
 941       let ngrams_terms = (table ^.. each . ne_ngrams)
 942       occurrences <- getOccByNgramsOnlyFast nId
 943                                             ngramsType
 944                                             ngrams_terms
 945       {-
 946       occurrences <- getOccByNgramsOnlySlow nType nId
 947                                             (lIds <> [listId])
 948                                             ngramsType
 949                                             ngrams_terms
 950     -}
 951       let
 952         setOcc ne = ne & ne_occurrences .~ sumOf (at (ne ^. ne_ngrams) . _Just) occurrences
 953
 954       pure $ table & each %~ setOcc
 955     ---------------------------------------
 956
 957   -- lists <- catMaybes <$> listsWith userMaster
 958   -- trace (show lists) $
 959   -- getNgramsTableMap ({-lists <>-} listIds) ngramsType
 960
 961   let nSco = needsScores orderBy
 962   tableMap1 <- getNgramsTableMap listId ngramsType
 963   tableMap2 <- tableMap1 & v_data %%~ setScores nSco
 964                                     . Map.mapWithKey ngramsElementFromRepo
 965   tableMap2 & v_data %%~ fmap NgramsTable
 966                        . setScores (not nSco)
 967                        . selectAndPaginate
 968
 969 -- APIs
 970
 971 -- TODO: find a better place for the code above, All APIs stay here
 972 type QueryParamR = QueryParam' '[Required, Strict]
 973
 974
 975 data OrderBy = TermAsc | TermDesc | ScoreAsc | ScoreDesc
 976              deriving (Generic, Enum, Bounded, Read, Show)
 977
 978 instance FromHttpApiData OrderBy
 979   where
 980     parseUrlPiece "TermAsc"   = pure TermAsc
 981     parseUrlPiece "TermDesc"  = pure TermDesc
 982     parseUrlPiece "ScoreAsc"  = pure ScoreAsc
 983     parseUrlPiece "ScoreDesc" = pure ScoreDesc
 984     parseUrlPiece _           = Left "Unexpected value of OrderBy"
 985
 986 instance ToParamSchema OrderBy
 987 instance FromJSON  OrderBy
 988 instance ToJSON    OrderBy
 989 instance ToSchema  OrderBy
 990 instance Arbitrary OrderBy
 991   where
 992     arbitrary = elements [minBound..maxBound]
 993
 994 needsScores :: Maybe OrderBy -> Bool
 995 needsScores (Just ScoreAsc)  = True
 996 needsScores (Just ScoreDesc) = True
 997 needsScores _ = False
 998
 999 type TableNgramsApiGet = Summary " Table Ngrams API Get"
1000                       :> QueryParamR "ngramsType"  TabType
1001                       :> QueryParamR "list"        ListId
1002                       :> QueryParamR "limit"       Limit
1003                       :> QueryParam  "offset"      Offset
1004                       :> QueryParam  "listType"    ListType
1005                       :> QueryParam  "minTermSize" MinSize
1006                       :> QueryParam  "maxTermSize" MaxSize
1007                       :> QueryParam  "orderBy"     OrderBy
1008                       :> QueryParam  "search"      Text
1009                       :> Get    '[JSON] (Versioned NgramsTable)
1010
1011 type TableNgramsApiPut = Summary " Table Ngrams API Change"
1012                        :> QueryParamR "ngramsType" TabType
1013                        :> QueryParamR "list"       ListId
1014                        :> ReqBody '[JSON] (Versioned NgramsTablePatch)
1015                        :> Put     '[JSON] (Versioned NgramsTablePatch)
1016
1017 type TableNgramsApiPost = Summary " Table Ngrams API Adds new ngrams"
1018                        :> QueryParamR "ngramsType" TabType
1019                        :> QueryParamR "list"       ListId
1020                        :> QueryParam  "listType"   ListType
1021                        :> ReqBody '[JSON] [NgramsTerm]
1022                        :> Post    '[JSON] ()
1023
1024 type TableNgramsApi =  TableNgramsApiGet
1025                   :<|> TableNgramsApiPut
1026                   :<|> TableNgramsApiPost
1027
1028 getTableNgramsCorpus :: (RepoCmdM env err m, HasNodeError err, HasConnection env)
1029                => NodeId -> TabType
1030                -> ListId -> Limit -> Maybe Offset
1031                -> Maybe ListType
1032                -> Maybe MinSize -> Maybe MaxSize
1033                -> Maybe OrderBy
1034                -> Maybe Text -- full text search
1035                -> m (Versioned NgramsTable)
1036 getTableNgramsCorpus nId tabType listId limit_ offset listType minSize maxSize orderBy mt =
1037   getTableNgrams NodeCorpus nId tabType listId limit_ offset listType minSize maxSize orderBy searchQuery
1038     where
1039       searchQuery = maybe (const True) isInfixOf mt
1040
1041 -- | Text search is deactivated for now for ngrams by doc only
1042 getTableNgramsDoc :: (RepoCmdM env err m, HasNodeError err, HasConnection env)
1043                => DocId -> TabType
1044                -> ListId -> Limit -> Maybe Offset
1045                -> Maybe ListType
1046                -> Maybe MinSize -> Maybe MaxSize
1047                -> Maybe OrderBy
1048                -> Maybe Text -- full text search
1049                -> m (Versioned NgramsTable)
1050 getTableNgramsDoc dId tabType listId limit_ offset listType minSize maxSize orderBy _mt = do
1051   ns <- selectNodesWithUsername NodeList userMaster
1052   let ngramsType = ngramsTypeFromTabType tabType
1053   ngs <- selectNgramsByDoc (ns <> [listId]) dId ngramsType
1054   let searchQuery = flip S.member (S.fromList ngs)
1055   getTableNgrams NodeDocument dId tabType listId limit_ offset listType minSize maxSize orderBy searchQuery
1056
1057
1058
1059
1060
1061 apiNgramsTableCorpus :: ( RepoCmdM env err m
1062                         , HasNodeError err
1063                         , HasInvalidError err
1064                         , HasConnection env
1065                         )
1066                      => NodeId -> ServerT TableNgramsApi m
1067 apiNgramsTableCorpus cId =  getTableNgramsCorpus cId
1068                        :<|> tableNgramsPut
1069                        :<|> tableNgramsPost
1070
1071
1072 apiNgramsTableDoc :: ( RepoCmdM env err m
1073                      , HasNodeError err
1074                      , HasInvalidError err
1075                      , HasConnection env
1076                      )
1077                   => DocId -> ServerT TableNgramsApi m
1078 apiNgramsTableDoc dId =  getTableNgramsDoc dId
1079                     :<|> tableNgramsPut
1080                     :<|> tableNgramsPost
1081                         -- > add new ngrams in database (TODO AD)
1082                         -- > index all the corpus accordingly (TODO AD)
1083