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
157
Issues
157
List
Board
Labels
Milestones
Merge Requests
9
Merge Requests
9
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
9d76403e
Commit
9d76403e
authored
Dec 03, 2021
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Plain Diff
[MERGE]
parents
7e9eeaf1
50d10679
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
31 additions
and
15 deletions
+31
-15
GraphQL.hs
src/Gargantext/API/GraphQL.hs
+2
-2
Node.hs
src/Gargantext/API/GraphQL/Node.hs
+22
-13
Frame.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Frame.hs
+6
-0
stack.yaml
stack.yaml
+1
-0
No files found.
src/Gargantext/API/GraphQL.hs
View file @
9d76403e
...
...
@@ -148,5 +148,5 @@ api
::
(
Typeable
env
,
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
,
HasJobEnv'
env
)
=>
ServerT
API
(
GargM
env
GargError
)
api
(
SAS
.
Authenticated
_auser
)
=
httpPubApp
[]
app
:<|>
pure
httpPlayground
api
_
=
panic
"401 in graphql"
--SAS.throwAll (_ServerError # err401)
--
api _ = httpPubApp [] app :<|> pure httpPlayground
--
api _ = panic "401 in graphql" --SAS.throwAll (_ServerError # err401)
api
_
=
httpPubApp
[]
app
:<|>
pure
httpPlayground
src/Gargantext/API/GraphQL/Node.hs
View file @
9d76403e
...
...
@@ -4,6 +4,7 @@
module
Gargantext.API.GraphQL.Node
where
import
Data.Either
(
Either
(
..
))
import
Data.Morpheus.Types
(
GQLType
,
Resolver
...
...
@@ -11,16 +12,18 @@ import Data.Morpheus.Types
,
lift
)
import
Data.Text
(
Text
)
import
qualified
Data.Text
as
T
import
Gargantext.API.Prelude
(
GargM
,
GargError
)
import
Gargantext.Core.Mail.Types
(
HasMail
)
import
Gargantext.Database.Admin.Config
(
fromNodeTypeId
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
(
..
))
import
Gargantext.Database.Admin.Types.Node
(
NodeId
(
..
),
NodeType
)
import
qualified
Gargantext.Database.Admin.Types.Node
as
NN
import
Gargantext.Database.Query.Table.Node
(
getClosestParentIdByType
,
getNode
)
import
Gargantext.Database.Prelude
(
HasConnectionPool
,
HasConfig
)
import
qualified
Gargantext.Database.Schema.Node
as
N
import
Gargantext.Prelude
import
GHC.Generics
(
Generic
)
import
qualified
Prelude
as
Prelude
import
Text.Read
(
readEither
)
data
Node
=
Node
{
id
::
Int
...
...
@@ -51,25 +54,31 @@ dbNodes node_id = do
data
NodeParentArgs
=
NodeParentArgs
{
node_id
::
Int
,
parent_type
_id
::
In
t
{
node_id
::
Int
,
parent_type
::
Tex
t
}
deriving
(
Generic
,
GQLType
)
resolveNodeParent
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
NodeParentArgs
->
GqlM
e
env
[
Node
]
resolveNodeParent
NodeParentArgs
{
node_id
,
parent_type
_id
}
=
dbParentNodes
node_id
parent_type_id
resolveNodeParent
NodeParentArgs
{
node_id
,
parent_type
}
=
dbParentNodes
node_id
parent_type
dbParentNodes
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
Int
->
Int
->
GqlM
e
env
[
Node
]
dbParentNodes
node_id
parent_type_id
=
do
mNodeId
<-
lift
$
getClosestParentIdByType
(
NodeId
node_id
)
(
fromNodeTypeId
parent_type_id
)
case
mNodeId
of
Nothing
->
pure
[]
Just
id
->
do
node
<-
lift
$
getNode
id
pure
[
toNode
node
]
=>
Int
->
Text
->
GqlM
e
env
[
Node
]
dbParentNodes
node_id
parent_type
=
do
let
mParentType
=
readEither
(
T
.
unpack
parent_type
)
::
Either
Prelude
.
String
NodeType
case
mParentType
of
Left
err
->
do
lift
$
printDebug
"[dbParentNodes] error reading parent type"
(
T
.
pack
err
)
pure
[]
Right
parentType
->
do
mNodeId
<-
lift
$
getClosestParentIdByType
(
NodeId
node_id
)
parentType
-- (fromNodeTypeId parent_type_id)
case
mNodeId
of
Nothing
->
pure
[]
Just
id
->
do
node
<-
lift
$
getNode
id
pure
[
toNode
node
]
toNode
::
NN
.
Node
json
->
Node
toNode
(
N
.
Node
{
..
})
=
Node
{
id
=
NN
.
unNodeId
_node_id
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/Frame.hs
View file @
9d76403e
...
...
@@ -73,3 +73,9 @@ getHyperdataFrameContents (HyperdataFrame { _hf_base, _hf_frame_id }) = do
let
path
=
T
.
concat
[
_hf_base
,
"/"
,
_hf_frame_id
,
"/download"
]
r
<-
Wreq
.
get
$
T
.
unpack
path
pure
$
decodeUtf8
$
toStrict
$
r
^.
Wreq
.
responseBody
getHyperdataFrameCSV
::
HyperdataFrame
->
IO
Text
getHyperdataFrameCSV
(
HyperdataFrame
{
_hf_base
,
_hf_frame_id
})
=
do
let
path
=
T
.
concat
[
_hf_base
,
"/"
,
_hf_frame_id
,
".csv"
]
r
<-
Wreq
.
get
$
T
.
unpack
path
pure
$
decodeUtf8
$
toStrict
$
r
^.
Wreq
.
responseBody
stack.yaml
View file @
9d76403e
...
...
@@ -2,6 +2,7 @@ resolver:
url
:
https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/18.yaml
flags
:
{}
extra-package-dbs
:
[]
skip-ghc-check
:
true
packages
:
-
.
#- 'deps/gargantext-graph'
...
...
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