[DESIGN] NodeStory as generalization of Repo

src/Gargantext/API/Admin/Settings.hs

@@ -38,6 +38,7 @@ import System.IO.Temp (withTempFile)
 import System.Log.FastLogger
 import qualified Data.ByteString.Lazy as L
 
+import Gargantext.Core.Types (NodeId)
 import Gargantext.API.Admin.EnvTypes
 import Gargantext.API.Admin.Types
 import Gargantext.API.Ngrams.Types (NgramsRepo, HasRepo(..), RepoEnv(..), r_version, initRepo, renv_var, renv_lock)
@@ -97,6 +98,11 @@ type RepoDirFilePath = FilePath
 repoSnapshot :: RepoDirFilePath -> FilePath
 repoSnapshot repoDir = repoDir <> "/repo.cbor"
 
+repoSnapshot' :: RepoDirFilePath -> NodeId -> FilePath
+repoSnapshot' repoDir nId = repoDir <> "/repo" <> "-" <> (cs $ show nId) <> ".cbor"
+
+
+
 -- | TODO add hard coded file in Settings
 -- This assumes we own the lock on repoSnapshot.
 repoSaverAction :: RepoDirFilePath -> Serialise a => a -> IO ()
@@ -107,6 +113,17 @@ repoSaverAction repoDir a = do
     hClose h
     renameFile fp (repoSnapshot repoDir)
 
+
+repoSaverAction' :: RepoDirFilePath -> NgramsRepo -> IO ()
+repoSaverAction' repoDir a = do
+  withTempFile "repos" "tmp-repo.cbor" $ \fp h -> do
+    printDebug "repoSaverAction" fp
+    L.hPut h $ serialise a
+    hClose h
+    renameFile fp (repoSnapshot repoDir)
+
+
+
 -- The use of mkDebounce makes sure that repoSaverAction is not called too often.
 -- If repoSaverAction start taking more time than the debounceFreq then it should
 -- be increased.
@@ -161,17 +178,17 @@ devJwkFile = "dev.jwk"
 
 newEnv :: PortNumber -> FilePath -> IO Env
 newEnv port file = do
-  manager     <- newTlsManager
+  manager_env  <- newTlsManager
   settings'    <- devSettings devJwkFile <&> appPort .~ port -- TODO read from 'file'
   when (port /= settings' ^. appPort) $
     panic "TODO: conflicting settings of port"
 
-  config'       <- readConfig file
-  self_url     <- parseBaseUrl $ "http://0.0.0.0:" <> show port
+  config_env   <- readConfig file
+  self_url_env <- parseBaseUrl $ "http://0.0.0.0:" <> show port
   dbParam      <- databaseParameters file
   pool         <- newPool dbParam
-  repo         <- readRepoEnv (_gc_repofilepath config')
-  scrapers_env <- newJobEnv defaultSettings manager
+  repo         <- readRepoEnv (_gc_repofilepath config_env)
+  scrapers_env <- newJobEnv defaultSettings manager_env
   logger       <- newStderrLoggerSet defaultBufSize
 
   pure $ Env
@@ -179,10 +196,10 @@ newEnv port file = do
     , _env_logger   = logger
     , _env_pool     = pool
     , _env_repo     = repo
-    , _env_manager  = manager
+    , _env_manager  = manager_env
     , _env_scrapers = scrapers_env
-    , _env_self_url = self_url
-    , _env_config   = config'
+    , _env_self_url = self_url_env
+    , _env_config   = config_env
     }
 
 newPool :: ConnectInfo -> IO (Pool Connection)

src/Gargantext/API/Ngrams.hs

@@ -281,7 +281,8 @@ newNgramsFromNgramsStatePatch p =
   ]
 
 -- tableNgramsPut :: (HasInvalidError err, RepoCmdM env err m)
-commitStatePatch :: RepoCmdM env err m => Versioned NgramsStatePatch -> m (Versioned NgramsStatePatch)
+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

src/Gargantext/API/Ngrams/Types.hs

@@ -23,7 +23,7 @@ import Data.Hashable (Hashable)
 import Data.Map.Strict (Map)
 import Data.Maybe (fromMaybe)
 import Data.Monoid
-import Data.Patch.Class (Replace, replace, Action(act), Group, Applicable(..), Composable(..), Transformable(..),PairPatch(..), Patched, ConflictResolution, ConflictResolutionReplace,MaybePatch(Mod), unMod, old, new)
+import Data.Patch.Class (Replace, replace, Action(act), Group, Applicable(..), Composable(..), Transformable(..), PairPatch(..), Patched, ConflictResolution, ConflictResolutionReplace, MaybePatch(Mod), unMod, old, new)
 import Data.Set (Set)
 import Data.String (IsString, fromString)
 import Data.Swagger hiding (version, patch)
@@ -577,7 +577,7 @@ ngramsElementFromRepo
                 , _ne_parent      = p
                 , _ne_children    = c
                 , _ne_ngrams      = ngrams
