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
2618ee47
Commit
2618ee47
authored
Jan 05, 2022
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FIX] Doc Table fixed
parent
156790ff
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
82 additions
and
30 deletions
+82
-30
Node.hs
src/Gargantext/API/Node.hs
+1
-1
Types.hs
src/Gargantext/Core/Types.hs
+1
-1
Node.hs
src/Gargantext/Database/Admin/Types/Node.hs
+12
-8
Prelude.hs
src/Gargantext/Database/Prelude.hs
+1
-3
Children.hs
src/Gargantext/Database/Query/Table/Node/Children.hs
+67
-17
No files found.
src/Gargantext/API/Node.hs
View file @
2618ee47
...
...
@@ -212,7 +212,7 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
:<|>
postNodeAsyncAPI
uId
id'
:<|>
FrameCalcUpload
.
api
uId
id'
:<|>
putNode
id'
:<|>
Update
.
api
uId
id'
:<|>
Update
.
api
uId
id'
:<|>
Action
.
deleteNode
(
RootId
$
NodeId
uId
)
id'
:<|>
getChildren
id'
p
...
...
src/Gargantext/Core/Types.hs
View file @
2618ee47
...
...
@@ -147,7 +147,7 @@ type NodeTableResult a = TableResult (Node a)
data
TableResult
a
=
TableResult
{
tr_count
::
Int
,
tr_docs
::
[
a
]
}
deriving
(
Generic
)
}
deriving
(
Generic
,
Show
)
$
(
deriveJSON
(
unPrefix
"tr_"
)
''
T
ableResult
)
...
...
src/Gargantext/Database/Admin/Types/Node.hs
View file @
2618ee47
...
...
@@ -33,21 +33,21 @@ import Data.Time (UTCTime)
import
Database.PostgreSQL.Simple.FromField
(
FromField
,
fromField
)
import
Database.PostgreSQL.Simple.ToField
(
ToField
,
toField
)
import
GHC.Generics
(
Generic
)
import
Servant
import
qualified
Opaleye
as
O
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixSwagger
,
wellNamedSchema
)
import
Gargantext.Database.Schema.Context
import
Gargantext.Database.Schema.Node
import
Gargantext.Prelude
import
Gargantext.Prelude.Crypto.Hash
(
Hash
)
import
Opaleye
(
DefaultFromField
,
defaultFromField
,
SqlInt4
,
SqlText
,
SqlTSVector
,
Nullable
,
fromPGSFromField
)
import
Servant
hiding
(
Context
)
import
Test.QuickCheck
(
elements
)
import
Gargantext.Prelude.Crypto.Hash
(
Hash
)
import
Test.QuickCheck.Arbitrary
import
Test.QuickCheck.Instances.Text
()
import
Test.QuickCheck.Instances.Time
()
import
Text.Read
(
read
)
import
qualified
Opaleye
as
O
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixSwagger
,
wellNamedSchema
)
-- import Gargantext.Database.Prelude (fromField')
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.Context
import
Gargantext.Prelude
type
UserId
=
Int
type
MasterUserId
=
UserId
...
...
@@ -441,4 +441,8 @@ instance DefaultFromField SqlText (Maybe Hash)
where
defaultFromField
=
fromPGSFromField
---------------------------------------------------------------------
context2node
::
Context
a
->
Node
a
context2node
(
Context
ci
ch
ct
cu
cp
cn
cd
chy
)
=
Node
ci
ch
ct
cu
cp
cn
cd
chy
src/Gargantext/Database/Prelude.hs
View file @
2618ee47
...
...
@@ -148,16 +148,14 @@ runPGSQuery_ :: ( CmdM env err m
runPGSQuery_
q
=
mkCmd
$
\
conn
->
catch
(
PGS
.
query_
conn
q
)
printError
where
printError
(
SomeException
e
)
=
do
printDebug
"[G.D.P.runPGSQuery_]"
(
"TODO: format query error
query
"
::
Text
)
printDebug
"[G.D.P.runPGSQuery_]"
(
"TODO: format query error"
::
Text
)
throw
(
SomeException
e
)
execPGSQuery
::
PGS
.
ToRow
a
=>
PGS
.
Query
->
a
->
Cmd
err
Int64
execPGSQuery
q
a
=
mkCmd
$
\
conn
->
PGS
.
execute
conn
q
a
------------------------------------------------------------------------
databaseParameters
::
FilePath
->
IO
PGS
.
ConnectInfo
databaseParameters
fp
=
do
ini
<-
readIniFile'
fp
...
...
src/Gargantext/Database/Query/Table/Node/Children.hs
View file @
2618ee47
...
...
@@ -23,10 +23,15 @@ import Gargantext.Core.Types
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataDocument
,
HyperdataContact
)
import
Gargantext.Database.Prelude
import
Gargantext.Database.Query.Filter
import
Gargantext.Database.Query.Table.NodeNode
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.Context
import
Gargantext.Database.Schema.NodeContext
import
Gargantext.Database.Query.Table.NodeContext
import
Gargantext.Prelude
import
Opaleye
import
Protolude
-- TODO getAllTableDocuments
...
...
@@ -46,6 +51,7 @@ getAllChildren :: (JSONB a, HasDBid NodeType)
->
Cmd
err
(
NodeTableResult
a
)
getAllChildren
pId
p
maybeNodeType
=
getChildren
pId
p
maybeNodeType
Nothing
Nothing
getChildren
::
(
JSONB
a
,
HasDBid
NodeType
)
=>
ParentId
->
proxy
a
...
...
@@ -53,31 +59,75 @@ getChildren :: (JSONB a, HasDBid NodeType)
->
Maybe
Offset
->
Maybe
Limit
->
Cmd
err
(
NodeTableResult
a
)
getChildren
pId
_
maybeNodeType
maybeOffset
maybeLimit
=
do
docs
<-
runOpaQuery
$
limit'
maybeLimit
$
offset'
maybeOffset
$
orderBy
(
asc
_node_id
)
$
query
getChildren
pId
p
t
@
(
Just
NodeDocument
)
maybeOffset
maybeLimit
=
getChildrenContext
pId
p
t
maybeOffset
maybeLimit
getChildren
pId
p
t
@
(
Just
NodeContact
)
maybeOffset
maybeLimit
=
getChildrenContext
pId
p
t
maybeOffset
maybeLimit
getChildren
a
b
c
d
e
=
getChildrenNode
a
b
c
d
e
docCount
<-
runCountOpaQuery
query
getChildrenNode
::
(
JSONB
a
,
HasDBid
NodeType
)
=>
ParentId
->
proxy
a
->
Maybe
NodeType
->
Maybe
Offset
->
Maybe
Limit
->
Cmd
err
(
NodeTableResult
a
)
getChildrenNode
pId
_
maybeNodeType
maybeOffset
maybeLimit
=
do
printDebug
"getChildrenNode"
(
pId
,
maybeNodeType
)
let
query
=
selectChildrenNode
pId
maybeNodeType
docs
<-
runOpaQuery
$
limit'
maybeLimit
$
offset'
maybeOffset
$
orderBy
(
asc
_node_id
)
$
query
docCount
<-
runCountOpaQuery
query
pure
$
TableResult
{
tr_docs
=
docs
,
tr_count
=
docCount
}
where
query
=
selectChildren
pId
maybeNodeType
selectChildren
::
HasDBid
NodeType
selectChildren
Node
::
HasDBid
NodeType
=>
ParentId
->
Maybe
NodeType
->
Select
NodeRead
selectChildren
parentId
maybeNodeType
=
proc
()
->
do
row
@
(
Node
nId
_
typeName
_
parent_id
_
_
_
)
<-
queryNodeTable
-<
()
(
NodeNode
n1id
n2id
_
_
)
<-
queryNodeNodeTable
-<
()
selectChildrenNode
parentId
maybeNodeType
=
proc
()
->
do
row
@
(
Node
_
_
typeName
_
parent_id
_
_
_
)
<-
queryNodeTable
-<
()
let
nodeType
=
maybe
0
toDBid
maybeNodeType
restrict
-<
typeName
.==
sqlInt4
nodeType
restrict
-<
parent_id
.==
(
pgNodeId
parentId
)
returnA
-<
row
getChildrenContext
::
(
JSONB
a
,
HasDBid
NodeType
)
=>
ParentId
->
proxy
a
->
Maybe
NodeType
->
Maybe
Offset
->
Maybe
Limit
->
Cmd
err
(
NodeTableResult
a
)
getChildrenContext
pId
_
maybeNodeType
maybeOffset
maybeLimit
=
do
printDebug
"getChildrenContext"
(
pId
,
maybeNodeType
)
let
query
=
selectChildren'
pId
maybeNodeType
docs
<-
runOpaQuery
$
limit'
maybeLimit
$
offset'
maybeOffset
$
orderBy
(
asc
_context_id
)
$
query
docCount
<-
runCountOpaQuery
query
pure
$
TableResult
{
tr_docs
=
map
context2node
docs
,
tr_count
=
docCount
}
selectChildren'
::
HasDBid
NodeType
=>
ParentId
->
Maybe
NodeType
->
Select
ContextRead
selectChildren'
parentId
maybeNodeType
=
proc
()
->
do
row
@
(
Context
cid
_
typeName
_
_
_
_
_
)
<-
queryContextTable
-<
()
(
NodeContext
nid
cid'
_
_
)
<-
queryNodeContextTable
-<
()
let
nodeType
=
maybe
0
toDBid
maybeNodeType
restrict
-<
typeName
.==
sqlInt4
nodeType
restrict
-<
(
.||
)
(
parent_id
.==
(
pgNodeId
parentId
))
(
(
.&&
)
(
n1id
.==
pgNodeId
parentId
)
(
n2id
.==
nId
))
restrict
-<
nid
.==
pgNodeId
parentId
restrict
-<
cid
.==
cid'
returnA
-<
row
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