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
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