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
39826d6a
Commit
39826d6a
authored
Jan 07, 2021
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[REFACT] Indexed type more generic
parent
44100b6d
Changes
8
Hide whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
25 additions
and
26 deletions
+25
-26
Flow.hs
src/Gargantext/Database/Action/Flow.hs
+3
-12
Utils.hs
src/Gargantext/Database/Action/Flow/Utils.hs
+1
-1
Contact.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Contact.hs
+4
-2
Document.hs
src/Gargantext/Database/Admin/Types/Hyperdata/Document.hs
+8
-1
Ngrams.hs
src/Gargantext/Database/Query/Table/Ngrams.hs
+1
-1
NgramsPostag.hs
src/Gargantext/Database/Query/Table/NgramsPostag.hs
+1
-1
Ngrams.hs
src/Gargantext/Database/Schema/Ngrams.hs
+4
-4
Types.hs
src/Gargantext/Database/Types.hs
+3
-4
No files found.
src/Gargantext/Database/Action/Flow.hs
View file @
39826d6a
...
...
@@ -333,9 +333,6 @@ mergeData rs = catMaybes . map toDocumentWithId . Map.toList
<*>
Just
hpd
------------------------------------------------------------------------
instance
HasText
HyperdataContact
where
hasText
=
undefined
------------------------------------------------------------------------
------------------------------------------------------------------------
documentIdWithNgrams
::
HasNodeError
err
...
...
@@ -358,16 +355,10 @@ instance ExtractNgramsT HyperdataContact
->
Cmd
err
(
Map
Ngrams
(
Map
NgramsType
Int
))
extract
_l
hc'
=
do
let
authors
=
map
text2ngrams
$
maybe
[
"Nothing"
]
(
\
a
->
[
a
])
$
view
(
hc_who
.
_Just
.
cw_lastName
)
hc'
pure
$
Map
.
fromList
$
[(
a'
,
Map
.
singleton
Authors
1
)
|
a'
<-
authors
]
$
maybe
[
"Nothing"
]
(
\
a
->
[
a
])
$
view
(
hc_who
.
_Just
.
cw_lastName
)
hc'
instance
HasText
HyperdataDocument
where
hasText
h
=
catMaybes
[
_hd_title
h
,
_hd_abstract
h
]
pure
$
Map
.
fromList
$
[(
a'
,
Map
.
singleton
Authors
1
)
|
a'
<-
authors
]
instance
ExtractNgramsT
HyperdataDocument
...
...
src/Gargantext/Database/Action/Flow/Utils.hs
View file @
39826d6a
...
...
@@ -82,7 +82,7 @@ insertDocNgramsOn cId dn =
$
(
map
(
docNgrams2nodeNodeNgrams
cId
)
dn
)
insertDocNgrams
::
CorpusId
->
Map
(
Indexed
Ngrams
)
(
Map
NgramsType
(
Map
NodeId
Int
))
->
Map
(
Indexed
Int
Ngrams
)
(
Map
NgramsType
(
Map
NodeId
Int
))
->
Cmd
err
Int
insertDocNgrams
cId
m
=
insertDocNgramsOn
cId
[
DocNgrams
n
(
_index
ng
)
(
ngramsTypeId
t
)
(
fromIntegral
i
)
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/Contact.hs
View file @
39826d6a
...
...
@@ -25,7 +25,7 @@ module Gargantext.Database.Admin.Types.Hyperdata.Contact
import
Data.Time.Segment
(
jour
)
import
Data.Time
(
UTCTime
)
import
Gargantext.Core.Text
(
HasText
(
..
))
import
Gargantext.Database.Admin.Types.Hyperdata.Prelude
import
Gargantext.Prelude
...
...
@@ -42,7 +42,9 @@ data HyperdataContact =
}
deriving
(
Eq
,
Show
,
Generic
)
instance
HasText
HyperdataContact
where
hasText
=
undefined
defaultHyperdataContact
::
HyperdataContact
defaultHyperdataContact
=
HyperdataContact
(
Just
"bdd"
)
...
...
src/Gargantext/Database/Admin/Types/Hyperdata/Document.hs
View file @
39826d6a
...
...
@@ -20,11 +20,12 @@ Portability : POSIX
module
Gargantext.Database.Admin.Types.Hyperdata.Document
where
import
Data.Maybe
(
catMaybes
)
import
Gargantext.Prelude
import
Gargantext.Core.Text
(
HasText
(
..
))
import
Gargantext.Core.Utils.Prefix
(
unCapitalize
,
dropPrefix
)
import
Gargantext.Database.Admin.Types.Hyperdata.Prelude
------------------------------------------------------------------------
data
HyperdataDocument
=
HyperdataDocument
{
_hd_bdd
::
!
(
Maybe
Text
)
,
_hd_doi
::
!
(
Maybe
Text
)
...
...
@@ -49,6 +50,12 @@ data HyperdataDocument = HyperdataDocument { _hd_bdd :: !(Maybe T
deriving
(
Show
,
Generic
)
instance
HasText
HyperdataDocument
where
hasText
h
=
catMaybes
[
_hd_title
h
,
_hd_abstract
h
]
defaultHyperdataDocument
::
HyperdataDocument
defaultHyperdataDocument
=
case
decode
docExample
of
Just
hp
->
hp
...
...
src/Gargantext/Database/Query/Table/Ngrams.hs
View file @
39826d6a
...
...
@@ -68,7 +68,7 @@ insertNgrams :: [Ngrams] -> Cmd err (Map Text NgramsId)
insertNgrams
ns
=
fromList
<$>
map
(
\
(
Indexed
i
t
)
->
(
t
,
i
))
<$>
(
insertNgrams'
ns
)
-- TODO-ACCESS: access must not be checked here but when insertNgrams' is called.
insertNgrams'
::
[
Ngrams
]
->
Cmd
err
[
Indexed
Text
]
insertNgrams'
::
[
Ngrams
]
->
Cmd
err
[
Indexed
Int
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 @
39826d6a
...
...
@@ -37,7 +37,7 @@ type NgramsPostagInsert = ( Int
)
insertNgramsPostag
::
[
NgramsPostagInsert
]
->
Cmd
err
[
Indexed
Text
]
insertNgramsPostag
::
[
NgramsPostagInsert
]
->
Cmd
err
[
Indexed
Int
Text
]
insertNgramsPostag
ns
=
runPGSQuery
queryInsertNgramsPostag
(
PGS
.
Only
$
Values
fields
ns
)
where
...
...
src/Gargantext/Database/Schema/Ngrams.hs
View file @
39826d6a
...
...
@@ -179,17 +179,17 @@ instance Functor NgramsT where
withMap
::
Map
Text
NgramsId
->
Text
->
NgramsId
withMap
m
n
=
maybe
(
panic
"withMap: should not happen"
)
identity
(
lookup
n
m
)
indexNgramsT
::
Map
Text
NgramsId
->
NgramsT
Ngrams
->
NgramsT
(
Indexed
Ngrams
)
indexNgramsT
::
Map
Text
NgramsId
->
NgramsT
Ngrams
->
NgramsT
(
Indexed
Int
Ngrams
)
indexNgramsT
=
fmap
.
indexNgramsWith
.
withMap
-- | TODO replace NgramsT whith Typed NgramsType Ngrams
indexTypedNgrams
::
Map
Text
NgramsId
->
Typed
NgramsType
Ngrams
->
Typed
NgramsType
(
Indexed
Ngrams
)
->
Typed
NgramsType
(
Indexed
Int
Ngrams
)
indexTypedNgrams
=
fmap
.
indexNgramsWith
.
withMap
indexNgrams
::
Map
Text
NgramsId
->
Ngrams
->
Indexed
Ngrams
indexNgrams
::
Map
Text
NgramsId
->
Ngrams
->
Indexed
Int
Ngrams
indexNgrams
=
indexNgramsWith
.
withMap
indexNgramsWith
::
(
Text
->
NgramsId
)
->
Ngrams
->
Indexed
Ngrams
indexNgramsWith
::
(
Text
->
NgramsId
)
->
Ngrams
->
Indexed
Int
Ngrams
indexNgramsWith
f
n
=
Indexed
(
f
$
_ngramsTerms
n
)
n
src/Gargantext/Database/Types.hs
View file @
39826d6a
...
...
@@ -20,15 +20,14 @@ import qualified Database.PostgreSQL.Simple as PGS
-- | Index memory of any type in Gargantext
type
Index
=
Int
data
Indexed
a
=
Indexed
{
_index
::
Index
data
Indexed
i
a
=
Indexed
{
_index
::
i
,
_unIndex
::
a
}
deriving
(
Show
,
Generic
,
Eq
,
Ord
)
makeLenses
''
I
ndexed
instance
(
FromField
a
)
=>
PGS
.
FromRow
(
Indexed
a
)
where
instance
(
FromField
i
,
FromField
a
)
=>
PGS
.
FromRow
(
Indexed
i
a
)
where
fromRow
=
Indexed
<$>
field
<*>
field
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