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