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
02eb40eb
Commit
02eb40eb
authored
Jan 07, 2021
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[REFACT] Types
parent
2f672573
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
18 additions
and
29 deletions
+18
-29
Ngrams.hs
src/Gargantext/API/Ngrams.hs
+1
-1
Utils.hs
src/Gargantext/Database/Action/Flow/Utils.hs
+3
-2
Ngrams.hs
src/Gargantext/Database/Query/Table/Ngrams.hs
+3
-2
NgramsPostag.hs
src/Gargantext/Database/Query/Table/NgramsPostag.hs
+3
-3
Ngrams.hs
src/Gargantext/Database/Schema/Ngrams.hs
+8
-21
No files found.
src/Gargantext/API/Ngrams.hs
View file @
02eb40eb
...
...
@@ -132,7 +132,7 @@ import Gargantext.Database.Admin.Types.Node (NodeType(..))
import
Gargantext.Database.Prelude
(
HasConnectionPool
,
HasConfig
)
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
)
import
Gargantext.Database.Query.Table.Node.Select
import
Gargantext.Database.Query.Table.Ngrams
hiding
(
NgramsType
(
..
),
ngrams
,
ngrams
Type
,
ngrams_terms
)
import
Gargantext.Database.Query.Table.Ngrams
hiding
(
NgramsType
(
..
),
ngramsType
,
ngrams_terms
)
import
qualified
Gargantext.Database.Query.Table.Ngrams
as
TableNgrams
import
Gargantext.Database.Query.Table.Node
(
getNode
)
import
Gargantext.Database.Schema.Node
(
node_id
,
node_parentId
,
node_userId
)
...
...
src/Gargantext/Database/Action/Flow/Utils.hs
View file @
02eb40eb
...
...
@@ -20,6 +20,7 @@ import Gargantext.Database.Prelude (Cmd)
import
Gargantext.Database.Query.Table.NodeNodeNgrams
import
Gargantext.Database.Schema.Ngrams
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Types
import
Gargantext.Prelude
import
qualified
Data.Map
as
DM
...
...
@@ -81,10 +82,10 @@ insertDocNgramsOn cId dn =
$
(
map
(
docNgrams2nodeNodeNgrams
cId
)
dn
)
insertDocNgrams
::
CorpusId
->
Map
(
Ngrams
Indexed
Ngrams
)
(
Map
NgramsType
(
Map
NodeId
Int
))
->
Map
(
Indexed
Ngrams
)
(
Map
NgramsType
(
Map
NodeId
Int
))
->
Cmd
err
Int
insertDocNgrams
cId
m
=
insertDocNgramsOn
cId
[
DocNgrams
n
(
_
ngramsId
ng
)
(
ngramsTypeId
t
)
(
fromIntegral
i
)
insertDocNgramsOn
cId
[
DocNgrams
n
(
_
index
ng
)
(
ngramsTypeId
t
)
(
fromIntegral
i
)
|
(
ng
,
t2n2i
)
<-
DM
.
toList
m
,
(
t
,
n2i
)
<-
DM
.
toList
t2n2i
,
(
n
,
i
)
<-
DM
.
toList
n2i
...
...
src/Gargantext/Database/Query/Table/Ngrams.hs
View file @
02eb40eb
...
...
@@ -33,6 +33,7 @@ import Gargantext.Database.Prelude (runPGSQuery, formatPGSQuery)
import
Gargantext.Database.Query.Table.NodeNodeNgrams
import
Gargantext.Database.Schema.Ngrams
import
Gargantext.Database.Schema.Prelude
import
Gargantext.Database.Types
import
Gargantext.Prelude
queryNgramsTable
::
Query
NgramsRead
...
...
@@ -64,10 +65,10 @@ _dbGetNgramsDb = runOpaQuery queryNgramsTable
-- TODO-ACCESS: access must not be checked here but when insertNgrams is called.
insertNgrams
::
[
Ngrams
]
->
Cmd
err
(
Map
NgramsTerms
NgramsId
)
insertNgrams
ns
=
fromList
<$>
map
(
\
(
Ngrams
Indexed
t
i
)
->
(
t
,
i
))
<$>
(
insertNgrams'
ns
)
insertNgrams
ns
=
fromList
<$>
map
(
\
(
Indexed
t
i
)
->
(
t
,
i
))
<$>
(
insertNgrams'
ns
)
-- TODO-ACCESS: access must not be checked here but when insertNgrams' is called.
insertNgrams'
::
[
Ngrams
]
->
Cmd
err
[
Ngrams
Indexed
Text
]
insertNgrams'
::
[
Ngrams
]
->
Cmd
err
[
Indexed
Text
]
insertNgrams'
ns
=
runPGSQuery
queryInsertNgrams
(
PGS
.
Only
$
Values
fields
ns
)
where
fields
=
map
(
\
t
->
QualifiedIdentifier
Nothing
t
)
[
"text"
,
"int4"
]
...
...
src/Gargantext/Database/Query/Table/NgramsPostag.hs
View file @
02eb40eb
...
...
@@ -17,10 +17,10 @@ module Gargantext.Database.Query.Table.NgramsPostag
where
import
Data.Text
(
Text
)
import
Gargantext.Database.Prelude
(
Cmd
)
import
Gargantext.Database.Prelude
(
runPGSQuery
)
import
Gargantext.Database.Prelude
(
Cmd
,
runPGSQuery
)
import
Gargantext.Database.Schema.Ngrams
import
Gargantext.Database.Schema.Prelude
import
Gargantext.Database.Types
import
Gargantext.Prelude
import
qualified
Database.PostgreSQL.Simple
as
PGS
...
...
@@ -37,7 +37,7 @@ type NgramsPostagInsert = ( Int
)
insertNgramsPostag
::
[
NgramsPostagInsert
]
->
Cmd
err
[
Ngrams
Indexed
Text
]
insertNgramsPostag
::
[
NgramsPostagInsert
]
->
Cmd
err
[
Indexed
Text
]
insertNgramsPostag
ns
=
runPGSQuery
queryInsertNgramsPostag
(
PGS
.
Only
$
Values
fields
ns
)
where
...
...
src/Gargantext/Database/Schema/Ngrams.hs
View file @
02eb40eb
...
...
@@ -32,6 +32,7 @@ import Gargantext.Prelude
import
Prelude
(
Functor
)
import
Servant
(
FromHttpApiData
,
parseUrlPiece
,
Proxy
(
..
))
import
Text.Read
(
read
)
import
Gargantext.Database.Types
import
Gargantext.Database.Schema.Prelude
import
qualified
Database.PostgreSQL.Simple
as
PGS
...
...
@@ -70,14 +71,12 @@ ngramsTable = Table "ngrams" (pNgramsDb NgramsDB { _ngrams_id = optional "id"
}
)
-- | Main Ngrams Types
-- | Typed Ngrams
-- Typed Ngrams localize the context of the ngrams
-- ngrams in source
field of document
has Sources Type
-- ngrams in authors field
of document
has Authors Type
-- ngrams in text
(title or abstract) of documents has Terms Type
-- ngrams in source
field of document
has Sources Type
-- ngrams in authors field
of document
has Authors Type
-- ngrams in text
fields of documents has Terms Type (i.e. either title or abstract)
data
NgramsType
=
Authors
|
Institutes
|
Sources
|
NgramsTerms
deriving
(
Eq
,
Show
,
Read
,
Ord
,
Enum
,
Bounded
,
Generic
)
...
...
@@ -177,26 +176,14 @@ makeLenses ''NgramsT
instance
Functor
NgramsT
where
fmap
=
over
ngramsT
-----------------------------------------------------------------------
data
NgramsIndexed
a
=
NgramsIndexed
{
_ngrams
::
a
,
_ngramsId
::
NgramsId
}
deriving
(
Show
,
Generic
,
Eq
,
Ord
)
makeLenses
''
N
gramsIndexed
instance
(
FromField
a
)
=>
PGS
.
FromRow
(
NgramsIndexed
a
)
where
fromRow
=
NgramsIndexed
<$>
field
<*>
field
------------------------------------------------------------------------
withMap
::
Map
NgramsTerms
NgramsId
->
NgramsTerms
->
NgramsId
withMap
m
n
=
maybe
(
panic
"withMap: should not happen"
)
identity
(
lookup
n
m
)
indexNgramsT
::
Map
NgramsTerms
NgramsId
->
NgramsT
Ngrams
->
NgramsT
(
Ngrams
Indexed
Ngrams
)
indexNgramsT
::
Map
NgramsTerms
NgramsId
->
NgramsT
Ngrams
->
NgramsT
(
Indexed
Ngrams
)
indexNgramsT
=
fmap
.
indexNgramsWith
.
withMap
indexNgrams
::
Map
NgramsTerms
NgramsId
->
Ngrams
->
(
NgramsIndexed
Ngrams
)
indexNgrams
::
Map
NgramsTerms
NgramsId
->
Ngrams
->
Indexed
Ngrams
indexNgrams
=
indexNgramsWith
.
withMap
indexNgramsWith
::
(
NgramsTerms
->
NgramsId
)
->
Ngrams
->
Ngrams
Indexed
Ngrams
indexNgramsWith
f
n
=
Ngrams
Indexed
n
(
f
$
_ngramsTerms
n
)
indexNgramsWith
::
(
NgramsTerms
->
NgramsId
)
->
Ngrams
->
Indexed
Ngrams
indexNgramsWith
f
n
=
Indexed
n
(
f
$
_ngramsTerms
n
)
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