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
141
Issues
141
List
Board
Labels
Milestones
Merge Requests
5
Merge Requests
5
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
11ec91d2
Commit
11ec91d2
authored
Apr 28, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[DB/REFACT] start of refactoring
parent
56d3a2b3
Changes
8
Hide whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
24 additions
and
152 deletions
+24
-152
Export.hs
src/Gargantext/API/Corpus/Export.hs
+1
-1
Node.hs
src/Gargantext/API/Node.hs
+1
-0
Ngrams.hs
src/Gargantext/Database/Schema/Ngrams.hs
+0
-2
NodeNgrams.hs
src/Gargantext/Database/Schema/NodeNgrams.hs
+0
-1
NodeNode.hs
src/Gargantext/Database/Schema/NodeNode.hs
+6
-126
User.hs
src/Gargantext/Database/Schema/User.hs
+14
-20
Chart.hs
src/Gargantext/Viz/Chart.hs
+1
-1
Main.hs
src/Gargantext/Viz/Phylo/Main.hs
+1
-1
No files found.
src/Gargantext/API/Corpus/Export.hs
View file @
11ec91d2
...
...
@@ -46,7 +46,7 @@ import Gargantext.Database.Admin.Types.Node (Node, HyperdataDocument(..), NodeId
import
Gargantext.Database.Admin.Utils
(
Cmd
)
import
Gargantext.Database.Schema.Node
(
_node_id
,
_node_hyperdata
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Database.
Schema
.NodeNode
(
selectDocNodes
)
import
Gargantext.Database.
Query.Table
.NodeNode
(
selectDocNodes
)
import
Gargantext.Prelude
import
Gargantext.Prelude.Utils
(
sha
)
import
Servant
...
...
src/Gargantext/API/Node.hs
View file @
11ec91d2
...
...
@@ -66,6 +66,7 @@ import Gargantext.Database.Admin.Types.Errors (HasNodeError(..))
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Utils
-- (Cmd, CmdM)
import
Gargantext.Database.Schema.Node
(
node_userId
,
_node_typename
)
import
Gargantext.Database.Query.Table.NodeNode
import
Gargantext.Database.Schema.NodeNode
import
Gargantext.Prelude
import
Gargantext.Viz.Chart
...
...
src/Gargantext/Database/Schema/Ngrams.hs
View file @
11ec91d2
...
...
@@ -135,7 +135,6 @@ instance ToParamSchema NgramsType where
toParamSchema
_
=
toParamSchema
(
Proxy
::
Proxy
TODO
)
instance
QueryRunnerColumnDefault
(
Nullable
PGInt4
)
NgramsTypeId
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
...
...
@@ -252,4 +251,3 @@ queryInsertNgrams = [sql|
JOIN ngrams c USING (terms); -- columns of unique index
|]
src/Gargantext/Database/Schema/NodeNgrams.hs
View file @
11ec91d2
...
...
@@ -67,7 +67,6 @@ data NodeNgramsPoly id
}
deriving
(
Show
,
Eq
,
Ord
)
{-
type NodeNgramsWrite = NodeNgramsPoly (Maybe (Column (PGInt4)))
(Column (PGInt4))
(Maybe (Column (PGInt4)))
...
...
src/Gargantext/Database/Schema/NodeNode.hs
View file @
11ec91d2
...
...
@@ -45,6 +45,7 @@ import Opaleye
import
qualified
Database.PostgreSQL.Simple
as
PGS
(
Query
,
Only
(
..
))
import
qualified
Opaleye
as
O
data
NodeNodePoly
node1_id
node2_id
score
cat
=
NodeNode
{
_nn_node1_id
::
!
node1_id
,
_nn_node2_id
::
!
node2_id
...
...
@@ -89,139 +90,18 @@ queryNodeNodeTable = queryTable nodeNodeTable
nodesNodes
::
Cmd
err
[
NodeNode
]
nodesNodes
=
runOpaQuery
queryNodeNodeTable
instance
QueryRunnerColumnDefault
(
Nullable
PGInt4
)
Int
where
instance
QueryRunnerColumnDefault
(
Nullable
PGInt4
)
Int
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
(
Nullable
PGFloat8
)
Int
where
instance
QueryRunnerColumnDefault
(
Nullable
PGFloat8
)
Int
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
(
Nullable
PGFloat8
)
Double
where
instance
QueryRunnerColumnDefault
(
Nullable
PGFloat8
)
Double
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGFloat8
(
Maybe
Double
)
where
instance
QueryRunnerColumnDefault
PGFloat8
(
Maybe
Double
)
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGInt4
(
Maybe
Int
)
where
instance
QueryRunnerColumnDefault
PGInt4
(
Maybe
Int
)
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
------------------------------------------------------------------------
-- | Basic NodeNode tools
getNodeNode
::
NodeId
->
Cmd
err
[
NodeNode
]
getNodeNode
n
=
runOpaQuery
(
selectNodeNode
$
pgNodeId
n
)
where
selectNodeNode
::
Column
PGInt4
->
Query
NodeNodeRead
selectNodeNode
n'
=
proc
()
->
do
ns
<-
queryNodeNodeTable
-<
()
restrict
-<
_nn_node1_id
ns
.==
n'
returnA
-<
ns
-------------------------
insertNodeNode
::
[
NodeNode
]
->
Cmd
err
Int64
insertNodeNode
ns
=
mkCmd
$
\
conn
->
runInsert_
conn
$
Insert
nodeNodeTable
ns'
rCount
Nothing
where
ns'
::
[
NodeNodeWrite
]
ns'
=
map
(
\
(
NodeNode
n1
n2
x
y
)
->
NodeNode
(
pgNodeId
n1
)
(
pgNodeId
n2
)
(
pgDouble
<$>
x
)
(
pgInt4
<$>
y
)
)
ns
-- | Favorite management
nodeNodeCategory
::
CorpusId
->
DocId
->
Int
->
Cmd
err
[
Int
]
nodeNodeCategory
cId
dId
c
=
map
(
\
(
PGS
.
Only
a
)
->
a
)
<$>
runPGSQuery
favQuery
(
c
,
cId
,
dId
)
where
favQuery
::
PGS
.
Query
favQuery
=
[
sql
|
UPDATE nodes_nodes SET category = ?
WHERE node1_id = ? AND node2_id = ?
RETURNING node2_id;
|]
nodeNodesCategory
::
[(
CorpusId
,
DocId
,
Int
)]
->
Cmd
err
[
Int
]
nodeNodesCategory
inputData
=
map
(
\
(
PGS
.
Only
a
)
->
a
)
<$>
runPGSQuery
catQuery
(
PGS
.
Only
$
Values
fields
inputData
)
where
fields
=
map
(
\
t
->
QualifiedIdentifier
Nothing
t
)
[
"int4"
,
"int4"
,
"int4"
]
catQuery
::
PGS
.
Query
catQuery
=
[
sql
|
UPDATE nodes_nodes as nn0
SET category = nn1.category
FROM (?) as nn1(node1_id,node2_id,category)
WHERE nn0.node1_id = nn1.node1_id
AND nn0.node2_id = nn1.node2_id
RETURNING nn1.node2_id
|]
------------------------------------------------------------------------
-- | TODO use UTCTime fast
selectDocsDates
::
CorpusId
->
Cmd
err
[
Text
]
selectDocsDates
cId
=
map
(
head'
"selectDocsDates"
.
splitOn
"-"
)
<$>
catMaybes
<$>
map
(
view
hyperdataDocument_publication_date
)
<$>
selectDocs
cId
selectDocs
::
CorpusId
->
Cmd
err
[
HyperdataDocument
]
selectDocs
cId
=
runOpaQuery
(
queryDocs
cId
)
queryDocs
::
CorpusId
->
O
.
Query
(
Column
PGJsonb
)
queryDocs
cId
=
proc
()
->
do
(
n
,
nn
)
<-
joinInCorpus
-<
()
restrict
-<
nn
^.
nn_node1_id
.==
(
toNullable
$
pgNodeId
cId
)
restrict
-<
nn
^.
nn_category
.>=
(
toNullable
$
pgInt4
1
)
restrict
-<
n
^.
node_typename
.==
(
pgInt4
$
nodeTypeId
NodeDocument
)
returnA
-<
view
(
node_hyperdata
)
n
selectDocNodes
::
CorpusId
->
Cmd
err
[
Node
HyperdataDocument
]
selectDocNodes
cId
=
runOpaQuery
(
queryDocNodes
cId
)
queryDocNodes
::
CorpusId
->
O
.
Query
NodeRead
queryDocNodes
cId
=
proc
()
->
do
(
n
,
nn
)
<-
joinInCorpus
-<
()
restrict
-<
nn
^.
nn_node1_id
.==
(
toNullable
$
pgNodeId
cId
)
restrict
-<
nn
^.
nn_category
.>=
(
toNullable
$
pgInt4
1
)
restrict
-<
n
^.
node_typename
.==
(
pgInt4
$
nodeTypeId
NodeDocument
)
returnA
-<
n
joinInCorpus
::
O
.
Query
(
NodeRead
,
NodeNodeReadNull
)
joinInCorpus
=
leftJoin
queryNodeTable
queryNodeNodeTable
cond
where
cond
::
(
NodeRead
,
NodeNodeRead
)
->
Column
PGBool
cond
(
n
,
nn
)
=
nn
^.
nn_node2_id
.==
(
view
node_id
n
)
------------------------------------------------------------------------
-- | Trash management
nodeToTrash
::
CorpusId
->
DocId
->
Bool
->
Cmd
err
[
PGS
.
Only
Int
]
nodeToTrash
cId
dId
b
=
runPGSQuery
trashQuery
(
b
,
cId
,
dId
)
where
trashQuery
::
PGS
.
Query
trashQuery
=
[
sql
|
UPDATE nodes_nodes SET delete = ?
WHERE node1_id = ? AND node2_id = ?
RETURNING node2_id
|]
-- | Trash Massive
nodesToTrash
::
[(
CorpusId
,
DocId
,
Bool
)]
->
Cmd
err
[
Int
]
nodesToTrash
input
=
map
(
\
(
PGS
.
Only
a
)
->
a
)
<$>
runPGSQuery
trashQuery
(
PGS
.
Only
$
Values
fields
input
)
where
fields
=
map
(
\
t
->
QualifiedIdentifier
Nothing
t
)
[
"int4"
,
"int4"
,
"bool"
]
trashQuery
::
PGS
.
Query
trashQuery
=
[
sql
|
UPDATE nodes_nodes as nn0 SET
delete = nn1.delete
from (?) as nn1(node1_id,node2_id,delete)
WHERE nn0.node1_id = nn1.node1_id
AND nn0.node2_id = nn1.node2_id
RETURNING nn1.node2_id
|]
-- | /!\ Really remove nodes in the Corpus or Annuaire
emptyTrash
::
CorpusId
->
Cmd
err
[
PGS
.
Only
Int
]
emptyTrash
cId
=
runPGSQuery
delQuery
(
PGS
.
Only
cId
)
where
delQuery
::
PGS
.
Query
delQuery
=
[
sql
|
DELETE from nodes_nodes n
WHERE n.node1_id = ?
AND n.delete = true
RETURNING n.node2_id
|]
------------------------------------------------------------------------
src/Gargantext/Database/Schema/User.hs
View file @
11ec91d2
...
...
@@ -35,8 +35,6 @@ import Gargantext.Prelude
import
Opaleye
------------------------------------------------------------------------
------------------------------------------------------------------------
data
UserLight
=
UserLight
{
userLight_id
::
!
Int
,
userLight_username
::
!
Text
,
userLight_email
::
!
Text
...
...
@@ -84,27 +82,23 @@ type UserReadNull = UserPoly (Column (Nullable PGInt4)) (Column (Nul
(
Column
(
Nullable
PGBool
))
(
Column
(
Nullable
PGBool
))
(
Column
(
Nullable
PGTimestamptz
))
type
UserDB
=
UserPoly
Int
Text
(
Maybe
UTCTime
)
Bool
Text
Text
Text
Text
Bool
Bool
UTCTime
$
(
makeAdaptorAndInstance
"pUserDB"
''
U
serPoly
)
$
(
makeLensesWith
abbreviatedFields
''
U
serPoly
)
userTable
::
Table
UserWrite
UserRead
userTable
=
Table
"auth_user"
(
pUserDB
UserDB
{
user_id
=
optional
"id"
,
user_password
=
required
"passwor
d"
,
user_lastLogin
=
optional
"last_login
"
,
user_isSuperUser
=
required
"is_superuser
"
,
user_username
=
required
"username
"
,
user_firstName
=
required
"first_
name"
,
user_lastName
=
required
"la
st_name"
,
user_email
=
required
"email
"
,
user_isStaff
=
required
"is_staff
"
,
user_isActive
=
required
"is_active
"
,
user_dateJoined
=
optional
"date_joined
"
}
)
userTable
=
Table
"auth_user"
(
pUserDB
UserDB
{
user_id
=
optional
"i
d"
,
user_password
=
required
"password
"
,
user_lastLogin
=
optional
"last_login
"
,
user_isSuperUser
=
required
"is_superuser
"
,
user_username
=
required
"user
name"
,
user_firstName
=
required
"fir
st_name"
,
user_lastName
=
required
"last_name
"
,
user_email
=
required
"email
"
,
user_isStaff
=
required
"is_staff
"
,
user_isActive
=
required
"is_active
"
,
user_dateJoined
=
optional
"date_joined"
}
)
src/Gargantext/Viz/Chart.hs
View file @
11ec91d2
...
...
@@ -28,7 +28,7 @@ import Gargantext.Database.Action.Query.Node
import
Gargantext.Database.Admin.Config
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
)
import
Gargantext.Database.Admin.Utils
import
Gargantext.Database.
Schema
.NodeNode
(
selectDocsDates
)
import
Gargantext.Database.
Query.Table
.NodeNode
(
selectDocsDates
)
import
Gargantext.Database.Schema.Node
import
Gargantext.Prelude
import
Gargantext.Text.Metrics.Count
(
occurrencesWith
)
...
...
src/Gargantext/Viz/Phylo/Main.hs
View file @
11ec91d2
...
...
@@ -29,7 +29,7 @@ import Gargantext.Core.Types
import
Gargantext.Database.Action.Flow
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Database.Action.Query.Node
(
defaultList
)
import
Gargantext.Database.
Schema
.NodeNode
(
selectDocs
)
import
Gargantext.Database.
Query.Table
.NodeNode
(
selectDocs
)
import
Gargantext.Prelude
import
Gargantext.Text.Context
(
TermList
)
import
Gargantext.Text.Terms.WithList
...
...
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