Commit 67818106 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'dev' into testing

parents 702e218f 4df661c3
Pipeline #6461 passed with stages
in 18 minutes and 58 seconds
{ {
"name": "Gargantext", "name": "Gargantext",
"version": "0.0.7.1.11", "version": "0.0.7.1.14",
"scripts": { "scripts": {
"build": "spago build", "build": "spago build",
"bundle": "spago bundle --module Main --outfile dist/bundle.js", "bundle": "spago bundle --module Main --outfile dist/bundle.js",
......
...@@ -21,6 +21,7 @@ here = R2.here "Gargantext.Components.Frame.Layout" ...@@ -21,6 +21,7 @@ here = R2.here "Gargantext.Components.Frame.Layout"
type Props = type Props =
( frame :: NodePoly Hyperdata ( frame :: NodePoly Hyperdata
, nodeType :: NodeType , nodeType :: NodeType
, nodeId :: Int
) )
layout :: R2.Leaf Props layout :: R2.Leaf Props
...@@ -29,6 +30,7 @@ layoutCpt :: R.Component Props ...@@ -29,6 +30,7 @@ layoutCpt :: R.Component Props
layoutCpt = here.component "main" cpt where layoutCpt = here.component "main" cpt where
cpt { frame: NodePoly { hyperdata: Hyperdata { base, frame_id } } cpt { frame: NodePoly { hyperdata: Hyperdata { base, frame_id } }
, nodeType , nodeType
, nodeId
} _ = case nodeType of } _ = case nodeType of
-- Visio Node -- Visio Node
...@@ -58,7 +60,7 @@ layoutCpt = here.component "main" cpt where ...@@ -58,7 +60,7 @@ layoutCpt = here.component "main" cpt where
, ,
H.a H.a
{ className : "fa fa-video-camera fa-5x" { className : "fa fa-video-camera fa-5x"
, href : hframeUrl nodeType base frame_id , href : hframeUrl nodeType base frame_id nodeId
, target: "_blank" , target: "_blank"
} }
[] []
...@@ -92,7 +94,7 @@ layoutCpt = here.component "main" cpt where ...@@ -92,7 +94,7 @@ layoutCpt = here.component "main" cpt where
[ [
-- H.script { src: "https://visio.gargantext.org/external_api.js"} [], -- H.script { src: "https://visio.gargantext.org/external_api.js"} [],
H.iframe H.iframe
{ src: hframeUrl nodeType base frame_id { src: hframeUrl nodeType base frame_id nodeId
, width: "100%" , width: "100%"
, height: "100%" , height: "100%"
} }
...@@ -132,8 +134,8 @@ layoutCpt = here.component "main" cpt where ...@@ -132,8 +134,8 @@ layoutCpt = here.component "main" cpt where
-------------------------------------------------------------- --------------------------------------------------------------
hframeUrl :: NodeType -> Base -> FrameId -> String hframeUrl :: NodeType -> Base -> FrameId -> Int -> String
hframeUrl NodeFrameNotebook base frame_id = base <> "/" <> frame_id -- Temp fix : frame_id is currently the whole url created hframeUrl NodeFrameNotebook base frame_id _ = base <> "/" <> frame_id -- Temp fix : frame_id is currently the whole url created
hframeUrl Calc base frame_id = base <> "/" <> frame_id hframeUrl Calc base frame_id _ = base <> "/" <> frame_id
hframeUrl NodeFrameVisio base frame_id = base <> "/" <> frame_id hframeUrl NodeFrameVisio base frame_id _ = base <> "/" <> frame_id
hframeUrl _ base frame_id = base <> "/" <> frame_id <> "?view" -- "?both" hframeUrl _ base frame_id node_id = base <> "/" <> frame_id <> "?view&node_id=" <> show node_id -- "?both"
...@@ -40,7 +40,7 @@ nodeCpt = R2.hereComponent here "node" hCpt where ...@@ -40,7 +40,7 @@ nodeCpt = R2.hereComponent here "node" hCpt where
-- | -- |
session <- useSession session <- useSession
state' /\ state <- R2.useBox' (Nothing :: Maybe PhyloSet) state' /\ state <- R2.useBox' (Nothing :: Maybe (Maybe PhyloSet))
cache' /\ cache <- R2.useBox' (defaultCacheParams :: CacheParams) cache' /\ cache <- R2.useBox' (defaultCacheParams :: CacheParams)
-- | Computed -- | Computed
...@@ -92,8 +92,9 @@ nodeCpt = R2.hereComponent here "node" hCpt where ...@@ -92,8 +92,9 @@ nodeCpt = R2.hereComponent here "node" hCpt where
] ]
] ]
, defaultSlot: , defaultSlot:
R2.fromMaybe state' \(PhyloSet { corpusId, listId, phyloData, phyloConfig}) -> R2.fromMaybe state' \p ->
case p of
Just (PhyloSet {phyloData, phyloConfig, corpusId, listId}) ->
let let
state_ :: Record PhyloStore.State state_ :: Record PhyloStore.State
state_ = state_ =
...@@ -116,4 +117,7 @@ nodeCpt = R2.hereComponent here "node" hCpt where ...@@ -116,4 +117,7 @@ nodeCpt = R2.hereComponent here "node" hCpt where
layout layout
{} {}
] ]
_ -> H.p
{ className: "text-center pt-10" }
[ H.text "Phylo not generated yet, please update the node settings to see your phylonometry." ]
} }
...@@ -70,6 +70,7 @@ nodeCpt = R2.hereComponent here "node" hCpt where ...@@ -70,6 +70,7 @@ nodeCpt = R2.hereComponent here "node" hCpt where
layout layout
{ frame { frame
, nodeType , nodeType
, nodeId
} }
} }
......
...@@ -30,7 +30,7 @@ import Simple.JSON.Generics as JSONG ...@@ -30,7 +30,7 @@ import Simple.JSON.Generics as JSONG
import Type.Proxy (Proxy(..)) import Type.Proxy (Proxy(..))
get :: S.Session -> NodeID -> AffRESTError (PhyloSet) get :: S.Session -> NodeID -> AffRESTError (Maybe PhyloSet)
get session nodeId = request >>= (_ <#> parseToPhyloSet) >>> pure get session nodeId = request >>= (_ <#> parseToPhyloSet) >>> pure
where where
request :: AffRESTError (PhyloJSON) request :: AffRESTError (PhyloJSON)
......
...@@ -23,7 +23,7 @@ import Simple.JSON as JSON ...@@ -23,7 +23,7 @@ import Simple.JSON as JSON
newtype PhyloJSON = PhyloJSON newtype PhyloJSON = PhyloJSON
{ pd_corpusId :: Int { pd_corpusId :: Int
, pd_listId :: Int , pd_listId :: Int
, pd_data :: , pd_data :: Maybe (
{ _subgraph_cnt :: Int { _subgraph_cnt :: Int
, directed :: Boolean , directed :: Boolean
, edges :: Array RawEdge , edges :: Array RawEdge
...@@ -31,7 +31,8 @@ newtype PhyloJSON = PhyloJSON ...@@ -31,7 +31,8 @@ newtype PhyloJSON = PhyloJSON
, strict :: Boolean , strict :: Boolean
| GraphData | GraphData
} }
, pd_config :: )
, pd_config :: Maybe (
{ clique :: Cluster { clique :: Cluster
, exportLabel :: Array PhyloLabel , exportLabel :: Array PhyloLabel
, exportSort :: Sort , exportSort :: Sort
...@@ -42,6 +43,7 @@ newtype PhyloJSON = PhyloJSON ...@@ -42,6 +43,7 @@ newtype PhyloJSON = PhyloJSON
, timeUnit :: TimeUnit , timeUnit :: TimeUnit
| ConfigData | ConfigData
} }
)
} }
derive instance Generic PhyloJSON _ derive instance Generic PhyloJSON _
......
...@@ -56,8 +56,8 @@ derive instance Generic PhyloSet _ ...@@ -56,8 +56,8 @@ derive instance Generic PhyloSet _
derive instance Eq PhyloSet derive instance Eq PhyloSet
instance Show PhyloSet where show = genericShow instance Show PhyloSet where show = genericShow
parseToPhyloSet :: PhyloJSON -> PhyloSet parseToPhyloSet :: PhyloJSON -> Maybe PhyloSet
parseToPhyloSet (PhyloJSON o) = PhyloSet parseToPhyloSet (PhyloJSON o@{pd_data: Just p, pd_config: Just c}) = Just $ PhyloSet
{ corpusId : o.pd_corpusId { corpusId : o.pd_corpusId
, listId : o.pd_listId , listId : o.pd_listId
, phyloData : PhyloData , phyloData : PhyloData
...@@ -91,9 +91,6 @@ parseToPhyloSet (PhyloJSON o) = PhyloSet ...@@ -91,9 +91,6 @@ parseToPhyloSet (PhyloJSON o) = PhyloSet
} }
where where
p = o.pd_data
c = o.pd_config
epochTS = p.phyloTimeScale == "epoch" epochTS = p.phyloTimeScale == "epoch"
ancestorLinks = parseAncestorLinks p.edges ancestorLinks = parseAncestorLinks p.edges
...@@ -102,6 +99,7 @@ parseToPhyloSet (PhyloJSON o) = PhyloSet ...@@ -102,6 +99,7 @@ parseToPhyloSet (PhyloJSON o) = PhyloSet
groups = parseGroups epochTS p.objects groups = parseGroups epochTS p.objects
links = parseLinks p.edges links = parseLinks p.edges
periods = parsePeriods epochTS p.objects periods = parsePeriods epochTS p.objects
parseToPhyloSet _ = Nothing
---------------------------------------------------------------------- ----------------------------------------------------------------------
......
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