Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
152
Issues
152
List
Board
Labels
Milestones
Merge Requests
9
Merge Requests
9
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
haskell-gargantext
Commits
e892077f
Commit
e892077f
authored
Jul 22, 2022
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[nodeStory] fix file migration
parent
59ecd4af
Pipeline
#3047
failed with stage
in 60 minutes and 55 seconds
Changes
3
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
28 additions
and
12 deletions
+28
-12
Dev.hs
src/Gargantext/API/Dev.hs
+1
-1
Tools.hs
src/Gargantext/API/Ngrams/Tools.hs
+6
-3
NodeStoryFile.hs
src/Gargantext/Core/NodeStoryFile.hs
+21
-8
No files found.
src/Gargantext/API/Dev.hs
View file @
e892077f
{-|
Module : Gargantext.API.Dev
Description :
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
...
...
src/Gargantext/API/Ngrams/Tools.hs
View file @
e892077f
...
...
@@ -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
...
...
src/Gargantext/Core/NodeStoryFile.hs
View file @
e892077f
...
...
@@ -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)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment