Commit e892077f authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[nodeStory] fix file migration

parent 59ecd4af
Pipeline #3047 failed with stage
in 60 minutes and 55 seconds
{-|
Module : Gargantext.API.Dev
Description :
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
......
......@@ -30,6 +30,7 @@ import qualified Data.HashMap.Strict as HM
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Gargantext.Core.NodeStory
import qualified Gargantext.Core.NodeStoryFile as NSF
mergeNgramsElement :: NgramsRepoElement -> NgramsRepoElement -> NgramsRepoElement
......@@ -198,11 +199,13 @@ getCoocByNgrams' f (Diagonal diag) m =
migrateFromDirToDb :: (CmdM env err m, HasNodeStory env err m)
=> m ()
migrateFromDirToDb = do
=> NSF.NodeStoryDir -> m ()
migrateFromDirToDb dir = do
pool <- view connPool
listIds <- liftBase $ getNodesIdWithType pool NodeList
(NodeStory nls) <- getRepo listIds
printDebug "[migrateFromDirToDb] listIds" listIds
(NodeStory nls) <- NSF.getRepoNoEnv dir listIds
printDebug "[migrateFromDirToDb] nls" nls
_ <- mapM (\(nId, a) -> do
n <- liftBase $ nodeExists pool nId
case n of
......
......@@ -7,11 +7,12 @@ module Gargantext.Core.NodeStoryFile where
import Control.Lens (view)
import Control.Monad (foldM)
import Codec.Serialise (serialise, deserialise)
import Codec.Serialise.Class
import Codec.Serialise.Class
import Control.Concurrent (MVar(), modifyMVar_, newMVar, readMVar, withMVar)
import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceFreq, debounceAction)
import Gargantext.Core.NodeStory
import Gargantext.Core.NodeStory hiding (readNodeStoryEnv)
import Gargantext.Core.Types (ListId, NodeId(..))
import Gargantext.Database.Prelude (CmdM)
import Gargantext.Prelude
import System.Directory (renameFile, createDirectoryIfMissing, doesFileExist, removeFile)
import System.IO (FilePath, hClose)
......@@ -25,10 +26,22 @@ import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
getRepo :: HasNodeStory env err m
=> [ListId] -> m NodeListStory
getRepo listIds = do
f <- getNodeListStory
v <- liftBase $ f listIds
v' <- liftBase $ readMVar v
pure $ v'
g <- getNodeListStory
liftBase $ do
v <- g listIds
readMVar v
-- v <- liftBase $ f listIds
-- v' <- liftBase $ readMVar v
-- pure $ v'
getRepoNoEnv :: (CmdM env err m)
=> NodeStoryDir -> [ListId] -> m NodeListStory
getRepoNoEnv dir listIds = do
env <- liftBase $ readNodeStoryEnv dir
let g = view nse_getter env
liftBase $ do
v <- g listIds
readMVar v
getNodeListStory :: HasNodeStory env err m
=> m ([NodeId] -> IO (MVar NodeListStory))
......@@ -184,7 +197,7 @@ repoToNodeListStory (Repo _v s h) = NodeStory $ Map.fromList ns
ngramsState_migration :: NgramsState
-> Map NodeId NgramsState'
ngramsState_migration ns =
Map.fromListWith (Map.union) $
Map.fromListWith (Map.union) $
List.concat $
map (\(nt, nTable)
-> map (\(nid, table)
......@@ -200,7 +213,7 @@ ngramsStatePatch_migration np' = Map.fromListWith (<>)
$ map toPatch np'
where
toPatch :: NgramsStatePatch -> [(NodeId, [NgramsStatePatch'])]
toPatch p =
toPatch p =
List.concat $
map (\(nt, nTable)
-> map (\(nid, table)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment