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
41c23932
Verified
Commit
41c23932
authored
Jul 20, 2023
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[hyperdata] HyperdataC class to unify things better
parent
70073361
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
20 additions
and
25 deletions
+20
-25
Main.hs
bin/gargantext-server/Main.hs
+0
-5
Node.hs
src/Gargantext/API/Node.hs
+2
-5
Hyperdata.hs
src/Gargantext/Database/Admin/Types/Hyperdata.hs
+1
-1
Prelude.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Prelude.hs
+10
-1
UpdateOpaleye.hs
src/Gargantext/Database/Query/Table/Node/UpdateOpaleye.hs
+7
-13
No files found.
bin/gargantext-server/Main.hs
View file @
41c23932
...
...
@@ -21,14 +21,9 @@ Script to start gargantext with different modes (Dev, Prod, Mock).
module
Main
where
import
Data.Maybe
(
fromMaybe
)
import
Data.Text
(
unpack
)
import
Data.Version
(
showVersion
)
import
Database.PostgreSQL.Simple.SqlQQ
(
sql
)
import
GHC.IO.Exception
(
IOException
)
import
Gargantext.API
(
startGargantext
,
Mode
(
..
))
-- , startGargantextMock)
import
Gargantext.API.Admin.EnvTypes
(
DevEnv
)
import
Gargantext.API.Dev
(
withDevEnv
,
runCmdDev
)
import
Gargantext.Prelude
import
Options.Generic
import
System.Exit
(
exitSuccess
)
...
...
src/Gargantext/API/Node.hs
View file @
41c23932
...
...
@@ -192,10 +192,7 @@ nodeNodeAPI p uId cId nId = withAccess (Proxy :: Proxy (NodeNodeAPI a)) Proxy uI
------------------------------------------------------------------------
-- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
nodeAPI
::
forall
proxy
a
.
(
JSONB
a
,
FromJSON
a
,
ToJSON
a
,
Hyperdata
a
(
HyperdataC
a
)
=>
proxy
a
->
UserId
->
NodeId
...
...
@@ -349,7 +346,7 @@ treeFlatAPI = tree_flat
rename
::
NodeId
->
RenameNode
->
Cmd
err
[
Int
]
rename
nId
(
RenameNode
name'
)
=
U
.
update
(
U
.
Rename
nId
name'
)
putNode
::
forall
err
a
.
(
HasNodeError
err
,
JSONB
a
,
ToJSON
a
,
Hyperdata
a
)
putNode
::
forall
err
a
.
(
HasNodeError
err
,
HyperdataC
a
)
=>
NodeId
->
a
->
Cmd
err
Int
...
...
src/Gargantext/Database/Admin/Types/Hyperdata.hs
View file @
41c23932
...
...
@@ -41,7 +41,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Folder
import
Gargantext.Database.Admin.Types.Hyperdata.Frame
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
,
HyperdataC
)
import
Gargantext.Database.Admin.Types.Hyperdata.Texts
import
Gargantext.Database.Admin.Types.Hyperdata.Phylo
import
Gargantext.Database.Admin.Types.Hyperdata.User
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/Prelude.hs
View file @
41c23932
{-# LANGUAGE ConstraintKinds #-}
{-|
Module : Gargantext.Database.Admin.Types.Hyperdata.Prelude
Description :
...
...
@@ -29,6 +31,7 @@ module Gargantext.Database.Admin.Types.Hyperdata.Prelude
,
module
Test
.
QuickCheck
,
module
Test
.
QuickCheck
.
Arbitrary
,
Hyperdata
,
HyperdataC
,
Chart
(
..
)
)
where
...
...
@@ -46,7 +49,7 @@ import Database.PostgreSQL.Simple.FromField (FromField, fromField)
import
Database.PostgreSQL.Simple.ToField
(
ToField
,
toField
,
toJSONField
)
import
GHC.Generics
(
Generic
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixSwagger
,
wellNamedSchema
)
import
Gargantext.Database.Prelude
(
fromField'
)
import
Gargantext.Database.Prelude
(
fromField'
,
JSONB
)
import
Gargantext.Prelude
import
Opaleye
(
DefaultFromField
,
defaultFromField
,
Nullable
,
SqlJsonb
,
fromPGSFromField
)
import
Test.QuickCheck
(
elements
)
...
...
@@ -56,6 +59,12 @@ import Test.QuickCheck.Arbitrary hiding (vector)
-- Only Hyperdata types should be member of this type class.
class
Hyperdata
a
type
HyperdataC
a
=
(
Hyperdata
a
,
JSONB
a
,
ToJSON
a
,
FromJSON
a
,
FromField
a
)
data
Chart
=
CDocsHistogram
...
...
src/Gargantext/Database/Query/Table/Node/UpdateOpaleye.hs
View file @
41c23932
...
...
@@ -16,24 +16,24 @@ module Gargantext.Database.Query.Table.Node.UpdateOpaleye
where
import
Opaleye
import
Data.Aeson
(
encode
,
ToJSON
)
import
Data.Aeson
(
encode
)
import
Gargantext.Core
import
Gargantext.Prelude
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
(
Cmd
,
mkCmd
,
JSONB
)
import
Gargantext.Database.Prelude
(
Cmd
,
mkCmd
)
import
Gargantext.Database.Query.Table.Node
import
Gargantext.Database.Query.Table.Node.Error
import
Debug.Trace
(
trace
)
updateHyperdata
::
(
ToJSON
a
,
Hyperdata
a
)
=>
NodeId
->
a
->
Cmd
err
Int64
updateHyperdata
::
HyperdataC
a
=>
NodeId
->
a
->
Cmd
err
Int64
updateHyperdata
i
h
=
mkCmd
$
\
c
->
putStrLn
"before runUpdate_"
>>
runUpdate_
c
(
updateHyperdataQuery
i
h
)
>>=
\
res
->
putStrLn
"after runUpdate_"
>>
return
res
updateHyperdataQuery
::
(
ToJSON
a
,
Hyperdata
a
)
=>
NodeId
->
a
->
Update
Int64
updateHyperdataQuery
::
HyperdataC
a
=>
NodeId
->
a
->
Update
Int64
updateHyperdataQuery
i
h
=
seq
h'
$
trace
"updateHyperdataQuery: encoded JSON"
$
Update
{
uTable
=
nodeTable
,
uUpdateWith
=
updateEasy
(
\
(
Node
{
..
})
...
...
@@ -47,20 +47,16 @@ updateHyperdataQuery i h = seq h' $ trace "updateHyperdataQuery: encoded JSON" $
----------------------------------------------------------------------------------
updateNodesWithType
::
(
HasNodeError
err
,
JSONB
a
,
ToJSON
a
,
Hyperdata
a
,
HasDBid
NodeType
,
HyperdataC
a
)
=>
NodeType
->
proxy
a
->
(
a
->
a
)
->
Cmd
err
[
Int64
]
updateNodesWithType
nt
p
f
=
do
ns
<-
getNodesWithType
nt
p
mapM
(
\
n
->
updateHyperdata
(
_node_id
n
)
(
f
$
_node_hyperdata
n
))
ns
updateNodeWithType
::
(
HasNodeError
err
,
JSONB
a
,
ToJSON
a
,
Hyperdata
a
,
HasDBid
NodeType
,
HyperdataC
a
)
=>
NodeId
->
NodeType
->
proxy
a
...
...
@@ -73,9 +69,7 @@ updateNodeWithType nId nt p f = do
-- | In case the Hyperdata Types are not compatible
updateNodesWithType_
::
(
HasNodeError
err
,
JSONB
a
,
ToJSON
a
,
Hyperdata
a
,
HyperdataC
a
,
HasDBid
NodeType
)
=>
NodeType
->
a
->
Cmd
err
[
Int64
]
updateNodesWithType_
nt
h
=
do
...
...
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