Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
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
Przemyslaw Kaminski
haskell-gargantext
Commits
70057b4c
Commit
70057b4c
authored
4 years ago
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FIX] Instances declations: HasDBid NodeType (more ids for types coming)
parent
b5c9a011
Changes
9
Hide whitespace changes
Inline
Side-by-side
Showing
9 changed files
with
78 additions
and
56 deletions
+78
-56
Delete.hs
src/Gargantext/Database/Action/Delete.hs
+0
-1
Learn.hs
src/Gargantext/Database/Action/Learn.hs
+6
-3
Node.hs
src/Gargantext/Database/Action/Node.hs
+4
-3
Search.hs
src/Gargantext/Database/Action/Search.hs
+21
-14
Node.hs
src/Gargantext/Database/Admin/Types/Node.hs
+3
-4
Prelude.hs
src/Gargantext/Database/Prelude.hs
+4
-5
Node.hs
src/Gargantext/Database/Query/Table/Node.hs
+32
-22
UpdateOpaleye.hs
src/Gargantext/Database/Query/Table/Node/UpdateOpaleye.hs
+6
-3
User.hs
src/Gargantext/Database/Query/Table/Node/User.hs
+2
-1
No files found.
src/Gargantext/Database/Action/Delete.hs
View file @
70057b4c
...
...
@@ -25,7 +25,6 @@ import Gargantext.Core.Types.Individu (User(..))
import
Gargantext.Database.Action.User
(
getUserId
)
import
Gargantext.Database.Action.Share
(
delFolderTeam
)
import
Gargantext.Core
import
Gargantext.Database.Admin.Config
import
Gargantext.Database.Admin.Types.Hyperdata.File
import
Gargantext.Database.Admin.Types.Node
-- (NodeType(..))
import
Gargantext.Database.Prelude
(
Cmd
'
,
HasConfig
,
HasConnectionPool
)
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/Database/Action/Learn.hs
View file @
70057b4c
...
...
@@ -17,6 +17,7 @@ module Gargantext.Database.Action.Learn
import
Data.Maybe
import
Data.Text
(
Text
)
import
Gargantext.Core
import
Gargantext.Core.Types
(
Offset
,
Limit
)
import
Gargantext.Database.Query.Facet
import
Gargantext.Database.Admin.Types.Hyperdata
...
...
@@ -31,14 +32,15 @@ data FavOrTrash = IsFav | IsTrash
deriving
(
Eq
)
moreLike
::
CorpusId
->
Maybe
Offset
->
Maybe
Limit
->
Maybe
OrderBy
moreLike
::
HasDBid
NodeType
=>
CorpusId
->
Maybe
Offset
->
Maybe
Limit
->
Maybe
OrderBy
->
FavOrTrash
->
Cmd
err
[
FacetDoc
]
moreLike
cId
o
_l
order
ft
=
do
priors
<-
getPriors
ft
cId
moreLikeWith
cId
o
(
Just
3
)
order
ft
priors
---------------------------------------------------------------------------
getPriors
::
FavOrTrash
->
CorpusId
->
Cmd
err
(
Events
Bool
)
getPriors
::
HasDBid
NodeType
=>
FavOrTrash
->
CorpusId
->
Cmd
err
(
Events
Bool
)
getPriors
ft
cId
=
do
docs_fav
<-
filter
(
\
(
FacetDoc
_
_
_
_
f
_
_
)
->
f
==
Just
2
)
...
...
@@ -54,7 +56,8 @@ getPriors ft cId = do
pure
priors
moreLikeWith
::
CorpusId
->
Maybe
Offset
->
Maybe
Limit
->
Maybe
OrderBy
moreLikeWith
::
HasDBid
NodeType
=>
CorpusId
->
Maybe
Offset
->
Maybe
Limit
->
Maybe
OrderBy
->
FavOrTrash
->
Events
Bool
->
Cmd
err
[
FacetDoc
]
moreLikeWith
cId
o
l
order
ft
priors
=
do
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/Database/Action/Node.hs
View file @
70057b4c
...
...
@@ -20,6 +20,7 @@ Portability : POSIX
module
Gargantext.Database.Action.Node
where
import
Gargantext.Core
import
Gargantext.Core.Types
(
Name
)
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Hyperdata.Default
...
...
@@ -35,7 +36,7 @@ import Gargantext.Prelude.Config (GargConfig(..))
------------------------------------------------------------------------
-- | TODO mk all others nodes
mkNodeWithParent
::
(
HasNodeError
err
)
mkNodeWithParent
::
(
HasNodeError
err
,
HasDBid
NodeType
)
=>
NodeType
->
Maybe
ParentId
->
UserId
...
...
@@ -66,7 +67,7 @@ mkNodeWithParent nt (Just pId) uId name = insertNode nt (Just name) Nothing pId
-- | Sugar to create a node, get its NodeId and update its Hyperdata after
mkNodeWithParent_ConfigureHyperdata
::
(
HasNodeError
err
)
mkNodeWithParent_ConfigureHyperdata
::
(
HasNodeError
err
,
HasDBid
NodeType
)
=>
NodeType
->
Maybe
ParentId
->
UserId
...
...
@@ -85,7 +86,7 @@ mkNodeWithParent_ConfigureHyperdata _ _ _ _ = nodeError NotImplYet
-- | Function not exposed
mkNodeWithParent_ConfigureHyperdata'
::
(
HasNodeError
err
)
mkNodeWithParent_ConfigureHyperdata'
::
(
HasNodeError
err
,
HasDBid
NodeType
)
=>
NodeType
->
Maybe
ParentId
->
UserId
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/Database/Action/Search.hs
View file @
70057b4c
...
...
@@ -24,7 +24,6 @@ import Database.PostgreSQL.Simple (Query)
import
Database.PostgreSQL.Simple.ToField
import
Gargantext.Core
import
Gargantext.Core.Types
import
Gargantext.Database.Admin.Config
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataDocument
(
..
),
HyperdataContact
(
..
))
import
Gargantext.Database.Prelude
(
Cmd
,
runPGSQuery
,
runOpaQuery
,
runCountOpaQuery
)
import
Gargantext.Database.Query.Facet
...
...
@@ -40,9 +39,10 @@ import Data.Profunctor.Product (p4)
import
qualified
Opaleye
as
O
hiding
(
Order
)
------------------------------------------------------------------------
searchDocInDatabase
::
ParentId
->
Text
->
Cmd
err
[(
NodeId
,
HyperdataDocument
)]
searchDocInDatabase
::
HasDBid
NodeType
=>
ParentId
->
Text
->
Cmd
err
[(
NodeId
,
HyperdataDocument
)]
searchDocInDatabase
p
t
=
runOpaQuery
(
queryDocInDatabase
p
t
)
where
-- | Global search query where ParentId is Master Node Corpus Id
...
...
@@ -55,7 +55,8 @@ searchDocInDatabase p t = runOpaQuery (queryDocInDatabase p t)
------------------------------------------------------------------------
-- | todo add limit and offset and order
searchInCorpus
::
CorpusId
searchInCorpus
::
HasDBid
NodeType
=>
CorpusId
->
IsTrash
->
[
Text
]
->
Maybe
Offset
...
...
@@ -68,7 +69,8 @@ searchInCorpus cId t q o l order = runOpaQuery
$
intercalate
" | "
$
map
stemIt
q
searchCountInCorpus
::
CorpusId
searchCountInCorpus
::
HasDBid
NodeType
=>
CorpusId
->
IsTrash
->
[
Text
]
->
Cmd
err
Int
...
...
@@ -77,7 +79,8 @@ searchCountInCorpus cId t q = runCountOpaQuery
$
intercalate
" | "
$
map
stemIt
q
queryInCorpus
::
CorpusId
queryInCorpus
::
HasDBid
NodeType
=>
CorpusId
->
IsTrash
->
Text
->
O
.
Query
FacetDocRead
...
...
@@ -105,7 +108,8 @@ joinInCorpus = leftJoin queryNodeSearchTable queryNodeNodeTable cond
------------------------------------------------------------------------
searchInCorpusWithContacts
::
CorpusId
::
HasDBid
NodeType
=>
CorpusId
->
AnnuaireId
->
[
Text
]
->
Maybe
Offset
...
...
@@ -121,7 +125,8 @@ searchInCorpusWithContacts cId aId q o l _order =
$
map
stemIt
q
selectContactViaDoc
::
CorpusId
::
HasDBid
NodeType
=>
CorpusId
->
AnnuaireId
->
Text
->
QueryArr
()
...
...
@@ -143,10 +148,11 @@ selectContactViaDoc cId aId q = proc () -> do
,
toNullable
$
pgInt4
1
)
selectGroup
::
NodeId
->
NodeId
->
Text
->
Select
FacetPairedReadNull
selectGroup
::
HasDBid
NodeType
=>
NodeId
->
NodeId
->
Text
->
Select
FacetPairedReadNull
selectGroup
cId
aId
q
=
proc
()
->
do
(
a
,
b
,
c
,
d
)
<-
aggregate
(
p4
(
groupBy
,
groupBy
,
groupBy
,
O
.
sum
))
(
selectContactViaDoc
cId
aId
q
)
-<
()
...
...
@@ -261,7 +267,8 @@ textSearchQuery = "SELECT n.id, n.hyperdata->'publication_year' \
-- Example:
-- textSearchTest :: ParentId -> TSQuery -> Cmd err [(Int, Value, Value, Value, Value, Maybe Int)]
-- textSearchTest pId q = textSearch q pId 5 0 Asc
textSearch
::
TSQuery
->
ParentId
textSearch
::
HasDBid
NodeType
=>
TSQuery
->
ParentId
->
Limit
->
Offset
->
Order
->
Cmd
err
[(
Int
,
Value
,
Value
,
Value
,
Value
,
Maybe
Int
)]
textSearch
q
p
l
o
ord
=
runPGSQuery
textSearchQuery
(
q
,
p
,
p
,
typeId
,
ord
,
o
,
l
)
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/Database/Admin/Types/Node.hs
View file @
70057b4c
...
...
@@ -42,7 +42,7 @@ import Test.QuickCheck.Instances.Time ()
import
Text.Read
(
read
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixSwagger
,
wellNamedSchema
)
import
Gargantext.Database.Prelude
(
fromField'
)
--
import Gargantext.Database.Prelude (fromField')
import
Gargantext.Database.Schema.Node
import
Gargantext.Prelude
...
...
@@ -324,17 +324,16 @@ instance Arbitrary NodeType where
------------------------------------------------------------------------
-- Instances
------------------------------------------------------------------------
instance
ToSchema
Status
where
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"status_"
)
------------------------------------------------------------------------
{-
instance FromField (NodeId, Text)
where
fromField = fromField'
-}
------------------------------------------------------------------------
instance
QueryRunnerColumnDefault
PGTSVector
(
Maybe
TSVector
)
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/Database/Prelude.hs
View file @
70057b4c
...
...
@@ -13,12 +13,12 @@ Portability : POSIX
module
Gargantext.Database.Prelude
where
-- import Control.Monad.Error.Class -- (MonadError(..), Error)
import
Control.Exception
import
Control.Lens
(
Getter
,
view
)
-- import Control.Monad.Error.Class -- (MonadError(..), Error)
import
Control.Monad.Except
import
Control.Monad.Reader
import
Control.Monad.Random
import
Control.Monad.Reader
import
Control.Monad.Trans.Control
(
MonadBaseControl
)
import
Data.Aeson
(
Result
(
Error
,
Success
),
fromJSON
,
FromJSON
)
import
Data.ByteString.Char8
(
hPutStrLn
)
...
...
@@ -31,6 +31,8 @@ import Data.Word (Word16)
import
Database.PostgreSQL.Simple
(
Connection
,
connect
)
import
Database.PostgreSQL.Simple.FromField
(
Conversion
,
ResultError
(
ConversionFailed
),
fromField
,
returnError
)
import
Database.PostgreSQL.Simple.Internal
(
Field
)
import
Gargantext.Prelude
import
Gargantext.Prelude.Config
(
GargConfig
())
import
Opaleye
(
Query
,
Unpackspec
,
showSqlForPostgres
,
FromFields
,
Select
,
runQuery
,
PGJsonb
,
QueryRunnerColumnDefault
)
import
Opaleye.Aggregate
(
countRows
)
import
System.IO
(
FilePath
)
...
...
@@ -40,9 +42,6 @@ import qualified Data.ByteString as DB
import
qualified
Data.List
as
DL
import
qualified
Database.PostgreSQL.Simple
as
PGS
import
Gargantext.Prelude
import
Gargantext.Prelude.Config
(
GargConfig
())
-------------------------------------------------------
class
HasConnectionPool
env
where
connPool
::
Getter
env
(
Pool
Connection
)
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/Database/Query/Table/Node.hs
View file @
70057b4c
...
...
@@ -59,7 +59,8 @@ runGetNodes = runOpaQuery
------------------------------------------------------------------------
-- | order by publication date
-- Favorites (Bool), node_ngrams
selectNodesWith
::
ParentId
->
Maybe
NodeType
selectNodesWith
::
HasDBid
NodeType
=>
ParentId
->
Maybe
NodeType
->
Maybe
Offset
->
Maybe
Limit
->
Query
NodeRead
selectNodesWith
parentId
maybeNodeType
maybeOffset
maybeLimit
=
--offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId
...
...
@@ -67,7 +68,8 @@ selectNodesWith parentId maybeNodeType maybeOffset maybeLimit =
$
orderBy
(
asc
_node_id
)
$
selectNodesWith'
parentId
maybeNodeType
selectNodesWith'
::
ParentId
->
Maybe
NodeType
->
Query
NodeRead
selectNodesWith'
::
HasDBid
NodeType
=>
ParentId
->
Maybe
NodeType
->
Query
NodeRead
selectNodesWith'
parentId
maybeNodeType
=
proc
()
->
do
node'
<-
(
proc
()
->
do
row
@
(
Node
_
_
typeId
_
parentId'
_
_
_
)
<-
queryNodeTable
-<
()
...
...
@@ -92,7 +94,7 @@ deleteNodes ns = mkCmd $ \conn ->
(
\
(
Node
n_id
_
_
_
_
_
_
_
)
->
in_
((
map
pgNodeId
ns
))
n_id
)
-- TODO: NodeType should match with `a'
getNodesWith
::
JSONB
a
=>
NodeId
->
proxy
a
->
Maybe
NodeType
getNodesWith
::
(
JSONB
a
,
HasDBid
NodeType
)
=>
NodeId
->
proxy
a
->
Maybe
NodeType
->
Maybe
Offset
->
Maybe
Limit
->
Cmd
err
[
Node
a
]
getNodesWith
parentId
_
nodeType
maybeOffset
maybeLimit
=
runOpaQuery
$
selectNodesWith
parentId
nodeType
maybeOffset
maybeLimit
...
...
@@ -112,7 +114,8 @@ getNodesWithParentId n = runOpaQuery $ selectNodesWithParentID n'
-- | Given a node id, find it's closest parent of given type
-- NOTE: This isn't too optimal: can make successive queries depending on how
-- deeply nested the child is.
getClosestParentIdByType
::
NodeId
getClosestParentIdByType
::
HasDBid
NodeType
=>
NodeId
->
NodeType
->
Cmd
err
(
Maybe
NodeId
)
getClosestParentIdByType
nId
nType
=
do
...
...
@@ -134,17 +137,17 @@ getClosestParentIdByType nId nType = do
|]
------------------------------------------------------------------------
getDocumentsV3WithParentId
::
NodeId
->
Cmd
err
[
Node
HyperdataDocumentV3
]
getDocumentsV3WithParentId
::
HasDBid
NodeType
=>
NodeId
->
Cmd
err
[
Node
HyperdataDocumentV3
]
getDocumentsV3WithParentId
n
=
runOpaQuery
$
selectNodesWith'
n
(
Just
NodeDocument
)
-- TODO: merge with getDocumentsWithParentId by having a class IsHyperdataDocument
getDocumentsWithParentId
::
NodeId
->
Cmd
err
[
Node
HyperdataDocument
]
getDocumentsWithParentId
::
HasDBid
NodeType
=>
NodeId
->
Cmd
err
[
Node
HyperdataDocument
]
getDocumentsWithParentId
n
=
runOpaQuery
$
selectNodesWith'
n
(
Just
NodeDocument
)
getListsModelWithParentId
::
NodeId
->
Cmd
err
[
Node
HyperdataModel
]
getListsModelWithParentId
::
HasDBid
NodeType
=>
NodeId
->
Cmd
err
[
Node
HyperdataModel
]
getListsModelWithParentId
n
=
runOpaQuery
$
selectNodesWith'
n
(
Just
NodeModel
)
getCorporaWithParentId
::
NodeId
->
Cmd
err
[
Node
HyperdataCorpus
]
getCorporaWithParentId
::
HasDBid
NodeType
=>
NodeId
->
Cmd
err
[
Node
HyperdataCorpus
]
getCorporaWithParentId
n
=
runOpaQuery
$
selectNodesWith'
n
(
Just
NodeCorpus
)
------------------------------------------------------------------------
...
...
@@ -158,21 +161,23 @@ selectNodesWithParentID n = proc () -> do
------------------------------------------------------------------------
-- | Example of use:
-- runCmdReplEasy (getNodesWithType NodeList (Proxy :: Proxy HyperdataList))
getNodesWithType
::
(
HasNodeError
err
,
JSONB
a
)
=>
NodeType
->
proxy
a
->
Cmd
err
[
Node
a
]
getNodesWithType
::
(
HasNodeError
err
,
JSONB
a
,
HasDBid
NodeType
)
=>
NodeType
->
proxy
a
->
Cmd
err
[
Node
a
]
getNodesWithType
nt
_
=
runOpaQuery
$
selectNodesWithType
nt
where
selectNodesWithType
::
NodeType
->
Query
NodeRead
selectNodesWithType
::
HasDBid
NodeType
=>
NodeType
->
Query
NodeRead
selectNodesWithType
nt'
=
proc
()
->
do
row
@
(
Node
_
_
tn
_
_
_
_
_
)
<-
queryNodeTable
-<
()
restrict
-<
tn
.==
(
pgInt4
$
hasDBid
nt'
)
returnA
-<
row
getNodesIdWithType
::
HasNodeError
err
=>
NodeType
->
Cmd
err
[
NodeId
]
getNodesIdWithType
::
(
HasNodeError
err
,
HasDBid
NodeType
)
=>
NodeType
->
Cmd
err
[
NodeId
]
getNodesIdWithType
nt
=
do
ns
<-
runOpaQuery
$
selectNodesIdWithType
nt
pure
(
map
NodeId
ns
)
selectNodesIdWithType
::
NodeType
->
Query
(
Column
PGInt4
)
selectNodesIdWithType
::
HasDBid
NodeType
=>
NodeType
->
Query
(
Column
PGInt4
)
selectNodesIdWithType
nt
=
proc
()
->
do
row
@
(
Node
_
_
tn
_
_
_
_
_
)
<-
queryNodeTable
-<
()
restrict
-<
tn
.==
(
pgInt4
$
hasDBid
nt
)
...
...
@@ -199,20 +204,23 @@ getNodeWith nId _ = do
------------------------------------------------------------------------
-- | Sugar to insert Node with NodeType in Database
insertDefaultNode
::
NodeType
->
ParentId
->
UserId
->
Cmd
err
[
NodeId
]
insertDefaultNode
::
HasDBid
NodeType
=>
NodeType
->
ParentId
->
UserId
->
Cmd
err
[
NodeId
]
insertDefaultNode
nt
p
u
=
insertNode
nt
Nothing
Nothing
p
u
insertNode
::
NodeType
->
Maybe
Name
->
Maybe
DefaultHyperdata
->
ParentId
->
UserId
->
Cmd
err
[
NodeId
]
insertNode
::
HasDBid
NodeType
=>
NodeType
->
Maybe
Name
->
Maybe
DefaultHyperdata
->
ParentId
->
UserId
->
Cmd
err
[
NodeId
]
insertNode
nt
n
h
p
u
=
insertNodesR
[
nodeW
nt
n
h
p
u
]
nodeW
::
NodeType
->
Maybe
Name
->
Maybe
DefaultHyperdata
->
ParentId
->
UserId
->
NodeWrite
nodeW
::
HasDBid
NodeType
=>
NodeType
->
Maybe
Name
->
Maybe
DefaultHyperdata
->
ParentId
->
UserId
->
NodeWrite
nodeW
nt
n
h
p
u
=
node
nt
n'
h'
(
Just
p
)
u
where
n'
=
fromMaybe
(
defaultName
nt
)
n
h'
=
maybe
(
defaultHyperdata
nt
)
identity
h
------------------------------------------------------------------------
node
::
(
ToJSON
a
,
Hyperdata
a
)
node
::
(
ToJSON
a
,
Hyperdata
a
,
HasDBid
NodeType
)
=>
NodeType
->
Name
->
a
...
...
@@ -265,7 +273,8 @@ insertNodesWithParentR pid ns = insertNodesR (set node_parentId (pgNodeId <$> pi
-- currently this function removes the child relation
-- needs a Temporary type between Node' and NodeWriteT
node2table
::
UserId
->
Maybe
ParentId
->
Node'
->
NodeWrite
node2table
::
HasDBid
NodeType
=>
UserId
->
Maybe
ParentId
->
Node'
->
NodeWrite
node2table
uid
pid
(
Node'
nt
txt
v
[]
)
=
Node
Nothing
Nothing
(
pgInt4
$
hasDBid
nt
)
(
pgInt4
uid
)
(
fmap
pgNodeId
pid
)
(
pgStrictText
txt
)
Nothing
(
pgStrictJSONB
$
cs
$
encode
v
)
node2table
_
_
(
Node'
_
_
_
_
)
=
panic
"node2table: should not happen, Tree insert not implemented yet"
...
...
@@ -284,7 +293,8 @@ mkNodeR :: [NodeWrite] -> Cmd err [NodeId]
mkNodeR
ns
=
mkCmd
$
\
conn
->
runInsert_
conn
$
Insert
nodeTable
ns
(
rReturning
_node_id
)
Nothing
------------------------------------------------------------------------
childWith
::
UserId
->
ParentId
->
Node'
->
NodeWrite
childWith
::
HasDBid
NodeType
=>
UserId
->
ParentId
->
Node'
->
NodeWrite
childWith
uId
pId
(
Node'
NodeDocument
txt
v
[]
)
=
node2table
uId
(
Just
pId
)
(
Node'
NodeDocument
txt
v
[]
)
childWith
uId
pId
(
Node'
NodeContact
txt
v
[]
)
=
node2table
uId
(
Just
pId
)
(
Node'
NodeContact
txt
v
[]
)
childWith
_
_
(
Node'
_
_
_
_
)
=
panic
"This NodeType can not be a child"
...
...
@@ -298,7 +308,7 @@ data CorpusType = CorpusDocument | CorpusContact
class
MkCorpus
a
where
mk
::
Maybe
Name
->
Maybe
a
->
ParentId
->
UserId
->
Cmd
err
[
NodeId
]
mk
::
HasDBid
NodeType
=>
Maybe
Name
->
Maybe
a
->
ParentId
->
UserId
->
Cmd
err
[
NodeId
]
instance
MkCorpus
HyperdataCorpus
where
...
...
@@ -312,7 +322,7 @@ instance MkCorpus HyperdataAnnuaire
mk
n
(
Just
h
)
p
u
=
insertNode
NodeAnnuaire
n
(
Just
$
DefaultAnnuaire
h
)
p
u
getOrMkList
::
HasNodeError
err
getOrMkList
::
(
HasNodeError
err
,
HasDBid
NodeType
)
=>
ParentId
->
UserId
->
Cmd
err
ListId
...
...
@@ -322,11 +332,11 @@ getOrMkList pId uId =
mkList'
pId'
uId'
=
maybe
(
nodeError
MkNode
)
pure
.
headMay
=<<
insertDefaultNode
NodeList
pId'
uId'
-- | TODO remove defaultList
defaultList
::
HasNodeError
err
=>
CorpusId
->
Cmd
err
ListId
defaultList
::
(
HasNodeError
err
,
HasDBid
NodeType
)
=>
CorpusId
->
Cmd
err
ListId
defaultList
cId
=
maybe
(
nodeError
NoListFound
)
(
pure
.
view
node_id
)
.
headMay
=<<
getListsWithParentId
cId
getListsWithParentId
::
NodeId
->
Cmd
err
[
Node
HyperdataList
]
getListsWithParentId
::
HasDBid
NodeType
=>
NodeId
->
Cmd
err
[
Node
HyperdataList
]
getListsWithParentId
n
=
runOpaQuery
$
selectNodesWith'
n
(
Just
NodeList
)
This diff is collapsed.
Click to expand it.
src/Gargantext/Database/Query/Table/Node/UpdateOpaleye.hs
View file @
70057b4c
...
...
@@ -17,6 +17,7 @@ module Gargantext.Database.Query.Table.Node.UpdateOpaleye
import
Opaleye
import
Data.Aeson
(
encode
,
ToJSON
)
import
Gargantext.Core
import
Gargantext.Prelude
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Admin.Types.Node
...
...
@@ -42,6 +43,7 @@ updateHyperdataQuery i h = Update
updateNodesWithType
::
(
HasNodeError
err
,
JSONB
a
,
ToJSON
a
,
HasDBid
NodeType
)
=>
NodeType
->
proxy
a
->
(
a
->
a
)
->
Cmd
err
[
Int64
]
updateNodesWithType
nt
p
f
=
do
ns
<-
getNodesWithType
nt
p
...
...
@@ -50,9 +52,10 @@ updateNodesWithType nt p f = do
-- | In case the Hyperdata Types are not compatible
updateNodesWithType_
::
(
HasNodeError
err
,
JSONB
a
,
ToJSON
a
)
=>
NodeType
->
a
->
Cmd
err
[
Int64
]
,
JSONB
a
,
ToJSON
a
,
HasDBid
NodeType
)
=>
NodeType
->
a
->
Cmd
err
[
Int64
]
updateNodesWithType_
nt
h
=
do
ns
<-
getNodesIdWithType
nt
mapM
(
\
n
->
updateHyperdata
n
h
)
ns
...
...
This diff is collapsed.
Click to expand it.
src/Gargantext/Database/Query/Table/Node/User.hs
View file @
70057b4c
...
...
@@ -13,6 +13,7 @@ module Gargantext.Database.Query.Table.Node.User
where
import
Data.Maybe
(
fromMaybe
)
import
Gargantext.Core
import
Gargantext.Core.Types
(
Name
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataUser
(
..
),
defaultHyperdataUser
)
import
Gargantext.Database.Admin.Types.Node
(
Node
,
NodeId
(
..
),
UserId
,
NodeType
(
..
),
pgNodeId
)
...
...
@@ -28,7 +29,7 @@ getNodeUser nId = do
fromMaybe
(
panic
$
"Node does not exist: "
<>
(
cs
$
show
nId
))
.
headMay
<$>
runOpaQuery
(
limit
1
$
selectNode
(
pgNodeId
nId
))
nodeUserW
::
Maybe
Name
->
Maybe
HyperdataUser
->
UserId
->
NodeWrite
nodeUserW
::
HasDBid
NodeType
=>
Maybe
Name
->
Maybe
HyperdataUser
->
UserId
->
NodeWrite
nodeUserW
maybeName
maybeHyperdata
=
node
NodeUser
name
user
Nothing
where
name
=
maybe
"User"
identity
maybeName
...
...
This diff is collapsed.
Click to expand it.
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