[TOOLS] WIP getting NodeListStory

src/Gargantext/API/Ngrams/Tools.hs

@@ -28,6 +28,7 @@ import Gargantext.Prelude
 import qualified Data.HashMap.Strict as HM
 import qualified Data.Map.Strict     as Map
 import qualified Data.Set            as Set
+import Gargantext.Core.NodeStory
 
 mergeNgramsElement :: NgramsRepoElement -> NgramsRepoElement -> NgramsRepoElement
 mergeNgramsElement _neOld neNew = neNew
@@ -39,6 +40,29 @@ getRepo = do
   v <- view repoVar
   liftBase $ readMVar v
 
+getNodeListStory :: HasNodeStory' env err m
+                 => m (NodeId -> IO (MVar NodeListStory))
+getNodeListStory = do
+  env <- view hasNodeStory
+  pure $ view nse_getter env
+
+getNodeListStory' :: HasNodeStory' env err m
+                 => NodeId -> m (IO NodeListStory)
+getNodeListStory' n = do
+  f <- getNodeListStory
+  v <- liftBase $ f n
+  pure $ readMVar v
+
+getNodeListStory'' :: HasNodeStory' env err m
+                 => NodeId -> m NodeListStory
+getNodeListStory'' n = do
+  f <- getNodeListStory
+  v  <- liftBase  $ f n
+  v' <- liftBase $ readMVar v
+  pure $ v'
+
+
+
 listNgramsFromRepo :: [ListId] -> NgramsType
                    -> NgramsRepo -> HashMap NgramsTerm NgramsRepoElement
 listNgramsFromRepo nodeIds ngramsType repo = ngrams

src/Gargantext/API/Ngrams/Types.hs

@@ -13,7 +13,6 @@ import Codec.Serialise (Serialise())
 import Control.Category ((>>>))
 import Control.Concurrent
 import Control.Lens (makeLenses, makePrisms, Getter, Iso', iso, from, (.~), (?=), (#), to, folded, {-withIndex, ifolded,-} view, use, (^.), (^?), (%~), (.~), (%=), at, _Just, Each(..), itraverse_, both, forOf_, (?~))
-import Control.Monad.Reader
 import Control.Monad.State
 import Data.Aeson hiding ((.=))
 import Data.Aeson.TH (deriveJSON)
@@ -32,8 +31,7 @@ import Data.Validity
 import Database.PostgreSQL.Simple.FromField (FromField, fromField, ResultError(ConversionFailed), returnError)
 import GHC.Generics (Generic)
 import Gargantext.Core.Text (size)
-import Gargantext.Core.Types (ListType(..), ListId, NodeId)
-import Gargantext.Core.Types (TODO)
+import Gargantext.Core.Types (ListType(..), ListId, NodeId, TODO)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixUntagged, unPrefixSwagger, wellNamedSchema)
 import Gargantext.Database.Prelude (fromField', CmdM', HasConnectionPool, HasConfig)
 import Gargantext.Prelude
@@ -724,35 +722,31 @@ data RepoEnv = RepoEnv
 
 makeLenses ''RepoEnv
 
+type RepoCmdM   env err m =
+  ( CmdM'             env err m
+  , HasRepo           env
+  , HasConnectionPool env
+  , HasConfig         env
+  )
+
+class (HasRepoVar env, HasRepoSaver env)
+  => HasRepo env where
+  repoEnv :: Getter env RepoEnv
 class HasRepoVar env where
   repoVar :: Getter env (MVar NgramsRepo)
-
-instance HasRepoVar (MVar NgramsRepo) where
-  repoVar = identity
-
-
-
 class HasRepoSaver env where
   repoSaver :: Getter env (IO ())
 
-class (HasRepoVar env, HasRepoSaver env) => HasRepo env where
-  repoEnv :: Getter env RepoEnv
 
 instance HasRepo RepoEnv where
   repoEnv = identity
-
+instance HasRepoVar (MVar NgramsRepo) where
+  repoVar = identity
 instance HasRepoVar RepoEnv where
   repoVar = renv_var
-
 instance HasRepoSaver RepoEnv where
   repoSaver = renv_saver
 
-type RepoCmdM   env err m =
-  ( CmdM'             env err m
-  , HasRepo           env
-  , HasConnectionPool env
-  , HasConfig         env
-  )
 
 ------------------------------------------------------------------------
 

src/Gargantext/Core/NodeStory.hs

@@ -11,6 +11,7 @@ Portability : POSIX
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE ConstraintKinds   #-}
 
 module Gargantext.Core.NodeStory where
 
@@ -28,33 +29,40 @@ import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Types (NodeId)
 import Gargantext.Core.Utils.Prefix (unPrefix)
 import Gargantext.Prelude
+import Control.Monad.Reader
 import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
 import qualified Data.Map.Strict.Patch.Internal as Patch
 import qualified Data.ByteString.Lazy as L
 import System.Directory (renameFile, createDirectoryIfMissing, doesFileExist)
 import System.IO.Temp (withTempFile)
 import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceFreq, debounceAction)
+import Gargantext.Database.Prelude (CmdM', HasConnectionPool, HasConfig)
 
 ------------------------------------------------------------------------
 data NodeStoryEnv = NodeStoryEnv
-  { _nse_var :: !(MVar NodeListStory)
-  , _nse_saver :: !(IO ())
+  { _nse_var    :: !(MVar NodeListStory)
+  , _nse_saver  :: !(IO ())
   , _nse_getter :: NodeId -> IO (MVar NodeListStory)
   --, _nse_cleaner :: !(IO ()) -- every 12 hours: cleans the repos of unused NodeStories
   -- , _nse_lock  :: !FileLock -- TODO (it depends on the option: if with database or file only)
   }
   deriving (Generic)
 
+type HasNodeStory' env err m = (CmdM' env err m
+                               , HasNodeStory env
+                               , HasConfig env
+                               )
 
-class HasNodeStoryEnv env where
-  nodeStoryEnv :: env -> IO (MVar NodeListStory)
-
-instance HasNodeStoryEnv (MVar NodeListStory) where
-  nodeStoryEnv = pure
+class (HasNodeStoryVar env, HasNodeStorySaver env)
+  => HasNodeStory env where
+    hasNodeStory :: Getter env NodeStoryEnv
 
+class HasNodeStoryVar env where
+  hasNodeStoryVar :: Getter env (NodeId -> IO (MVar NodeListStory))
 
 class HasNodeStorySaver env where
-  nodeStorySaver :: Getter env (IO ())
+  hasNodeStorySaver :: Getter env (IO ())
+
 
 
 ------------------------------------------------------------------------
@@ -170,13 +178,8 @@ ngramsStatePatch_migration np' = Map.fromListWith (<>)
     , (nid, table) <- Patch.toList nTable
     ]
 
-
-
-
-
 ------------------------------------------------------------------------
 
-
 {- | Node Story for each NodeType where the Key of the Map is NodeId
   TODO : generalize for any NodeType, let's start with NodeList which
   is implemented already
@@ -216,7 +219,6 @@ instance (ToJSON s, ToJSON p) => ToJSON (Archive s p) where
 
 ------------------------------------------------------------------------
 
-
 initNodeStory :: Monoid s => NodeId -> NodeStory s p
 initNodeStory ni = NodeStory $ Map.singleton ni initArchive
 
@@ -235,4 +237,5 @@ initNodeListStoryMock = NodeStory $ Map.singleton nodeListId archive
                    ]
 
 ------------------------------------------------------------------------
+-- | Lenses at the bottom of the file because Template Haskell would reorder order of execution in others cases
 makeLenses ''NodeStoryEnv