[NodeStory] this compiles, CmdM helped

src/Gargantext/Database/NodeStory.hs

@@ -15,7 +15,7 @@ import Gargantext.Core.Mail.Types (HasMail)
 import Gargantext.Core.NodeStory (Archive(..), NodeStory(..), NodeListStory, NgramsState', NgramsStatePatch')
 import qualified Gargantext.Core.NodeStory as NS
 import Gargantext.Core.Types (NodeId(..), NodeType(..))
-import Gargantext.Database.Prelude (Cmd, mkCmd, runOpaQuery)
+import Gargantext.Database.Prelude (CmdM, mkCmd, runOpaQuery)
 import Gargantext.Database.Query.Table.Node (getNodesIdWithType, nodeExists)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Prelude
@@ -45,7 +45,7 @@ nodeStoryTable =
 nodeStorySelect :: Select NodeStoryRead
 nodeStorySelect = selectTable nodeStoryTable
 
-getNodeStory :: NodeId -> Cmd err NodeListStory
+getNodeStory :: CmdM env err m => NodeId -> m NodeListStory
 getNodeStory (NodeId nodeId) = do
   res <- runOpaQuery query
   pure $ NodeStory $ Map.fromListWith (<>) $ (\(NodeStoryDB nId a) -> (nId, a)) <$> res
@@ -56,7 +56,7 @@ getNodeStory (NodeId nodeId) = do
       restrict -< node_id .== sqlInt4 nodeId
       returnA -< row
 
-insertNodeArchive :: NodeId -> ArchiveQ -> Cmd err Int64
+insertNodeArchive :: CmdM env err m => NodeId -> ArchiveQ -> m Int64
 insertNodeArchive (NodeId nId) a = mkCmd $ \c -> runInsert c insert
   where
     insert = Insert { iTable      = nodeStoryTable
@@ -65,7 +65,7 @@ insertNodeArchive (NodeId nId) a = mkCmd $ \c -> runInsert c insert
                     , iReturning  = rCount
                     , iOnConflict = Nothing }
 
-updateNodeArchive :: NodeId -> ArchiveQ -> Cmd err Int64
+updateNodeArchive :: CmdM env err m => NodeId -> ArchiveQ -> m Int64
 updateNodeArchive (NodeId nId) a = mkCmd $ \c -> runUpdate c update
   where
     update = Update { uTable      = nodeStoryTable
@@ -73,27 +73,27 @@ updateNodeArchive (NodeId nId) a = mkCmd $ \c -> runUpdate c update
                     , uWhere      = (\row -> node_id row .== sqlInt4 nId)
                     , uReturning  = rCount }
 
-nodeStoryRemove :: NodeId -> Cmd err Int64
+nodeStoryRemove :: CmdM env err m => NodeId -> m Int64
 nodeStoryRemove (NodeId nId) = mkCmd $ \c -> runDelete c delete
   where
     delete = Delete { dTable     = nodeStoryTable
                     , dWhere     = (\row -> node_id row .== sqlInt4 nId)
                     , dReturning = rCount }
 
-upsertNodeArchive :: NodeId -> ArchiveQ -> Cmd err Int64
+upsertNodeArchive :: CmdM env err m => NodeId -> ArchiveQ -> m Int64
 upsertNodeArchive nId a = do
   (NodeStory m) <- getNodeStory nId
   case Map.lookup nId m of
     Nothing -> insertNodeArchive nId a
     Just _  -> updateNodeArchive nId a
 
-writeNodeStories :: NodeListStory -> Cmd err ()
+writeNodeStories :: CmdM env err m => NodeListStory -> m ()
 writeNodeStories (NodeStory nls) = do
   _ <- mapM (\(nId, a) -> upsertNodeArchive nId a) $ Map.toList nls
   pure ()
   
 -- | Returns a `NodeListStory`, updating the given one for given `NodeId`
-nodeStoryInc :: Maybe NodeListStory -> NodeId -> Cmd err NodeListStory
+nodeStoryInc :: CmdM env err m => Maybe NodeListStory -> NodeId -> m NodeListStory
 nodeStoryInc Nothing nId = getNodeStory nId
 nodeStoryInc (Just ns@(NodeStory nls)) nId = do
   case Map.lookup nId nls of
@@ -102,14 +102,14 @@ nodeStoryInc (Just ns@(NodeStory nls)) nId = do
       pure $ NodeStory $ Map.union nls nls'
     Just _ -> pure ns
 
-nodeStoryIncs :: Maybe NodeListStory -> [NodeId] -> Cmd err NodeListStory
+nodeStoryIncs :: CmdM env err m => Maybe NodeListStory -> [NodeId] -> m NodeListStory
 nodeStoryIncs Nothing [] = pure $ NodeStory $ Map.empty
 nodeStoryIncs (Just nls) ns = foldM (\m n -> nodeStoryInc (Just m) n) nls ns
 nodeStoryIncs Nothing (ni:ns) = do
   m <- getNodeStory ni
   nodeStoryIncs (Just m) ns
 
-nodeStoryDec :: NodeListStory -> NodeId -> Cmd err NodeListStory
+nodeStoryDec :: CmdM env err m => NodeListStory -> NodeId -> m NodeListStory
 nodeStoryDec ns@(NodeStory nls) ni = do
   case Map.lookup ni nls of
     Nothing -> do
@@ -136,17 +136,17 @@ migrateFromDir = do
 
 ------------------------------------
 
-data NodeStoryEnv err = NodeStoryEnv
+data NodeStoryEnv env err m = NodeStoryEnv
   { _nse_var    :: !(MVar NodeListStory)
-  , _nse_saver  :: !(Cmd err ())
-  , _nse_getter :: [NodeId] -> Cmd err (MVar NodeListStory)
+  , _nse_saver  :: !(m ())
+  , _nse_getter :: [NodeId] -> m (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)
 
 
-nodeStoryEnv :: Cmd err (NodeStoryEnv err)
+nodeStoryEnv :: CmdM env err m => m (NodeStoryEnv env err m)
 nodeStoryEnv = do
   mvar <- nodeStoryVar Nothing []
   --saver <- mkNodeStorySaver mvar
@@ -158,7 +158,7 @@ nodeStoryEnv = do
                       , _nse_saver  = saver
                       , _nse_getter = nodeStoryVar (Just mvar) }
 
-nodeStoryVar :: Maybe (MVar NodeListStory) -> [NodeId] -> Cmd err (MVar NodeListStory)
+nodeStoryVar :: CmdM env err m => Maybe (MVar NodeListStory) -> [NodeId] -> m (MVar NodeListStory)
 nodeStoryVar Nothing nIds = do
   state <- nodeStoryIncs Nothing nIds
   newMVar state
@@ -169,7 +169,7 @@ nodeStoryVar (Just mv) nIds = do
 -- TODO No debounce since this is IO stuff.
 -- debounce is useful since it could delay the saving to some later
 -- time, asynchronously and we keep operating on memory only.
-mkNodeStorySaver :: MVar NodeListStory -> Cmd err ()
+mkNodeStorySaver :: CmdM env err m => MVar NodeListStory -> m ()
 mkNodeStorySaver mvns = withMVar mvns writeNodeStories
 
 -- mkNodeStorySaver :: MVar NodeListStory -> Cmd err (Cmd err ())