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
108
Issues
108
List
Board
Labels
Milestones
Merge Requests
5
Merge Requests
5
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
25cdbe65
Commit
25cdbe65
authored
Feb 08, 2022
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[CONFIG] fixing default config (and removing spaces at end of lines)
parent
9b0d6bb8
Changes
1
Show whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
107 additions
and
19 deletions
+107
-19
API.hs
src/Gargantext/Core/Viz/Phylo/API.hs
+107
-19
No files found.
src/Gargantext/Core/Viz/Phylo/API.hs
View file @
25cdbe65
...
...
@@ -13,31 +13,87 @@ Portability : POSIX
module
Gargantext.Core.Viz.Phylo.API
where
import
Data.Proxy
import
Data.Aeson
(
Value
,
decodeFileStrict
,
eitherDecode
,
encode
)
import
Data.Map
(
Map
)
import
Data.Maybe
(
catMaybes
)
import
Data.Text
(
Text
,
pack
)
import
Data.Set
(
Set
)
import
Data.Text
(
Text
,
pack
)
import
Data.Time.Calendar
(
fromGregorian
,
diffGregorianDurationClip
,
cdMonths
,
diffDays
,
showGregorian
)
import
Data.Time.Clock.POSIX
(
posixSecondsToUTCTime
)
import
Gargantext.API.Ngrams.Prelude
(
getTermList
)
import
Gargantext.API.Ngrams.Tools
(
getRepo'
)
import
Gargantext.API.Ngrams.Types
(
NgramsTerm
(
..
))
import
Gargantext.API.Node.Corpus.Export
(
getContextNgrams
)
import
Gargantext.API.Prelude
(
GargNoServer
)
import
Gargantext.Core.Text.Context
(
TermList
)
import
Gargantext.Core.Types
(
Context
)
import
Gargantext.Core.Types.Main
(
ListType
(
MapTerm
))
import
Gargantext.Core.Viz.Phylo
(
TimeUnit
(
..
),
Date
,
Document
(
..
))
import
Gargantext.Core.Viz.Phylo
(
TimeUnit
(
..
),
Date
,
Document
(
..
),
Config
(
..
),
Phylo
)
import
Gargantext.Core.Viz.Phylo.PhyloExport
(
toPhyloExport
,
dotToFile
)
import
Gargantext.Core.Viz.Phylo.PhyloMaker
(
toPhylo
,
toPhyloStep
)
import
Gargantext.Core.Viz.Phylo.PhyloTools
(
{-printIOMsg, printIOComment,-}
setConfig
)
import
Gargantext.Database.Admin.Types.Hyperdata.Document
(
HyperdataDocument
(
..
))
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
,
ContextId
)
import
Gargantext.Database.Query.Table.Node
(
defaultList
)
import
Gargantext.Database.Admin.Types.Hyperdata
(
HyperdataPhylo
(
..
))
import
Gargantext.Database.Admin.Types.Node
(
CorpusId
,
ContextId
,
PhyloId
)
import
Gargantext.Database.Query.Table.Node
(
defaultList
,
getNodeWith
)
import
Gargantext.Database.Query.Table.NodeContext
(
selectDocNodes
)
import
Gargantext.Database.Schema.Context
import
Gargantext.Database.Schema.Node
import
Gargantext.Database.Schema.Ngrams
(
NgramsType
(
..
))
import
Gargantext.Prelude
import
Prelude
as
Prelude
import
Gargantext.API.Ngrams.Types
(
NgramsTerm
(
..
))
import
System.Process
as
Shell
import
qualified
Data.ByteString.Lazy
as
Lazy
import
qualified
Data.List
as
List
import
qualified
Data.Map
as
Map
import
qualified
Data.Set
as
Set
import
qualified
Data.List
as
List
corpusIdtoDocuments
::
TimeUnit
->
CorpusId
->
GargNoServer
[
Document
]
--------------------------------------------------------------------
getPhyloData
::
PhyloId
->
GargNoServer
(
Maybe
Phylo
)
getPhyloData
phyloId
=
do
nodePhylo
<-
getNodeWith
phyloId
(
Proxy
::
Proxy
HyperdataPhylo
)
pure
$
_hp_data
$
_node_hyperdata
nodePhylo
putPhylo
::
PhyloId
->
GargNoServer
Phylo
putPhylo
=
undefined
savePhylo
::
PhyloId
->
GargNoServer
()
savePhylo
=
undefined
--------------------------------------------------------------------
phylo2dot2json
::
Phylo
->
IO
Value
phylo2dot2json
phylo
=
do
let
file_from
=
"/tmp/fromPhylo.json"
file_dot
=
"/tmp/tmp.dot"
file_to_json
=
"/tmp/toPhylo.json"
_
<-
dotToFile
file_from
(
toPhyloExport
phylo
)
_
<-
Shell
.
callProcess
"/usr/bin/dot"
[
"-Tdot"
,
"-o"
,
file_dot
,
file_from
]
_
<-
Shell
.
callProcess
"/usr/bin/dot"
[
"-Txdot_json"
,
"-o"
,
file_to_json
,
file_dot
]
maybeValue
<-
decodeFileStrict
file_to_json
_
<-
Shell
.
callProcess
"/bin/rm"
[
"-rf"
,
file_from
,
file_to_json
,
file_dot
]
case
maybeValue
of
Nothing
->
panic
"[G.C.V.Phylo.API.phylo2dot2json] Error no file"
Just
v
->
pure
v
flowPhyloAPI
::
Config
->
CorpusId
->
GargNoServer
Phylo
flowPhyloAPI
config
cId
=
do
(
mapList
,
corpus
)
<-
corpusIdtoDocuments
(
timeUnit
config
)
cId
phyloWithCliques
<-
pure
$
toPhyloStep
corpus
mapList
config
-- writePhylo phyloWithCliquesFile phyloWithCliques
pure
$
toPhylo
(
setConfig
config
phyloWithCliques
)
--------------------------------------------------------------------
corpusIdtoDocuments
::
TimeUnit
->
CorpusId
->
GargNoServer
(
TermList
,
[
Document
])
corpusIdtoDocuments
timeUnit
corpusId
=
do
docs
<-
selectDocNodes
corpusId
...
...
@@ -47,7 +103,13 @@ corpusIdtoDocuments timeUnit corpusId = do
ngs_terms
<-
getContextNgrams
corpusId
lId
MapTerm
NgramsTerms
repo
ngs_sources
<-
getContextNgrams
corpusId
lId
MapTerm
Sources
repo
pure
$
catMaybes
termList
<-
getTermList
lId
MapTerm
NgramsTerms
case
termList
of
Nothing
->
panic
"[G.C.V.Phylo.API] no termList found"
Just
termList'
->
pure
(
termList'
,
docs'
)
where
docs'
=
catMaybes
$
List
.
map
(
\
doc
->
context2phyloDocument
timeUnit
doc
(
ngs_terms
,
ngs_sources
)
)
docs
...
...
@@ -76,7 +138,7 @@ context2date context timeUnit = do
year
<-
_hd_publication_year
hyperdata
month
<-
_hd_publication_month
hyperdata
day
<-
_hd_publication_day
hyperdata
pure
(
toPhyloDate
year
month
day
timeUnit
,
toPhyloDate'
year
month
day
)
pure
(
toPhyloDate
year
month
day
timeUnit
,
toPhyloDate'
year
month
day
timeUnit
)
---------------
...
...
@@ -99,10 +161,36 @@ toPhyloDate y m d tu = case tu of
Month
_
_
_
->
toMonths
(
Prelude
.
toInteger
y
)
m
d
Week
_
_
_
->
div
(
toDays
(
Prelude
.
toInteger
y
)
m
d
)
7
Day
_
_
_
->
toDays
(
Prelude
.
toInteger
y
)
m
d
_
->
panic
"[G.C.V.Phylo.API] toPhyloDate"
toPhyloDate'
::
Int
->
Int
->
Int
->
TimeUnit
->
Text
toPhyloDate'
y
m
d
tu
=
case
tu
of
Epoch
_
_
_
->
pack
$
show
$
posixSecondsToUTCTime
$
fromIntegral
y
Year
_
_
_
->
pack
$
showGregorian
$
fromGregorian
(
toInteger
y
)
m
d
Month
_
_
_
->
pack
$
showGregorian
$
fromGregorian
(
toInteger
y
)
m
d
Week
_
_
_
->
pack
$
showGregorian
$
fromGregorian
(
toInteger
y
)
m
d
Day
_
_
_
->
pack
$
showGregorian
$
fromGregorian
(
toInteger
y
)
m
d
-- Utils
writePhylo
::
[
Char
]
->
Phylo
->
IO
()
writePhylo
path
phylo
=
Lazy
.
writeFile
path
$
encode
phylo
readPhylo
::
[
Char
]
->
IO
Phylo
readPhylo
path
=
do
phyloJson
<-
(
eitherDecode
<$>
readJson
path
)
::
IO
(
Either
String
Phylo
)
case
phyloJson
of
Left
err
->
do
putStrLn
err
undefined
Right
phylo
->
pure
phylo
-- | To read and decode a Json file
readJson
::
FilePath
->
IO
Lazy
.
ByteString
readJson
path
=
Lazy
.
readFile
path
-- Function to use in Database export
toPhyloDate'
::
Int
->
Int
->
Int
->
Text
toPhyloDate'
y
m
d
=
pack
$
showGregorian
$
fromGregorian
(
Prelude
.
toInteger
y
)
m
d
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