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
153
Issues
153
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
f7186aaa
Commit
f7186aaa
authored
Apr 13, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[DB|WIP] fix imports and cycles
parent
b28af36c
Changes
14
Hide whitespace changes
Inline
Side-by-side
Showing
14 changed files
with
140 additions
and
91 deletions
+140
-91
Utils.hs
src/Gargantext/Database/Action/Flow/Utils.hs
+18
-0
Query.hs
src/Gargantext/Database/Action/Query.hs
+88
-0
Ngrams.hs
src/Gargantext/Database/Action/Query/Ngrams.hs
+2
-0
Node.hs
src/Gargantext/Database/Action/Query/Node.hs
+0
-59
Children.hs
src/Gargantext/Database/Action/Query/Node/Children.hs
+2
-1
User.hs
src/Gargantext/Database/Action/Query/Node/User.hs
+12
-22
Tree.hs
src/Gargantext/Database/Action/Query/Tree.hs
+1
-0
Search.hs
src/Gargantext/Database/Action/Search.hs
+1
-1
Node.hs
src/Gargantext/Database/Admin/Types/Node.hs
+9
-3
Utils.hs
src/Gargantext/Database/Admin/Utils.hs
+1
-0
NodeNode.hs
src/Gargantext/Database/Schema/NodeNode.hs
+2
-1
NodeNodeNgrams.hs
src/Gargantext/Database/Schema/NodeNodeNgrams.hs
+1
-1
NodeNodeNgrams2.hs
src/Gargantext/Database/Schema/NodeNodeNgrams2.hs
+1
-1
Node_NodeNgramsNodeNgrams.hs
src/Gargantext/Database/Schema/Node_NodeNgramsNodeNgrams.hs
+2
-2
No files found.
src/Gargantext/Database/Action/Flow/Utils.hs
View file @
f7186aaa
...
...
@@ -23,9 +23,27 @@ import Gargantext.Database.Admin.Types.Node (NodeId, Node, NodePoly(..), Hyperda
import
Gargantext.Database.Admin.Utils
(
Cmd
)
import
Gargantext.Database.Schema.Ngrams
import
Gargantext.Database.Schema.NodeNodeNgrams
import
Gargantext.Database.Action.Query.Node
(
getNode
)
import
Gargantext.Prelude
import
qualified
Data.Map
as
DM
getUserId
::
HasNodeError
err
=>
User
->
Cmd
err
UserId
getUserId
(
UserDBId
uid
)
=
pure
uid
getUserId
(
RootId
rid
)
=
do
n
<-
getNode
rid
pure
$
_node_userId
n
getUserId
(
UserName
u
)
=
do
muser
<-
getUser
u
case
muser
of
Just
user
->
pure
$
userLight_id
user
Nothing
->
nodeError
NoUserFound
toMaps
::
Hyperdata
a
=>
(
a
->
Map
(
NgramsT
Ngrams
)
Int
)
->
[
Node
a
]
...
...
src/Gargantext/Database/Action/Query.hs
0 → 100644
View file @
f7186aaa
{-|
Module : Gargantext.Database.Action.Query
Description : Main Tools of Node to the database
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module
Gargantext.Database.Action.Query
where
import
Gargantext.Database.Action.Query.Node
import
Gargantext.Database.Action.Query.User
import
Opaleye
hiding
(
FromField
)
import
Prelude
hiding
(
null
,
id
,
map
,
sum
)
------------------------------------------------------------------------
-- | TODO mk all others nodes
mkNodeWithParent
::
HasNodeError
err
=>
NodeType
->
Maybe
ParentId
->
UserId
->
Name
->
Cmd
err
[
NodeId
]
mkNodeWithParent
NodeUser
(
Just
_
)
_
_
=
nodeError
UserNoParent
------------------------------------------------------------------------
mkNodeWithParent
NodeUser
Nothing
uId
name
=
insertNodesWithParentR
Nothing
[
node
NodeUser
name
fake_HyperdataUser
Nothing
uId
]
mkNodeWithParent
_
Nothing
_
_
=
nodeError
HasParent
------------------------------------------------------------------------
mkNodeWithParent
NodeFolder
(
Just
i
)
uId
name
=
insertNodesWithParentR
(
Just
i
)
[
node
NodeFolder
name
hd
Nothing
uId
]
where
hd
=
defaultFolder
mkNodeWithParent
NodeFolderPrivate
(
Just
i
)
uId
_
=
insertNodesWithParentR
(
Just
i
)
[
node
NodeFolderPrivate
"Private"
hd
Nothing
uId
]
where
hd
=
defaultFolder
mkNodeWithParent
NodeFolderShared
(
Just
i
)
uId
_
=
insertNodesWithParentR
(
Just
i
)
[
node
NodeFolderShared
"Shared"
hd
Nothing
uId
]
where
hd
=
defaultFolder
mkNodeWithParent
NodeFolderPublic
(
Just
i
)
uId
_
=
insertNodesWithParentR
(
Just
i
)
[
node
NodeFolderPublic
"Public"
hd
Nothing
uId
]
where
hd
=
defaultFolder
mkNodeWithParent
NodeTeam
(
Just
i
)
uId
_
=
insertNodesWithParentR
(
Just
i
)
[
node
NodeTeam
"Team"
hd
Nothing
uId
]
where
hd
=
defaultFolder
------------------------------------------------------------------------
mkNodeWithParent
NodeCorpus
(
Just
i
)
uId
name
=
insertNodesWithParentR
(
Just
i
)
[
node
NodeCorpus
name
hd
Nothing
uId
]
where
hd
=
defaultCorpus
mkNodeWithParent
NodeAnnuaire
(
Just
i
)
uId
name
=
insertNodesWithParentR
(
Just
i
)
[
node
NodeAnnuaire
name
hd
Nothing
uId
]
where
hd
=
defaultAnnuaire
mkNodeWithParent
_
_
_
_
=
nodeError
NotImplYet
src/Gargantext/Database/Action/Query/Ngrams.hs
View file @
f7186aaa
...
...
@@ -21,6 +21,8 @@ import Control.Arrow (returnA)
import
Control.Lens
((
^.
))
import
Data.Text
(
Text
)
import
Gargantext.Core.Types
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Types.Node
(
pgNodeId
)
import
Gargantext.Database.Admin.Utils
(
runOpaQuery
,
Cmd
)
import
Gargantext.Database.Schema.Ngrams
import
Gargantext.Database.Schema.Node
...
...
src/Gargantext/Database/Action/Query/Node.hs
View file @
f7186aaa
...
...
@@ -44,7 +44,6 @@ import Gargantext.Database.Admin.Types.Errors
import
Gargantext.Database.Admin.Types.Node
(
NodeType
(
..
),
defaultCorpus
,
Hyperdata
,
HyperData
(
..
))
import
Gargantext.Database.Admin.Utils
import
Gargantext.Database.Action.Query.Node.Contact
(
HyperdataContact
(
..
),
arbitraryHyperdataContact
)
import
Gargantext.Database.Action.Query.Node.User
import
Gargantext.Database.Schema.Node
import
Gargantext.Prelude
hiding
(
sum
,
head
)
import
Gargantext.Viz.Graph
(
HyperdataGraph
(
..
))
...
...
@@ -53,9 +52,6 @@ import Opaleye.Internal.QueryArr (Query)
import
Prelude
hiding
(
null
,
id
,
map
,
sum
)
pgNodeId
::
NodeId
->
Column
PGInt4
pgNodeId
=
pgInt4
.
id2int
queryNodeSearchTable
::
Query
NodeSearchRead
queryNodeSearchTable
=
queryTable
nodeTableSearch
...
...
@@ -66,7 +62,6 @@ selectNode id = proc () -> do
returnA
-<
row
runGetNodes
::
Query
NodeRead
->
Cmd
err
[
Node
HyperdataAny
]
runGetNodes
=
runOpaQuery
...
...
@@ -405,60 +400,6 @@ childWith uId pId (Node' NodeContact txt v []) = node2table uId (Just pId) (Nod
childWith
_
_
(
Node'
_
_
_
_
)
=
panic
"This NodeType can not be a child"
-- =================================================================== --
------------------------------------------------------------------------
-- | TODO mk all others nodes
mkNodeWithParent
::
HasNodeError
err
=>
NodeType
->
Maybe
ParentId
->
UserId
->
Name
->
Cmd
err
[
NodeId
]
mkNodeWithParent
NodeUser
(
Just
_
)
_
_
=
nodeError
UserNoParent
------------------------------------------------------------------------
mkNodeWithParent
NodeUser
Nothing
uId
name
=
insertNodesWithParentR
Nothing
[
node
NodeUser
name
fake_HyperdataUser
Nothing
uId
]
mkNodeWithParent
_
Nothing
_
_
=
nodeError
HasParent
------------------------------------------------------------------------
mkNodeWithParent
NodeFolder
(
Just
i
)
uId
name
=
insertNodesWithParentR
(
Just
i
)
[
node
NodeFolder
name
hd
Nothing
uId
]
where
hd
=
defaultFolder
mkNodeWithParent
NodeFolderPrivate
(
Just
i
)
uId
_
=
insertNodesWithParentR
(
Just
i
)
[
node
NodeFolderPrivate
"Private"
hd
Nothing
uId
]
where
hd
=
defaultFolder
mkNodeWithParent
NodeFolderShared
(
Just
i
)
uId
_
=
insertNodesWithParentR
(
Just
i
)
[
node
NodeFolderShared
"Shared"
hd
Nothing
uId
]
where
hd
=
defaultFolder
mkNodeWithParent
NodeFolderPublic
(
Just
i
)
uId
_
=
insertNodesWithParentR
(
Just
i
)
[
node
NodeFolderPublic
"Public"
hd
Nothing
uId
]
where
hd
=
defaultFolder
mkNodeWithParent
NodeTeam
(
Just
i
)
uId
_
=
insertNodesWithParentR
(
Just
i
)
[
node
NodeTeam
"Team"
hd
Nothing
uId
]
where
hd
=
defaultFolder
------------------------------------------------------------------------
mkNodeWithParent
NodeCorpus
(
Just
i
)
uId
name
=
insertNodesWithParentR
(
Just
i
)
[
node
NodeCorpus
name
hd
Nothing
uId
]
where
hd
=
defaultCorpus
mkNodeWithParent
NodeAnnuaire
(
Just
i
)
uId
name
=
insertNodesWithParentR
(
Just
i
)
[
node
NodeAnnuaire
name
hd
Nothing
uId
]
where
hd
=
defaultAnnuaire
mkNodeWithParent
_
_
_
_
=
nodeError
NotImplYet
------------------------------------------------------------------------
-- =================================================================== --
-- |
-- CorpusDocument is a corpus made from a set of documents
...
...
src/Gargantext/Database/Action/Query/Node/Children.hs
View file @
f7186aaa
...
...
@@ -23,11 +23,12 @@ import Control.Arrow (returnA)
import
Data.Proxy
import
Gargantext.Core.Types
import
Gargantext.Database.Action.Query.Filter
import
Gargantext.Database.Action.Query.Node
import
Gargantext.Database.Action.Query.Node.Contact
(
HyperdataContact
)
import
Gargantext.Database.Admin.Config
(
nodeTypeId
)
import
Gargantext.Database.Admin.Types.Node
(
pgNodeId
)
import
Gargantext.Database.Admin.Utils
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.Node
(
pgNodeId
)
import
Gargantext.Database.Schema.NodeNode
import
Opaleye
...
...
src/Gargantext/Database/Action/Query/Node/User.hs
View file @
f7186aaa
...
...
@@ -10,11 +10,13 @@ Portability : POSIX
-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
module
Gargantext.Database.Action.Query.Node.User
...
...
@@ -22,20 +24,22 @@ module Gargantext.Database.Action.Query.Node.User
import
Control.Lens
(
makeLenses
)
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Maybe
(
fromMaybe
)
import
Data.Swagger
(
ToSchema
(
..
),
genericDeclareNamedSchema
)
import
Data.Text
(
Text
)
import
Database.PostgreSQL.Simple.FromField
(
FromField
,
fromField
)
import
GHC.Generics
(
Generic
)
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core.Types
(
Name
)
import
Gargantext.Core.Types.Individu
(
Username
,
arbitraryUsername
,
User
(
..
),
UserId
)
import
Gargantext.Database.Action.Query.Node
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixSwagger
)
import
Gargantext.Database.Action.Query.Node
(
getNode
)
import
Gargantext.Database.Action.Query.Node.Contact
(
HyperdataContact
,
fake_HyperdataContact
)
import
Gargantext.Database.Admin.Types.Node
(
Node
,
Hyperdata
,
DocumentId
,
NodeId
(
..
))
import
Gargantext.Database.Admin.Utils
(
fromField'
)
import
Gargantext.Database.Schema.Node
(
Node
(
..
))
import
Gargantext.Database.Admin.Utils
-- (fromField', Cmd
)
import
Gargantext.Database.Schema.Node
--
(Node(..))
import
Gargantext.Prelude
import
Opaleye
(
QueryRunnerColumnDefault
,
queryRunnerColumnDefault
,
PGJsonb
,
fieldQueryRunnerColumn
)
import
Opaleye
hiding
(
FromField
)
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck.Arbitrary
(
Arbitrary
,
arbitrary
)
...
...
@@ -130,23 +134,9 @@ $(deriveJSON (unPrefix "_hpu_") ''HyperdataPublic)
-----------------------------------------------------------------
getUserId
::
HasNodeError
err
=>
User
->
Cmd
err
UserId
getUserId
(
UserDBId
uid
)
=
pure
uid
getUserId
(
RootId
rid
)
=
do
n
<-
getNode
rid
pure
$
_node_userId
n
getUserId
(
UserName
u
)
=
do
muser
<-
getUser
u
case
muser
of
Just
user
->
pure
$
userLight_id
user
Nothing
->
nodeError
NoUserFound
getNodeUser
::
NodeId
->
Cmd
err
(
Node
HyperdataUser
)
getNodeUser
nId
=
do
fromMaybe
(
error
$
"Node does not exist: "
<>
show
nId
)
.
headMay
fromMaybe
(
panic
$
"Node does not exist: "
<>
show
nId
)
.
headMay
<$>
runOpaQuery
(
limit
1
$
selectNode
(
pgNodeId
nId
))
...
...
src/Gargantext/Database/Action/Query/Tree.hs
View file @
f7186aaa
...
...
@@ -39,6 +39,7 @@ import Gargantext.Prelude
import
Gargantext.Core.Types.Main
(
NodeTree
(
..
),
Tree
(
..
))
import
Gargantext.Database.Admin.Config
(
fromNodeTypeId
,
nodeTypeId
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
,
NodeType
,
DocId
,
allNodeTypes
)
import
Gargantext.Database.Admin.Types.Errors
import
Gargantext.Database.Admin.Utils
(
Cmd
,
runPGSQuery
)
import
Gargantext.Database.Action.Query.Node
import
Gargantext.Database.Action.Query.User
...
...
src/Gargantext/Database/Action/Search.hs
View file @
f7186aaa
...
...
@@ -29,7 +29,7 @@ import Data.Time (UTCTime)
import
Database.PostgreSQL.Simple
(
Query
)
import
Database.PostgreSQL.Simple.ToField
import
Gargantext.Core.Types
import
Gargantext.Database.Action.Facet
import
Gargantext.Database.Action.
Query.
Facet
import
Gargantext.Database.Action.Query.Join
(
leftJoin6
)
import
Gargantext.Database.Admin.Config
(
nodeTypeId
)
import
Gargantext.Database.Admin.Types.Node
(
NodeType
(
..
))
...
...
src/Gargantext/Database/Admin/Types/Node.hs
View file @
f7186aaa
...
...
@@ -53,9 +53,18 @@ import Test.QuickCheck.Instances.Text ()
import
Test.QuickCheck.Instances.Time
()
import
Text.Read
(
read
)
import
Text.Show
(
Show
())
import
qualified
Opaleye
as
O
------------------------------------------------------------------------
pgNodeId
::
NodeId
->
O
.
Column
O
.
PGInt4
pgNodeId
=
O
.
pgInt4
.
id2int
where
id2int
::
NodeId
->
Int
id2int
(
NodeId
n
)
=
n
------------------------------------------------------------------------
newtype
NodeId
=
NodeId
Int
deriving
(
Show
,
Read
,
Generic
,
Num
,
Eq
,
Ord
,
Enum
,
ToJSONKey
,
FromJSONKey
,
ToJSON
,
FromJSON
)
...
...
@@ -123,9 +132,6 @@ type ContactId = NodeId
type
UserId
=
Int
type
MasterUserId
=
UserId
id2int
::
NodeId
->
Int
id2int
(
NodeId
n
)
=
n
------------------------------------------------------------------------
data
Status
=
Status
{
status_failed
::
!
Int
,
status_succeeded
::
!
Int
...
...
src/Gargantext/Database/Admin/Utils.hs
View file @
f7186aaa
...
...
@@ -51,6 +51,7 @@ import qualified Data.ByteString as DB
import
qualified
Data.List
as
DL
import
qualified
Database.PostgreSQL.Simple
as
PGS
class
HasConnectionPool
env
where
connPool
::
Getter
env
(
Pool
Connection
)
...
...
src/Gargantext/Database/Schema/NodeNode.hs
View file @
f7186aaa
...
...
@@ -35,10 +35,11 @@ import Data.Text (Text, splitOn)
import
Database.PostgreSQL.Simple.SqlQQ
(
sql
)
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
import
Gargantext.Core.Types
import
Gargantext.Database.A
ction.Query
.Node
(
pgNodeId
)
import
Gargantext.Database.A
dmin.Types
.Node
(
pgNodeId
)
import
Gargantext.Database.Admin.Config
(
nodeTypeId
)
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
,
DocId
)
import
Gargantext.Database.Admin.Utils
import
Gargantext.Database.Schema.Node
import
Gargantext.Prelude
import
Opaleye
import
qualified
Database.PostgreSQL.Simple
as
PGS
(
Query
,
Only
(
..
))
...
...
src/Gargantext/Database/Schema/NodeNodeNgrams.hs
View file @
f7186aaa
...
...
@@ -28,7 +28,7 @@ import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
import
Control.Lens.TH
(
makeLenses
)
import
Gargantext.Database.Admin.Utils
(
Cmd
,
mkCmd
)
import
Gargantext.Database.Schema.Ngrams
(
NgramsTypeId
,
pgNgramsTypeId
,
NgramsId
)
import
Gargantext.Database.A
ction.Query
.Node
(
pgNodeId
)
import
Gargantext.Database.A
dmin.Types
.Node
(
pgNodeId
)
import
Gargantext.Database.Admin.Types.Node
import
Opaleye
...
...
src/Gargantext/Database/Schema/NodeNodeNgrams2.hs
View file @
f7186aaa
...
...
@@ -26,7 +26,7 @@ module Gargantext.Database.Schema.NodeNodeNgrams2
import
Control.Lens.TH
(
makeLenses
)
import
Data.Profunctor.Product.TH
(
makeAdaptorAndInstance
)
import
Gargantext.Database.Schema.NodeNgrams
(
NodeNgramsId
)
import
Gargantext.Database.A
ction.Query
.Node
(
pgNodeId
)
import
Gargantext.Database.A
dmin.Types
.Node
(
pgNodeId
)
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Admin.Utils
(
Cmd
,
mkCmd
)
import
Opaleye
...
...
src/Gargantext/Database/Schema/Node_NodeNgramsNodeNgrams.hs
View file @
f7186aaa
...
...
@@ -40,8 +40,8 @@ import Control.Lens.TH (makeLensesWith, abbreviatedFields)
import
Data.Maybe
(
Maybe
)
import
Data.Profunctor.Product.TH
(
makeAdaptorAndInstance
)
import
Gargantext.Database.Admin.Utils
(
Cmd
,
runOpaQuery
,
mkCmd
)
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
)
import
Gargantext.Database.
Action.Query.Node
(
pgNodeId
)
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
,
pgNodeId
)
import
Gargantext.Database.
Schema.Node
import
Gargantext.Prelude
import
Opaleye
...
...
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