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
Christian Merten
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
Changes
14
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