Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
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
Przemyslaw Kaminski
haskell-gargantext
Commits
061a675f
Commit
061a675f
authored
Sep 09, 2021
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[social] add selected lists support for new corpus
parent
ba44095b
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
35 additions
and
11 deletions
+35
-11
package.yaml
package.yaml
+1
-0
New.hs
src/Gargantext/API/Node/Corpus/New.hs
+6
-1
Social.hs
src/Gargantext/Core/Text/List/Social.hs
+25
-2
Node.hs
src/Gargantext/Database/Admin/Types/Node.hs
+3
-8
No files found.
package.yaml
View file @
061a675f
...
...
@@ -196,6 +196,7 @@ library:
-
resource-pool
-
resourcet
-
safe
-
scientific
-
semigroups
-
serialise
-
servant
...
...
src/Gargantext/API/Node/Corpus/New.hs
View file @
061a675f
...
...
@@ -180,7 +180,11 @@ addToCorpusWithQuery :: FlowCmdM env err m
->
Maybe
Integer
->
(
JobLog
->
m
()
)
->
m
JobLog
addToCorpusWithQuery
user
cid
(
WithQuery
q
dbs
datafield
l
_nid
)
maybeLimit
logStatus
=
do
addToCorpusWithQuery
user
cid
(
WithQuery
{
_wq_query
=
q
,
_wq_databases
=
dbs
,
_wq_datafield
=
datafield
,
_wq_lang
=
l
,
_wq_flowListWith
=
flw
})
maybeLimit
logStatus
=
do
-- TODO ...
logStatus
JobLog
{
_scst_succeeded
=
Just
0
,
_scst_failed
=
Just
0
...
...
@@ -189,6 +193,7 @@ addToCorpusWithQuery user cid (WithQuery q dbs datafield l _nid) maybeLimit logS
}
printDebug
"[addToCorpusWithQuery] (cid, dbs)"
(
cid
,
dbs
)
printDebug
"[addToCorpusWithQuery] datafield"
datafield
printDebug
"[addToCorpusWithQuery] flowListWith"
flw
case
datafield
of
Just
Web
->
do
...
...
src/Gargantext/Core/Text/List/Social.hs
View file @
061a675f
...
...
@@ -8,14 +8,21 @@ Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE ScopedTypeVariables #-}
module
Gargantext.Core.Text.List.Social
where
import
Control.Monad
(
mzero
)
import
Data.Aeson
import
GHC.Generics
import
Data.HashMap.Strict
(
HashMap
)
import
Data.Map
(
Map
)
import
Data.Monoid
(
mconcat
)
import
qualified
Data.Scientific
as
Scientific
import
Data.Swagger
import
qualified
Data.Text
as
T
import
qualified
Data.Vector
as
V
import
Gargantext.API.Ngrams.Tools
import
Gargantext.API.Ngrams.Types
import
Gargantext.Core.NodeStory
...
...
@@ -30,6 +37,7 @@ import Gargantext.Database.Query.Table.Node.Error
import
Gargantext.Database.Query.Tree
import
Gargantext.Database.Schema.Ngrams
import
Gargantext.Prelude
import
qualified
Prelude
as
Prelude
------------------------------------------------------------------------
------------------------------------------------------------------------
...
...
@@ -41,18 +49,33 @@ import Gargantext.Prelude
data
FlowSocialListWith
=
FlowSocialListWithPriority
{
fslw_priority
::
FlowSocialListPriority
}
|
FlowSocialListWithLists
{
fslw_lists
::
[
ListId
]
}
deriving
(
Show
,
Generic
)
instance
FromJSON
FlowSocialListWith
where
parseJSON
(
Object
v
)
=
do
typ
<-
v
.:
"type"
typ
::
T
.
Text
<-
v
.:
"type"
value
<-
v
.:?
"value"
.!=
[]
case
typ
of
"MyListsFirst"
->
pure
$
FlowSocialListWithPriority
{
fslw_priority
=
MySelfFirst
}
"OtherListsFirst"
->
pure
$
FlowSocialListWithPriority
{
fslw_priority
=
OthersFirst
}
"SelectedLists"
->
pure
$
FlowSocialListWithLists
{
fslw_lists
=
v
}
"SelectedLists"
->
pure
$
FlowSocialListWithLists
{
fslw_lists
=
v
alue
}
_
->
pure
$
FlowSocialListWithPriority
{
fslw_priority
=
MySelfFirst
}
parseJSON
_
=
mzero
instance
ToJSON
FlowSocialListWith
where
toJSON
(
FlowSocialListWithPriority
{
fslw_priority
=
MySelfFirst
})
=
object
[
(
"type"
,
String
"MyListsFirst"
)
]
toJSON
(
FlowSocialListWithPriority
{
fslw_priority
=
OthersFirst
})
=
object
[
(
"type"
,
String
"ListsFirst"
)
]
toJSON
(
FlowSocialListWithLists
{
fslw_lists
=
ids
})
=
object
[
(
"type"
,
String
"SelectedLists"
)
,
(
"value"
,
Array
$
V
.
fromList
$
(
map
(
\
(
NodeId
id
)
->
Number
$
Scientific
.
scientific
(
Prelude
.
toInteger
id
)
1
)
ids
))
]
instance
ToSchema
FlowSocialListWith
where
declareNamedSchema
=
genericDeclareNamedSchema
defaultSchemaOptions
data
FlowSocialListPriority
=
MySelfFirst
|
OthersFirst
deriving
(
Show
,
Generic
)
instance
ToSchema
FlowSocialListPriority
where
declareNamedSchema
=
genericDeclareNamedSchema
defaultSchemaOptions
flowSocialListPriority
::
FlowSocialListPriority
->
[
NodeMode
]
flowSocialListPriority
MySelfFirst
=
[
Private
{-, Shared, Public -}
]
flowSocialListPriority
OthersFirst
=
reverse
$
flowSocialListPriority
MySelfFirst
...
...
src/Gargantext/Database/Admin/Types/Node.hs
View file @
061a675f
...
...
@@ -132,27 +132,22 @@ pgNodeId = O.pgInt4 . id2int
------------------------------------------------------------------------
newtype
NodeId
=
NodeId
Int
deriving
(
Read
,
Generic
,
Num
,
Eq
,
Ord
,
Enum
,
ToJSONKey
,
FromJSONKey
,
ToJSON
,
FromJSON
,
Hashable
)
instance
Show
NodeId
where
show
(
NodeId
n
)
=
"nodeId-"
<>
show
n
unNodeId
::
NodeId
->
Int
unNodeId
(
NodeId
n
)
=
n
instance
Serialise
NodeId
instance
ToField
NodeId
where
toField
(
NodeId
n
)
=
toField
n
instance
FromField
NodeId
where
fromField
field
mdata
=
do
n
<-
fromField
field
mdata
if
(
n
::
Int
)
>
0
then
return
$
NodeId
n
else
mzero
instance
ToSchema
NodeId
unNodeId
::
NodeId
->
Int
unNodeId
(
NodeId
n
)
=
n
type
NodeTypeId
=
Int
type
NodeName
=
Text
type
TSVector
=
Text
...
...
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