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
164
Issues
164
List
Board
Labels
Milestones
Merge Requests
10
Merge Requests
10
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
f4838983
Commit
f4838983
authored
Dec 18, 2018
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[Database] Clean tables.
parent
b13b85bf
Pipeline
#69
failed with stage
Changes
8
Pipelines
1
Show whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
53 additions
and
56 deletions
+53
-56
Node.hs
src/Gargantext/API/Node.hs
+5
-9
Flow.hs
src/Gargantext/Database/Flow.hs
+4
-5
Children.hs
src/Gargantext/Database/Node/Children.hs
+1
-1
Node.hs
src/Gargantext/Database/Schema/Node.hs
+25
-24
User.hs
src/Gargantext/Database/Schema/User.hs
+1
-2
schema.sql
src/Gargantext/Database/Schema/schema.sql
+10
-9
Utils.hs
src/Gargantext/Database/Utils.hs
+5
-5
Flow.hs
src/Gargantext/Text/Flow.hs
+2
-1
No files found.
src/Gargantext/API/Node.hs
View file @
f4838983
...
@@ -86,16 +86,12 @@ nodesAPI ids = deleteNodes ids
...
@@ -86,16 +86,12 @@ nodesAPI ids = deleteNodes ids
-- | TODO: access by admin only
-- | TODO: access by admin only
-- To manager the Users roots
-- To manager the Users roots
type
Roots
=
Get
'[
J
SON
]
[
NodeAny
]
type
Roots
=
Get
'[
J
SON
]
[
NodeAny
]
:<|>
Post
'[
J
SON
]
Int
-- TODO
:<|>
Put
'[
J
SON
]
Int
-- TODO
:<|>
Put
'[
J
SON
]
Int
-- TODO
:<|>
Delete
'[
J
SON
]
Int
-- TODO
-- | TODO: access by admin only
-- | TODO: access by admin only
roots
::
GargServer
Roots
roots
::
GargServer
Roots
roots
=
(
liftIO
(
putStrLn
(
"/user"
::
Text
))
>>
getNodesWithParentId
0
Nothing
)
roots
=
(
liftIO
(
putStrLn
(
"/user"
::
Text
))
>>
getNodesWithParentId
0
Nothing
)
:<|>
pure
(
panic
"not implemented yet"
)
-- TODO
:<|>
pure
(
panic
"not implemented yet"
)
-- TODO use patch map to update what we need
:<|>
pure
(
panic
"not implemented yet"
)
-- TODO
:<|>
pure
(
panic
"not implemented yet"
)
-- TODO
-------------------------------------------------------------------
-------------------------------------------------------------------
-- | Node API Types management
-- | Node API Types management
...
@@ -260,11 +256,11 @@ graphAPI nId = do
...
@@ -260,11 +256,11 @@ graphAPI nId = do
,
LegendField
2
"#0048BA"
"Label 2"
,
LegendField
2
"#0048BA"
"Label 2"
]
]
graph
<-
set
graph_metadata
(
Just
metadata
)
<$>
maybe
defaultGraph
identity
<$>
readGraphFromJson
"purescript-gargantext/dist/examples/imtNew.json"
graph
<-
set
graph_metadata
(
Just
metadata
)
<$>
maybe
defaultGraph
identity
<$>
readGraphFromJson
"purescript-gargantext/dist/examples/imtNew.json"
pure
graph
pure
graph
-- t <- textFlow (Mono EN) (Contexts contextText)
-- t <- textFlow (Mono EN) (Contexts contextText)
-- liftIO $ liftIO $ pure $ maybe t identity maybeGraph
-- liftIO $ liftIO $ pure $ maybe t identity maybeGraph
-- TODO what do we get about the node? to replace contextText
-- TODO what do we get about the node? to replace contextText
...
...
src/Gargantext/Database/Flow.hs
View file @
f4838983
...
@@ -211,8 +211,8 @@ toInserted = DM.fromList . map (\r -> (reUniqId r, r) )
...
@@ -211,8 +211,8 @@ toInserted = DM.fromList . map (\r -> (reUniqId r, r) )
.
filter
(
\
r
->
reInserted
r
==
True
)
.
filter
(
\
r
->
reInserted
r
==
True
)
data
DocumentWithId
=
data
DocumentWithId
=
DocumentWithId
{
documentId
::
NodeId
DocumentWithId
{
documentId
::
!
NodeId
,
documentData
::
HyperdataDocument
,
documentData
::
!
HyperdataDocument
}
deriving
(
Show
)
}
deriving
(
Show
)
mergeData
::
Map
HashId
ReturnId
->
Map
HashId
HyperdataDocument
->
[
DocumentWithId
]
mergeData
::
Map
HashId
ReturnId
->
Map
HashId
HyperdataDocument
->
[
DocumentWithId
]
...
@@ -226,8 +226,8 @@ mergeData rs = catMaybes . map toDocumentWithId . DM.toList
...
@@ -226,8 +226,8 @@ mergeData rs = catMaybes . map toDocumentWithId . DM.toList
data
DocumentIdWithNgrams
=
data
DocumentIdWithNgrams
=
DocumentIdWithNgrams
DocumentIdWithNgrams
{
documentWithId
::
DocumentWithId
{
documentWithId
::
!
DocumentWithId
,
document_ngrams
::
Map
(
NgramsT
Ngrams
)
Int
,
document_ngrams
::
!
(
Map
(
NgramsT
Ngrams
)
Int
)
}
deriving
(
Show
)
}
deriving
(
Show
)
-- TODO add Terms (Title + Abstract)
-- TODO add Terms (Title + Abstract)
...
@@ -327,4 +327,3 @@ insertLists lId lngs =
...
@@ -327,4 +327,3 @@ insertLists lId lngs =
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
src/Gargantext/Database/Node/Children.hs
View file @
f4838983
...
@@ -47,7 +47,7 @@ selectChildren parentId maybeNodeType = proc () -> do
...
@@ -47,7 +47,7 @@ selectChildren parentId maybeNodeType = proc () -> do
let
nodeType
=
maybe
0
nodeTypeId
maybeNodeType
let
nodeType
=
maybe
0
nodeTypeId
maybeNodeType
restrict
-<
typeName
.==
pgInt4
nodeType
restrict
-<
typeName
.==
pgInt4
nodeType
restrict
-<
(
.||
)
(
parent_id
.==
(
toNullable
$
pgInt4
parentId
))
restrict
-<
(
.||
)
(
parent_id
.==
(
pgInt4
parentId
))
(
(
.&&
)
(
n1id
.==
pgInt4
parentId
)
(
(
.&&
)
(
n1id
.==
pgInt4
parentId
)
(
n2id
.==
nId
))
(
n2id
.==
nId
))
returnA
-<
row
returnA
-<
row
...
...
src/Gargantext/Database/Schema/Node.hs
View file @
f4838983
...
@@ -140,6 +140,9 @@ instance QueryRunnerColumnDefault PGTSVector (Maybe TSVector)
...
@@ -140,6 +140,9 @@ instance QueryRunnerColumnDefault PGTSVector (Maybe TSVector)
where
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGInt4
(
Maybe
NodeParentId
)
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
------------------------------------------------------------------------
------------------------------------------------------------------------
...
@@ -155,18 +158,18 @@ $(makeLensesWith abbreviatedFields ''NodePolySearch)
...
@@ -155,18 +158,18 @@ $(makeLensesWith abbreviatedFields ''NodePolySearch)
type
NodeWrite
=
NodePoly
(
Maybe
(
Column
PGInt4
))
type
NodeWrite
=
NodePoly
(
Maybe
(
Column
PGInt4
))
(
Column
PGInt4
)
(
Column
PGInt4
)
(
Column
PGInt4
)
(
Column
PGInt4
)
(
Column
(
Nullable
PGInt4
))
(
Maybe
(
Column
PGInt4
))
(
Column
(
PGText
)
)
(
Column
PGText
)
(
Maybe
(
Column
PGTimestamptz
))
(
Maybe
(
Column
PGTimestamptz
))
(
Column
PGJsonb
)
(
Column
PGJsonb
)
type
NodeRead
=
NodePoly
(
Column
PGInt4
)
type
NodeRead
=
NodePoly
(
Column
PGInt4
)
(
Column
PGInt4
)
(
Column
PGInt4
)
(
Column
PGInt4
)
(
Column
PGInt4
)
(
Column
(
Nullable
PGInt4
)
)
(
Column
PGInt4
)
(
Column
(
PGText
)
)
(
Column
PGText
)
(
Column
PGTimestamptz
)
(
Column
PGTimestamptz
)
(
Column
PGJsonb
)
(
Column
PGJsonb
)
type
NodeReadNull
=
NodePoly
(
Column
(
Nullable
PGInt4
))
type
NodeReadNull
=
NodePoly
(
Column
(
Nullable
PGInt4
))
...
@@ -182,7 +185,7 @@ nodeTable = Table "nodes" (pNode Node { _node_id = optional "id"
...
@@ -182,7 +185,7 @@ nodeTable = Table "nodes" (pNode Node { _node_id = optional "id"
,
_node_typename
=
required
"typename"
,
_node_typename
=
required
"typename"
,
_node_userId
=
required
"user_id"
,
_node_userId
=
required
"user_id"
,
_node_parentId
=
required
"parent_id"
,
_node_parentId
=
optional
"parent_id"
,
_node_name
=
required
"name"
,
_node_name
=
required
"name"
,
_node_date
=
optional
"date"
,
_node_date
=
optional
"date"
...
@@ -306,7 +309,7 @@ selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead
...
@@ -306,7 +309,7 @@ selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead
selectNodesWith'
parentId
maybeNodeType
=
proc
()
->
do
selectNodesWith'
parentId
maybeNodeType
=
proc
()
->
do
node
<-
(
proc
()
->
do
node
<-
(
proc
()
->
do
row
@
(
Node
_
typeId
_
parentId'
_
_
_
)
<-
queryNodeTable
-<
()
row
@
(
Node
_
typeId
_
parentId'
_
_
_
)
<-
queryNodeTable
-<
()
restrict
-<
parentId'
.==
(
toNullable
$
pgInt4
parentId
)
restrict
-<
parentId'
.==
(
pgInt4
parentId
)
let
typeId'
=
maybe
0
nodeTypeId
maybeNodeType
let
typeId'
=
maybe
0
nodeTypeId
maybeNodeType
...
@@ -359,9 +362,7 @@ getCorporaWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeCorpus)
...
@@ -359,9 +362,7 @@ getCorporaWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeCorpus)
selectNodesWithParentID
::
Int
->
Query
NodeRead
selectNodesWithParentID
::
Int
->
Query
NodeRead
selectNodesWithParentID
n
=
proc
()
->
do
selectNodesWithParentID
n
=
proc
()
->
do
row
@
(
Node
_
_
_
parent_id
_
_
_
)
<-
queryNodeTable
-<
()
row
@
(
Node
_
_
_
parent_id
_
_
_
)
<-
queryNodeTable
-<
()
restrict
-<
if
n
>
0
restrict
-<
parent_id
.==
(
pgInt4
n
)
then
parent_id
.==
(
toNullable
$
pgInt4
n
)
else
isNull
parent_id
returnA
-<
row
returnA
-<
row
selectNodesWithType
::
Column
PGInt4
->
Query
NodeRead
selectNodesWithType
::
Column
PGInt4
->
Query
NodeRead
...
...
src/Gargantext/Database/Schema/User.hs
View file @
f4838983
...
@@ -103,7 +103,7 @@ userTable = Table "auth_user" (pUser User { user_id = optional "id"
...
@@ -103,7 +103,7 @@ userTable = Table "auth_user" (pUser User { user_id = optional "id"
)
)
-- TODO: on conflict, nice message
-- TODO: on conflict, nice message
insertUsers
::
[
UserWrite
]
->
Cmd
Int64
insertUsers
::
[
UserWrite
]
->
Cmd
err
Int64
insertUsers
us
=
mkCmd
$
\
c
->
runInsertMany
c
userTable
us
insertUsers
us
=
mkCmd
$
\
c
->
runInsertMany
c
userTable
us
gargantuaUser
::
UserWrite
gargantuaUser
::
UserWrite
...
@@ -167,4 +167,3 @@ getUser :: Username -> Cmd err (Maybe UserLight)
...
@@ -167,4 +167,3 @@ getUser :: Username -> Cmd err (Maybe UserLight)
getUser
u
=
userLightWithUsername
u
<$>
usersLight
getUser
u
=
userLightWithUsername
u
<$>
usersLight
src/Gargantext/Database/Schema/schema.sql
View file @
f4838983
CREATE
EXTENSION
IF
NOT
EXISTS
plpgsql
WITH
SCHEMA
pg_catalog
;
CREATE
EXTENSION
IF
NOT
EXISTS
plpgsql
WITH
SCHEMA
pg_catalog
;
COMMENT
ON
EXTENSION
plpgsql
IS
'PL/pgSQL procedural language'
;
COMMENT
ON
EXTENSION
plpgsql
IS
'PL/pgSQL procedural language'
;
CREATE
EXTENSION
IF
NOT
EXISTS
acl
WITH
SCHEMA
public
;
-- needed for rights management
-- CREATE EXTENSION IF NOT EXISTS acl WITH SCHEMA public;
-- CREATE USER WITH ...
-- CREATE USER WITH ...
-- createdb "gargandb"
-- createdb "gargandb"
...
...
src/Gargantext/Database/Utils.hs
View file @
f4838983
...
@@ -84,6 +84,7 @@ formatPGSQuery q a = mkCmd $ \conn -> PGS.formatQuery conn q a
...
@@ -84,6 +84,7 @@ formatPGSQuery q a = mkCmd $ \conn -> PGS.formatQuery conn q a
runPGSQuery
::
(
PGS
.
ToRow
a
,
PGS
.
FromRow
b
)
=>
PGS
.
Query
->
a
->
Cmd
err
[
b
]
runPGSQuery
::
(
PGS
.
ToRow
a
,
PGS
.
FromRow
b
)
=>
PGS
.
Query
->
a
->
Cmd
err
[
b
]
runPGSQuery
q
a
=
mkCmd
$
\
conn
->
PGS
.
query
conn
q
a
runPGSQuery
q
a
=
mkCmd
$
\
conn
->
PGS
.
query
conn
q
a
------------------------------------------------------------------------
------------------------------------------------------------------------
databaseParameters
::
FilePath
->
IO
PGS
.
ConnectInfo
databaseParameters
::
FilePath
->
IO
PGS
.
ConnectInfo
...
@@ -107,9 +108,6 @@ databaseParameters fp = do
...
@@ -107,9 +108,6 @@ databaseParameters fp = do
connectGargandb
::
FilePath
->
IO
Connection
connectGargandb
::
FilePath
->
IO
Connection
connectGargandb
fp
=
databaseParameters
fp
>>=
\
params
->
connect
params
connectGargandb
fp
=
databaseParameters
fp
>>=
\
params
->
connect
params
printSql
::
Default
Unpackspec
a
a
=>
Query
a
->
IO
()
printSql
=
putStrLn
.
maybe
"Empty query"
identity
.
showSqlForPostgres
fromField'
::
(
Typeable
b
,
FromJSON
b
)
=>
Field
->
Maybe
DB
.
ByteString
->
Conversion
b
fromField'
::
(
Typeable
b
,
FromJSON
b
)
=>
Field
->
Maybe
DB
.
ByteString
->
Conversion
b
fromField'
field
mb
=
do
fromField'
field
mb
=
do
v
<-
fromField
field
mb
v
<-
fromField
field
mb
...
@@ -119,5 +117,7 @@ fromField' field mb = do
...
@@ -119,5 +117,7 @@ fromField' field mb = do
Success
a
->
pure
a
Success
a
->
pure
a
Error
_err
->
returnError
ConversionFailed
field
"cannot parse hyperdata"
Error
_err
->
returnError
ConversionFailed
field
"cannot parse hyperdata"
-- | Opaleye leftJoin* functions
printSqlOpa
::
Default
Unpackspec
a
a
=>
Query
a
->
IO
()
-- TODO add here from Node.hs
printSqlOpa
=
putStrLn
.
maybe
"Empty query"
identity
.
showSqlForPostgres
src/Gargantext/Text/Flow.hs
View file @
f4838983
...
@@ -13,6 +13,7 @@ From text to viz, all the flow of texts in Gargantext.
...
@@ -13,6 +13,7 @@ From text to viz, all the flow of texts in Gargantext.
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module
Gargantext.Text.Flow
module
Gargantext.Text.Flow
where
where
...
@@ -60,7 +61,7 @@ import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain, l_community_id)
...
@@ -60,7 +61,7 @@ import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain, l_community_id)
contextText
::
[
T
.
Text
]
contextText
::
[
T
.
Text
]
contextText
=
map
T
.
pack
[
"The dog is an animal."
contextText
=
[
"The dog is an animal."
,
"The bird is an animal."
,
"The bird is an animal."
,
"The dog is an animal."
,
"The dog is an animal."
,
"The animal is a bird or a dog ?"
,
"The animal is a bird or a dog ?"
...
...
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