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
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
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
Grégoire Locqueville
haskell-gargantext
Commits
9f30d0b4
Verified
Commit
9f30d0b4
authored
Feb 26, 2024
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[refactor] some more refactoring
parent
c0adc078
Changes
14
Hide whitespace changes
Inline
Side-by-side
Showing
14 changed files
with
89 additions
and
70 deletions
+89
-70
README.md
README.md
+13
-0
gargantext.cabal
gargantext.cabal
+1
-1
New.hs
src/Gargantext/API/Node/Corpus/New.hs
+1
-1
Types.hs
src/Gargantext/API/Node/Corpus/Types.hs
+8
-1
NodeStory.hs
src/Gargantext/Core/NodeStory.hs
+3
-3
Types.hs
src/Gargantext/Core/Text/Corpus/Types.hs
+0
-3
Flow.hs
src/Gargantext/Database/Action/Flow.hs
+15
-16
Extract.hs
src/Gargantext/Database/Action/Flow/Extract.hs
+9
-3
List.hs
src/Gargantext/Database/Action/Flow/List.hs
+14
-12
Pairing.hs
src/Gargantext/Database/Action/Flow/Pairing.hs
+8
-13
Types.hs
src/Gargantext/Database/Action/Flow/Types.hs
+4
-5
Utils.hs
src/Gargantext/Database/Action/Flow/Utils.hs
+11
-11
Clustering.hs
test/Test/Graph/Clustering.hs
+1
-1
JSON.hs
test/Test/Offline/JSON.hs
+1
-0
No files found.
README.md
View file @
9f30d0b4
...
@@ -180,6 +180,19 @@ The good news is that you don't have to do all of this manually; during developm
...
@@ -180,6 +180,19 @@ The good news is that you don't have to do all of this manually; during developm
./bin/update-project-dependencies
./bin/update-project-dependencies
```
```
#### Using =ghcup=
If you want to use ghcup and haskell-language-server for development,
please keep in mind that we use custom GHC 9.4.7. By default ghcup
doesn't install hls for 9.4.7 but for 9.4.8 (as of 2024-02-23). So you
should invoke:
```
sh
ghcup compile hls --version 2.5.0.0 --ghc 9.4.7
```
See https://www.haskell.org/ghcup/guide/#hls for more details.
## Initialization <a name="init"></a>
## Initialization <a name="init"></a>
#### 1. Docker-compose will configure your database and some NLP bricks (such as CoreNLP):
#### 1. Docker-compose will configure your database and some NLP bricks (such as CoreNLP):
...
...
gargantext.cabal
View file @
9f30d0b4
...
@@ -109,6 +109,7 @@ library
...
@@ -109,6 +109,7 @@ library
Gargantext.API.Ngrams.Prelude
Gargantext.API.Ngrams.Prelude
Gargantext.API.Node
Gargantext.API.Node
Gargantext.API.Node.Corpus.New
Gargantext.API.Node.Corpus.New
Gargantext.API.Node.Corpus.New.Types
Gargantext.API.Node.Corpus.Types
Gargantext.API.Node.Corpus.Types
Gargantext.API.Node.Corpus.Update
Gargantext.API.Node.Corpus.Update
Gargantext.API.Node.File
Gargantext.API.Node.File
...
@@ -244,7 +245,6 @@ library
...
@@ -244,7 +245,6 @@ library
Gargantext.API.Node.Corpus.Export
Gargantext.API.Node.Corpus.Export
Gargantext.API.Node.Corpus.Export.Types
Gargantext.API.Node.Corpus.Export.Types
Gargantext.API.Node.Corpus.New.File
Gargantext.API.Node.Corpus.New.File
Gargantext.API.Node.Corpus.New.Types
Gargantext.API.Node.Corpus.Searx
Gargantext.API.Node.Corpus.Searx
Gargantext.API.Node.Document.Export
Gargantext.API.Node.Document.Export
Gargantext.API.Node.Document.Export.Types
Gargantext.API.Node.Document.Export.Types
...
...
src/Gargantext/API/Node/Corpus/New.hs
View file @
9f30d0b4
...
@@ -129,7 +129,7 @@ api uid (Query q _ as) = do
...
@@ -129,7 +129,7 @@ api uid (Query q _ as) = do
------------------------------------------------
------------------------------------------------
-- TODO use this route for Client implementation
-- TODO use this route for Client implementation
data
ApiInfo
=
ApiInfo
{
api_info
::
[
API
.
ExternalAPIs
]}
newtype
ApiInfo
=
ApiInfo
{
api_info
::
[
API
.
ExternalAPIs
]}
deriving
(
Generic
)
deriving
(
Generic
)
instance
Arbitrary
ApiInfo
where
instance
Arbitrary
ApiInfo
where
arbitrary
=
ApiInfo
<$>
arbitrary
arbitrary
=
ApiInfo
<$>
arbitrary
...
...
src/Gargantext/API/Node/Corpus/Types.hs
View file @
9f30d0b4
...
@@ -13,16 +13,23 @@ Portability : POSIX
...
@@ -13,16 +13,23 @@ Portability : POSIX
module
Gargantext.API.Node.Corpus.Types
where
module
Gargantext.API.Node.Corpus.Types
where
import
Control.Lens
hiding
(
elements
,
Empty
)
import
Control.Lens
(
(
?~
)
)
import
Control.Monad.Fail
(
fail
)
import
Control.Monad.Fail
(
fail
)
import
Data.Aeson
import
Data.Aeson
import
Data.Swagger
import
Data.Swagger
(
NamedSchema
(
NamedSchema
),
genericDeclareNamedSchemaUnrestricted
,
defaultSchemaOptions
,
SwaggerType
(
SwaggerObject
),
ToSchema
(
..
),
HasType
(
type_
)
)
import
Data.Text
qualified
as
T
import
Data.Text
qualified
as
T
import
Gargantext.Core.Text.Corpus.Types
qualified
as
Types
import
Gargantext.Core.Text.Corpus.Types
qualified
as
Types
import
Gargantext.Core.Utils.Prefix
(
unPrefix
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
)
import
Gargantext.Database.Action.Flow.Types
(
DataOrigin
(
..
))
import
Gargantext.Database.Action.Flow.Types
(
DataOrigin
(
..
))
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Test.QuickCheck
import
Test.QuickCheck
(
Arbitrary
(
arbitrary
),
oneof
,
arbitraryBoundedEnum
)
data
Database
=
Empty
data
Database
=
Empty
|
OpenAlex
|
OpenAlex
...
...
src/Gargantext/Core/NodeStory.hs
View file @
9f30d0b4
...
@@ -43,7 +43,7 @@ TODO:
...
@@ -43,7 +43,7 @@ TODO:
{-# LANGUAGE Arrows #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module
Gargantext.Core.NodeStory
module
Gargantext.Core.NodeStory
(
module
Gargantext
.
Core
.
NodeStory
.
Types
(
module
Gargantext
.
Core
.
NodeStory
.
Types
...
@@ -295,7 +295,7 @@ fromDBNodeStoryEnv pool = do
...
@@ -295,7 +295,7 @@ fromDBNodeStoryEnv pool = do
,
_nse_getter
=
\
nId
->
withResource
pool
$
\
c
->
,
_nse_getter
=
\
nId
->
withResource
pool
$
\
c
->
getNodeStory'
c
nId
getNodeStory'
c
nId
,
_nse_getter_multi
=
\
nIds
->
withResource
pool
$
\
c
->
,
_nse_getter_multi
=
\
nIds
->
withResource
pool
$
\
c
->
foldM
(
\
m
nId
->
nodeStoryInc
c
m
nId
)
(
NodeStory
Map
.
empty
)
nIds
foldM
(
nodeStoryInc
c
)
(
NodeStory
Map
.
empty
)
nIds
}
}
currentVersion
::
(
HasNodeStory
env
err
m
)
=>
ListId
->
m
Version
currentVersion
::
(
HasNodeStory
env
err
m
)
=>
ListId
->
m
Version
...
@@ -347,7 +347,7 @@ fixNodeStoryVersions = do
...
@@ -347,7 +347,7 @@ fixNodeStoryVersions = do
[
PGS
.
Only
(
Just
maxVersion
)]
->
do
[
PGS
.
Only
(
Just
maxVersion
)]
->
do
_
<-
runPGSExecute
c
updateVerQuery
(
maxVersion
,
nId
,
ngramsType
)
_
<-
runPGSExecute
c
updateVerQuery
(
maxVersion
,
nId
,
ngramsType
)
pure
()
pure
()
_
->
panicTrace
"Should get only 1 result!"
_
other
->
panicTrace
"Should get only 1 result!"
-----------------------------------------
-----------------------------------------
...
...
src/Gargantext/Core/Text/Corpus/Types.hs
View file @
9f30d0b4
...
@@ -9,9 +9,6 @@ Portability : POSIX
...
@@ -9,9 +9,6 @@ Portability : POSIX
-}
-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
module
Gargantext.Core.Text.Corpus.Types
module
Gargantext.Core.Text.Corpus.Types
where
where
...
...
src/Gargantext/Database/Action/Flow.hs
View file @
9f30d0b4
...
@@ -46,16 +46,14 @@ import Data.Conduit.List qualified as CList
...
@@ -46,16 +46,14 @@ import Data.Conduit.List qualified as CList
import
Data.HashMap.Strict
qualified
as
HashMap
import
Data.HashMap.Strict
qualified
as
HashMap
import
Data.List
qualified
as
List
import
Data.List
qualified
as
List
import
Data.Map.Strict
qualified
as
Map
import
Data.Map.Strict
qualified
as
Map
import
Data.Proxy
import
Data.Set
qualified
as
Set
import
Data.Set
qualified
as
Set
import
Data.Text
qualified
as
T
import
Data.Text
qualified
as
T
import
EPO.API.Client.Types
qualified
as
EPO
import
EPO.API.Client.Types
qualified
as
EPO
import
Gargantext.Core
(
Lang
(
..
),
NLPServerConfig
)
import
Gargantext.Core
(
Lang
(
..
),
NLPServerConfig
,
withDefaultLanguage
)
import
Gargantext.Core
(
withDefaultLanguage
)
import
Gargantext.Core.Ext.IMTUser
(
readFile_Annuaire
)
import
Gargantext.Core.Ext.IMTUser
(
readFile_Annuaire
)
import
Gargantext.Core.Ngrams.Tools
(
getTermsWith
)
import
Gargantext.Core.NLP
(
HasNLPServer
,
nlpServerGet
)
import
Gargantext.Core.NLP
(
HasNLPServer
,
nlpServerGet
)
import
Gargantext.Core.NodeStory
(
HasNodeStory
)
import
Gargantext.Core.Ngrams.Tools
(
getTermsWith
)
import
Gargantext.Core.NodeStory.Types
(
HasNodeStory
)
import
Gargantext.Core.Text.Corpus.API
qualified
as
API
import
Gargantext.Core.Text.Corpus.API
qualified
as
API
import
Gargantext.Core.Text.Corpus.Parsers
(
parseFile
)
import
Gargantext.Core.Text.Corpus.Parsers
(
parseFile
)
import
Gargantext.Core.Text.Corpus.Parsers.Types
(
FileFormat
,
FileType
)
import
Gargantext.Core.Text.Corpus.Parsers.Types
(
FileFormat
,
FileType
)
...
@@ -66,30 +64,32 @@ import Gargantext.Core.Types (HasValidationError)
...
@@ -66,30 +64,32 @@ import Gargantext.Core.Types (HasValidationError)
import
Gargantext.Core.Types.Individu
(
User
(
UserName
))
import
Gargantext.Core.Types.Individu
(
User
(
UserName
))
import
Gargantext.Core.Types.Main
(
CorpusName
,
ListType
(
MapTerm
))
import
Gargantext.Core.Types.Main
(
CorpusName
,
ListType
(
MapTerm
))
import
Gargantext.Core.Types.Query
(
Limit
)
import
Gargantext.Core.Types.Query
(
Limit
)
import
Gargantext.Database.Action.Flow.Utils
(
buildSocialList
,
createNodes
,
docNgrams
,
insertMasterDocs
,
saveDocNgramsWith
)
import
Gargantext.Database.Action.Flow.Types
(
DataOrigin
(
..
),
DataText
(
..
),
FlowCorpus
,
printDataText
)
import
Gargantext.Database.Action.Flow.Types
(
DataOrigin
(
..
),
DataText
(
..
),
FlowCorpus
,
printDataText
)
import
Gargantext.Database.Action.Flow.Utils
(
buildSocialList
,
createNodes
,
docNgrams
,
insertMasterDocs
,
saveDocNgramsWith
)
import
Gargantext.Database.Action.Metrics
(
updateNgramsOccurrences
,
updateContextScore
)
import
Gargantext.Database.Action.Metrics
(
updateNgramsOccurrences
,
updateContextScore
)
import
Gargantext.Database.Action.Search
(
searchDocInDatabase
)
import
Gargantext.Database.Action.Search
(
searchDocInDatabase
)
import
Gargantext.Database.Admin.Config
(
userMaster
)
import
Gargantext.Database.Admin.Config
(
userMaster
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataAnnuaire
,
HyperdataContact
,
HyperdataCorpus
,
hc_lang
,
toHyperdataDocument
)
import
Gargantext.Database.Admin.Types.Hyperdata.Contact
(
HyperdataContact
)
import
Gargantext.Database.Admin.Types.Node
hiding
(
DEBUG
)
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
(
HyperdataAnnuaire
,
HyperdataCorpus
,
hc_lang
)
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
toHyperdataDocument
)
import
Gargantext.Database.Admin.Types.Node
(
AnnuaireId
,
DocId
,
ListId
,
CorpusId
,
nodeId2ContextId
)
import
Gargantext.Database.Prelude
(
DbCmd
'
,
DBCmd
,
hasConfig
)
import
Gargantext.Database.Prelude
(
DbCmd
'
,
DBCmd
,
hasConfig
)
import
Gargantext.Database.Query.Table.Ngrams
(
NgramsType
(
NgramsTerms
),
text2ngrams
)
import
Gargantext.Database.Query.Table.Node
(
MkCorpus
,
getNodeWith
)
import
Gargantext.Database.Query.Table.Node
(
MkCorpus
,
getNodeWith
)
import
Gargantext.Database.Query.Table.Node.Document.Add
qualified
as
Doc
(
add
)
import
Gargantext.Database.Query.Table.Node.Document.Add
qualified
as
Doc
(
add
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
(
..
))
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
(
..
))
import
Gargantext.Database.Query.Table.NodeContext
(
selectDocNodes
)
import
Gargantext.Database.Query.Table.NodeContext
(
selectDocNodes
)
import
Gargantext.Database.Query.Tree.Root
(
getOrMk_RootWithCorpus
)
import
Gargantext.Database.Query.Tree.Root
(
getOrMk_RootWithCorpus
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
NgramsTerms
),
text2ngrams
)
import
Gargantext.Database.Schema.Node
(
node_hyperdata
)
import
Gargantext.Database.Schema.Node
(
node_hyperdata
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Prelude.Config
(
GargConfig
(
..
))
import
Gargantext.Prelude.Config
(
GargConfig
(
..
))
import
Gargantext.System.Logging
(
LogLevel
(
DEBUG
),
MonadLogger
,
logLocM
)
import
Gargantext.System.Logging
(
LogLevel
(
DEBUG
),
MonadLogger
,
logLocM
)
import
Gargantext.Utils.Jobs
(
JobHandle
,
MonadJobStatus
(
..
)
)
import
Gargantext.Utils.Jobs
.Monad
(
JobHandle
,
MonadJobStatus
(
..
)
)
import
PUBMED.Types
qualified
as
PUBMED
import
PUBMED.Types
qualified
as
PUBMED
------------------------------------------------------------------------
------------------------------------------------------------------------
-- Imports for upgrade function
-- Imports for upgrade function
import
Gargantext.Database.Query.Tree
(
HasTreeError
)
import
Gargantext.Database.Query.Tree
.Error
(
HasTreeError
)
---------------
---------------
...
@@ -150,7 +150,7 @@ flowDataText u (DataOld ids) tt cid mfslw _ = do
...
@@ -150,7 +150,7 @@ flowDataText u (DataOld ids) tt cid mfslw _ = do
_
<-
Doc
.
add
userCorpusId
(
map
nodeId2ContextId
ids
)
_
<-
Doc
.
add
userCorpusId
(
map
nodeId2ContextId
ids
)
flowCorpusUser
(
_tt_lang
tt
)
u
userCorpusId
listId
corpusType
mfslw
flowCorpusUser
(
_tt_lang
tt
)
u
userCorpusId
listId
corpusType
mfslw
where
where
corpusType
=
(
Nothing
::
Maybe
HyperdataCorpus
)
corpusType
=
Nothing
::
Maybe
HyperdataCorpus
flowDataText
u
(
DataNew
(
mLen
,
txtC
))
tt
cid
mfslw
jobHandle
=
do
flowDataText
u
(
DataNew
(
mLen
,
txtC
))
tt
cid
mfslw
jobHandle
=
do
$
(
logLocM
)
DEBUG
$
T
.
pack
$
"Found "
<>
show
mLen
<>
" new documents to process"
$
(
logLocM
)
DEBUG
$
T
.
pack
$
"Found "
<>
show
mLen
<>
" new documents to process"
for_
(
mLen
<&>
fromInteger
)
(`
addMoreSteps
`
jobHandle
)
for_
(
mLen
<&>
fromInteger
)
(`
addMoreSteps
`
jobHandle
)
...
@@ -167,13 +167,13 @@ flowAnnuaire :: ( DbCmd' env err m
...
@@ -167,13 +167,13 @@ flowAnnuaire :: ( DbCmd' env err m
,
MonadJobStatus
m
)
,
MonadJobStatus
m
)
=>
User
=>
User
->
Either
CorpusName
[
CorpusId
]
->
Either
CorpusName
[
CorpusId
]
->
(
TermType
Lang
)
->
TermType
Lang
->
FilePath
->
FilePath
->
JobHandle
m
->
JobHandle
m
->
m
AnnuaireId
->
m
AnnuaireId
flowAnnuaire
u
n
l
filePath
jobHandle
=
do
flowAnnuaire
u
n
l
filePath
jobHandle
=
do
-- TODO Conduit for file
-- TODO Conduit for file
docs
<-
liftBase
$
((
readFile_Annuaire
filePath
)
::
IO
[
HyperdataContact
])
docs
<-
liftBase
(
readFile_Annuaire
filePath
::
IO
[
HyperdataContact
])
flow
(
Nothing
::
Maybe
HyperdataAnnuaire
)
u
n
l
Nothing
(
fromIntegral
$
length
docs
,
yieldMany
docs
)
jobHandle
flow
(
Nothing
::
Maybe
HyperdataAnnuaire
)
u
n
l
Nothing
(
fromIntegral
$
length
docs
,
yieldMany
docs
)
jobHandle
------------------------------------------------------------------------
------------------------------------------------------------------------
...
@@ -342,5 +342,4 @@ reIndexWith cId lId nt lts = do
...
@@ -342,5 +342,4 @@ reIndexWith cId lId nt lts = do
$
map
(
docNgrams
corpusLang
nt
ts
)
docs
$
map
(
docNgrams
corpusLang
nt
ts
)
docs
-- Saving the indexation in database
-- Saving the indexation in database
_
<-
mapM
(
saveDocNgramsWith
lId
)
ngramsByDoc
mapM_
(
saveDocNgramsWith
lId
)
ngramsByDoc
pure
()
src/Gargantext/Database/Action/Flow/Extract.hs
View file @
9f30d0b4
...
@@ -25,10 +25,11 @@ import Gargantext.Core.Text (HasText(..))
...
@@ -25,10 +25,11 @@ import Gargantext.Core.Text (HasText(..))
import
Gargantext.Core.Text.Corpus.Parsers
(
splitOn
)
import
Gargantext.Core.Text.Corpus.Parsers
(
splitOn
)
import
Gargantext.Core.Text.Terms
(
ExtractNgramsT
,
ExtractedNgrams
(
..
),
TermType
,
cleanExtractedNgrams
,
enrichedTerms
,
extractNgramsT
,
extractTerms
,
tt_lang
)
import
Gargantext.Core.Text.Terms
(
ExtractNgramsT
,
ExtractedNgrams
(
..
),
TermType
,
cleanExtractedNgrams
,
enrichedTerms
,
extractNgramsT
,
extractTerms
,
tt_lang
)
import
Gargantext.Core.Types
(
POS
(
NP
),
TermsCount
)
import
Gargantext.Core.Types
(
POS
(
NP
),
TermsCount
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataContact
,
HyperdataDocument
,
cw_lastName
,
hc_who
,
hd_authors
,
hd_bdd
,
hd_institutes
,
hd_source
)
import
Gargantext.Database.Admin.Types.Hyperdata.Contact
(
HyperdataContact
,
cw_lastName
,
hc_who
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
HyperdataDocument
,
hd_authors
,
hd_bdd
,
hd_institutes
,
hd_source
)
import
Gargantext.Database.Admin.Types.Node
(
Node
)
import
Gargantext.Database.Prelude
(
DBCmd
)
import
Gargantext.Database.Prelude
(
DBCmd
)
import
Gargantext.Database.Schema.Ngrams
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
),
text2ngrams
)
import
Gargantext.Database.Schema.Node
(
NodePoly
(
..
))
import
Gargantext.Database.Schema.Node
(
NodePoly
(
..
))
import
Gargantext.Prelude
import
Gargantext.Prelude
...
@@ -37,6 +38,11 @@ import Gargantext.Prelude
...
@@ -37,6 +38,11 @@ import Gargantext.Prelude
------------------------------------------------------------------------
------------------------------------------------------------------------
instance
ExtractNgramsT
HyperdataContact
instance
ExtractNgramsT
HyperdataContact
where
where
extractNgramsT
::
HasText
HyperdataContact
=>
NLPServerConfig
->
TermType
Lang
->
HyperdataContact
->
DBCmd
err
(
HashMap
.
HashMap
ExtractedNgrams
(
Map
NgramsType
Int
,
TermsCount
))
extractNgramsT
_ncs
l
hc
=
HashMap
.
mapKeys
(
cleanExtractedNgrams
255
)
<$>
extract
l
hc
extractNgramsT
_ncs
l
hc
=
HashMap
.
mapKeys
(
cleanExtractedNgrams
255
)
<$>
extract
l
hc
where
where
extract
::
TermType
Lang
->
HyperdataContact
extract
::
TermType
Lang
->
HyperdataContact
...
...
src/Gargantext/Database/Action/Flow/List.hs
View file @
9f30d0b4
...
@@ -11,30 +11,33 @@ Portability : POSIX
...
@@ -11,30 +11,33 @@ Portability : POSIX
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE InstanceSigs #-}
module
Gargantext.Database.Action.Flow.List
module
Gargantext.Database.Action.Flow.List
(
flowList_DbRepo
(
flowList_DbRepo
,
toNodeNgramsW'
)
,
toNodeNgramsW'
)
where
where
import
Control.Lens
((
+~
),
(
%~
),
at
)
import
Control.Lens
((
+~
),
(
%~
),
(
?~
),
at
)
import
Control.Monad.Reader
import
Data.List
qualified
as
List
import
Data.Map.Strict
(
toList
)
import
Data.Map.Strict
(
toList
)
import
Data.Map.Strict
qualified
as
Map
import
Data.Map.Strict
qualified
as
Map
import
Data.Map.Strict.Patch
qualified
as
PM
import
Data.Map.Strict.Patch
qualified
as
PM
import
Gargantext.Core.Ngrams.Tools
(
getNodeStory
)
import
Gargantext.Core.Ngrams.Tools
(
getNodeStory
)
import
Gargantext.Core.Ngrams.Types
import
Gargantext.Core.Ngrams.Types
import
Gargantext.Core.NodeStory
(
HasNodeStory
,
a_history
,
a_state
,
a_version
)
(
NgramsTerm
(
NgramsTerm
),
NgramsRepoElement
,
NgramsElement
(
..
),
ne_ngrams
,
NgramsPatch
(
NgramsReplace
),
NgramsTablePatch
(
NgramsTablePatch
),
ngramsElementToRepo
)
import
Gargantext.Core.NodeStory.Types
(
HasNodeStory
,
a_history
,
a_state
,
a_version
)
import
Gargantext.Core.NodeStory.Utils
(
saveNodeStory
)
import
Gargantext.Core.NodeStory.Utils
(
saveNodeStory
)
import
Gargantext.Core.Types
(
HasValidationError
(
..
),
assertValid
)
import
Gargantext.Core.Types
(
HasValidationError
(
..
),
assertValid
)
import
Gargantext.Core.Types.Main
(
ListType
(
CandidateTerm
))
import
Gargantext.Core.Types.Main
(
ListType
(
CandidateTerm
))
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
(
ListId
,
NodeId
)
import
Gargantext.Database.Query.Table.Ngrams
qualified
as
TableNgrams
import
Gargantext.Database.Query.Table.NodeNgrams
(
NodeNgramsPoly
(
..
),
NodeNgramsW
,
listInsertDb
,
{- getCgramsId -}
)
import
Gargantext.Database.Query.Table.NodeNgrams
(
NodeNgramsPoly
(
..
),
NodeNgramsW
,
listInsertDb
,
{- getCgramsId -}
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Database.Schema.Ngrams
qualified
as
TableNgrams
import
Gargantext.Prelude
hiding
(
toList
)
import
Gargantext.Prelude
hiding
(
toList
)
-- FLOW LIST
-- FLOW LIST
...
@@ -110,7 +113,7 @@ flowList_DbRepo lId ngs = do
...
@@ -110,7 +113,7 @@ flowList_DbRepo lId ngs = do
toNodeNgramsW
::
ListId
toNodeNgramsW
::
ListId
->
[(
NgramsType
,
[
NgramsElement
])]
->
[(
NgramsType
,
[
NgramsElement
])]
->
[
NodeNgramsW
]
->
[
NodeNgramsW
]
toNodeNgramsW
l
ngs
=
List
.
concat
$
map
(
toNodeNgramsW''
l
)
ngs
toNodeNgramsW
l
=
concatMap
(
toNodeNgramsW''
l
)
where
where
toNodeNgramsW''
::
ListId
toNodeNgramsW''
::
ListId
->
(
NgramsType
,
[
NgramsElement
])
->
(
NgramsType
,
[
NgramsElement
])
...
@@ -159,8 +162,7 @@ listInsert :: (HasValidationError err, HasNodeStory env err m)
...
@@ -159,8 +162,7 @@ listInsert :: (HasValidationError err, HasNodeStory env err m)
=>
ListId
=>
ListId
->
Map
NgramsType
[
NgramsElement
]
->
Map
NgramsType
[
NgramsElement
]
->
m
()
->
m
()
listInsert
lId
ngs
=
mapM_
(
\
(
typeList
,
ngElmts
)
listInsert
lId
ngs
=
mapM_
(
uncurry
(
putListNgrams
lId
))
(
toList
ngs
)
->
putListNgrams
lId
typeList
ngElmts
)
(
toList
ngs
)
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
...
@@ -205,7 +207,7 @@ putListNgrams nodeId ngramsType nes = putListNgrams' nodeId ngramsType m
...
@@ -205,7 +207,7 @@ putListNgrams nodeId ngramsType nes = putListNgrams' nodeId ngramsType m
a
<-
getNodeStory
listId
a
<-
getNodeStory
listId
let
a'
=
a
&
a_version
+~
1
let
a'
=
a
&
a_version
+~
1
&
a_history
%~
(
p
:
)
&
a_history
%~
(
p
:
)
&
a_state
.
at
ngramsType'
.~
Just
ns
&
((
a_state
.
at
ngramsType'
)
?~
ns
)
-- liftBase $ atomically $ do
-- liftBase $ atomically $ do
-- r <- readTVar var
-- r <- readTVar var
-- writeTVar var $
-- writeTVar var $
...
...
src/Gargantext/Database/Action/Flow/Pairing.hs
View file @
9f30d0b4
...
@@ -12,7 +12,6 @@ Portability : POSIX
...
@@ -12,7 +12,6 @@ Portability : POSIX
{-# OPTIONS_GHC -fno-warn-deprecations #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE QuasiQuotes #-}
module
Gargantext.Database.Action.Flow.Pairing
module
Gargantext.Database.Action.Flow.Pairing
(
isPairedWith
(
isPairedWith
...
@@ -29,13 +28,13 @@ import Data.Text qualified as Text
...
@@ -29,13 +28,13 @@ import Data.Text qualified as Text
import
Gargantext.Core
(
toDBid
)
import
Gargantext.Core
(
toDBid
)
import
Gargantext.Core.Ngrams.Tools
(
filterListWithRoot
,
getRepo
,
groupNodesByNgrams
,
mapTermListRoot
)
import
Gargantext.Core.Ngrams.Tools
(
filterListWithRoot
,
getRepo
,
groupNodesByNgrams
,
mapTermListRoot
)
import
Gargantext.Core.Ngrams.Types
(
NgramsTerm
(
..
))
import
Gargantext.Core.Ngrams.Types
(
NgramsTerm
(
..
))
import
Gargantext.Core.NodeStory
(
HasNodeStory
)
import
Gargantext.Core.NodeStory
.Types
(
HasNodeStory
)
import
Gargantext.Core.Text.Metrics.CharByChar
(
levenshtein
)
import
Gargantext.Core.Text.Metrics.CharByChar
(
levenshtein
)
import
Gargantext.Core.Types
(
TableResult
(
..
))
import
Gargantext.Core.Types
(
TableResult
(
..
))
import
Gargantext.Core.Types.Main
(
ListType
(
..
))
import
Gargantext.Core.Types.Main
(
ListType
(
..
))
import
Gargantext.Database.Action.Metrics.NgramsByContext
(
getContextsByNgramsOnlyUser
)
import
Gargantext.Database.Action.Metrics.NgramsByContext
(
getContextsByNgramsOnlyUser
)
import
Gargantext.Database.Admin.Config
(
userMaster
)
import
Gargantext.Database.Admin.Config
(
userMaster
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataContact
(
..
),
cw_firstName
,
cw_lastName
,
hc_who
)
import
Gargantext.Database.Admin.Types.Hyperdata
.Contact
(
HyperdataContact
(
..
),
cw_firstName
,
cw_lastName
,
hc_who
)
import
Gargantext.Database.Admin.Types.Node
(
AnnuaireId
,
CorpusId
,
ListId
,
DocId
,
ContactId
,
Node
,
NodeId
,
NodeType
(
NodeList
),
contextId2NodeId
,
pgNodeId
)
import
Gargantext.Database.Admin.Types.Node
(
AnnuaireId
,
CorpusId
,
ListId
,
DocId
,
ContactId
,
Node
,
NodeId
,
NodeType
(
NodeList
),
contextId2NodeId
,
pgNodeId
)
import
Gargantext.Database.Prelude
(
Cmd
,
DBCmd
,
runOpaQuery
)
import
Gargantext.Database.Prelude
(
Cmd
,
DBCmd
,
runOpaQuery
)
import
Gargantext.Database.Query.Prelude
(
returnA
,
queryNodeNodeTable
)
import
Gargantext.Database.Query.Prelude
(
returnA
,
queryNodeNodeTable
)
...
@@ -97,13 +96,11 @@ prepareInsert :: CorpusId -> AnnuaireId -> HashMap ContactId (Set DocId)
...
@@ -97,13 +96,11 @@ prepareInsert :: CorpusId -> AnnuaireId -> HashMap ContactId (Set DocId)
->
[(
CorpusId
,
AnnuaireId
,
DocId
,
ContactId
)]
->
[(
CorpusId
,
AnnuaireId
,
DocId
,
ContactId
)]
prepareInsert
corpusId
annuaireId
mapContactDocs
=
prepareInsert
corpusId
annuaireId
mapContactDocs
=
map
(
\
(
contactId
,
docId
)
->
(
corpusId
,
docId
,
annuaireId
,
contactId
))
map
(
\
(
contactId
,
docId
)
->
(
corpusId
,
docId
,
annuaireId
,
contactId
))
$
List
.
concat
$
concatMap
(
\
(
contactId
,
setDocIds
)
$
map
(
\
(
contactId
,
setDocIds
)
->
map
(
\
setDocId
->
map
(
\
setDocId
->
(
contactId
,
setDocId
)
->
(
contactId
,
setDocId
)
)
$
Set
.
toList
setDocIds
)
$
Set
.
toList
setDocIds
)
)
(
HM
.
toList
mapContactDocs
)
$
HM
.
toList
mapContactDocs
------------------------------------------------------------------------
------------------------------------------------------------------------
type
ContactName
=
NgramsTerm
type
ContactName
=
NgramsTerm
...
@@ -113,16 +110,14 @@ fusion :: HashMap ContactName (Set ContactId)
...
@@ -113,16 +110,14 @@ fusion :: HashMap ContactName (Set ContactId)
->
HashMap
DocAuthor
(
Set
DocId
)
->
HashMap
DocAuthor
(
Set
DocId
)
->
HashMap
ContactId
(
Set
DocId
)
->
HashMap
ContactId
(
Set
DocId
)
fusion
mc
md
=
HM
.
fromListWith
(
<>
)
fusion
mc
md
=
HM
.
fromListWith
(
<>
)
$
List
.
concat
$
concatMap
(
\
(
docAuthor
,
docs
)
$
map
(
\
(
docAuthor
,
docs
)
->
case
getClosest
Text
.
toLower
docAuthor
(
HM
.
keys
mc
)
of
->
case
(
getClosest
Text
.
toLower
docAuthor
(
HM
.
keys
mc
))
of
Nothing
->
[]
Nothing
->
[]
Just
author
->
case
HM
.
lookup
author
mc
of
Just
author
->
case
HM
.
lookup
author
mc
of
Nothing
->
[]
Nothing
->
[]
Just
contactIds
->
map
(
\
contactId
->
(
contactId
,
docs
))
Just
contactIds
->
map
(
\
contactId
->
(
contactId
,
docs
))
$
Set
.
toList
contactIds
$
Set
.
toList
contactIds
)
)
(
HM
.
toList
md
)
$
HM
.
toList
md
getClosest
::
(
Text
->
Text
)
->
NgramsTerm
->
[
NgramsTerm
]
->
Maybe
NgramsTerm
getClosest
::
(
Text
->
Text
)
->
NgramsTerm
->
[
NgramsTerm
]
->
Maybe
NgramsTerm
...
@@ -147,7 +142,7 @@ getNgramsContactId aId = do
...
@@ -147,7 +142,7 @@ getNgramsContactId aId = do
-- POC here, should be a probabilistic function (see the one used to find lang)
-- POC here, should be a probabilistic function (see the one used to find lang)
toName
::
Node
HyperdataContact
->
NgramsTerm
toName
::
Node
HyperdataContact
->
NgramsTerm
-- toName contact = NgramsTerm $ (Text.toTitle $ Text.take 1 firstName) <> ". " <> (Text.toTitle lastName)
-- toName contact = NgramsTerm $ (Text.toTitle $ Text.take 1 firstName) <> ". " <> (Text.toTitle lastName)
toName
contact
=
NgramsTerm
$
(
Text
.
toTitle
firstName
)
<>
" "
<>
(
Text
.
toTitle
lastName
)
toName
contact
=
NgramsTerm
$
Text
.
toTitle
firstName
<>
" "
<>
Text
.
toTitle
lastName
where
where
firstName
=
fromMaybe
""
$
contact
^.
(
node_hyperdata
.
hc_who
.
_Just
.
cw_firstName
)
firstName
=
fromMaybe
""
$
contact
^.
(
node_hyperdata
.
hc_who
.
_Just
.
cw_firstName
)
lastName
=
fromMaybe
""
$
contact
^.
(
node_hyperdata
.
hc_who
.
_Just
.
cw_lastName
)
lastName
=
fromMaybe
""
$
contact
^.
(
node_hyperdata
.
hc_who
.
_Just
.
cw_lastName
)
...
...
src/Gargantext/Database/Action/Flow/Types.hs
View file @
9f30d0b4
...
@@ -11,7 +11,6 @@ Portability : POSIX
...
@@ -11,7 +11,6 @@ Portability : POSIX
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TemplateHaskell #-}
...
@@ -24,16 +23,16 @@ import Data.Conduit.List qualified as CL
...
@@ -24,16 +23,16 @@ import Data.Conduit.List qualified as CL
import
Data.HashMap.Strict
(
HashMap
)
import
Data.HashMap.Strict
(
HashMap
)
import
Data.Swagger
(
ToSchema
(
..
),
genericDeclareNamedSchema
)
import
Data.Swagger
(
ToSchema
(
..
),
genericDeclareNamedSchema
)
import
Gargantext.Core.Flow.Types
(
UniqId
)
import
Gargantext.Core.Flow.Types
(
UniqId
)
import
Gargantext.Core.NodeStory
(
HasNodeStory
)
import
Gargantext.Core.NodeStory
.Types
(
HasNodeStory
)
import
Gargantext.Core.Text
(
HasText
)
import
Gargantext.Core.Text
(
HasText
)
import
Gargantext.Core.Text.Corpus.
API
qualified
as
API
import
Gargantext.Core.Text.Corpus.
Types
qualified
as
API
import
Gargantext.Core.Text.Terms
(
ExtractNgramsT
)
import
Gargantext.Core.Text.Terms
(
ExtractNgramsT
)
import
Gargantext.Core.Types
(
HasValidationError
,
TermsCount
)
import
Gargantext.Core.Types
(
HasValidationError
,
TermsCount
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixSwagger
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixSwagger
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataDocument
)
import
Gargantext.Database.Admin.Types.Hyperdata
.Document
(
HyperdataDocument
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
)
import
Gargantext.Database.Prelude
(
CmdM
)
import
Gargantext.Database.Prelude
(
CmdM
)
import
Gargantext.Database.Query.Table.Node.Document.Insert
import
Gargantext.Database.Query.Table.Node.Document.Insert
(
ToNode
,
UniqParameters
,
AddUniqId
,
InsertDb
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Tree.Error
(
HasTreeError
)
import
Gargantext.Database.Query.Tree.Error
(
HasTreeError
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
...
...
src/Gargantext/Database/Action/Flow/Utils.hs
View file @
9f30d0b4
...
@@ -38,7 +38,7 @@ import Gargantext.Core (Lang, NLPServerConfig, toDBid)
...
@@ -38,7 +38,7 @@ import Gargantext.Core (Lang, NLPServerConfig, toDBid)
import
Gargantext.Core.Flow.Types
(
UniqId
,
uniqId
)
import
Gargantext.Core.Flow.Types
(
UniqId
,
uniqId
)
import
Gargantext.Core.Ngrams.Types
qualified
as
NT
import
Gargantext.Core.Ngrams.Types
qualified
as
NT
import
Gargantext.Core.NLP
(
HasNLPServer
,
nlpServerGet
)
import
Gargantext.Core.NLP
(
HasNLPServer
,
nlpServerGet
)
import
Gargantext.Core.NodeStory
(
HasNodeStory
)
import
Gargantext.Core.NodeStory
.Types
(
HasNodeStory
)
import
Gargantext.Core.Text.List
(
buildNgramsLists
)
import
Gargantext.Core.Text.List
(
buildNgramsLists
)
import
Gargantext.Core.Text.List.Group.WithStem
(
GroupParams
(
GroupWithPosTag
))
import
Gargantext.Core.Text.List.Group.WithStem
(
GroupParams
(
GroupWithPosTag
))
import
Gargantext.Core.Text.List.Social
(
FlowSocialListWith
(
..
))
import
Gargantext.Core.Text.List.Social
(
FlowSocialListWith
(
..
))
...
@@ -53,7 +53,7 @@ import Gargantext.Database.Action.Flow.Extract () -- ExtractNgramsT instances
...
@@ -53,7 +53,7 @@ import Gargantext.Database.Action.Flow.Extract () -- ExtractNgramsT instances
import
Gargantext.Database.Action.Flow.List
(
flowList_DbRepo
,
toNodeNgramsW'
)
import
Gargantext.Database.Action.Flow.List
(
flowList_DbRepo
,
toNodeNgramsW'
)
import
Gargantext.Database.Action.Flow.Types
(
DocumentIdWithNgrams
(
..
),
FlowCorpus
,
FlowInsertDB
)
import
Gargantext.Database.Action.Flow.Types
(
DocumentIdWithNgrams
(
..
),
FlowCorpus
,
FlowInsertDB
)
import
Gargantext.Database.Admin.Config
(
userMaster
,
corpusMasterName
)
import
Gargantext.Database.Admin.Config
(
userMaster
,
corpusMasterName
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataDocument
,
hd_abstract
,
hd_title
)
import
Gargantext.Database.Admin.Types.Hyperdata
.Document
(
HyperdataDocument
,
hd_abstract
,
hd_title
)
import
Gargantext.Database.Admin.Types.Node
(
Context
,
ContextId
,
CorpusId
,
DocId
,
ListId
,
NodeId
,
NodeType
(
NodeGraph
,
NodeTexts
),
UserId
,
contextId2NodeId
,
nodeId2ContextId
)
import
Gargantext.Database.Admin.Types.Node
(
Context
,
ContextId
,
CorpusId
,
DocId
,
ListId
,
NodeId
,
NodeType
(
NodeGraph
,
NodeTexts
),
UserId
,
contextId2NodeId
,
nodeId2ContextId
)
import
Gargantext.Database.Prelude
(
DBCmd
,
DbCmd
'
)
import
Gargantext.Database.Prelude
(
DBCmd
,
DbCmd
'
)
import
Gargantext.Database.Query.Table.ContextNodeNgrams
(
ContextNodeNgramsPoly
(
ContextNodeNgrams
),
insertContextNodeNgrams
)
import
Gargantext.Database.Query.Table.ContextNodeNgrams
(
ContextNodeNgramsPoly
(
ContextNodeNgrams
),
insertContextNodeNgrams
)
...
@@ -63,7 +63,7 @@ import Gargantext.Database.Query.Table.Node.Document.Add qualified as Doc (add)
...
@@ -63,7 +63,7 @@ import Gargantext.Database.Query.Table.Node.Document.Add qualified as Doc (add)
import
Gargantext.Database.Query.Table.Node.Document.Insert
(
ReturnId
,
addUniqId
,
insertDb
,
reId
,
reInserted
,
reUniqId
,
toNode
)
import
Gargantext.Database.Query.Table.Node.Document.Insert
(
ReturnId
,
addUniqId
,
insertDb
,
reId
,
reInserted
,
reUniqId
,
toNode
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
(
..
))
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
(
..
))
import
Gargantext.Database.Query.Table.NodeNgrams
(
getCgramsId
,
listInsertDb
)
import
Gargantext.Database.Query.Table.NodeNgrams
(
getCgramsId
,
listInsertDb
)
import
Gargantext.Database.Query.Tree
(
HasTreeError
)
import
Gargantext.Database.Query.Tree
.Error
(
HasTreeError
)
import
Gargantext.Database.Query.Tree.Root
(
getOrMk_RootWithCorpus
)
import
Gargantext.Database.Query.Tree.Root
(
getOrMk_RootWithCorpus
)
import
Gargantext.Database.Schema.Context
(
context_hyperdata
,
context_id
)
import
Gargantext.Database.Schema.Context
(
context_hyperdata
,
context_id
)
import
Gargantext.Database.Schema.ContextNodeNgrams2
(
ContextNodeNgrams2Poly
(
ContextNodeNgrams2
))
import
Gargantext.Database.Schema.ContextNodeNgrams2
(
ContextNodeNgrams2Poly
(
ContextNodeNgrams2
))
...
@@ -116,13 +116,13 @@ saveDocNgramsWith lId mapNgramsDocs' = do
...
@@ -116,13 +116,13 @@ saveDocNgramsWith lId mapNgramsDocs' = do
-- new
-- new
mapCgramsId
<-
listInsertDb
lId
toNodeNgramsW'
mapCgramsId
<-
listInsertDb
lId
toNodeNgramsW'
$
map
(
first
_ngramsTerms
.
second
DM
.
keys
)
$
map
(
bimap
_ngramsTerms
DM
.
keys
)
$
HashMap
.
toList
mapNgramsDocs
$
HashMap
.
toList
mapNgramsDocs
--printDebug "saveDocNgramsWith" mapCgramsId
--printDebug "saveDocNgramsWith" mapCgramsId
-- insertDocNgrams
-- insertDocNgrams
let
ngrams2insert
=
catMaybes
[
ContextNodeNgrams2
<$>
Just
(
nodeId2ContextId
nId
)
let
ngrams2insert
=
catMaybes
[
ContextNodeNgrams2
<$>
Just
(
nodeId2ContextId
nId
)
<*>
(
getCgramsId
mapCgramsId
ngrams_type
(
_ngramsTerms
terms''
)
)
<*>
getCgramsId
mapCgramsId
ngrams_type
(
_ngramsTerms
terms''
)
<*>
Just
(
fromIntegral
w
::
Double
)
<*>
Just
(
fromIntegral
w
::
Double
)
|
(
terms''
,
mapNgramsTypes
)
<-
HashMap
.
toList
mapNgramsDocs
|
(
terms''
,
mapNgramsTypes
)
<-
HashMap
.
toList
mapNgramsDocs
,
(
ngrams_type
,
mapNodeIdWeight
)
<-
DM
.
toList
mapNgramsTypes
,
(
ngrams_type
,
mapNodeIdWeight
)
<-
DM
.
toList
mapNgramsTypes
...
@@ -152,9 +152,9 @@ docNgrams lang nt ts doc =
...
@@ -152,9 +152,9 @@ docNgrams lang nt ts doc =
,
doc
^.
context_hyperdata
.
hd_abstract
,
doc
^.
context_hyperdata
.
hd_abstract
]
]
)
)
(
List
.
cycle
[
DM
.
fromList
$
[(
nt
,
DM
.
singleton
(
doc
^.
context_id
)
1
)]])
(
repeat
(
DM
.
fromList
$
[(
nt
,
DM
.
singleton
(
doc
^.
context_id
)
1
)]))
-- TODO Type NodeDocumentUnicised
-- TODO Type NodeDocumentUnicised
insertDocs
::
(
DbCmd'
env
err
m
insertDocs
::
(
DbCmd'
env
err
m
,
FlowInsertDB
a
,
FlowInsertDB
a
...
@@ -274,7 +274,7 @@ viewUniqId' d = maybe err (\h -> (h,d)) (d ^. uniqId)
...
@@ -274,7 +274,7 @@ viewUniqId' d = maybe err (\h -> (h,d)) (d ^. uniqId)
mergeData
::
Map
Hash
ReturnId
mergeData
::
Map
Hash
ReturnId
->
Map
Hash
a
->
Map
Hash
a
->
[
Indexed
NodeId
a
]
->
[
Indexed
NodeId
a
]
mergeData
rs
=
catMaybes
.
map
toDocumentWithId
.
DM
.
toList
mergeData
rs
=
mapMaybe
toDocumentWithId
.
DM
.
toList
where
where
toDocumentWithId
(
sha
,
hpd
)
=
toDocumentWithId
(
sha
,
hpd
)
=
Indexed
<$>
fmap
reId
(
DM
.
lookup
sha
rs
)
Indexed
<$>
fmap
reId
(
DM
.
lookup
sha
rs
)
...
@@ -287,7 +287,7 @@ toInserted :: [ReturnId]
...
@@ -287,7 +287,7 @@ toInserted :: [ReturnId]
->
Map
Hash
ReturnId
->
Map
Hash
ReturnId
toInserted
=
toInserted
=
DM
.
fromList
.
map
(
\
r
->
(
reUniqId
r
,
r
)
)
DM
.
fromList
.
map
(
\
r
->
(
reUniqId
r
,
r
)
)
.
filter
(
\
r
->
reInserted
r
==
True
)
.
filter
reInserted
...
@@ -317,9 +317,9 @@ mapNodeIdNgrams = HashMap.unionsWith (DM.unionWith (DM.unionWith addTuples)) . f
...
@@ -317,9 +317,9 @@ mapNodeIdNgrams = HashMap.unionsWith (DM.unionWith (DM.unionWith addTuples)) . f
-- document) is copied over to all its types.
-- document) is copied over to all its types.
f
::
DocumentIdWithNgrams
a
b
f
::
DocumentIdWithNgrams
a
b
->
HashMap
.
HashMap
b
(
Map
NgramsType
(
Map
NodeId
(
Int
,
TermsCount
)))
->
HashMap
.
HashMap
b
(
Map
NgramsType
(
Map
NodeId
(
Int
,
TermsCount
)))
f
d
=
fmap
(
\
(
ngramsTypeMap
,
cnt
)
->
fmap
(
\
i
->
DM
.
singleton
nId
(
i
,
cnt
))
ngramsTypeMap
)
$
documentNgrams
d
f
d
=
(
\
(
ngramsTypeMap
,
cnt
)
->
fmap
(
\
i
->
DM
.
singleton
nId
(
i
,
cnt
))
ngramsTypeMap
)
<$>
documentNgrams
d
where
where
nId
=
(
documentWithId
d
)
^.
index
nId
=
documentWithId
d
^.
index
...
...
test/Test/Graph/Clustering.hs
View file @
9f30d0b4
...
@@ -16,7 +16,7 @@ import Data.HashMap.Strict (HashMap)
...
@@ -16,7 +16,7 @@ import Data.HashMap.Strict (HashMap)
import
Data.HashMap.Strict
qualified
as
HashMap
import
Data.HashMap.Strict
qualified
as
HashMap
import
Data.List
qualified
as
List
import
Data.List
qualified
as
List
import
Gargantext.Core.Methods.Similarities
(
Similarity
(
..
))
import
Gargantext.Core.Methods.Similarities
(
Similarity
(
..
))
import
Gargantext.Core
API
.Ngrams.Types
(
NgramsTerm
(
..
))
import
Gargantext.Core.Ngrams.Types
(
NgramsTerm
(
..
))
import
Gargantext.Core.Viz.Graph.Tools
(
doSimilarityMap
)
import
Gargantext.Core.Viz.Graph.Tools
(
doSimilarityMap
)
import
Gargantext.Core.Viz.Graph.Tools.IGraph
(
spinglass
)
import
Gargantext.Core.Viz.Graph.Tools.IGraph
(
spinglass
)
import
Gargantext.Core.Viz.Graph.Types
import
Gargantext.Core.Viz.Graph.Types
...
...
test/Test/Offline/JSON.hs
View file @
9f30d0b4
...
@@ -10,6 +10,7 @@ import Data.Aeson
...
@@ -10,6 +10,7 @@ import Data.Aeson
import
Data.Either
import
Data.Either
import
Gargantext.API.Errors
import
Gargantext.API.Errors
import
Gargantext.API.Node.Corpus.New
import
Gargantext.API.Node.Corpus.New
import
Gargantext.API.Node.Corpus.New.Types
(
WithQuery
(
..
))
import
Gargantext.API.Node.Corpus.Types
import
Gargantext.API.Node.Corpus.Types
import
Gargantext.Core.Types.Phylo
import
Gargantext.Core.Types.Phylo
import
Gargantext.Core.Viz.Phylo.API
import
Gargantext.Core.Viz.Phylo.API
...
...
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