-                , _ne_occurrences = panic $ "API.Ngrams._ne_occurrences"
+                , _ne_occurrences = panic $ "API.Ngrams.Types._ne_occurrences"
                 {-
                 -- Here we could use 0 if we want to avoid any `panic`.
                 -- It will not happen using getTableNgrams if
@@ -666,6 +666,8 @@ instance Arbitrary a => Arbitrary (VersionedWithCount a) where
 toVersionedWithCount :: Count -> Versioned a -> VersionedWithCount a
 toVersionedWithCount count (Versioned version data_) = VersionedWithCount version count data_
 ------------------------------------------------------------------------
+
+-- | TOREMOVE
 data Repo s p = Repo
   { _r_version :: !Version
   , _r_state   :: !s
@@ -674,6 +676,16 @@ data Repo s p = Repo
   }
   deriving (Generic, Show)
 
+
+
+-- | TO REMOVE
+type NgramsRepo       = Repo     NgramsState NgramsStatePatch
+type NgramsState      = Map      TableNgrams.NgramsType (Map NodeId NgramsTableMap)
+type NgramsStatePatch = PatchMap TableNgrams.NgramsType (PatchMap NodeId NgramsTablePatch)
+
+----------------------------------------------------------------------
+
+
 instance (FromJSON s, FromJSON p) => FromJSON (Repo s p) where
   parseJSON = genericParseJSON $ unPrefix "_r_"
 
@@ -688,10 +700,6 @@ makeLenses ''Repo
 initRepo :: Monoid s => Repo s p
 initRepo = Repo 1 mempty []
 
-type NgramsRepo       = Repo NgramsState NgramsStatePatch
-type NgramsState      = Map      TableNgrams.NgramsType (Map NodeId NgramsTableMap)
-type NgramsStatePatch = PatchMap TableNgrams.NgramsType (PatchMap NodeId NgramsTablePatch)
-
 instance Serialise (PM.PatchMap NodeId NgramsTablePatch)
 instance Serialise NgramsStatePatch
 
@@ -718,6 +726,8 @@ class HasRepoVar env where
 instance HasRepoVar (MVar NgramsRepo) where
   repoVar = identity
 
+
+
 class HasRepoSaver env where
   repoSaver :: Getter env (IO ())
 
@@ -756,13 +766,13 @@ instance FromHttpApiData (Map TableNgrams.NgramsType (Versioned NgramsTableMap))
 
 ngramsTypeFromTabType :: TabType -> TableNgrams.NgramsType
 ngramsTypeFromTabType tabType =
-  let lieu = "Garg.API.Ngrams: " :: Text in
+  let here = "Garg.API.Ngrams: " :: Text in
     case tabType of
       Sources    -> TableNgrams.Sources
       Authors    -> TableNgrams.Authors
       Institutes -> TableNgrams.Institutes
       Terms      -> TableNgrams.NgramsTerms
-      _          -> panic $ lieu <> "No Ngrams for this tab"
+      _          -> panic $ here <> "No Ngrams for this tab"
       -- TODO: This `panic` would disapear with custom NgramsType.
 
 ----

src/Gargantext/API/Swagger.hs

@@ -25,7 +25,7 @@ import Gargantext.Prelude
 -- | Swagger Specifications
 swaggerDoc :: Swagger
 swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
-  & info.title       .~ "Gargantext"
+  & info.title       .~ "GarganText"
   & info.version     .~ (cs $ showVersion PG.version)
   -- & info.base_url     ?~ (URL "http://gargantext.org/")
   & info.description ?~ "REST API specifications"
@@ -34,4 +34,4 @@ swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
                  ["Gargantext" & description ?~ "Main operations"]
   & info.license     ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
     where
-        urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
+        urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
\ No newline at end of file

src/Gargantext/Core/NodeStory.hs

+{-|
+Module      : Gargantext.Core.NodeStory
+Description : Node API generation
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+
+module Gargantext.Core.NodeStory where
+
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as Dict
+import Data.Map (Map)
+import Data.Map as Map
+import Gargantext.API.Ngrams.Types
+import Gargantext.Core.Types (ListType(..), ListId, NodeId)
+import Data.IntMap as Bibliotheque
+import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
+import Gargantext.Prelude
+import GHC.Generics (Generic)
+
+-- Key is NodeId
+-- | Node Story for each NodeType
+type NodeStory s p = Map NodeId (Archive s p)
+
+data Archive s p = Archive
+  { _a_version :: !Version
+  , _a_state   :: !s
+  , _a_history :: ![p]
+    -- first patch in the list is the most recent
+  }
+  deriving (Generic, Show)
+
+-- TODO Semigroup instance for unions
+
+
+type NodeListStory     = NodeStory NgramsState' NgramsStatePatch'
+type NgramsState'      = Map       TableNgrams.NgramsType NgramsTableMap
+type NgramsStatePatch' = PatchMap  TableNgrams.NgramsType NgramsTablePatch