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
9533783a
Commit
9533783a
authored
Oct 23, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[Phylo] Code session Phylo
parent
6466fa7f
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
22 additions
and
8 deletions
+22
-8
API.hs
src/Gargantext/Core/Viz/Phylo/API.hs
+8
-7
PhyloMaker.hs
src/Gargantext/Core/Viz/Phylo/PhyloMaker.hs
+14
-1
No files found.
src/Gargantext/Core/Viz/Phylo/API.hs
View file @
9533783a
...
...
@@ -17,6 +17,7 @@ Portability : POSIX
module
Gargantext.Core.Viz.Phylo.API
where
import
Data.Maybe
(
fromMaybe
)
import
Control.Lens
((
^.
))
import
Data.String.Conversions
--import Control.Monad.Reader (ask)
...
...
@@ -98,13 +99,13 @@ getPhylo :: PhyloId -> GargServer GetPhylo
getPhylo
phId
_lId
l
msb
=
do
phNode
<-
getNodeWith
phId
(
Proxy
::
Proxy
HyperdataPhylo
)
let
level
=
maybe
2
identity
l
branc
=
maybe
2
identity
msb
level
=
fromMaybe
2
l
branc
=
fromMaybe
2
msb
maybePhylo
=
phNode
^.
(
node_hyperdata
.
hp_data
)
p
<-
liftBase
$
viewPhylo2Svg
$
viewPhylo
level
branc
$
maybe
phyloFromQuery
identit
y
maybePhylo
$
fromMaybe
phyloFromQuer
y
maybePhylo
pure
(
SVG
p
)
------------------------------------------------------------------------
type
PostPhylo
=
QueryParam
"listId"
ListId
...
...
@@ -112,16 +113,16 @@ type PostPhylo = QueryParam "listId" ListId
:>
(
Post
'[
J
SON
]
NodeId
)
postPhylo
::
CorpusId
->
UserId
->
GargServer
PostPhylo
postPhylo
n
userId
_lId
=
do
postPhylo
corpusId
userId
_lId
=
do
-- TODO get Reader settings
-- s <- ask
-- let
-- _vrs = Just ("1" :: Text)
-- _sft = Just (Software "Gargantext" "4")
-- _prm = initPhyloParam vrs sft (Just q)
phy
<-
flowPhylo
n
p
Id
<-
insertNodes
[
node
NodePhylo
"Phylo"
(
HyperdataPhylo
Nothing
(
Just
phy
))
(
Just
n
)
userId
]
pure
$
NodeId
(
fromIntegral
pId
)
phy
<-
flowPhylo
corpusId
-- params
p
hyloId
<-
insertNodes
[
node
NodePhylo
"Phylo"
(
HyperdataPhylo
Nothing
(
Just
phy
))
(
Just
corpusId
)
userId
]
pure
$
NodeId
(
fromIntegral
p
hylo
Id
)
------------------------------------------------------------------------
-- | DELETE Phylo == delete a node
...
...
src/Gargantext/Core/Viz/Phylo/PhyloMaker.hs
View file @
9533783a
...
...
@@ -37,6 +37,17 @@ import qualified Data.Set as Set
-- | To Phylo | --
------------------
{-
-- TODO AD
data Phylo' = PhyloBase { _phylo'_phyloBase :: Phylo}
| PhyloN { _phylo'_phylo1 :: Phylo}
toPhylo' :: Phylo' -> [Document] -> TermList -> Config -> Phylo
toPhylo' (PhyloN phylo) = toPhylo'
toPhylo' (PhyloBase phylo) = toPhylo
-}
toPhylo
::
[
Document
]
->
TermList
->
Config
->
Phylo
toPhylo
docs
lst
conf
=
trace
(
"# phylo1 groups "
<>
show
(
length
$
getGroupsFromLevel
1
phylo1
))
...
...
@@ -48,9 +59,11 @@ toPhylo docs lst conf = trace ("# phylo1 groups " <> show(length $ getGroupsFrom
--------------------------------------
phylo1
::
Phylo
phylo1
=
toPhylo1
docs
phyloBase
-- > AD to db here
--------------------------------------
phyloBase
::
Phylo
phyloBase
::
Phylo
phyloBase
=
toPhyloBase
docs
lst
conf
-- > AD to db here
--------------------------------------
...
...
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