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
76f0419f
Commit
76f0419f
authored
Feb 03, 2018
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FIX] getNodesWithParentId == children with null parent_id
parent
7384c431
Changes
3
Show whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
28 additions
and
18 deletions
+28
-18
Node.hs
src/Data/Gargantext/Database/Node.hs
+22
-13
Server.hs
src/Data/Gargantext/Server.hs
+6
-4
Main.hs
src/Data/Gargantext/Types/Main.hs
+0
-1
No files found.
src/Data/Gargantext/Database/Node.hs
View file @
76f0419f
...
@@ -15,6 +15,7 @@ import Database.PostgreSQL.Simple.FromField ( Conversion
...
@@ -15,6 +15,7 @@ import Database.PostgreSQL.Simple.FromField ( Conversion
,
fromField
,
fromField
,
returnError
,
returnError
)
)
import
Prelude
hiding
(
null
,
id
)
import
Database.PostgreSQL.Simple.Internal
(
Field
)
import
Database.PostgreSQL.Simple.Internal
(
Field
)
import
Control.Arrow
(
returnA
)
import
Control.Arrow
(
returnA
)
import
Control.Lens.TH
(
makeLensesWith
,
abbreviatedFields
)
import
Control.Lens.TH
(
makeLensesWith
,
abbreviatedFields
)
...
@@ -115,17 +116,29 @@ runGetNodes :: Connection -> Query NodeRead -> IO [Document]
...
@@ -115,17 +116,29 @@ runGetNodes :: Connection -> Query NodeRead -> IO [Document]
runGetNodes
=
runQuery
runGetNodes
=
runQuery
queryNodeTable
::
Query
NodeRead
queryNodeTable
=
queryTable
nodeTable
selectNodeWithParentID
::
Column
(
Nullable
PGInt4
)
->
Query
NodeRead
-- NP check type
selectNodeWithParentID
node_id
=
proc
()
->
do
getNodesWithParentId
::
Connection
->
Int
->
IO
[
Node
Value
]
getNodesWithParentId
conn
n
=
runQuery
conn
$
selectNodeWithParentID
n
selectNodeWithParentID
::
Int
->
Query
NodeRead
selectNodeWithParentID
n
=
proc
()
->
do
row
@
(
Node
_id
_tn
_u
p_id
_n
_d
_h
)
<-
queryNodeTable
-<
()
row
@
(
Node
_id
_tn
_u
p_id
_n
_d
_h
)
<-
queryNodeTable
-<
()
-- restrict -< maybe (isNull p_id) (p_id .==) node_id
restrict
-<
if
n
>
0
restrict
-<
p_id
.==
node_id
then
p_id
.==
(
toNullable
$
pgInt4
n
)
else
isNull
p_id
returnA
-<
row
returnA
-<
row
queryNodeTable
::
Query
NodeRead
queryNodeTable
=
queryTable
nodeTable
selectNodesWithType
::
Column
PGInt4
->
Query
NodeRead
selectNodesWithType
::
Column
PGInt4
->
Query
NodeRead
selectNodesWithType
type_id
=
proc
()
->
do
selectNodesWithType
type_id
=
proc
()
->
do
row
@
(
Node
_
tn
_
_
_
_
_
)
<-
queryNodeTable
-<
()
row
@
(
Node
_
tn
_
_
_
_
_
)
<-
queryNodeTable
-<
()
...
@@ -140,16 +153,12 @@ getNodesWithType :: Connection -> Column PGInt4 -> IO [Node Value]
...
@@ -140,16 +153,12 @@ getNodesWithType :: Connection -> Column PGInt4 -> IO [Node Value]
getNodesWithType
conn
type_id
=
do
getNodesWithType
conn
type_id
=
do
runQuery
conn
$
selectNodesWithType
type_id
runQuery
conn
$
selectNodesWithType
type_id
-- NP check type
getNodesWithParentId
::
Connection
->
Column
(
Nullable
PGInt4
)
->
IO
[
Node
Value
]
getNodesWithParentId
conn
node_id
=
do
runQuery
conn
$
selectNodeWithParentID
node_id
-- NP check type
-- NP check type
getCorpusDocument
::
Connection
->
Column
PGInt4
->
IO
[
Document
]
getCorpusDocument
::
Connection
->
Int
->
IO
[
Document
]
getCorpusDocument
conn
n
ode_id
=
runQuery
conn
(
selectNodeWithParentID
$
toNullable
node_id
)
getCorpusDocument
conn
n
=
runQuery
conn
(
selectNodeWithParentID
n
)
-- NP check type
-- NP check type
getProjectCorpora
::
Connection
->
Column
(
Nullable
PGInt4
)
->
IO
[
Corpus
]
getProjectCorpora
::
Connection
->
Int
->
IO
[
Corpus
]
getProjectCorpora
conn
node_id
=
do
getProjectCorpora
conn
node_id
=
do
runQuery
conn
$
selectNodeWithParentID
node_id
runQuery
conn
$
selectNodeWithParentID
node_id
src/Data/Gargantext/Server.hs
View file @
76f0419f
...
@@ -37,7 +37,7 @@ type API = "roots" :> Get '[JSON] [Node Value]
...
@@ -37,7 +37,7 @@ type API = "roots" :> Get '[JSON] [Node Value]
server
::
Connection
->
Server
API
server
::
Connection
->
Server
API
server
conn
server
conn
=
liftIO
(
getNodesWith
Type
conn
1
)
=
liftIO
(
getNodesWith
ParentId
conn
0
)
:<|>
nodeAPI
conn
:<|>
nodeAPI
conn
:<|>
echo
:<|>
echo
:<|>
upload
:<|>
upload
...
@@ -71,8 +71,10 @@ api = Proxy
...
@@ -71,8 +71,10 @@ api = Proxy
nodeAPI
::
Connection
->
NodeId
->
Server
NodeAPI
nodeAPI
::
Connection
->
NodeId
->
Server
NodeAPI
nodeAPI
conn
id
nodeAPI
conn
id
=
liftIO
(
getNode
conn
id'
)
=
liftIO
(
getNode
conn
id'
)
:<|>
liftIO
(
getNodesWithParentId
conn
(
toNullable
id'
))
:<|>
liftIO
(
getNodesWithParentId
conn
id
)
where
id'
=
pgInt4
id
where
id'
=
pgInt4
id
-- | Upload files
-- | Upload files
-- TODO Is it possible to adapt the function according to iValue input ?
-- TODO Is it possible to adapt the function according to iValue input ?
...
...
src/Data/Gargantext/Types/Main.hs
View file @
76f0419f
...
@@ -31,7 +31,6 @@ data Language = EN | FR -- | DE | IT | SP
...
@@ -31,7 +31,6 @@ data Language = EN | FR -- | DE | IT | SP
-- > ... add your language and help us to implement it (:
-- > ... add your language and help us to implement it (:
-- All the Database is structred like a hierarchical Tree
-- All the Database is structred like a hierarchical Tree
data
Tree
a
=
NodeT
a
[
Tree
a
]
data
Tree
a
=
NodeT
a
[
Tree
a
]
deriving
(
Show
,
Read
,
Eq
)
deriving
(
Show
,
Read
,
Eq
)
...
...
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