Commit 6469b1b6 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[Demo Version] Graph Title / Legend / Side Right Panel / Role fixed.

parent b0ddf801
...@@ -46,6 +46,7 @@ newtype GraphData = GraphData ...@@ -46,6 +46,7 @@ newtype GraphData = GraphData
derive instance newtypeGraphData :: Newtype GraphData _ derive instance newtypeGraphData :: Newtype GraphData _
newtype MetaData = MetaData newtype MetaData = MetaData
{ {
title :: String title :: String
...@@ -91,8 +92,9 @@ instance decodeJsonLegend :: DecodeJson Legend where ...@@ -91,8 +92,9 @@ instance decodeJsonLegend :: DecodeJson Legend where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
id_ <- obj .? "id" id_ <- obj .? "id"
color <- obj .? "color"
label <- obj .? "label" label <- obj .? "label"
pure $ Legend { id_, label } pure $ Legend { id_, color, label }
instance decodeJsonCluster :: DecodeJson Cluster where instance decodeJsonCluster :: DecodeJson Cluster where
...@@ -110,7 +112,7 @@ instance decodeJsonEdge :: DecodeJson Edge where ...@@ -110,7 +112,7 @@ instance decodeJsonEdge :: DecodeJson Edge where
weight <- obj .? "weight" weight <- obj .? "weight"
pure $ Edge { id_, source, target, weight } pure $ Edge { id_, source, target, weight }
newtype Legend = Legend {id_ ::Int , label :: String} newtype Legend = Legend {id_ ::Int , color :: String, label :: String}
instance eqLegend :: Eq Legend where instance eqLegend :: Eq Legend where
eq (Legend l1) (Legend l2) = eq l1.id_ l2.id_ eq (Legend l1) (Legend l2) = eq l1.id_ l2.id_
...@@ -119,16 +121,9 @@ instance ordLegend :: Ord Legend where ...@@ -119,16 +121,9 @@ instance ordLegend :: Ord Legend where
compare (Legend l1) (Legend l2) = compare l1.id_ l2.id_ compare (Legend l1) (Legend l2) = compare l1.id_ l2.id_
getLegendData :: GraphData -> Array Legend getLegendData :: GraphData -> Array Legend
getLegendData (GraphData {nodes, edges}) = nn getLegendData (GraphData {nodes, edges, metaData}) = getLegend metaData
where
--mp (NonEmptyArray a ary) = [a] <> (if length ary > 0 then [unsafePartial $ fromJust $ head ary] else [])
n = sort $ map t' nodes
g = group n
nn = take 5 $ concat $ map fromFoldable g -- TODO: fix this after checking the output
t' :: Node -> Legend
t' (Node r) = Legend { id_ : clustDefault, label : r.label}
where where
(Cluster {clustDefault}) = r.attributes getLegend (Just (MetaData {legend})) = legend
getLegend Nothing = []
...@@ -68,9 +68,9 @@ getLastName' = fromMaybe "Empty last name" <<< _.lastName <<< unwrap ...@@ -68,9 +68,9 @@ getLastName' = fromMaybe "Empty last name" <<< _.lastName <<< unwrap
-- | ContactWhere infos -- | ContactWhere infos
-- TODO factor below -- TODO factor below
getRole :: Array ContactWhere -> String getRole :: Array ContactWhere -> String
getRole obj = joinWith ", " $ getRole' <$> obj getRole = maybe "Empty Contact-Where" getRole' <<< head
where where
getRole' = fromMaybe "Empty role" <<< _.role <<< unwrap getRole' = fromMaybe "Empty Role" <<< _.role <<< unwrap
getOrga :: Array ContactWhere -> String getOrga :: Array ContactWhere -> String
getOrga = maybe "Emtpy Contact-Where" getOrga' <<< head getOrga = maybe "Emtpy Contact-Where" getOrga' <<< head
......
...@@ -96,7 +96,6 @@ performAction (LoadGraph fp) _ _ = void do ...@@ -96,7 +96,6 @@ performAction (LoadGraph fp) _ _ = void do
Just (AuthData {token,tree_id }) -> Just (AuthData {token,tree_id }) ->
modifyState \(State s) -> State s {graphData = resp, sigmaGraphData = Just $ convert resp, legendData = getLegendData resp, treeId = Just tree_id} modifyState \(State s) -> State s {graphData = resp, sigmaGraphData = Just $ convert resp, legendData = getLegendData resp, treeId = Just tree_id}
Nothing -> Nothing ->
modifyState \(State s) -> State s { graphData = resp, sigmaGraphData = Just $ convert resp, legendData = getLegendData resp, treeId = Nothing} modifyState \(State s) -> State s { graphData = resp, sigmaGraphData = Just $ convert resp, legendData = getLegendData resp, treeId = Nothing}
-- TODO: here one might `catchError getNodes` to visually empty the -- TODO: here one might `catchError getNodes` to visually empty the
-- graph. -- graph.
...@@ -155,8 +154,9 @@ render d p (State s) c = ...@@ -155,8 +154,9 @@ render d p (State s) c =
, edgeShapes {"default" : edgeShape.curve} , edgeShapes {"default" : edgeShape.curve}
] ]
] ]
<> -- TODO clean unused code: this seems to be not used
[dispLegend s.legendData] -- <>
-- [dispLegend s.legendData]
forceAtlas2Config :: { slowDown :: Number forceAtlas2Config :: { slowDown :: Number
, startingIterations :: Number , startingIterations :: Number
...@@ -290,9 +290,9 @@ nOverlap ns = { nodes : ns ...@@ -290,9 +290,9 @@ nOverlap ns = { nodes : ns
dispLegend :: Array Legend -> ReactElement dispLegend :: Array Legend -> ReactElement
dispLegend ary = div [] $ map dl ary dispLegend ary = div [] $ map dl ary
where where
dl (Legend {id_, label}) = dl (Legend {id_, color, label}) =
p [] p []
[ span [style {width : 10, height : 10, backgroundColor : intColor id_, display: "inline-block"}] [] [ span [style {width : 10, height : 10, backgroundColor : intColor id_ , display: "inline-block"}] []
, text $ " " <> label , text $ " " <> label
] ]
......
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