Skip to content

P
purescript-gargantext
Commit 7a9fdad7 authored by arturo's avatar arturo
Browse files
Options

>>> continue

parent 8e4975ab
Show whitespace changes
Inline Side-by-side
Showing with 595 additions and 212 deletions
src/Gargantext/Components/Nodes/Corpus/Phylo.purs
View file @ 7a9fdad7
...@@ -12,8 +12,9 @@ import Data.HTTP.Method (Method(..)) ...@@ -12,8 +12,9 @@ import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Gargantext.Components.PhyloExplorer.JSON (PhyloJSONSet)
import Gargantext.Components.PhyloExplorer.Layout (layout) import Gargantext.Components.PhyloExplorer.Layout (layout)
import Gargantext.Components.PhyloExplorer.Types (PhyloDataset) import Gargantext.Components.PhyloExplorer.Types (PhyloDataSet)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (NodeID) import Gargantext.Types (NodeID)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -36,7 +37,7 @@ phyloLayoutCpt :: R.Component Props ...@@ -36,7 +37,7 @@ phyloLayoutCpt :: R.Component Props
phyloLayoutCpt = here.component "phyloLayout" cpt where phyloLayoutCpt = here.component "phyloLayout" cpt where
cpt _ _ = do cpt _ _ = do
fetchedDataBox <- T.useBox (Nothing :: Maybe PhyloDataset) fetchedDataBox <- T.useBox (Nothing :: Maybe PhyloJSONSet)
fetchedData <- T.useLive T.unequal fetchedDataBox fetchedData <- T.useLive T.unequal fetchedDataBox
R.useEffectOnce' $ launchAff_ do R.useEffectOnce' $ launchAff_ do
...@@ -47,10 +48,10 @@ phyloLayoutCpt = here.component "phyloLayout" cpt where ...@@ -47,10 +48,10 @@ phyloLayoutCpt = here.component "phyloLayout" cpt where
pure case fetchedData of pure case fetchedData of
Nothing -> mempty Nothing -> mempty
Just phyloDataset -> layout { phyloDataset } [] Just phyloDataSet -> layout { phyloDataSet } []
fetchPhyloJSON :: Aff (Either String PhyloDataset) fetchPhyloJSON :: Aff (Either String PhyloDataSet)
fetchPhyloJSON = fetchPhyloJSON =
let let
request = AX.defaultRequest request = AX.defaultRequest
...@@ -65,4 +66,4 @@ fetchPhyloJSON = ...@@ -65,4 +66,4 @@ fetchPhyloJSON =
Left err -> pure $ Left $ AX.printError err Left err -> pure $ Left $ AX.printError err
Right response -> case JSON.readJSON response.body of Right response -> case JSON.readJSON response.body of
Left err -> pure $ Left $ show err Left err -> pure $ Left $ show err
Right (res :: PhyloDataset) -> pure $ Right res Right (res :: PhyloJSONSet) -> pure $ Right $ parsePhyloJSONSet res
src/Gargantext/Components/PhyloExplorer/JSON.purs 0 → 100644
View file @ 7a9fdad7
module Gargantext.Components.PhyloExplorer.JSON where
import Gargantext.Prelude
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep as GR
import Data.Maybe (Maybe)
import Data.Show.Generic (genericShow)
import Gargantext.Utils.SimpleJSON (untaggedSumRep)
import Simple.JSON as JSON
type GraphData =
( bb :: String
, color :: String
, fontsize :: String
, label :: String
, labelloc :: String
, lheight :: String
, lp :: String
, lwidth :: String
, name :: String
, nodesep :: String
, overlap :: String
, phyloBranches :: String
, phyloDocs :: String
, phyloFoundations :: String
, phyloGroups :: String
, phyloPeriods :: String
, phyloSources :: String
, phyloTerms :: String
, phyloTimeScale :: String
, rank :: String
, ranksep :: String
, ratio :: String
, splines :: String
, style :: String
)
--------------------------------------------------
newtype PhyloJSONSet = PhyloJSONSet
{ _subgraph_cnt :: Int
, directed :: Boolean
, edges :: Array Edge
, objects :: Array PhyloObject
, strict :: Boolean
| GraphData
}
derive instance Generic PhyloJSONSet _
derive instance Eq PhyloJSONSet
instance Show PhyloJSONSet where show = genericShow
derive newtype instance JSON.ReadForeign PhyloJSONSet
--------------------------------------------------
type NodeData =
( height :: String
, label :: String
, name :: String
, nodeType :: String
, pos :: String
, shape :: String
, width :: String
)
data PhyloObject
= Layer
{ _gvid :: Int
, nodes :: Array Int
| GraphData
}
| BranchToNode
{ _gvid :: Int
, age :: String
, bId :: String
, birth :: String
, branchId :: String
, branch_x :: String
, branch_y :: String
, fillcolor :: String
, fontname :: String
, fontsize :: String
, size :: String
, style :: String
| NodeData
}
| GroupToNode
{ _gvid :: Int
, bId :: String
, branchId :: String
, fontname :: String
, foundation :: String
, frequence :: String
, from :: String
, lbl :: String
, penwidth :: String
, role :: String
, seaLvl :: String
, source :: String
, strFrom :: Maybe String
, strTo :: Maybe String
, support :: String
, to :: String
, weight :: String
| NodeData
}
| PeriodToNode
{ _gvid :: Int
, fontsize :: String
, from :: String
, strFrom :: Maybe String
, strTo :: Maybe String
, to :: String
| NodeData
}
derive instance Generic PhyloObject _
derive instance Eq PhyloObject
instance Show PhyloObject where show = genericShow
instance JSON.ReadForeign PhyloObject where
readImpl f = GR.to <$> untaggedSumRep f
--------------------------------------------------
type EdgeData =
( color :: String
, head :: Int
, pos :: String
, tail :: Int
, width :: String
)
data Edge
= GroupToGroup
{ _gvid :: Int
, constraint :: String
, edgeType :: String
, lbl :: String
, penwidth :: String
| EdgeData
}
| BranchToGroup
{ _gvid :: Int
, arrowhead :: String
, edgeType :: String
| EdgeData
}
| BranchToBranch
{ _gvid :: Int
, arrowhead :: String
, style :: String
| EdgeData
}
| GroupToAncestor
{ _gvid :: Int
, arrowhead :: String
, lbl :: String
, penwidth :: String
, style :: String
| EdgeData
}
| PeriodToPeriod
{ _gvid :: Int
| EdgeData
}
derive instance Generic Edge _
derive instance Eq Edge
instance Show Edge where show = genericShow
instance JSON.ReadForeign Edge where
readImpl f = GR.to <$> untaggedSumRep f
src/Gargantext/Components/PhyloExplorer/Layout.purs
View file @ 7a9fdad7
...@@ -4,12 +4,20 @@ module Gargantext.Components.PhyloExplorer.Layout ...@@ -4,12 +4,20 @@ module Gargantext.Components.PhyloExplorer.Layout
import Gargantext.Prelude import Gargantext.Prelude
import DOM.Simple.Console (log2) import DOM.Simple (Window, window)
import Data.Array as Array import Data.Array as Array
import Data.Int (fromString) import Data.Date as Date
import Data.Maybe (maybe) import Data.FoldableWithIndex (forWithIndex_)
import Data.Int as Int
import Data.Maybe (Maybe(..), maybe)
import Data.Number as Number
import Data.String as String import Data.String as String
import Gargantext.Components.PhyloExplorer.Types (PhyloDataset(..)) import Data.Traversable (for)
import Data.Tuple as Tuple
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import FFI.Simple (maybeGetProperty, (..), (...))
import Gargantext.Components.PhyloExplorer.Types (Group, PhyloDataSet(..))
import Gargantext.Utils (nbsp) import Gargantext.Utils (nbsp)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R import Reactix as R
...@@ -20,40 +28,20 @@ here :: R2.Here ...@@ -20,40 +28,20 @@ here :: R2.Here
here = R2.here "Gargantext.Components.PhyloExplorer" here = R2.here "Gargantext.Components.PhyloExplorer"
type Props = type Props =
( phyloDataset :: PhyloDataset ( phyloDataSet :: PhyloDataSet
) )
layout :: R2.Component Props layout :: R2.Component Props
layout = R.createElement layoutCpt layout = R.createElement layoutCpt
layoutCpt :: R.Component Props layoutCpt :: R.Component Props
layoutCpt = here.component "layout" cpt where layoutCpt = here.component "layout" cpt where
cpt { phyloDataset: (PhyloDataset phyloDataset) cpt { phyloDataSet: (PhyloDataSet o)
} _ = do } _ = do
-- States -- States
let
{ phyloDocs
, phyloBranches
, phyloGroups
, phyloTerms
, phyloPeriods
, phyloFoundations
, phyloSources
} = phyloDataset
nbDocs = parseInt phyloDocs
nbBranches = parseInt phyloBranches
nbGroups = parseInt phyloGroups
nbTerms = parseInt phyloTerms
nbPeriods = parseInt phyloPeriods
nbFoundations = parseInt phyloFoundations
sourcesBox <- T.useBox (mempty :: Array String)
sources <- T.useLive T.unequal sourcesBox
-- Hooks
R.useEffectOnce' $ do R.useEffectOnce' $ do
sources' <- pure $ stringArrToArr phyloSources pure unit
T.write_ sources' sourcesBox
-- @hightlightSource -- @hightlightSource
let let
...@@ -126,7 +114,7 @@ layoutCpt = here.component "layout" cpt where ...@@ -126,7 +114,7 @@ layoutCpt = here.component "layout" cpt where
[ H.text "unselect source ✕" ] [ H.text "unselect source ✕" ]
] ]
<> <>
flip Array.mapWithIndex sources flip Array.mapWithIndex o.sources
( \idx val -> ( \idx val ->
H.option H.option
{ value: idx } { value: idx }
...@@ -162,7 +150,10 @@ layoutCpt = here.component "layout" cpt where ...@@ -162,7 +150,10 @@ layoutCpt = here.component "layout" cpt where
phyloCorpus {} [] phyloCorpus {} []
, ,
phyloCorpusInfo phyloCorpusInfo
{ nbDocs, nbFoundations, nbPeriods } { nbDocs : o.nbDocs
, nbFoundations : o.nbFoundations
, nbPeriods : o.nbPeriods
}
[] []
, ,
-- H.div -- H.div
...@@ -176,7 +167,10 @@ layoutCpt = here.component "layout" cpt where ...@@ -176,7 +167,10 @@ layoutCpt = here.component "layout" cpt where
phyloPhyloInfo phyloPhyloInfo
{ nbTerms, nbGroups, nbBranches } { nbTerms : o.nbTerms
, nbGroups : o.nbGroups
, nbBranches : o.nbBranches
}
[] []
, ,
...@@ -261,15 +255,33 @@ layoutCpt = here.component "layout" cpt where ...@@ -261,15 +255,33 @@ layoutCpt = here.component "layout" cpt where
] ]
parseInt :: String -> Int
parseInt s = maybe 0 identity $ fromString s
stringArrToArr :: String -> Array String
stringArrToArr setGlobalDependencies :: Window -> PhyloDataSet -> Effect Unit
= String.replace (String.Pattern "[") (String.Replacement "") setGlobalDependencies w (PhyloDataSet o)
>>> String.replace (String.Pattern "]") (String.Replacement "") = do
>>> String.split (String.Pattern ",") -- _ <- w ... "freq" $ {}
>>> Array.filter (\s -> not eq 0 $ String.length s) -- _ <- w ... "nbBranches" $ o.nbBranches
-- _ <- w ... "nbDocs" $ o.nbDocs
-- _ <- w ... "nbFoundations" $ o.nbFoundations
-- _ <- w ... "nbGroups" $ o.nbGroups
-- _ <- w ... "nbPeriods" $ o.nbPeriods
-- _ <- w ... "nbTerms" $ o.nbTerms
-- _ <- w ... "sources" $ o.sources
-- _ <- w ... "terms" $ {}
-- _ <- w ... "timeScale" $ o.timeScale
-- _ <- w ... "weighted" $ o.weighted
(freq :: Array Int) <- pure $ w .. "freq"
pure unit
-- forWithIndex_ o.foundations $ \i _ -> case maybeGetProperty (show i) freq of
-- Nothing -> freq ... (show i) $ 0
-- Just v -> freq ... (show i) $ (v + 1)
-- pure $ for o.groups \(g :: Group)-> pure unit
-------------------------------------------------------- --------------------------------------------------------
......
src/Gargantext/Components/PhyloExplorer/layout.js → src/Gargantext/Components/PhyloExplorer/Types.js
View file @ 7a9fdad7
'use strict'; 'use strict';
/**
function readJson(file, callback) { * @name yearToDate
var raw = new XMLHttpRequest(); * @param {string} year
raw.overrideMimeType("application/json"); * @returns {Date}
raw.open("GET", file, true); */
raw.onreadystatechange = function() { function yearToDate(year) {
if (raw.readyState === 4 && raw.status == "200") { var d = new Date();
callback(raw.responseText);
} d.setYear(parseInt(year));
} d.setMonth(0);
raw.send(null); d.setDate(1);
return d;
} }
/**
function unhide(mode) { * @name stringToDate
document.querySelector("#reset").style.visibility = "visible"; * @param {string} str
document.querySelector("#label").style.visibility = "visible"; * @returns {Date}
document.querySelector("#heading").style.visibility = "visible"; */
if (mode != "static") { function stringToDate(str) {
document.querySelector("#export").style.visibility = "visible"; var arr = (str.replace('"','')).split('-');
} var d = new Date();
d.setYear(parseInt(arr[0]));
d.setMonth(parseInt(arr[1]));
d.setMonth(d.getMonth() - 1);
d.setDate(parseInt(arr[2]));
return d;
} }
/**
window.addEventListener("load", function() { * @name utcStringToDate
// read the config * @param {string} str
readJson("./config.json",function(data1){ * @returns {Date}
var conf = JSON.parse(data1); */
// available config modes are "static" or "explorable" function utcStringToDate(str) {
if (conf.mode == "static") { var arr = ((str.replace('"','')).replace(' UTC','')).split(/[\s-:]+/);
var path = ""; var d = new Date();
var name = "";
if (conf.path == null || conf.path == "") { d.setYear(parseInt(arr[0]));
path = conf.defaultPath; d.setMonth(parseInt(arr[1]));
name = conf.defaultName; d.setDate(parseInt(arr[2]));
} else { d.setHours(parseInt(arr[3]), parseInt(arr[4]), parseInt(arr[5]))
path = conf.path;
name = conf.pathName; return d;
}
document.querySelector("#file-label").style.display = "none";
document.querySelector("#spin").style.visibility = "visible";
document.getElementById("phyloName").innerHTML = name;
document.querySelector("#phyloName").style.visibility = "visible";
readJson(path,function(data2){
phylo = JSON.parse(data2);
unhide("static");
draw(phylo);
})
}
})
})
function readPhylo(file) {
var reader = new FileReader();
reader.onload = (function(f) {
return function(e) {
try {
json = JSON.parse(e.target.result);
unhide("explorable");
draw(json)
} catch (error) {
console.log(error)
}
};
})(file);
reader.readAsText(file, "UTF-8");
}
// display the Draw button after loading a phylo
document.querySelector("#file-path").onchange = function(){
document.querySelector("#file-name").textContent = (this.files[0].name).substring(0,15) + "...";
// document.querySelector("#file-name").textContent = this.files[0].name;
document.querySelector("#draw").style.display = "inline-block";
}
// draw the phylo
document.querySelector("#draw").onclick = function() {
document.querySelector("#spin").style.visibility = "visible";
readPhylo(document.getElementById("file-path").files[0]);
} }
exports.yearToDate = yearToDate;
function drawPhyloInfo(elemClass, docs, foundations, branches, groups, terms, periods) { exports.stringToDate = stringToDate;
exports.utcStringToDate = utcStringToDate;
ReactDOM.render(React.createElement(phyloCorpus,{}),document.getElementById('phyloCorpus'));
ReactDOM.render(React.createElement(phyloPhylo,{}),document.getElementById('phyloPhylo'));
ReactDOM.render(React.createElement(phyloHow,{}),document.getElementById('phyloHow'));
ReactDOM.render(React.createElement(phyloCorpusInfo,{
nbDocs : docs,
nbFoundations : foundations,
nbPeriods : periods
}),document.getElementById('phyloCorpusInfo'));
ReactDOM.render(React.createElement(phyloPhyloInfo,{
nbTerms : terms,
nbGroups : groups,
nbBranches : branches
}),document.getElementById('phyloPhyloInfo'));
}
function draw(json) { function draw(json) {
// draw PhyloInfo
window.freq = {};
window.terms = {};
window.sources = [];
window.nbDocs = parseFloat(json.phyloDocs);
window.nbBranches = parseFloat(json.phyloBranches);
window.nbGroups = parseFloat(json.phyloGroups);
window.nbTerms = parseFloat(json.phyloTerms);
window.nbPeriods = parseFloat(json.phyloPeriods);
window.nbFoundations = parseFloat(json.phyloFoundations);
window.timeScale = json.phyloTimeScale;
if (json.phyloSources != undefined) {
var sources = stringArrToArr(json.phyloSources);
var checkSource = document.getElementById("checkSource");
for (var i = 0; i < sources.length; i++) {
window.sources.push({source:sources[i],index:i});
}
window.sources.sort(function(a, b){
if(a.source < b.source) { return -1; }
if(a.source > b.source) { return 1; }
return 0;
})
for (var i = 0; i < window.sources.length; i++) {
var option = document.createElement("option");
option.text = window.sources[i].source;
option.value = window.sources[i].index;
checkSource.add(option);
}
}
// original bounding box
bb = ((json.bb).split(',')).map(xy => parseFloat(xy))
drawPhyloInfo("", window.nbDocs, window.nbFoundations, window.nbBranches, window.nbGroups, window.nbTerms, window.nbPeriods)
// draw PhyloIsoline
var branches = json.objects.filter(node => node.nodeType == "branch").map(function(b){
return { x1 : b.branch_x ,
y : b.branch_y ,
x2 : parseFloat(((b.pos).split(','))[0]) ,
label : b.label,
bId : parseInt(b.bId),
gvid : parseInt(b._gvid)
}
});
var periods = json.objects.filter(node => node.nodeType == "period").map(function(p){
var from = yearToDate(p.from),
to = yearToDate(p.to);
if (p.strFrom != undefined) {
if (window.timeScale == "epoch") {
from = utcStringToDate(p.strFrom)
} else {
from = stringToDate(p.strFrom)
}
}
if (p.strTo != undefined) {
if (window.timeScale == "epoch") {
to = utcStringToDate(p.strTo)
} else {
to = stringToDate(p.strTo)
}
}
return { from : from,
to : to,
y : parseFloat(((p.pos).split(','))[1])}
});
// groups // groups
window.weighted = false; window.weighted = false;
......
src/Gargantext/Components/PhyloExplorer/Types.purs
View file @ 7a9fdad7
module Gargantext.Components.PhyloExplorer.Types where module Gargantext.Components.PhyloExplorer.Types
( PhyloDataSet(..)
, Branch, Period, Group
, parsePhyloJSONSet
) where
import Gargantext.Prelude import Gargantext.Prelude
import Data.Array as Array
import Data.Date as Date
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep as GR import Data.Int as Int
import Data.Show.Generic (genericShow) import Data.Maybe (Maybe(..), maybe)
import Gargantext.Utils.SimpleJSON (untaggedSumRep) import Data.Number as Number
import Simple.JSON as JSON import Data.String as String
import Data.Tuple as Tuple
import Data.Tuple.Nested ((/\))
import Gargantext.Components.PhyloExplorer.JSON (PhyloJSONSet(..), PhyloObject(..))
-- @WIP Date or foreign?
foreign import yearToDate :: String -> Date.Date
foreign import stringToDate :: String -> Date.Date
foreign import utcStringToDate :: String -> Date.Date
newtype PhyloDataSet = PhyloDataSet
{ bb :: Array Number
, branches :: Array Branch
, groups :: Array Group
, nbBranches :: Int
, nbDocs :: Int
, nbFoundations :: Int
, nbGroups :: Int
, nbPeriods :: Int
, nbTerms :: Int
, periods :: Array Period
, sources :: Array String
, timeScale :: String
, weighted :: Boolean
}
type GraphData = derive instance Generic PhyloDataSet _
( bb :: String
, color :: String parsePhyloJSONSet :: PhyloJSONSet -> PhyloDataSet
, fontsize :: String parsePhyloJSONSet (PhyloJSONSet o) = PhyloDataSet
, label :: String { bb : parseBB o.bb
, labelloc :: String , branches
, lheight :: String , groups
, lp :: String , nbBranches : parseInt o.phyloBranches
, lwidth :: String , nbDocs : parseInt o.phyloDocs
, name :: String , nbFoundations : parseInt o.phyloFoundations
, nodesep :: String , nbGroups : parseInt o.phyloGroups
, overlap :: String , nbPeriods : parseInt o.phyloPeriods
, phyloBranches :: String , nbTerms : parseInt o.phyloTerms
, phyloDocs :: String , periods
, phyloFoundations :: String , sources : parseSources o.phyloSources
, phyloGroups :: String , timeScale : o.phyloTimeScale
, phyloPeriods :: String , weighted : getGlobalWeightedValue groups
, phyloSources :: String
, phyloTerms :: String
, phyloTimeScale :: String
, rank :: String
, ranksep :: String
, ratio :: String
, splines :: String
, style :: String
)
--------------------------------------------------
newtype PhyloDataset = PhyloDataset
{ _subgraph_cnt :: Int
, directed :: Boolean
, edges :: Array Edge
, objects :: Array Object
, strict :: Boolean
| GraphData
} }
derive instance Generic PhyloDataset _ where
derive instance Eq PhyloDataset epochTS = o.phyloTimeScale == "epoch"
instance Show PhyloDataset where show = genericShow branches = parseBranches o.objects
derive newtype instance JSON.ReadForeign PhyloDataset groups = parseGroups epochTS o.objects
periods = parsePeriods epochTS o.objects
-------------------------------------------------- -----------------------------------------------------------
type NodeData = data Branch = Branch
( height :: String { bId :: Int
, gvid :: Int
, label :: String , label :: String
, name :: String , x1 :: String
, nodeType :: String , x2 :: Number
, pos :: String , y :: String
, shape :: String
, width :: String
)
data Object
= Layer
{ _gvid :: Int
, nodes :: Array Int
| GraphData
}
| BranchToNode
{ _gvid :: Int
, age :: String
, bId :: String
, birth :: String
, branchId :: String
, branch_x :: String
, branch_y :: String
, fillcolor :: String
, fontname :: String
, fontsize :: String
, size :: String
, style :: String
| NodeData
}
| GroupToNode
{ _gvid :: Int
, bId :: String
, branchId :: String
, fontname :: String
, foundation :: String
, frequence :: String
, from :: String
, lbl :: String
, penwidth :: String
, role :: String
, seaLvl :: String
, source :: String
, strFrom :: String
, strTo :: String
, support :: String
, to :: String
, weight :: String
| NodeData
}
| PeriodToNode
{ _gvid :: Int
, fontsize :: String
, from :: String
, strFrom :: String
, strTo :: String
, to :: String
| NodeData
} }
derive instance Generic Object _ parseBranches :: Array PhyloObject -> Array Branch
derive instance Eq Object parseBranches
instance Show Object where show = genericShow = map parse
instance JSON.ReadForeign Object where >>> Array.catMaybes
readImpl f = GR.to <$> untaggedSumRep f
where
parse :: PhyloObject -> Maybe Branch
-------------------------------------------------- parse (BranchToNode o) = Just $ Branch
{ bId : parseInt o.bId
type EdgeData = , gvid : o._gvid
( color :: String , label : o.label
, head :: Int , x1 : o.branch_x
, pos :: String , x2 : Tuple.fst $ parsePos o.pos
, tail :: Int , y : o.branch_y
, width :: String
)
data Edge
= GroupToGroup
{ _gvid :: Int
, constraint :: String
, edgeType :: String
, lbl :: String
, penwidth :: String
| EdgeData
} }
| BranchToGroup parse _ = Nothing
{ _gvid :: Int
, arrowhead :: String -----------------------------------------------------------
, edgeType :: String
| EdgeData data Period = Period
} { from :: Date.Date
| BranchToBranch , to :: Date.Date
{ _gvid :: Int , y :: Number
, arrowhead :: String
, style :: String
| EdgeData
} }
| GroupToAncestor
{ _gvid :: Int parsePeriods :: Boolean -> Array PhyloObject -> Array Period
, arrowhead :: String parsePeriods epoch
, lbl :: String = map parse
, penwidth :: String >>> Array.catMaybes
, style :: String
| EdgeData where
parse :: PhyloObject -> Maybe Period
parse (PeriodToNode o) = Just $ Period
{ from : parseNodeDate o.strFrom o.from epoch
, to : parseNodeDate o.strTo o.to epoch
, y : Tuple.snd $ parsePos o.pos
} }
| PeriodToPeriod parse _ = Nothing
{ _gvid :: Int
| EdgeData -----------------------------------------------------------
data Group = Group
{ bId :: Int
, foundation :: Array Int -- @WIP: Array String ???
, from :: Date.Date
, gId :: Int
, label :: Array String
, role :: Array Int
, size :: Int
, source :: Array String
, to :: Date.Date
, weight :: Number
, x :: Number
, y :: Number
} }
derive instance Generic Edge _ parseGroups :: Boolean -> Array PhyloObject -> Array Group
derive instance Eq Edge parseGroups epoch
instance Show Edge where show = genericShow = map parse
instance JSON.ReadForeign Edge where >>> Array.catMaybes
readImpl f = GR.to <$> untaggedSumRep f
where
parse :: PhyloObject -> Maybe Group
parse (GroupToNode o) = Just $ Group
{ from : parseNodeDate o.strFrom o.from epoch
, to : parseNodeDate o.strTo o.to epoch
, x : Tuple.fst $ parsePos o.pos
, y : Tuple.snd $ parsePos o.pos
, bId : parseInt o.bId
, gId : o._gvid
, size : parseInt o.support
, source: parseSources o.source
, weight: stringedMaybeToNumber o.weight
, label : stringedArrayToArray o.lbl
, role : stringedArrayToArray' o.role
, foundation: stringedArrayToArray' o.foundation
}
parse _ = Nothing
-----------------------------------------------------------
parseInt :: String -> Int
parseInt s = maybe 0 identity $ Int.fromString s
parseFloat :: String -> Number
parseFloat s = maybe 0.0 identity $ Number.fromString s
parseSources :: String -> Array String
parseSources
= String.replace (String.Pattern "[") (String.Replacement "")
>>> String.replace (String.Pattern "]") (String.Replacement "")
>>> String.split (String.Pattern ",")
>>> Array.filter (\s -> not eq 0 $ String.length s)
>>> Array.sort
parseBB :: String -> Array Number
parseBB
= String.split (String.Pattern ",")
>>> map parseFloat
parseNodeDate :: Maybe String -> String -> Boolean -> Date.Date
parseNodeDate Nothing year _ = yearToDate(year)
parseNodeDate (Just str) _ true = utcStringToDate(str)
parseNodeDate (Just str) _ false = stringToDate(str)
parsePos :: String -> Tuple.Tuple Number Number
parsePos
= String.split (String.Pattern ",")
>>> \a -> (p $ Array.index a 0) /\
(p $ Array.index a 1)
where
p = case _ of
Nothing -> 0.0
Just s -> parseFloat s
-- @WIP: why taking last value? use `any`?
getGlobalWeightedValue :: Array Group -> Boolean
getGlobalWeightedValue
= Array.last
>>> case _ of
Nothing -> false
Just (Group o) -> o.weight > 0.0
stringedMaybeToNumber :: String -> Number
stringedMaybeToNumber "Nothing" = 0.0
stringedMaybeToNumber s =
s # String.replace (String.Pattern "Just ") (String.Replacement "")
>>> parseFloat
stringedArrayToArray :: String -> Array String
stringedArrayToArray str
= str # String.length
>>> (\length -> String.splitAt (length - 1) str)
>>> (\{ after } -> String.splitAt 1 after)
>>> (\{ after } -> String.split (String.Pattern "|") after)
>>> map String.trim
stringedArrayToArray' :: String -> Array Int
stringedArrayToArray'
= stringedArrayToArray
>>> map parseInt
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment