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
0ee7da5d
Commit
0ee7da5d
authored
Nov 06, 2018
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[API][NGRAMS] Table routes to patch (group and typeList).
parent
cbc7f171
Changes
9
Hide whitespace changes
Inline
Side-by-side
Showing
9 changed files
with
240 additions
and
63 deletions
+240
-63
Ngrams.hs
src/Gargantext/API/Ngrams.hs
+40
-33
Node.hs
src/Gargantext/API/Node.hs
+2
-1
Flow.hs
src/Gargantext/Database/Flow.hs
+3
-3
Ngrams.hs
src/Gargantext/Database/Ngrams.hs
+2
-2
Node.hs
src/Gargantext/Database/Node.hs
+19
-16
NodeNgram.hs
src/Gargantext/Database/NodeNgram.hs
+5
-7
NodeNgramsNgrams.hs
src/Gargantext/Database/NodeNgramsNgrams.hs
+160
-0
Types.hs
src/Gargantext/Text/List/Types.hs
+8
-0
Phylo.hs
src/Gargantext/Viz/Phylo.hs
+1
-1
No files found.
src/Gargantext/API/Ngrams.hs
View file @
0ee7da5d
...
...
@@ -30,35 +30,35 @@ add get
module
Gargantext.API.Ngrams
where
import
Prelude
(
Enum
,
Bounded
,
minBound
,
maxBound
)
import
Control.Monad.IO.Class
(
liftIO
)
import
Data.Aeson
(
FromJSON
,
ToJSON
)
import
Data.Either
(
Either
(
Left
))
import
Data.Aeson.TH
(
deriveJSON
)
import
Database.PostgreSQL.Simple
(
Connection
)
import
Data.Map.Strict
(
Map
)
import
GHC.Generics
(
Generic
)
--import qualified Data.Map.Strict as DM
-- import Gargantext.Database.User (UserId)
--import Data.Map.Strict.Patch (Patch, replace, fromList)
import
Data.Text
(
Text
)
--import Data.Maybe (catMaybes)
import
Data.Set
(
Set
)
--import qualified Data.Map.Strict as DM
--import qualified Data.Set as Set
import
Control.Lens
(
view
)
import
Data.Aeson
(
FromJSON
,
ToJSON
)
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Either
(
Either
(
Left
))
import
Data.List
(
concat
)
import
Data.Set
(
Set
)
import
Data.Swagger
(
ToSchema
,
ToParamSchema
)
import
Data.Text
(
Text
)
import
Database.PostgreSQL.Simple
(
Connection
)
import
GHC.Generics
(
Generic
)
import
Gargantext.Database.Ngram
(
NgramsId
)
import
Gargantext.Database.NodeNgram
(
updateNodeNgrams
)
import
Gargantext.Database.User
(
UserId
)
import
Gargantext.Text.List.Types
(
ListType
(
..
))
import
Gargantext.Core.Types
(
node_id
)
import
Gargantext.Core.Types.Main
(
Tree
(
..
))
import
Gargantext.Core.Utils.Prefix
(
unPrefix
)
import
Gargantext.Database.Ngrams
(
NgramsId
)
import
Gargantext.Database.Node
(
getListsWithParentId
)
import
Gargantext.Database.NodeNgram
-- (NodeNgram(..), NodeNgram, updateNodeNgrams, NodeNgramPoly)
import
Gargantext.Database.NodeNgramsNgrams
-- (NodeNgramsNgramsPoly(NodeNgramsNgrams))
import
Gargantext.Prelude
import
Gargantext.Text.List.Types
(
ListType
(
..
),
listTypeId
,
ListId
,
ListTypeId
)
import
Prelude
(
Enum
,
Bounded
,
minBound
,
maxBound
)
import
Servant
hiding
(
Patch
)
import
Data.Swagger
(
ToSchema
,
ToParamSchema
)
import
Test.QuickCheck
(
elements
)
import
Test.QuickCheck.Arbitrary
(
Arbitrary
,
arbitrary
)
import
qualified
Data.Set
as
Set
------------------------------------------------------------------------
--data FacetFormat = Table | Chart
...
...
@@ -108,7 +108,7 @@ instance ToJSON (Tree NgramsElement)
-- | SetListType NgramsId ListType
data
NgramsPatch
=
NgramsPatch
{
_np_list_types
::
Map
UserId
ListType
NgramsPatch
{
_np_list_types
::
ListType
-- TODO
Map UserId ListType
,
_np_add_children
::
Set
NgramsId
,
_np_rem_children
::
Set
NgramsId
}
...
...
@@ -178,7 +178,6 @@ ngramsIdPatch = fromList $ catMaybes $ reverse [ replace (1::NgramsId) (Just $ n
------------------------------------------------------------------------
------------------------------------------------------------------------
type
CorpusId
=
Int
type
ListId
=
Int
type
TableNgramsApi
=
Summary
" Table Ngrams API"
:>
QueryParam
"list"
ListId
:>
ReqBody
'[
J
SON
]
NgramsIdPatchs
...
...
@@ -188,27 +187,35 @@ type NgramsIdPatchsFeed = NgramsIdPatchs
type
NgramsIdPatchsBack
=
NgramsIdPatchs
getDefaultList
::
Connection
->
CorpusId
->
IO
ListId
getDefaultList
=
undefined
defaultList
::
Connection
->
CorpusId
->
IO
ListId
defaultList
c
cId
=
view
node_id
<$>
maybe
(
panic
errorMessage
)
identity
<$>
head
<$>
getListsWithParentId
c
cId
where
errorMessage
=
"Gargantext.API.Ngrams.defaultList: no list found"
toLists
::
ListId
->
NgramsIdPatchs
->
[(
ListId
,
NgramsId
,
ListTypeId
)]
toLists
lId
np
=
map
(
toList
lId
)
(
_nip_ngramsIdPatchs
np
)
t
ype
NgramsIdParent
=
Int
t
ype
NgramsIdChild
=
Int
t
oList
::
ListId
->
NgramsIdPatch
->
(
ListId
,
NgramsId
,
ListTypeId
)
t
oList
lId
(
NgramsIdPatch
ngId
(
NgramsPatch
lt
_
_
))
=
(
lId
,
ngId
,
listTypeId
lt
)
data
Action
=
Del
|
Add
toGroups
::
ListId
->
(
NgramsPatch
->
Set
NgramsId
)
->
NgramsIdPatchs
->
[
NodeNgramsNgrams
]
toGroups
lId
addOrRem
ps
=
concat
$
map
(
toGroup
lId
addOrRem
)
$
_nip_ngramsIdPatchs
ps
doNgramsGroup
::
Connection
->
ListId
->
Action
->
[(
NgramsIdParent
,
NgramsIdChild
)]
->
IO
[
Int
]
doNgramsGroup
=
undefined
toGroup
::
ListId
->
(
NgramsPatch
->
Set
NgramsId
)
->
NgramsIdPatch
->
[
NodeNgramsNgrams
]
toGroup
lId
addOrRem
(
NgramsIdPatch
ngId
patch
)
=
map
(
\
ng
->
(
NodeNgramsNgrams
lId
ngId
ng
(
Just
1
)))
(
Set
.
toList
$
addOrRem
patch
)
tableNgramsPatch
::
Connection
->
CorpusId
->
Maybe
ListId
->
NgramsIdPatchsFeed
->
IO
NgramsIdPatchsBack
tableNgramsPatch
conn
corpusId
maybeList
patchs
=
do
listId
<-
case
maybeList
of
Nothing
->
getD
efaultList
conn
corpusId
Nothing
->
d
efaultList
conn
corpusId
Just
listId'
->
pure
listId'
--
_
<-
doNgramsGroups
conn
listId
Add
$
--
_
<-
delNgramsGroups
conn
listId
--
_
<-
updateNodeNgrams
conn
_
<-
ngramsGroup'
conn
Add
$
toGroups
listId
_np_add_children
patchs
_
<-
ngramsGroup'
conn
Del
$
toGroups
listId
_np_rem_children
patchs
_
<-
updateNodeNgrams
conn
(
toLists
listId
patchs
)
pure
(
NgramsIdPatchs
[]
)
src/Gargantext/API/Node.hs
View file @
0ee7da5d
...
...
@@ -48,7 +48,7 @@ import Database.PostgreSQL.Simple (Connection)
import
GHC.Generics
(
Generic
)
import
Servant
import
Gargantext.API.Ngrams
(
TabType
(
..
),
TableNgramsApi
,
tableNgramsPatch
,
NgramsIdPatchsFeed
,
NgramsIdPatchsBack
,
ListId
)
import
Gargantext.API.Ngrams
(
TabType
(
..
),
TableNgramsApi
,
tableNgramsPatch
,
NgramsIdPatchsFeed
,
NgramsIdPatchsBack
)
import
Gargantext.Prelude
import
Gargantext.Database.Types.Node
import
Gargantext.Database.Node
(
runCmd
...
...
@@ -62,6 +62,7 @@ import Gargantext.Database.Tree (treeDB, HasTreeError(..), TreeError(..))
import
Gargantext.Database.NodeNode
(
nodesToFavorite
,
nodesToTrash
)
-- Graph
import
Gargantext.Text.Flow
import
Gargantext.Text.List.Types
(
ListId
)
import
Gargantext.Viz.Graph
(
Graph
)
import
Gargantext.Core
(
Lang
(
..
))
import
Gargantext.Core.Types
(
Offset
,
Limit
)
...
...
src/Gargantext/Database/Flow.hs
View file @
0ee7da5d
...
...
@@ -40,10 +40,10 @@ import Gargantext.Database.User (getUser, UserLight(..), Username)
import
Gargantext.Database.Node.Document.Insert
(
insertDocuments
,
ReturnId
(
..
),
addUniqIds
)
import
Gargantext.Database.Node.Document.Add
(
add
)
import
Gargantext.Database.NodeNgram
(
NodeNgramPoly
(
..
),
insertNodeNgrams
)
import
Gargantext.Database.NodeNgram
Ngram
(
NodeNgramNgramPoly
(
..
),
insertNodeNgramNgram
)
import
Gargantext.Database.NodeNgram
sNgrams
(
NodeNgramsNgramsPoly
(
..
),
insertNodeNgramsNgramsNew
)
import
Gargantext.Text.Parsers
(
parseDocs
,
FileFormat
(
WOS
))
import
Gargantext.Database.Ngram
(
insertNgrams
,
Ngrams
(
..
),
NgramsT
(
..
),
NgramsIndexed
(
..
),
indexNgramsT
,
ngramsTypeId
)
import
Gargantext.Database.Ngram
s
(
insertNgrams
,
Ngrams
(
..
),
NgramsT
(
..
),
NgramsIndexed
(
..
),
indexNgramsT
,
ngramsTypeId
)
type
UserId
=
Int
type
RootId
=
Int
...
...
@@ -162,7 +162,7 @@ groupNgramsBy = undefined
insertGroups
::
ListId
->
Map
NgramsIndexed
NgramsIndexed
->
Cmd
Int
insertGroups
lId
ngrs
=
insertNodeNgram
Ngram
$
[
NodeNgramNgram
lId
ng1
ng2
(
Just
1
)
insertNodeNgram
sNgramsNew
$
[
NodeNgramsNgrams
lId
ng1
ng2
(
Just
1
)
|
(
ng1
,
ng2
)
<-
map
(
both
_ngramsId
)
$
DM
.
toList
ngrs
]
...
...
src/Gargantext/Database/Ngram.hs
→
src/Gargantext/Database/Ngram
s
.hs
View file @
0ee7da5d
{-|
Module : Gargantext.Database.Ngram
Module : Gargantext.Database.Ngram
s
Description : Ngram connection to the Database
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
...
...
@@ -21,7 +21,7 @@ Ngrams connection to the Database.
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module
Gargantext.Database.Ngram
where
module
Gargantext.Database.Ngram
s
where
-- import Opaleye
import
Control.Lens
(
makeLenses
)
...
...
src/Gargantext/Database/Node.hs
View file @
0ee7da5d
...
...
@@ -66,6 +66,7 @@ import Opaleye hiding (FromField)
import
Opaleye.Internal.QueryArr
(
Query
)
import
qualified
Data.Profunctor.Product
as
PP
------------------------------------------------------------------------
------------------------------------------------------------------------
{- | Reader Monad reinvented here:
...
...
@@ -110,6 +111,9 @@ instance FromField HyperdataDocumentV3 where
instance
FromField
HyperdataUser
where
fromField
=
fromField'
instance
FromField
HyperdataList
where
fromField
=
fromField'
instance
FromField
HyperdataAnnuaire
where
fromField
=
fromField'
------------------------------------------------------------------------
...
...
@@ -128,6 +132,9 @@ instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus where
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataUser
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataList
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
instance
QueryRunnerColumnDefault
PGJsonb
HyperdataAnnuaire
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
------------------------------------------------------------------------
...
...
@@ -222,15 +229,15 @@ selectNodesWith parentId maybeNodeType maybeOffset maybeLimit =
selectNodesWith'
::
ParentId
->
Maybe
NodeType
->
Query
NodeRead
selectNodesWith'
parentId
maybeNodeType
=
proc
()
->
do
node
<-
(
proc
()
->
do
row
@
(
Node
_
typeId
_
parentId'
_
_
_
)
<-
queryNodeTable
-<
()
restrict
-<
parentId'
.==
(
toNullable
$
pgInt4
parentId
)
row
@
(
Node
_
typeId
_
parentId'
_
_
_
)
<-
queryNodeTable
-<
()
restrict
-<
parentId'
.==
(
toNullable
$
pgInt4
parentId
)
let
typeId'
=
maybe
0
nodeTypeId
maybeNodeType
let
typeId'
=
maybe
0
nodeTypeId
maybeNodeType
restrict
-<
if
typeId'
>
0
then
typeId
.==
(
pgInt4
(
typeId'
::
Int
))
else
(
pgBool
True
)
returnA
-<
row
)
-<
()
restrict
-<
if
typeId'
>
0
then
typeId
.==
(
pgInt4
(
typeId'
::
Int
))
else
(
pgBool
True
)
returnA
-<
row
)
-<
()
returnA
-<
node
...
...
@@ -275,20 +282,18 @@ getDocumentsV3WithParentId conn n = runQuery conn $ selectNodesWith' n (Just Nod
getDocumentsWithParentId
::
Connection
->
Int
->
IO
[
Node
HyperdataDocument
]
getDocumentsWithParentId
conn
n
=
runQuery
conn
$
selectNodesWith'
n
(
Just
NodeDocument
)
------------------------------------------------------------------------
getListsWithParentId
::
Connection
->
Int
->
IO
[
Node
HyperdataList
]
getListsWithParentId
conn
n
=
runQuery
conn
$
selectNodesWith'
n
(
Just
NodeList
)
------------------------------------------------------------------------
selectNodesWithParentID
::
Int
->
Query
NodeRead
selectNodesWithParentID
n
=
proc
()
->
do
row
@
(
Node
_
_
_
parent_id
_
_
_
)
<-
queryNodeTable
-<
()
restrict
-<
if
n
>
0
then
parent_id
.==
(
toNullable
$
pgInt4
n
)
else
isNull
parent_id
then
parent_id
.==
(
toNullable
$
pgInt4
n
)
else
isNull
parent_id
returnA
-<
row
selectNodesWithType
::
Column
PGInt4
->
Query
NodeRead
selectNodesWithType
type_id
=
proc
()
->
do
row
@
(
Node
_
tn
_
_
_
_
_
)
<-
queryNodeTable
-<
()
...
...
@@ -301,12 +306,10 @@ getNode :: JSONB a => Connection -> Int -> proxy a -> IO (Node a)
getNode
conn
id
_
=
do
fromMaybe
(
error
$
"Node does node exist: "
<>
show
id
)
.
headMay
<$>
runQuery
conn
(
limit
1
$
selectNode
(
pgInt4
id
))
getNodesWithType
::
Connection
->
Column
PGInt4
->
IO
[
Node
HyperdataDocument
]
getNodesWithType
conn
type_id
=
do
runQuery
conn
$
selectNodesWithType
type_id
------------------------------------------------------------------------
-- WIP
-- TODO Classe HasDefault where
...
...
src/Gargantext/Database/NodeNgram.hs
View file @
0ee7da5d
{-|
Module : Gargantext.Database.NodeNgram
Module : Gargantext.Database.NodeNgram
s
Description : NodeNgram for Ngram indexation or Lists
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
...
...
@@ -21,16 +21,20 @@ if Node is a List then it is listing (either Stop, Candidate or Map)
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
-- TODO NodeNgrams
module
Gargantext.Database.NodeNgram
where
import
Control.Lens.TH
(
makeLensesWith
,
abbreviatedFields
)
import
Data.Profunctor.Product.TH
(
makeAdaptorAndInstance
)
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
import
Database.PostgreSQL.Simple.SqlQQ
(
sql
)
import
Gargantext.Database.Ngrams
(
NgramsId
)
import
Gargantext.Text.List.Types
(
ListId
,
ListTypeId
)
import
Gargantext.Database.Node
(
mkCmd
,
Cmd
(
..
))
import
Gargantext.Prelude
import
Opaleye
...
...
@@ -94,10 +98,6 @@ insertNodeNgramW nns =
mkCmd
$
\
c
->
fromIntegral
<$>
runInsertMany
c
nodeNgramTable
nns
-- TODO: remove these type (duplicate with others)
type
ListId
=
Int
type
NgramsId
=
Int
type
ListTypeId
=
Int
updateNodeNgrams
::
PGS
.
Connection
->
[(
ListId
,
NgramsId
,
ListTypeId
)]
->
IO
[
PGS
.
Only
Int
]
updateNodeNgrams
c
input
=
PGS
.
query
c
updateQuery
(
PGS
.
Only
$
Values
fields
$
input
)
...
...
@@ -111,5 +111,3 @@ updateNodeNgrams c input = PGS.query c updateQuery (PGS.Only $ Values fields $ i
RETURNING new.ngram_id
|]
src/Gargantext/Database/NodeNgram
Ngram
.hs
→
src/Gargantext/Database/NodeNgram
sNgrams
.hs
View file @
0ee7da5d
{-|
Module : Gargantext.Database.NodeNgram
Ngram
Module : Gargantext.Database.NodeNgram
sNgrams
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
...
...
@@ -7,7 +7,7 @@ Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
NodeNgram
Ngram
table is used to group Ngrams
NodeNgram
sNgrams
table is used to group Ngrams
- NodeId :: List Id
- NgramId_1, NgramId_2 where all NgramId_2 will be added to NgramId_1
- weight: probability of the relation (TODO, fixed to 1 for simple stemming)
...
...
@@ -18,75 +18,79 @@ Next Step benchmark:
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module
Gargantext.Database.NodeNgram
Ngram
module
Gargantext.Database.NodeNgram
sNgrams
where
import
Control.Lens.TH
(
makeLensesWith
,
abbreviatedFields
)
import
Data.Maybe
(
Maybe
)
import
Data.Profunctor.Product.TH
(
makeAdaptorAndInstance
)
import
Database.PostgreSQL.Simple.SqlQQ
(
sql
)
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
import
Gargantext.Database.Node
(
mkCmd
,
Cmd
(
..
))
import
Gargantext.Prelude
import
Opaleye
import
qualified
Database.PostgreSQL.Simple
as
PG
S
import
qualified
Database.PostgreSQL.Simple
as
DP
S
data
NodeNgram
Ngram
Poly
node_id
ngram1_id
ngram2_id
weight
=
NodeNgram
Ngram
{
nng_NodeId
::
node_id
,
nng_Ngram1Id
::
ngram1_id
,
nng_Ngram2Id
::
ngram2_id
,
nng_Weight
::
weight
}
deriving
(
Show
)
data
NodeNgram
sNgrams
Poly
node_id
ngram1_id
ngram2_id
weight
=
NodeNgram
sNgrams
{
_
nng_NodeId
::
node_id
,
_
nng_Ngram1Id
::
ngram1_id
,
_
nng_Ngram2Id
::
ngram2_id
,
_
nng_Weight
::
weight
}
deriving
(
Show
)
type
NodeNgram
Ngram
Write
=
NodeNgram
Ngram
Poly
(
Column
PGInt4
)
type
NodeNgram
sNgrams
Write
=
NodeNgram
sNgrams
Poly
(
Column
PGInt4
)
(
Column
PGInt4
)
(
Column
PGInt4
)
(
Maybe
(
Column
PGFloat8
))
type
NodeNgram
Ngram
Read
=
NodeNgram
Ngram
Poly
(
Column
PGInt4
)
type
NodeNgram
sNgrams
Read
=
NodeNgram
sNgrams
Poly
(
Column
PGInt4
)
(
Column
PGInt4
)
(
Column
PGInt4
)
(
Column
PGFloat8
)
type
NodeNgram
Ngram
=
NodeNgram
Ngram
Poly
Int
type
NodeNgram
sNgrams
=
NodeNgram
sNgrams
Poly
Int
Int
Int
(
Maybe
Double
)
$
(
makeAdaptorAndInstance
"pNodeNgram
Ngram
"
''
N
odeNgram
Ngram
Poly
)
$
(
makeAdaptorAndInstance
"pNodeNgram
sNgrams
"
''
N
odeNgram
sNgrams
Poly
)
$
(
makeLensesWith
abbreviatedFields
''
N
odeNgram
Ngram
Poly
)
''
N
odeNgram
sNgrams
Poly
)
nodeNgram
NgramTable
::
Table
NodeNgramNgramWrite
NodeNgramNgram
Read
nodeNgram
Ngram
Table
=
nodeNgram
sNgramsTable
::
Table
NodeNgramsNgramsWrite
NodeNgramsNgrams
Read
nodeNgram
sNgrams
Table
=
Table
"nodes_ngrams_ngrams"
(
pNodeNgram
Ngram
NodeNgramNgram
{
nng_NodeId
=
required
"node_id"
,
nng_Ngram1Id
=
required
"ngram1_id"
,
nng_Ngram2Id
=
required
"ngram2_id"
,
nng_Weight
=
optional
"weight"
(
pNodeNgram
sNgrams
NodeNgramsNgrams
{
_
nng_NodeId
=
required
"node_id"
,
_
nng_Ngram1Id
=
required
"ngram1_id"
,
_
nng_Ngram2Id
=
required
"ngram2_id"
,
_
nng_Weight
=
optional
"weight"
}
)
queryNodeNgram
NgramTable
::
Query
NodeNgramNgram
Read
queryNodeNgram
NgramTable
=
queryTable
nodeNgramNgram
Table
queryNodeNgram
sNgramsTable
::
Query
NodeNgramsNgrams
Read
queryNodeNgram
sNgramsTable
=
queryTable
nodeNgramsNgrams
Table
-- | Select NodeNgram
Ngram
-- | Select NodeNgram
sNgrams
-- TODO not optimized (get all ngrams without filters)
nodeNgram
Ngram
::
PGS
.
Connection
->
IO
[
NodeNgramNgram
]
nodeNgram
Ngram
conn
=
runQuery
conn
queryNodeNgramNgram
Table
nodeNgram
sNgrams
::
DPS
.
Connection
->
IO
[
NodeNgramsNgrams
]
nodeNgram
sNgrams
conn
=
runQuery
conn
queryNodeNgramsNgrams
Table
instance
QueryRunnerColumnDefault
PGInt4
(
Maybe
Int
)
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
...
...
@@ -95,19 +99,62 @@ instance QueryRunnerColumnDefault PGFloat8 (Maybe Double) where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
insertNodeNgramNgram
::
[
NodeNgramNgram
]
->
Cmd
Int
insertNodeNgramNgram
=
insertNodeNgramNgramW
.
map
(
\
(
NodeNgramNgram
n
ng1
ng2
maybeWeight
)
->
NodeNgramNgram
(
pgInt4
n
)
(
pgInt4
ng1
)
(
pgInt4
ng2
)
(
pgDouble
<$>
maybeWeight
)
-- TODO: Add option on conflict
insertNodeNgramsNgramsNew
::
[
NodeNgramsNgrams
]
->
Cmd
Int
insertNodeNgramsNgramsNew
=
insertNodeNgramsNgramsW
.
map
(
\
(
NodeNgramsNgrams
n
ng1
ng2
maybeWeight
)
->
NodeNgramsNgrams
(
pgInt4
n
)
(
pgInt4
ng1
)
(
pgInt4
ng2
)
(
pgDouble
<$>
maybeWeight
)
)
insertNodeNgramNgramW
::
[
NodeNgramNgramWrite
]
->
Cmd
Int
insertNodeNgramNgramW
ns
=
insertNodeNgramsNgramsW
::
[
NodeNgramsNgramsWrite
]
->
Cmd
Int
insertNodeNgramsNgramsW
ns
=
mkCmd
$
\
c
->
fromIntegral
<$>
runInsertMany
c
nodeNgramNgramTable
ns
<$>
runInsertMany
c
nodeNgramsNgramsTable
ns
------------------------------------------------------------------------
data
Action
=
Del
|
Add
ngramsGroup
::
Action
->
[
NodeNgramsNgrams
]
->
Cmd
[
Int
]
ngramsGroup
a
ngs
=
mkCmd
$
\
c
->
ngramsGroup'
c
a
ngs
-- TODO: remove this function (use Reader Monad only)
ngramsGroup'
::
DPS
.
Connection
->
Action
->
[
NodeNgramsNgrams
]
->
IO
[
Int
]
ngramsGroup'
c
action
ngs
=
runNodeNgramsNgrams
c
q
ngs
where
q
=
case
action
of
Del
->
queryDelNodeNgramsNgrams
Add
->
queryInsertNodeNgramsNgrams
runNodeNgramsNgrams
::
DPS
.
Connection
->
DPS
.
Query
->
[
NodeNgramsNgrams
]
->
IO
[
Int
]
runNodeNgramsNgrams
c
q
ngs
=
map
(
\
(
DPS
.
Only
a
)
->
a
)
<$>
DPS
.
query
c
q
(
DPS
.
Only
$
Values
fields
ngs'
)
where
ngs'
=
map
(
\
(
NodeNgramsNgrams
n
ng1
ng2
w
)
->
(
n
,
ng1
,
ng2
,
maybe
0
identity
w
))
ngs
fields
=
map
(
\
t
->
QualifiedIdentifier
Nothing
t
)
[
"int4"
,
"int4"
,
"int4"
,
"double"
]
--------------------------------------------------------------------
-- TODO: on conflict update weight
queryInsertNodeNgramsNgrams
::
DPS
.
Query
queryInsertNodeNgramsNgrams
=
[
sql
|
WITH input_rows(nId,ng1,ng2,w) AS (?)
, ins AS (
INSERT INTO nodes_ngrams_ngrams (node_id,ngram1_id,ngram2_id,weight)
SELECT * FROM input_rows
ON CONFLICT (node_id,ngram1_id,ngram2_id) DO NOTHING -- unique index created here
)
|]
queryDelNodeNgramsNgrams
::
DPS
.
Query
queryDelNodeNgramsNgrams
=
[
sql
|
WITH input(nId,ng1,ng2,w) AS (?)
, DELETE FROM nodes_ngrams_ngrams
WHERE node_id = input.nId
AND ngram1_id = input.ng1
AND ngram2_id = input.ng2
;)
|]
src/Gargantext/Text/List/Types.hs
View file @
0ee7da5d
...
...
@@ -40,6 +40,14 @@ instance Arbitrary ListType where
type
Lists
=
Map
ListType
(
Map
Text
[
Text
])
type
ListId
=
Int
type
ListTypeId
=
Int
listTypeId
::
ListType
->
ListTypeId
listTypeId
GraphList
=
1
listTypeId
StopList
=
2
listTypeId
CandidateList
=
3
emptyLists
::
Lists
emptyLists
=
fromList
$
map
(
\
lt
->
(
lt
,
empty
))
...
...
src/Gargantext/Viz/Phylo.hs
View file @
0ee7da5d
...
...
@@ -33,7 +33,7 @@ import Data.Maybe (Maybe)
import
Data.Text
(
Text
)
import
Data.Time.Clock.POSIX
(
POSIXTime
)
import
GHC.Generics
(
Generic
)
import
Gargantext.Database.Ngram
(
NgramsId
)
import
Gargantext.Database.Ngram
s
(
NgramsId
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
)
import
Gargantext.Prelude
...
...
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