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
3a6e26c8
Commit
3a6e26c8
authored
Sep 04, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FIX] temp fix on the textflow (needs refactoring)
parent
8d8471b1
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
21 additions
and
26 deletions
+21
-26
TFICF.hs
src/Gargantext/Core/Text/Metrics/TFICF.hs
+1
-1
Flow.hs
src/Gargantext/Database/Action/Flow.hs
+5
-4
List.hs
src/Gargantext/Database/Action/Flow/List.hs
+0
-4
Insert.hs
src/Gargantext/Database/Query/Table/Node/Document/Insert.hs
+15
-17
No files found.
src/Gargantext/Core/Text/Metrics/TFICF.hs
View file @
3a6e26c8
...
...
@@ -47,7 +47,7 @@ tficf :: TficfContext Count Total
->
TFICF
tficf
(
TficfInfra
(
Count
ic
)
(
Total
it
)
)
(
TficfSupra
(
Count
sc
)
(
Total
st
)
)
|
it
>=
ic
&&
st
>=
sc
{-&& it <= st-}
=
(
ic
/
it
)
/
log
(
sc
/
st
)
|
it
>=
ic
&&
st
>=
sc
&&
it
<=
st
=
(
ic
/
it
)
/
log
(
sc
/
st
)
|
otherwise
=
panic
$
"[ERR]"
<>
path
<>
" Frequency impossible"
tficf
_
_
=
panic
$
"[ERR]"
<>
path
<>
"Undefined for these contexts"
...
...
src/Gargantext/Database/Action/Flow.hs
View file @
3a6e26c8
...
...
@@ -206,8 +206,8 @@ flowCorpusUser l user corpusName ctype ids = do
-- TODO: check if present already, ignore
_
<-
Doc
.
add
userCorpusId
ids
--
tId <- insertDefaultNode NodeTexts userCorpusId userId
-- printDebug "Node Text Id
" tId
tId
<-
insertDefaultNode
NodeTexts
userCorpusId
userId
printDebug
"Node Text Ids:
"
tId
-- User List Flow
(
masterUserId
,
_masterRootId
,
masterCorpusId
)
<-
getOrMk_RootWithCorpus
(
UserName
userMaster
)
(
Left
""
)
ctype
...
...
@@ -238,6 +238,7 @@ insertDocs hs uId cId = do
printDebug
"docs"
(
length
docs
)
ids
<-
insertDb
uId
cId
docs
printDebug
"ids"
(
length
ids
)
-- printDebug "inserted" (map reUniqId ids)
let
ids'
=
map
reId
ids
documentsWithId
=
mergeData
(
toInserted
ids
)
(
Map
.
fromList
$
map
viewUniqId'
docs
)
...
...
@@ -256,7 +257,7 @@ insertMasterDocs :: ( FlowCmdM env err m
insertMasterDocs
c
lang
hs
=
do
(
masterUserId
,
_
,
masterCorpusId
)
<-
getOrMk_RootWithCorpus
(
UserName
userMaster
)
(
Left
corpusMasterName
)
c
(
ids'
,
documentsWithId
)
<-
insertDocs
hs
masterUserId
masterCorpusId
_
<-
Doc
.
add
masterCorpusId
ids'
-- TODO
-- create a corpus with database name (CSV or PubMed)
-- add documents to the corpus (create node_node link)
...
...
@@ -303,7 +304,7 @@ viewUniqId' d = maybe err (\h -> (h,d)) (view uniqId d)
toInserted
::
[
ReturnId
]
->
Map
HashId
ReturnId
toInserted
=
Map
.
fromList
.
map
(
\
r
->
(
reUniqId
r
,
r
)
)
Map
.
fromList
.
map
(
\
r
->
(
reUniqId
r
,
r
)
)
.
filter
(
\
r
->
reInserted
r
==
True
)
mergeData
::
Map
HashId
ReturnId
...
...
src/Gargantext/Database/Action/Flow/List.hs
View file @
3a6e26c8
...
...
@@ -78,10 +78,6 @@ flowList_Tficf' u m nt f = do
-}
-- | TODO check optimization
mapNodeIdNgrams
::
[
DocumentIdWithNgrams
a
]
->
Map
Ngrams
(
Map
NgramsType
(
Map
NodeId
Int
))
...
...
src/Gargantext/Database/Query/Table/Node/Document/Insert.hs
View file @
3a6e26c8
...
...
@@ -57,12 +57,14 @@ module Gargantext.Database.Query.Table.Node.Document.Insert
import
Control.Lens
(
set
,
view
)
import
Control.Lens.Cons
import
Control.Lens.Prism
import
Data.Aeson
(
toJSON
)
import
Data.Aeson
(
toJSON
{-, ToJSON-}
)
import
Data.Maybe
(
maybe
)
import
Data.Text
(
Text
)
-- import Data.ByteString (ByteString)
import
Data.Time.Segment
(
jour
)
import
Database.PostgreSQL.Simple
(
FromRow
,
Query
,
Only
(
..
))
import
Database.PostgreSQL.Simple.FromRow
(
fromRow
,
field
)
-- import Database.PostgreSQL.Simple.ToRow (toRow, ToRow)
import
Database.PostgreSQL.Simple.SqlQQ
import
Database.PostgreSQL.Simple.ToField
(
toField
,
Action
)
import
Database.PostgreSQL.Simple.Types
(
Values
(
..
),
QualifiedIdentifier
(
..
))
...
...
@@ -70,7 +72,7 @@ import GHC.Generics (Generic)
import
Gargantext.Database.Admin.Config
(
nodeTypeId
)
import
Gargantext.Database.Admin.Types.Hyperdata
import
Gargantext.Database.Admin.Types.Node
import
Gargantext.Database.Prelude
(
Cmd
,
runPGSQuery
)
import
Gargantext.Database.Prelude
(
Cmd
,
runPGSQuery
{-, formatPGSQuery-}
)
import
Gargantext.Prelude
import
Gargantext.Prelude.Crypto.Hash
(
hash
)
import
qualified
Data.Text
as
DT
(
pack
,
concat
,
take
)
...
...
@@ -126,7 +128,7 @@ instance InsertDb HyperdataContact
,
toField
u
,
toField
p
,
toField
$
maybe
"Contact"
(
DT
.
take
255
)
(
Just
"Name"
)
-- (_hc_name h)
,
toField
$
jour
201
0
1
1
-- TODO put default date
,
toField
$
jour
0
1
1
-- TODO put default date
,
(
toField
.
toJSON
)
h
]
...
...
@@ -134,14 +136,14 @@ instance InsertDb HyperdataContact
--
-- to print rendered query (Debug purpose) use @formatQuery@ function.
{-
insertDocuments_Debug :: (Hyperdata a, ToJSON a, ToRow a) => UserId -> ParentId -> [a] -> Cmd ByteString
insertDocuments_Debug :: (Hyperdata a, ToJSON a, ToRow a, InsertDb [a])
=> UserId -> ParentId -> [a] -> Cmd err ByteString
insertDocuments_Debug uId pId hs = formatPGSQuery queryInsert (Only $ Values fields inputData)
where
fields = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
inputData =
prepare
uId pId hs
inputData =
insertDb'
uId pId hs
-}
-- | Input Tables: types of the tables
inputSqlTypes
::
[
Text
]
inputSqlTypes
=
map
DT
.
pack
[
"int4"
,
"int4"
,
"int4"
,
"text"
,
"date"
,
"jsonb"
]
...
...
@@ -153,27 +155,25 @@ queryInsert = [sql|
, ins AS (
INSERT INTO nodes (typename,user_id,parent_id,name,date,hyperdata)
SELECT * FROM input_rows
ON CONFLICT ((hyperdata ->> 'uniqIdBdd')) DO UPDATE SET user_id=EXCLUDED.user_id -- on unique index
-- ON CONFLICT ((hyperdata ->> 'uniqIdBdd')) DO NOTHING -- on unique index -- this does not return the ids
-- ON CONFLICT (typename, parent_id, (hyperdata ->> 'uniqId')) DO NOTHING
-- on unique index
ON CONFLICT ((hyperdata ->> 'uniqIdBdd')) DO UPDATE SET user_id=EXCLUDED.user_id
-- on unique index
RETURNING id,hyperdata
)
SELECT true AS source -- true for 'newly inserted'
, id
, hyperdata ->> 'uniqId' as doi
, hyperdata ->> 'uniqId
Bdd
' as doi
FROM ins
UNION ALL
SELECT false AS source -- false for 'not inserted'
, c.id
, hyperdata ->> 'uniqId' as doi
, hyperdata ->> 'uniqId
Bdd
' as doi
FROM input_rows
JOIN nodes c USING (hyperdata); -- columns of unique index
|]
------------------------------------------------------------------------
-- * Main Types used
-- ** Return Types
-- | When documents are inserted
...
...
@@ -229,12 +229,10 @@ addUniqIdsContact hc = set (hc_uniqIdBdd) (Just shaBdd)
-- | TODO add more shaparameters
shaParametersContact
::
[(
HyperdataContact
->
Text
)]
shaParametersContact
=
[
\
d
->
maybeText
$
view
(
hc_who
.
_Just
.
cw_firstName
)
d
,
\
d
->
maybeText
$
view
(
hc_who
.
_Just
.
cw_lastName
)
d
,
\
d
->
maybeText
$
view
(
hc_where
.
_head
.
cw_touch
.
_Just
.
ct_mail
)
d
]
shaParametersContact
=
[
\
d
->
maybeText
$
view
(
hc_who
.
_Just
.
cw_firstName
)
d
,
\
d
->
maybeText
$
view
(
hc_who
.
_Just
.
cw_lastName
)
d
,
\
d
->
maybeText
$
view
(
hc_where
.
_head
.
cw_touch
.
_Just
.
ct_mail
)
d
]
maybeText
::
Maybe
Text
->
Text
maybeText
=
maybe
(
DT
.
pack
""
)
identity
...
...
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