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
165
Issues
165
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
35857fe1
Commit
35857fe1
authored
Jul 13, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[WRONG] this type of refactoring fails in decodeJson
parent
9eaa8799
Pipeline
#946
failed with stage
Changes
7
Pipelines
1
Expand all
Show whitespace changes
Inline
Side-by-side
Showing
7 changed files
with
120 additions
and
127 deletions
+120
-127
Main.hs
bin/gargantext-init/Main.hs
+2
-2
Public.hs
src/Gargantext/API/Public.hs
+4
-4
Routes.hs
src/Gargantext/API/Routes.hs
+2
-2
Flow.hs
src/Gargantext/Database/Action/Flow.hs
+3
-3
Hyperdata.hs
src/Gargantext/Database/Admin/Types/Hyperdata.hs
+88
-95
Node.hs
src/Gargantext/Database/Query/Table/Node.hs
+8
-7
API.hs
src/Gargantext/Viz/Phylo/API.hs
+13
-14
No files found.
bin/gargantext-init/Main.hs
View file @
35857fe1
...
@@ -27,7 +27,7 @@ import Gargantext.Database.Query.Table.User (insertUsersDemo)
...
@@ -27,7 +27,7 @@ import Gargantext.Database.Query.Table.User (insertUsersDemo)
import
Gargantext.Database.Admin.Config
(
userMaster
,
corpusMasterName
)
import
Gargantext.Database.Admin.Config
(
userMaster
,
corpusMasterName
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Trigger.Init
(
initTriggers
)
import
Gargantext.Database.Admin.Trigger.Init
(
initTriggers
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
Hyper
dataCorpus
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
Hyper
Data
)
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
,
RootId
,
ListId
)
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
,
RootId
,
ListId
)
import
Gargantext.Database.Prelude
(
Cmd
,
)
import
Gargantext.Database.Prelude
(
Cmd
,
)
import
Gargantext.Prelude
import
Gargantext.Prelude
...
@@ -48,7 +48,7 @@ main = do
...
@@ -48,7 +48,7 @@ main = do
let
let
initMaster
::
Cmd
GargError
(
UserId
,
RootId
,
CorpusId
,
ListId
)
initMaster
::
Cmd
GargError
(
UserId
,
RootId
,
CorpusId
,
ListId
)
initMaster
=
do
initMaster
=
do
(
masterUserId
,
masterRootId
,
masterCorpusId
)
<-
getOrMk_RootWithCorpus
(
UserName
userMaster
)
(
Left
corpusMasterName
)
(
Nothing
::
Maybe
Hyper
dataCorpus
)
(
masterUserId
,
masterRootId
,
masterCorpusId
)
<-
getOrMk_RootWithCorpus
(
UserName
userMaster
)
(
Left
corpusMasterName
)
(
Nothing
::
Maybe
Hyper
Data
)
masterListId
<-
getOrMkList
masterCorpusId
masterUserId
masterListId
<-
getOrMkList
masterCorpusId
masterUserId
_triggers
<-
initTriggers
masterListId
_triggers
<-
initTriggers
masterListId
pure
(
masterUserId
,
masterRootId
,
masterCorpusId
,
masterListId
)
pure
(
masterUserId
,
masterRootId
,
masterCorpusId
,
masterListId
)
...
...
src/Gargantext/API/Public.hs
View file @
35857fe1
...
@@ -47,13 +47,13 @@ api = catMaybes <$> map toPublicData <$> filterPublicDatas <$> selectPublic
...
@@ -47,13 +47,13 @@ api = catMaybes <$> map toPublicData <$> filterPublicDatas <$> selectPublic
selectPublic
::
HasNodeError
err
selectPublic
::
HasNodeError
err
=>
Cmd
err
[(
Node
Hyper
dataFolder
,
Maybe
Int
)]
=>
Cmd
err
[(
Node
Hyper
Data
,
Maybe
Int
)]
selectPublic
=
selectPublicNodes
selectPublic
=
selectPublicNodes
-- | For tests only
-- | For tests only
-- pure $ replicate 6 defaultPublicData
-- pure $ replicate 6 defaultPublicData
filterPublicDatas
::
[(
Node
Hyper
dataFolder
,
Maybe
Int
)]
->
[(
Node
HyperdataFolder
,
[
NodeId
])]
filterPublicDatas
::
[(
Node
Hyper
Data
,
Maybe
Int
)]
->
[(
Node
HyperData
,
[
NodeId
])]
filterPublicDatas
datas
=
map
(
\
(
n
,
mi
)
->
let
mi'
=
NodeId
<$>
mi
in
filterPublicDatas
datas
=
map
(
\
(
n
,
mi
)
->
let
mi'
=
NodeId
<$>
mi
in
(
_node_id
n
,
(
n
,
maybe
[]
(
:
[]
)
mi'
))
(
_node_id
n
,
(
n
,
maybe
[]
(
:
[]
)
mi'
))
)
datas
)
datas
...
@@ -62,7 +62,7 @@ filterPublicDatas datas = map (\(n,mi) -> let mi' = NodeId <$> mi in
...
@@ -62,7 +62,7 @@ filterPublicDatas datas = map (\(n,mi) -> let mi' = NodeId <$> mi in
&
Map
.
elems
&
Map
.
elems
toPublicData
::
(
Node
Hyper
dataFolder
,
[
NodeId
])
->
Maybe
PublicData
toPublicData
::
(
Node
Hyper
Data
,
[
NodeId
])
->
Maybe
PublicData
toPublicData
(
n
,
_mn
)
=
PublicData
<$>
(
hd
^?
(
_Just
.
hf_data
.
cf_title
))
toPublicData
(
n
,
_mn
)
=
PublicData
<$>
(
hd
^?
(
_Just
.
hf_data
.
cf_title
))
<*>
(
hd
^?
(
_Just
.
hf_data
.
cf_desc
))
<*>
(
hd
^?
(
_Just
.
hf_data
.
cf_desc
))
<*>
Just
"images/Gargantextuel-212x300.jpg"
<*>
Just
"images/Gargantextuel-212x300.jpg"
...
@@ -73,7 +73,7 @@ toPublicData (n , _mn) = PublicData <$> (hd ^? (_Just . hf_data . cf_title))
...
@@ -73,7 +73,7 @@ toPublicData (n , _mn) = PublicData <$> (hd ^? (_Just . hf_data . cf_title))
where
where
hd
=
head
hd
=
head
$
filter
(
\
(
HyperdataField
cd
_
_
)
->
cd
==
JSON
)
$
filter
(
\
(
HyperdataField
cd
_
_
)
->
cd
==
JSON
)
$
n
^.
(
node_hyperdata
.
h
c
_fields
)
$
n
^.
(
node_hyperdata
.
h
d
_fields
)
data
PublicData
=
PublicData
data
PublicData
=
PublicData
...
...
src/Gargantext/API/Routes.hs
View file @
35857fe1
...
@@ -99,7 +99,7 @@ type GargPrivateAPI' =
...
@@ -99,7 +99,7 @@ type GargPrivateAPI' =
-- Corpus endpoints
-- Corpus endpoints
:<|>
"corpus"
:>
Summary
"Corpus endpoint"
:<|>
"corpus"
:>
Summary
"Corpus endpoint"
:>
Capture
"corpus_id"
CorpusId
:>
Capture
"corpus_id"
CorpusId
:>
NodeAPI
Hyper
dataCorpus
:>
NodeAPI
Hyper
Data
:<|>
"corpus"
:>
Summary
"Corpus endpoint"
:<|>
"corpus"
:>
Summary
"Corpus endpoint"
:>
Capture
"node1_id"
NodeId
:>
Capture
"node1_id"
NodeId
...
@@ -205,7 +205,7 @@ serverPrivateGargAPI' :: AuthenticatedUser -> GargServer GargPrivateAPI'
...
@@ -205,7 +205,7 @@ serverPrivateGargAPI' :: AuthenticatedUser -> GargServer GargPrivateAPI'
serverPrivateGargAPI'
(
AuthenticatedUser
(
NodeId
uid
))
serverPrivateGargAPI'
(
AuthenticatedUser
(
NodeId
uid
))
=
serverGargAdminAPI
=
serverGargAdminAPI
:<|>
nodeAPI
(
Proxy
::
Proxy
HyperdataAny
)
uid
:<|>
nodeAPI
(
Proxy
::
Proxy
HyperdataAny
)
uid
:<|>
nodeAPI
(
Proxy
::
Proxy
Hyper
dataCorpus
)
uid
:<|>
nodeAPI
(
Proxy
::
Proxy
Hyper
Data
)
uid
:<|>
nodeNodeAPI
(
Proxy
::
Proxy
HyperdataAny
)
uid
:<|>
nodeNodeAPI
(
Proxy
::
Proxy
HyperdataAny
)
uid
:<|>
Export
.
getCorpus
-- uid
:<|>
Export
.
getCorpus
-- uid
:<|>
nodeAPI
(
Proxy
::
Proxy
HyperdataAnnuaire
)
uid
:<|>
nodeAPI
(
Proxy
::
Proxy
HyperdataAnnuaire
)
uid
...
...
src/Gargantext/Database/Action/Flow.hs
View file @
35857fe1
...
@@ -126,7 +126,7 @@ getDataText (InternalOrigin _) _la q _li = do
...
@@ -126,7 +126,7 @@ getDataText (InternalOrigin _) _la q _li = do
(
_masterUserId
,
_masterRootId
,
cId
)
<-
getOrMk_RootWithCorpus
(
_masterUserId
,
_masterRootId
,
cId
)
<-
getOrMk_RootWithCorpus
(
UserName
userMaster
)
(
UserName
userMaster
)
(
Left
""
)
(
Left
""
)
(
Nothing
::
Maybe
Hyper
dataCorpus
)
(
Nothing
::
Maybe
Hyper
Data
)
ids
<-
map
fst
<$>
searchInDatabase
cId
(
stemIt
q
)
ids
<-
map
fst
<$>
searchInDatabase
cId
(
stemIt
q
)
pure
$
DataOld
ids
pure
$
DataOld
ids
...
@@ -139,7 +139,7 @@ flowDataText :: FlowCmdM env err m
...
@@ -139,7 +139,7 @@ flowDataText :: FlowCmdM env err m
->
m
CorpusId
->
m
CorpusId
flowDataText
u
(
DataOld
ids
)
tt
cid
=
flowCorpusUser
(
_tt_lang
tt
)
u
(
Right
[
cid
])
corpusType
ids
flowDataText
u
(
DataOld
ids
)
tt
cid
=
flowCorpusUser
(
_tt_lang
tt
)
u
(
Right
[
cid
])
corpusType
ids
where
where
corpusType
=
(
Nothing
::
Maybe
Hyper
dataCorpus
)
corpusType
=
(
Nothing
::
Maybe
Hyper
Data
)
flowDataText
u
(
DataNew
txt
)
tt
cid
=
flowCorpus
u
(
Right
[
cid
])
tt
txt
flowDataText
u
(
DataNew
txt
)
tt
cid
=
flowCorpus
u
(
Right
[
cid
])
tt
txt
------------------------------------------------------------------------
------------------------------------------------------------------------
...
@@ -177,7 +177,7 @@ flowCorpus :: (FlowCmdM env err m, FlowCorpus a)
...
@@ -177,7 +177,7 @@ flowCorpus :: (FlowCmdM env err m, FlowCorpus a)
->
TermType
Lang
->
TermType
Lang
->
[[
a
]]
->
[[
a
]]
->
m
CorpusId
->
m
CorpusId
flowCorpus
=
flow
(
Nothing
::
Maybe
Hyper
dataCorpus
)
flowCorpus
=
flow
(
Nothing
::
Maybe
Hyper
Data
)
flow
::
(
FlowCmdM
env
err
m
,
FlowCorpus
a
,
MkCorpus
c
)
flow
::
(
FlowCmdM
env
err
m
,
FlowCorpus
a
,
MkCorpus
c
)
...
...
src/Gargantext/Database/Admin/Types/Hyperdata.hs
View file @
35857fe1
This diff is collapsed.
Click to expand it.
src/Gargantext/Database/Query/Table/Node.hs
View file @
35857fe1
...
@@ -117,10 +117,10 @@ getDocumentsV3WithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocume
...
@@ -117,10 +117,10 @@ 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
Hyper
dataListModel
]
getListsModelWithParentId
::
NodeId
->
Cmd
err
[
Node
Hyper
Data
]
getListsModelWithParentId
n
=
runOpaQuery
$
selectNodesWith'
n
(
Just
NodeListModel
)
getListsModelWithParentId
n
=
runOpaQuery
$
selectNodesWith'
n
(
Just
NodeListModel
)
getCorporaWithParentId
::
NodeId
->
Cmd
err
[
Node
Hyper
dataCorpus
]
getCorporaWithParentId
::
NodeId
->
Cmd
err
[
Node
Hyper
Data
]
getCorporaWithParentId
n
=
runOpaQuery
$
selectNodesWith'
n
(
Just
NodeCorpus
)
getCorporaWithParentId
n
=
runOpaQuery
$
selectNodesWith'
n
(
Just
NodeCorpus
)
------------------------------------------------------------------------
------------------------------------------------------------------------
...
@@ -164,18 +164,18 @@ nodeContactW maybeName maybeContact aId =
...
@@ -164,18 +164,18 @@ nodeContactW maybeName maybeContact aId =
name
=
maybe
"Contact"
identity
maybeName
name
=
maybe
"Contact"
identity
maybeName
contact
=
maybe
arbitraryHyperdataContact
identity
maybeContact
contact
=
maybe
arbitraryHyperdataContact
identity
maybeContact
------------------------------------------------------------------------
------------------------------------------------------------------------
defaultFolder
::
Hyper
dataCorpus
defaultFolder
::
Hyper
Data
defaultFolder
=
defaultCorpus
defaultFolder
=
defaultCorpus
nodeFolderW
::
Maybe
Name
->
Maybe
Hyper
dataCorpus
->
ParentId
->
UserId
->
NodeWrite
nodeFolderW
::
Maybe
Name
->
Maybe
Hyper
Data
->
ParentId
->
UserId
->
NodeWrite
nodeFolderW
maybeName
maybeFolder
pid
=
node
NodeFolder
name
folder
(
Just
pid
)
nodeFolderW
maybeName
maybeFolder
pid
=
node
NodeFolder
name
folder
(
Just
pid
)
where
where
name
=
maybe
"Folder"
identity
maybeName
name
=
maybe
"Folder"
identity
maybeName
folder
=
maybe
defaultFolder
identity
maybeFolder
folder
=
maybe
defaultFolder
identity
maybeFolder
------------------------------------------------------------------------
------------------------------------------------------------------------
nodeCorpusW
::
Maybe
Name
->
Maybe
Hyper
dataCorpus
->
ParentId
->
UserId
->
NodeWrite
nodeCorpusW
::
Maybe
Name
->
Maybe
Hyper
Data
->
ParentId
->
UserId
->
NodeWrite
nodeCorpusW
maybeName
maybeCorpus
pId
=
node
NodeCorpus
name
corpus
(
Just
pId
)
nodeCorpusW
maybeName
maybeCorpus
pId
=
node
NodeCorpus
name
corpus
(
Just
pId
)
where
where
name
=
maybe
"Corpus"
identity
maybeName
name
=
maybe
"Corpus"
identity
maybeName
...
@@ -251,6 +251,7 @@ nodeDefault nt parent = node nt name hyper (Just parent)
...
@@ -251,6 +251,7 @@ nodeDefault nt parent = node nt name hyper (Just parent)
hyper
=
(
hasDefaultData
nt
)
hyper
=
(
hasDefaultData
nt
)
------------------------------------------------------------------------
------------------------------------------------------------------------
{-
arbitraryListModel :: HyperdataListModel
arbitraryListModel :: HyperdataListModel
arbitraryListModel = HyperdataListModel (400,500) "data/models/test.model" (Just 0.83)
arbitraryListModel = HyperdataListModel (400,500) "data/models/test.model" (Just 0.83)
...
@@ -262,7 +263,7 @@ nodeListModelW maybeName maybeListModel pId = node NodeListModel name list (Just
...
@@ -262,7 +263,7 @@ nodeListModelW maybeName maybeListModel pId = node NodeListModel name list (Just
where
where
name = maybe "List Model" identity maybeName
name = maybe "List Model" identity maybeName
list = maybe arbitraryListModel identity maybeListModel
list = maybe arbitraryListModel identity maybeListModel
-}
------------------------------------------------------------------------
------------------------------------------------------------------------
arbitraryGraph
::
HyperdataGraph
arbitraryGraph
::
HyperdataGraph
arbitraryGraph
=
HyperdataGraph
Nothing
arbitraryGraph
=
HyperdataGraph
Nothing
...
@@ -403,7 +404,7 @@ class MkCorpus a
...
@@ -403,7 +404,7 @@ class MkCorpus a
where
where
mk
::
Maybe
Name
->
Maybe
a
->
ParentId
->
UserId
->
Cmd
err
[
NodeId
]
mk
::
Maybe
Name
->
Maybe
a
->
ParentId
->
UserId
->
Cmd
err
[
NodeId
]
instance
MkCorpus
Hyper
dataCorpus
instance
MkCorpus
Hyper
Data
where
where
mk
n
h
p
u
=
insertNodesR
[
nodeCorpusW
n
h
p
u
]
mk
n
h
p
u
=
insertNodesR
[
nodeCorpusW
n
h
p
u
]
...
...
src/Gargantext/Viz/Phylo/API.hs
View file @
35857fe1
...
@@ -17,28 +17,27 @@ Portability : POSIX
...
@@ -17,28 +17,27 @@ Portability : POSIX
module
Gargantext.Viz.Phylo.API
module
Gargantext.Viz.Phylo.API
where
where
import
Data.String.Conversions
import
Control.Lens
((
^?
),
_Just
)
--import Control.Monad.Reader (ask)
import
qualified
Data.ByteString
as
DB
import
qualified
Data.ByteString.Lazy
as
DBL
import
Data.Proxy
(
Proxy
(
..
))
import
Data.Proxy
(
Proxy
(
..
))
import
Data.String.Conversions
import
Data.Swagger
import
Data.Swagger
import
Network.HTTP.Media
((
//
),
(
/:
))
import
Servant
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck.Arbitrary
(
Arbitrary
,
arbitrary
)
import
Web.HttpApiData
(
parseUrlPiece
,
readTextData
)
import
Gargantext.API.Prelude
import
Gargantext.API.Prelude
import
Gargantext.Core.Types
(
TODO
(
..
))
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Node
-- (PhyloId, ListId, CorpusId, UserId, NodeId(..))
import
Gargantext.Database.Admin.Types.Node
-- (PhyloId, ListId, CorpusId, UserId, NodeId(..))
import
Gargantext.Database.Query.Table.Node
(
insertNodes
,
node
,
getNodeWith
)
import
Gargantext.Database.Query.Table.Node
(
insertNodes
,
node
,
getNodeWith
)
import
Gargantext.Database.Schema.Node
(
_
node_hyperdata
)
import
Gargantext.Database.Schema.Node
(
node_hyperdata
)
import
Gargantext.Prelude
import
Gargantext.Prelude
import
Gargantext.Viz.Phylo
import
Gargantext.Viz.Phylo
import
Gargantext.Viz.Phylo.Main
import
Gargantext.Viz.Phylo.Example
import
Gargantext.Viz.Phylo.Example
import
Gargantext.Core.Types
(
TODO
(
..
))
import
Gargantext.Viz.Phylo.Main
import
Network.HTTP.Media
((
//
),
(
/:
))
import
Servant
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck.Arbitrary
(
Arbitrary
,
arbitrary
)
import
Web.HttpApiData
(
parseUrlPiece
,
readTextData
)
import
qualified
Data.ByteString
as
DB
import
qualified
Data.ByteString.Lazy
as
DBL
------------------------------------------------------------------------
------------------------------------------------------------------------
type
PhyloAPI
=
Summary
"Phylo API"
type
PhyloAPI
=
Summary
"Phylo API"
...
@@ -100,7 +99,7 @@ getPhylo phId _lId l msb = do
...
@@ -100,7 +99,7 @@ getPhylo phId _lId l msb = do
let
let
level
=
maybe
2
identity
l
level
=
maybe
2
identity
l
branc
=
maybe
2
identity
msb
branc
=
maybe
2
identity
msb
maybePhylo
=
hd_data
$
_node_hyperdata
phNode
maybePhylo
=
phNode
^?
(
node_hyperdata
.
hd_data
.
_Just
)
p
<-
liftBase
$
viewPhylo2Svg
p
<-
liftBase
$
viewPhylo2Svg
$
viewPhylo
level
branc
$
viewPhylo
level
branc
...
...
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