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
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