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
158
Issues
158
List
Board
Labels
Milestones
Merge Requests
11
Merge Requests
11
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
1c3ad407
Commit
1c3ad407
authored
Jul 15, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[REFACT] Hyperdatas WIP
parent
4c6a3b4c
Pipeline
#951
failed with stage
Changes
14
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
14 changed files
with
212 additions
and
142 deletions
+212
-142
Metrics.hs
src/Gargantext/API/Metrics.hs
+21
-21
Config.hs
src/Gargantext/Database/Admin/Config.hs
+1
-1
Hyperdata.hs
src/Gargantext/Database/Admin/Types/Hyperdata.hs
+4
-0
Any.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Any.hs
+9
-11
Corpus.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Corpus.hs
+37
-36
Dashboard.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Dashboard.hs
+7
-7
Document.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Document.hs
+12
-10
Folder.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Folder.hs
+30
-0
List.hs
src/Gargantext/Database/Admin/Types/Hyperdata/List.hs
+18
-41
Model.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Model.hs
+61
-0
Phylo.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Phylo.hs
+0
-2
Texts.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Texts.hs
+3
-4
Node.hs
src/Gargantext/Database/Admin/Types/Node.hs
+1
-1
Node.hs
src/Gargantext/Database/Query/Table/Node.hs
+8
-8
No files found.
src/Gargantext/API/Metrics.hs
View file @
1c3ad407
...
@@ -77,7 +77,7 @@ getScatter cId maybeListId tabType _maybeLimit = do
...
@@ -77,7 +77,7 @@ getScatter cId maybeListId tabType _maybeLimit = do
Just
lid
->
pure
lid
Just
lid
->
pure
lid
Nothing
->
defaultList
cId
Nothing
->
defaultList
cId
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
let
HyperdataList
{
hd
_scatter
=
mChart
}
=
node
^.
node_hyperdata
let
HyperdataList
{
_hl
_scatter
=
mChart
}
=
node
^.
node_hyperdata
chart
<-
case
mChart
of
chart
<-
case
mChart
of
Just
chart
->
pure
chart
Just
chart
->
pure
chart
...
@@ -115,10 +115,10 @@ updateScatter' cId maybeListId tabType maybeLimit = do
...
@@ -115,10 +115,10 @@ updateScatter' cId maybeListId tabType maybeLimit = do
Just
lid
->
pure
lid
Just
lid
->
pure
lid
Nothing
->
defaultList
cId
Nothing
->
defaultList
cId
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
let
HyperdataList
{
hd
_chart
=
hdc
let
HyperdataList
{
_hl
_chart
=
hdc
,
hd
_list
=
hdl
,
_hl
_list
=
hdl
,
hd
_pie
=
hdp
,
_hl
_pie
=
hdp
,
hd
_tree
=
hdt
}
=
node
^.
node_hyperdata
,
_hl
_tree
=
hdt
}
=
node
^.
node_hyperdata
_
<-
updateHyperdata
listId
$
HyperdataList
hdc
hdl
hdp
(
Just
$
Metrics
metrics
)
hdt
_
<-
updateHyperdata
listId
$
HyperdataList
hdc
hdl
hdp
(
Just
$
Metrics
metrics
)
hdt
pure
$
Metrics
metrics
pure
$
Metrics
metrics
...
@@ -170,7 +170,7 @@ getChart cId _start _end maybeListId tabType = do
...
@@ -170,7 +170,7 @@ getChart cId _start _end maybeListId tabType = do
Just
lid
->
pure
lid
Just
lid
->
pure
lid
Nothing
->
defaultList
cId
Nothing
->
defaultList
cId
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
let
HyperdataList
{
hd
_chart
=
mChart
}
=
node
^.
node_hyperdata
let
HyperdataList
{
_hl
_chart
=
mChart
}
=
node
^.
node_hyperdata
chart
<-
case
mChart
of
chart
<-
case
mChart
of
Just
chart
->
pure
chart
Just
chart
->
pure
chart
...
@@ -200,10 +200,10 @@ updateChart' cId maybeListId _tabType _maybeLimit = do
...
@@ -200,10 +200,10 @@ updateChart' cId maybeListId _tabType _maybeLimit = do
Just
lid
->
pure
lid
Just
lid
->
pure
lid
Nothing
->
defaultList
cId
Nothing
->
defaultList
cId
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
let
HyperdataList
{
hd
_list
=
hdl
let
HyperdataList
{
_hl
_list
=
hdl
,
hd
_pie
=
hdp
,
_hl
_pie
=
hdp
,
hd
_scatter
=
hds
,
_hl
_scatter
=
hds
,
hd
_tree
=
hdt
}
=
node
^.
node_hyperdata
,
_hl
_tree
=
hdt
}
=
node
^.
node_hyperdata
h
<-
histoData
cId
h
<-
histoData
cId
_
<-
updateHyperdata
listId
$
HyperdataList
(
Just
$
ChartMetrics
h
)
hdl
hdp
hds
hdt
_
<-
updateHyperdata
listId
$
HyperdataList
(
Just
$
ChartMetrics
h
)
hdl
hdp
hds
hdt
...
@@ -254,7 +254,7 @@ getPie cId _start _end maybeListId tabType = do
...
@@ -254,7 +254,7 @@ getPie cId _start _end maybeListId tabType = do
Just
lid
->
pure
lid
Just
lid
->
pure
lid
Nothing
->
defaultList
cId
Nothing
->
defaultList
cId
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
let
HyperdataList
{
hd
_pie
=
mChart
}
=
node
^.
node_hyperdata
let
HyperdataList
{
_hl
_pie
=
mChart
}
=
node
^.
node_hyperdata
chart
<-
case
mChart
of
chart
<-
case
mChart
of
Just
chart
->
pure
chart
Just
chart
->
pure
chart
...
@@ -284,10 +284,10 @@ updatePie' cId maybeListId tabType _maybeLimit = do
...
@@ -284,10 +284,10 @@ updatePie' cId maybeListId tabType _maybeLimit = do
Just
lid
->
pure
lid
Just
lid
->
pure
lid
Nothing
->
defaultList
cId
Nothing
->
defaultList
cId
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
let
HyperdataList
{
hd
_chart
=
hdc
let
HyperdataList
{
_hl
_chart
=
hdc
,
hd
_list
=
hdl
,
_hl
_list
=
hdl
,
hd
_scatter
=
hds
,
_hl
_scatter
=
hds
,
hd
_tree
=
hdt
}
=
node
^.
node_hyperdata
,
_hl
_tree
=
hdt
}
=
node
^.
node_hyperdata
p
<-
pieData
cId
(
ngramsTypeFromTabType
tabType
)
MapTerm
p
<-
pieData
cId
(
ngramsTypeFromTabType
tabType
)
MapTerm
_
<-
updateHyperdata
listId
$
HyperdataList
hdc
hdl
(
Just
$
ChartMetrics
p
)
hds
hdt
_
<-
updateHyperdata
listId
$
HyperdataList
hdc
hdl
(
Just
$
ChartMetrics
p
)
hds
hdt
...
@@ -348,7 +348,7 @@ getTree cId _start _end maybeListId tabType listType = do
...
@@ -348,7 +348,7 @@ getTree cId _start _end maybeListId tabType listType = do
Nothing
->
defaultList
cId
Nothing
->
defaultList
cId
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
let
HyperdataList
{
hd
_tree
=
mChart
}
=
node
^.
node_hyperdata
let
HyperdataList
{
_hl
_tree
=
mChart
}
=
node
^.
node_hyperdata
chart
<-
case
mChart
of
chart
<-
case
mChart
of
Just
chart
->
pure
chart
Just
chart
->
pure
chart
...
@@ -379,10 +379,10 @@ updateTree' cId maybeListId tabType listType = do
...
@@ -379,10 +379,10 @@ updateTree' cId maybeListId tabType listType = do
Nothing
->
defaultList
cId
Nothing
->
defaultList
cId
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
node
<-
getNodeWith
listId
(
Proxy
::
Proxy
HyperdataList
)
let
HyperdataList
{
hd
_chart
=
hdc
let
HyperdataList
{
_hl
_chart
=
hdc
,
hd
_list
=
hdl
,
_hl
_list
=
hdl
,
hd
_scatter
=
hds
,
_hl
_scatter
=
hds
,
hd
_pie
=
hdp
}
=
node
^.
node_hyperdata
,
_hl
_pie
=
hdp
}
=
node
^.
node_hyperdata
t
<-
treeData
cId
(
ngramsTypeFromTabType
tabType
)
listType
t
<-
treeData
cId
(
ngramsTypeFromTabType
tabType
)
listType
_
<-
updateHyperdata
listId
$
HyperdataList
hdc
hdl
hdp
hds
(
Just
$
ChartMetrics
t
)
_
<-
updateHyperdata
listId
$
HyperdataList
hdc
hdl
hdp
hds
(
Just
$
ChartMetrics
t
)
...
@@ -396,4 +396,4 @@ getTreeMD5 :: FlowCmdM env err m =>
...
@@ -396,4 +396,4 @@ getTreeMD5 :: FlowCmdM env err m =>
->
m
Text
->
m
Text
getTreeMD5
cId
maybeListId
tabType
listType
=
do
getTreeMD5
cId
maybeListId
tabType
listType
=
do
HashedResponse
{
md5
=
md5'
}
<-
getTree
cId
Nothing
Nothing
maybeListId
tabType
listType
HashedResponse
{
md5
=
md5'
}
<-
getTree
cId
Nothing
Nothing
maybeListId
tabType
listType
pure
md5'
pure
md5'
\ No newline at end of file
src/Gargantext/Database/Admin/Config.hs
View file @
1c3ad407
...
@@ -56,7 +56,7 @@ nodeTypeId n =
...
@@ -56,7 +56,7 @@ nodeTypeId n =
---- Lists
---- Lists
NodeList
->
5
NodeList
->
5
NodeListCooc
->
50
NodeListCooc
->
50
Node
List
Model
->
52
NodeModel
->
52
---- Scores
---- Scores
-- NodeOccurrences -> 10
-- NodeOccurrences -> 10
...
...
src/Gargantext/Database/Admin/Types/Hyperdata.hs
View file @
1c3ad407
...
@@ -16,7 +16,9 @@ module Gargantext.Database.Admin.Types.Hyperdata
...
@@ -16,7 +16,9 @@ module Gargantext.Database.Admin.Types.Hyperdata
,
module
Gargantext
.
Database
.
Admin
.
Types
.
Hyperdata
.
Corpus
,
module
Gargantext
.
Database
.
Admin
.
Types
.
Hyperdata
.
Corpus
,
module
Gargantext
.
Database
.
Admin
.
Types
.
Hyperdata
.
Dashboard
,
module
Gargantext
.
Database
.
Admin
.
Types
.
Hyperdata
.
Dashboard
,
module
Gargantext
.
Database
.
Admin
.
Types
.
Hyperdata
.
Document
,
module
Gargantext
.
Database
.
Admin
.
Types
.
Hyperdata
.
Document
,
module
Gargantext
.
Database
.
Admin
.
Types
.
Hyperdata
.
Folder
,
module
Gargantext
.
Database
.
Admin
.
Types
.
Hyperdata
.
List
,
module
Gargantext
.
Database
.
Admin
.
Types
.
Hyperdata
.
List
,
module
Gargantext
.
Database
.
Admin
.
Types
.
Hyperdata
.
Model
,
module
Gargantext
.
Database
.
Admin
.
Types
.
Hyperdata
.
Prelude
,
module
Gargantext
.
Database
.
Admin
.
Types
.
Hyperdata
.
Prelude
,
module
Gargantext
.
Database
.
Admin
.
Types
.
Hyperdata
.
Texts
,
module
Gargantext
.
Database
.
Admin
.
Types
.
Hyperdata
.
Texts
,
module
Gargantext
.
Database
.
Admin
.
Types
.
Hyperdata
.
Phylo
,
module
Gargantext
.
Database
.
Admin
.
Types
.
Hyperdata
.
Phylo
...
@@ -27,7 +29,9 @@ import Gargantext.Database.Admin.Types.Hyperdata.Any
...
@@ -27,7 +29,9 @@ import Gargantext.Database.Admin.Types.Hyperdata.Any
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
import
Gargantext.Database.Admin.Types.Hyperdata.Dashboard
import
Gargantext.Database.Admin.Types.Hyperdata.Dashboard
import
Gargantext.Database.Admin.Types.Hyperdata.Document
import
Gargantext.Database.Admin.Types.Hyperdata.Document
import
Gargantext.Database.Admin.Types.Hyperdata.Folder
import
Gargantext.Database.Admin.Types.Hyperdata.List
import
Gargantext.Database.Admin.Types.Hyperdata.List
import
Gargantext.Database.Admin.Types.Hyperdata.Model
import
Gargantext.Database.Admin.Types.Hyperdata.Prelude
(
Hyperdata
)
import
Gargantext.Database.Admin.Types.Hyperdata.Prelude
(
Hyperdata
)
import
Gargantext.Database.Admin.Types.Hyperdata.Texts
import
Gargantext.Database.Admin.Types.Hyperdata.Texts
import
Gargantext.Database.Admin.Types.Hyperdata.Phylo
import
Gargantext.Database.Admin.Types.Hyperdata.Phylo
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/Any.hs
View file @
1c3ad407
...
@@ -9,16 +9,14 @@ Portability : POSIX
...
@@ -9,16 +9,14 @@ Portability : POSIX
-}
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TemplateHaskell #-}
module
Gargantext.Database.Admin.Types.Hyperdata.Any
module
Gargantext.Database.Admin.Types.Hyperdata.Any
where
where
...
@@ -41,8 +39,8 @@ instance Arbitrary HyperdataAny where
...
@@ -41,8 +39,8 @@ instance Arbitrary HyperdataAny where
instance
ToSchema
HyperdataAny
where
instance
ToSchema
HyperdataAny
where
declareNamedSchema
proxy
=
declareNamedSchema
proxy
=
pure
$
genericNameSchema
defaultSchemaOptions
proxy
mempty
pure
$
genericNameSchema
defaultSchemaOptions
proxy
mempty
&
schema
.
description
?~
"a node
"
&
schema
.
description
?~
"Hyperdata of any node (Json Value)
"
&
schema
.
example
?~
emptyObject
-- TODO
&
schema
.
example
?~
emptyObject
-- TODO
instance
FromField
HyperdataAny
where
instance
FromField
HyperdataAny
where
fromField
=
fromField'
fromField
=
fromField'
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/Corpus.hs
View file @
1c3ad407
...
@@ -9,16 +9,14 @@ Portability : POSIX
...
@@ -9,16 +9,14 @@ Portability : POSIX
-}
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TemplateHaskell #-}
module
Gargantext.Database.Admin.Types.Hyperdata.Corpus
module
Gargantext.Database.Admin.Types.Hyperdata.Corpus
where
where
...
@@ -34,28 +32,24 @@ instance FromJSON CodeType
...
@@ -34,28 +32,24 @@ instance FromJSON CodeType
instance
ToSchema
CodeType
instance
ToSchema
CodeType
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
data
CorpusField
=
MarkdownField
{
_cf_text
::
!
Text
}
data
CorpusField
=
MarkdownField
{
_cf_text
::
!
Text
}
|
JsonField
{
_cf_title
::
!
Text
,
_cf_desc
::
!
Text
,
_cf_query
::
!
Text
,
_cf_authors
::
!
Text
-- , _cf_resources :: ![Resource]
}
|
HaskellField
{
_cf_haskell
::
!
Text
}
|
HaskellField
{
_cf_haskell
::
!
Text
}
|
JsonField
{
_cf_title
::
!
Text
,
_cf_desc
::
!
Text
,
_cf_query
::
!
Text
,
_cf_authors
::
!
Text
-- , _cf_resources :: ![Resource]
}
deriving
(
Generic
)
deriving
(
Generic
)
isField
::
CodeType
->
CorpusField
->
Bool
defaultCorpusField
::
CorpusField
isField
Markdown
(
MarkdownField
_
)
=
True
defaultCorpusField
=
MarkdownField
"# Title"
isField
JSON
(
JsonField
_
_
_
_
)
=
True
isField
Haskell
(
HaskellField
_
)
=
True
isField
_
_
=
False
$
(
deriveJSON
(
unPrefix
"_cf_"
)
''
C
orpusField
)
------------------------------------------------------------------------
-- Instances
------------------------------------------------------------------------
$
(
makeLenses
''
C
orpusField
)
$
(
makeLenses
''
C
orpusField
)
$
(
deriveJSON
(
unPrefix
"_cf_"
)
''
C
orpusField
)
defaultCorpusField
::
CorpusField
defaultCorpusField
=
MarkdownField
"# title"
instance
ToSchema
CorpusField
where
instance
ToSchema
CorpusField
where
declareNamedSchema
proxy
=
declareNamedSchema
proxy
=
...
@@ -63,36 +57,46 @@ instance ToSchema CorpusField where
...
@@ -63,36 +57,46 @@ instance ToSchema CorpusField where
&
mapped
.
schema
.
description
?~
"CorpusField"
&
mapped
.
schema
.
description
?~
"CorpusField"
&
mapped
.
schema
.
example
?~
toJSON
defaultCorpusField
&
mapped
.
schema
.
example
?~
toJSON
defaultCorpusField
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
data
HyperdataField
a
=
data
HyperdataField
a
=
HyperdataField
{
_hf_type
::
!
CodeType
HyperdataField
{
_hf_type
::
!
CodeType
,
_hf_name
::
!
Text
,
_hf_name
::
!
Text
,
_hf_data
::
!
a
,
_hf_data
::
!
a
}
deriving
(
Generic
)
}
deriving
(
Generic
)
$
(
deriveJSON
(
unPrefix
"_hf_"
)
''
H
yperdataField
)
$
(
makeLenses
''
H
yperdataField
)
defaultHyperdataField
::
HyperdataField
CorpusField
defaultHyperdataField
::
HyperdataField
CorpusField
defaultHyperdataField
=
HyperdataField
Markdown
"name"
defaultCorpusField
defaultHyperdataField
=
HyperdataField
Markdown
"name"
defaultCorpusField
------------------------------------------------------------------------
-- Instances
------------------------------------------------------------------------
$
(
makeLenses
''
H
yperdataField
)
$
(
deriveJSON
(
unPrefix
"_hf_"
)
''
H
yperdataField
)
instance
(
Typeable
a
,
ToSchema
a
)
=>
ToSchema
(
HyperdataField
a
)
where
instance
(
Typeable
a
,
ToSchema
a
)
=>
ToSchema
(
HyperdataField
a
)
where
declareNamedSchema
proxy
=
genericDeclareNamedSchema
(
unPrefixSwagger
"_hf_"
)
proxy
&
mapped
.
schema
.
description
?~
"Hyperdata Field"
&
mapped
.
schema
.
example
?~
toJSON
defaultCorpusField
{-
declareNamedSchema =
declareNamedSchema =
wellNamedSchema "_hf_"
wellNamedSchema "_hf_"
-- & mapped.schema.description ?~ "HyperdataField"
-- & mapped.schema.description ?~ "HyperdataField"
-- & mapped.schema.example ?~ toJSON defaultHyperdataField
-- & mapped.schema.example ?~ toJSON defaultHyperdataField
-}
------------------------------------------------------------------------
------------------------------------------------------------------------
data
HyperdataCorpus
=
data
HyperdataCorpus
=
HyperdataCorpus
{
_hc_fields
::
!
[
HyperdataField
CorpusField
]
}
HyperdataCorpus
{
_hc_fields
::
!
[
HyperdataField
CorpusField
]
}
deriving
(
Generic
)
deriving
(
Generic
)
------------------------------------------------------------------------
-- Instances
------------------------------------------------------------------------
instance
Hyperdata
HyperdataCorpus
$
(
deriveJSON
(
unPrefix
"_hc_"
)
''
H
yperdataCorpus
)
$
(
deriveJSON
(
unPrefix
"_hc_"
)
''
H
yperdataCorpus
)
$
(
makeLenses
''
H
yperdataCorpus
)
$
(
makeLenses
''
H
yperdataCorpus
)
instance
Hyperdata
HyperdataCorpus
type
HyperdataFolder
=
HyperdataCorpus
------------------------------------------------------------------------
------------------------------------------------------------------------
data
HyperdataFrame
=
data
HyperdataFrame
=
...
@@ -123,9 +127,6 @@ hyperdataCorpus = case decode corpusExample of
...
@@ -123,9 +127,6 @@ hyperdataCorpus = case decode corpusExample of
defaultHyperdataCorpus
::
HyperdataCorpus
defaultHyperdataCorpus
::
HyperdataCorpus
defaultHyperdataCorpus
=
defaultCorpus
defaultHyperdataCorpus
=
defaultCorpus
defaultHyperdataFolder
::
HyperdataFolder
defaultHyperdataFolder
=
defaultHyperdataCorpus
instance
Arbitrary
HyperdataCorpus
where
instance
Arbitrary
HyperdataCorpus
where
arbitrary
=
pure
hyperdataCorpus
-- TODO
arbitrary
=
pure
hyperdataCorpus
-- TODO
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/Dashboard.hs
View file @
1c3ad407
...
@@ -9,14 +9,14 @@ Portability : POSIX
...
@@ -9,14 +9,14 @@ Portability : POSIX
-}
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric
#-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleContexts
#-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiParamTypeClasses
#-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NoImplicitPrelude
#-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings
#-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RankNTypes
#-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TemplateHaskell
#-}
module
Gargantext.Database.Admin.Types.Hyperdata.Dashboard
module
Gargantext.Database.Admin.Types.Hyperdata.Dashboard
where
where
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/Document.hs
View file @
1c3ad407
...
@@ -9,15 +9,14 @@ Portability : POSIX
...
@@ -9,15 +9,14 @@ Portability : POSIX
-}
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric
#-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleContexts
#-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TemplateHaskell #-}
module
Gargantext.Database.Admin.Types.Hyperdata.Document
where
module
Gargantext.Database.Admin.Types.Hyperdata.Document
where
...
@@ -31,7 +30,6 @@ data StatusV3 = StatusV3 { statusV3_error :: !(Maybe Text)
...
@@ -31,7 +30,6 @@ data StatusV3 = StatusV3 { statusV3_error :: !(Maybe Text)
$
(
deriveJSON
(
unPrefix
"statusV3_"
)
''
S
tatusV3
)
$
(
deriveJSON
(
unPrefix
"statusV3_"
)
''
S
tatusV3
)
------------------------------------------------------------------------
------------------------------------------------------------------------
data
HyperdataDocumentV3
=
HyperdataDocumentV3
{
hyperdataDocumentV3_publication_day
::
!
(
Maybe
Int
)
data
HyperdataDocumentV3
=
HyperdataDocumentV3
{
hyperdataDocumentV3_publication_day
::
!
(
Maybe
Int
)
,
hyperdataDocumentV3_language_iso2
::
!
(
Maybe
Text
)
,
hyperdataDocumentV3_language_iso2
::
!
(
Maybe
Text
)
...
@@ -99,7 +97,7 @@ instance Hyperdata HyperdataDocumentV3
...
@@ -99,7 +97,7 @@ instance Hyperdata HyperdataDocumentV3
instance
ToSchema
HyperdataDocument
where
instance
ToSchema
HyperdataDocument
where
declareNamedSchema
proxy
=
declareNamedSchema
proxy
=
genericDeclareNamedSchema
(
unPrefixSwagger
"_hyperdataDocument_"
)
proxy
genericDeclareNamedSchema
(
unPrefixSwagger
"_hyperdataDocument_"
)
proxy
&
mapped
.
schema
.
description
?~
"
a document
"
&
mapped
.
schema
.
description
?~
"
Document Hyperdata
"
&
mapped
.
schema
.
example
?~
toJSON
defaultHyperdataDocument
&
mapped
.
schema
.
example
?~
toJSON
defaultHyperdataDocument
------------------------------------------------------------------------
------------------------------------------------------------------------
instance
FromField
HyperdataDocument
instance
FromField
HyperdataDocument
...
@@ -112,6 +110,10 @@ instance FromField HyperdataDocumentV3
...
@@ -112,6 +110,10 @@ instance FromField HyperdataDocumentV3
instance
ToField
HyperdataDocument
where
instance
ToField
HyperdataDocument
where
toField
=
toJSONField
toField
=
toJSONField
instance
ToField
HyperdataDocumentV3
where
toField
=
toJSONField
------------------------------------------------------------------------
------------------------------------------------------------------------
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataDocument
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataDocument
where
where
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/Folder.hs
0 → 100644
View file @
1c3ad407
{-|
Module : Gargantext.Database.Admin.Types.Hyperdata.Folder
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
module
Gargantext.Database.Admin.Types.Hyperdata.Folder
where
import
Gargantext.Database.Admin.Types.Hyperdata.Corpus
------------------------------------------------------------------------
type
HyperdataFolder
=
HyperdataCorpus
defaultHyperdataFolder
::
HyperdataFolder
defaultHyperdataFolder
=
defaultHyperdataCorpus
src/Gargantext/Database/Admin/Types/Hyperdata/List.hs
View file @
1c3ad407
...
@@ -30,60 +30,37 @@ import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metrics)
...
@@ -30,60 +30,37 @@ import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metrics)
------------------------------------------------------------------------
------------------------------------------------------------------------
data
HyperdataList
=
data
HyperdataList
=
HyperdataList
{
hd
_chart
::
!
(
Maybe
(
ChartMetrics
Histo
))
HyperdataList
{
_hl
_chart
::
!
(
Maybe
(
ChartMetrics
Histo
))
,
hd
_list
::
!
(
Maybe
Text
)
,
_hl
_list
::
!
(
Maybe
Text
)
,
hd
_pie
::
!
(
Maybe
(
ChartMetrics
Histo
))
,
_hl
_pie
::
!
(
Maybe
(
ChartMetrics
Histo
))
,
hd
_scatter
::
!
(
Maybe
Metrics
)
,
_hl
_scatter
::
!
(
Maybe
Metrics
)
,
hd
_tree
::
!
(
Maybe
(
ChartMetrics
[
MyTree
]))
,
_hl
_tree
::
!
(
Maybe
(
ChartMetrics
[
MyTree
]))
}
deriving
(
Show
,
Generic
)
}
deriving
(
Show
,
Generic
)
$
(
deriveJSON
(
unPrefix
"hd_"
)
''
H
yperdataList
)
instance
Hyperdata
HyperdataList
defaultHyperdataList
::
HyperdataList
defaultHyperdataList
::
HyperdataList
defaultHyperdataList
=
HyperdataList
Nothing
Nothing
Nothing
Nothing
Nothing
defaultHyperdataList
=
HyperdataList
Nothing
Nothing
Nothing
Nothing
Nothing
----
data
HyperdataListModel
=
HyperdataListModel
{
_hlm_params
::
!
(
Int
,
Int
)
,
_hlm_path
::
!
Text
,
_hlm_score
::
!
(
Maybe
Double
)
}
deriving
(
Show
,
Generic
)
instance
Hyperdata
HyperdataListModel
instance
Arbitrary
HyperdataListModel
where
arbitrary
=
elements
[
HyperdataListModel
(
100
,
100
)
"models/example.model"
Nothing
]
$
(
deriveJSON
(
unPrefix
"_hlm_"
)
''
H
yperdataListModel
)
$
(
makeLenses
''
H
yperdataListModel
)
defaultHyperdataListModel
::
HyperdataListModel
defaultHyperdataListModel
=
HyperdataListModel
(
400
,
500
)
"data/models/test.model"
(
Just
0.83
)
------------------------------------------------------------------------
data
HyperdataScore
=
HyperdataScore
{
hyperdataScore_preferences
::
!
(
Maybe
Text
)
}
deriving
(
Show
,
Generic
)
$
(
deriveJSON
(
unPrefix
"hyperdataScore_"
)
''
H
yperdataScore
)
instance
Hyperdata
HyperdataScore
------------------------------------------------------------------------
------------------------------------------------------------------------
-- Instances
-- Instances
------------------------------------------------------------------------
------------------------------------------------------------------------
instance
Hyperdata
HyperdataList
$
(
makeLenses
''
H
yperdataList
)
$
(
deriveJSON
(
unPrefix
"_hl_"
)
''
H
yperdataList
)
instance
Arbitrary
HyperdataList
where
arbitrary
=
pure
defaultHyperdataList
instance
FromField
HyperdataList
instance
FromField
HyperdataList
where
where
fromField
=
fromField'
fromField
=
fromField'
instance
FromField
HyperdataListModel
where
fromField
=
fromField'
------------------------------------------------------------------------
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataList
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataList
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataListModel
instance
ToSchema
HyperdataList
where
where
declareNamedSchema
proxy
=
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
genericDeclareNamedSchema
(
unPrefixSwagger
"_hl_"
)
proxy
&
mapped
.
schema
.
description
?~
"List Hyperdata"
&
mapped
.
schema
.
example
?~
toJSON
defaultHyperdataList
------------------------------------------------------------------------
src/Gargantext/Database/Admin/Types/Hyperdata/Model.hs
0 → 100644
View file @
1c3ad407
{-|
Module : Gargantext.Database.Admin.Types.Hyperdata.Model
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
module
Gargantext.Database.Admin.Types.Hyperdata.Model
where
import
Gargantext.Prelude
import
Gargantext.Database.Admin.Types.Hyperdata.Prelude
------------------------------------------------------------------------
data
HyperdataModel
=
HyperdataModel
{
_hm_params
::
!
(
Int
,
Int
)
,
_hm_path
::
!
Text
,
_hm_score
::
!
(
Maybe
Double
)
}
deriving
(
Show
,
Generic
)
defaultHyperdataModel
::
HyperdataModel
defaultHyperdataModel
=
HyperdataModel
(
400
,
500
)
"data/models/test.model"
(
Just
0.83
)
------------------------------------------------------------------------
-- Instances
------------------------------------------------------------------------
instance
Hyperdata
HyperdataModel
$
(
makeLenses
''
H
yperdataModel
)
$
(
deriveJSON
(
unPrefix
"_hm_"
)
''
H
yperdataModel
)
instance
Arbitrary
HyperdataModel
where
arbitrary
=
pure
defaultHyperdataModel
instance
FromField
HyperdataModel
where
fromField
=
fromField'
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataModel
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
ToSchema
HyperdataModel
where
declareNamedSchema
proxy
=
genericDeclareNamedSchema
(
unPrefixSwagger
"_hm_"
)
proxy
&
mapped
.
schema
.
description
?~
"Model Hyperdata"
&
mapped
.
schema
.
example
?~
toJSON
defaultHyperdataModel
src/Gargantext/Database/Admin/Types/Hyperdata/Phylo.hs
View file @
1c3ad407
...
@@ -53,11 +53,9 @@ instance ToSchema HyperdataPhylo where
...
@@ -53,11 +53,9 @@ instance ToSchema HyperdataPhylo where
&
mapped
.
schema
.
description
?~
"Phylo Hyperdata"
&
mapped
.
schema
.
description
?~
"Phylo Hyperdata"
&
mapped
.
schema
.
example
?~
toJSON
defaultHyperdataPhylo
&
mapped
.
schema
.
example
?~
toJSON
defaultHyperdataPhylo
instance
FromField
HyperdataPhylo
where
instance
FromField
HyperdataPhylo
where
fromField
=
fromField'
fromField
=
fromField'
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataPhylo
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataPhylo
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
src/Gargantext/Database/Admin/Types/Hyperdata/Texts.hs
View file @
1c3ad407
...
@@ -47,10 +47,9 @@ instance Arbitrary HyperdataTexts where
...
@@ -47,10 +47,9 @@ instance Arbitrary HyperdataTexts where
instance
ToSchema
HyperdataTexts
where
instance
ToSchema
HyperdataTexts
where
declareNamedSchema
proxy
=
declareNamedSchema
proxy
=
-- genericDeclareNamedSchema (unPrefixSwagger "_ht_") proxy
genericDeclareNamedSchema
(
unPrefixSwagger
"_ht_"
)
proxy
pure
$
genericNameSchema
defaultSchemaOptions
proxy
mempty
&
mapped
.
schema
.
description
?~
"Texts Hyperdata"
&
schema
.
description
?~
"Texts Hyperdata"
&
mapped
.
schema
.
example
?~
toJSON
defaultHyperdataTexts
&
schema
.
example
?~
toJSON
defaultHyperdataTexts
instance
FromField
HyperdataTexts
where
instance
FromField
HyperdataTexts
where
fromField
=
fromField'
fromField
=
fromField'
...
...
src/Gargantext/Database/Admin/Types/Node.hs
View file @
1c3ad407
...
@@ -245,7 +245,7 @@ data NodeType = NodeUser
...
@@ -245,7 +245,7 @@ data NodeType = NodeUser
|
NodeAnnuaire
|
NodeContact
|
NodeAnnuaire
|
NodeContact
|
NodeGraph
|
NodePhylo
|
NodeGraph
|
NodePhylo
|
NodeDashboard
|
NodeChart
|
NodeNoteBook
|
NodeDashboard
|
NodeChart
|
NodeNoteBook
|
NodeList
|
Node
List
Model
|
NodeList
|
NodeModel
|
NodeListCooc
|
NodeListCooc
{-
{-
...
...
src/Gargantext/Database/Query/Table/Node.hs
View file @
1c3ad407
...
@@ -117,8 +117,8 @@ getDocumentsV3WithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocume
...
@@ -117,8 +117,8 @@ getDocumentsV3WithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocume
getDocumentsWithParentId
::
NodeId
->
Cmd
err
[
Node
HyperdataDocument
]
getDocumentsWithParentId
::
NodeId
->
Cmd
err
[
Node
HyperdataDocument
]
getDocumentsWithParentId
n
=
runOpaQuery
$
selectNodesWith'
n
(
Just
NodeDocument
)
getDocumentsWithParentId
n
=
runOpaQuery
$
selectNodesWith'
n
(
Just
NodeDocument
)
getListsModelWithParentId
::
NodeId
->
Cmd
err
[
Node
Hyperdata
List
Model
]
getListsModelWithParentId
::
NodeId
->
Cmd
err
[
Node
HyperdataModel
]
getListsModelWithParentId
n
=
runOpaQuery
$
selectNodesWith'
n
(
Just
Node
List
Model
)
getListsModelWithParentId
n
=
runOpaQuery
$
selectNodesWith'
n
(
Just
NodeModel
)
getCorporaWithParentId
::
NodeId
->
Cmd
err
[
Node
HyperdataCorpus
]
getCorporaWithParentId
::
NodeId
->
Cmd
err
[
Node
HyperdataCorpus
]
getCorporaWithParentId
n
=
runOpaQuery
$
selectNodesWith'
n
(
Just
NodeCorpus
)
getCorporaWithParentId
n
=
runOpaQuery
$
selectNodesWith'
n
(
Just
NodeCorpus
)
...
@@ -195,14 +195,14 @@ nodeAnnuaireW maybeName maybeAnnuaire pId = node NodeAnnuaire name annuaire (Jus
...
@@ -195,14 +195,14 @@ nodeAnnuaireW maybeName maybeAnnuaire pId = node NodeAnnuaire name annuaire (Jus
annuaire
=
maybe
defaultHyperdataAnnuaire
identity
maybeAnnuaire
annuaire
=
maybe
defaultHyperdataAnnuaire
identity
maybeAnnuaire
------------------------------------------------------------------------
------------------------------------------------------------------------
mk
List
ModelNode
::
HasNodeError
err
=>
ParentId
->
UserId
->
Cmd
err
[
NodeId
]
mkModelNode
::
HasNodeError
err
=>
ParentId
->
UserId
->
Cmd
err
[
NodeId
]
mk
ListModelNode
p
u
=
insertNodesR
[
nodeList
ModelW
Nothing
Nothing
p
u
]
mk
ModelNode
p
u
=
insertNodesR
[
node
ModelW
Nothing
Nothing
p
u
]
node
ListModelW
::
Maybe
Name
->
Maybe
HyperdataList
Model
->
ParentId
->
UserId
->
NodeWrite
node
ModelW
::
Maybe
Name
->
Maybe
Hyperdata
Model
->
ParentId
->
UserId
->
NodeWrite
node
ListModelW
maybeName
maybeListModel
pId
=
node
NodeList
Model
name
list
(
Just
pId
)
node
ModelW
maybeName
maybeModel
pId
=
node
Node
Model
name
list
(
Just
pId
)
where
where
name
=
maybe
"List Model"
identity
maybeName
name
=
maybe
"List Model"
identity
maybeName
list
=
maybe
defaultHyperdata
ListModel
identity
maybeList
Model
list
=
maybe
defaultHyperdata
Model
identity
maybe
Model
------------------------------------------------------------------------
------------------------------------------------------------------------
nodeGraphW
::
Maybe
Name
->
Maybe
HyperdataGraph
->
ParentId
->
UserId
->
NodeWrite
nodeGraphW
::
Maybe
Name
->
Maybe
HyperdataGraph
->
ParentId
->
UserId
->
NodeWrite
...
@@ -224,7 +224,7 @@ nodeDefault NodeList parentId = node NodeList "List" defaultHyperdat
...
@@ -224,7 +224,7 @@ nodeDefault NodeList parentId = node NodeList "List" defaultHyperdat
nodeDefault
NodeCorpus
parentId
=
node
NodeCorpus
"Corpus"
defaultHyperdataCorpus
(
Just
parentId
)
nodeDefault
NodeCorpus
parentId
=
node
NodeCorpus
"Corpus"
defaultHyperdataCorpus
(
Just
parentId
)
nodeDefault
NodeDocument
parentId
=
node
NodeDocument
"Doc"
defaultHyperdataDocument
(
Just
parentId
)
nodeDefault
NodeDocument
parentId
=
node
NodeDocument
"Doc"
defaultHyperdataDocument
(
Just
parentId
)
nodeDefault
NodeTexts
parentId
=
node
NodeTexts
"Texts"
defaultHyperdataTexts
(
Just
parentId
)
nodeDefault
NodeTexts
parentId
=
node
NodeTexts
"Texts"
defaultHyperdataTexts
(
Just
parentId
)
nodeDefault
Node
ListModel
parentId
=
node
NodeListModel
"Model"
defaultHyperdataList
Model
(
Just
parentId
)
nodeDefault
Node
Model
parentId
=
node
NodeModel
"Model"
defaultHyperdata
Model
(
Just
parentId
)
nodeDefault
nt
_
=
panic
$
"G.D.Q.T.Node.nodeDefault "
<>
(
cs
$
show
nt
)
nodeDefault
nt
_
=
panic
$
"G.D.Q.T.Node.nodeDefault "
<>
(
cs
$
show
nt
)
------------------------------------------------------------------------
------------------------------------------------------------------------
...
...
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