Commit c37cc12f authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev' into dev-ngrams-table-cache-in-local-storage

parents 63b87cae 2d431463
This diff is collapsed.
{ {
"name": "Gargantext", "name": "Gargantext",
"version": "0.0.1.91.3", "version": "0.0.1.91.7",
"scripts": { "scripts": {
"rebase-set": "spago package-set-upgrade && spago psc-package-insdhall", "rebase-set": "spago package-set-upgrade && spago psc-package-insdhall",
"rebuild-set": "spago psc-package-insdhall", "rebuild-set": "spago psc-package-insdhall",
......
This diff is collapsed.
let upstream = let upstream =
./packages-0.13.8-20200822.dhall https://github.com/purescript/package-sets/releases/download/psc-0.13.8-20201021/packages.dhall
let overrides = let overrides =
{ thermite = { thermite =
......
...@@ -12,10 +12,10 @@ ...@@ -12,10 +12,10 @@
module Gargantext.Components.Annotation.AnnotatedField where module Gargantext.Components.Annotation.AnnotatedField where
import Prelude import Prelude
import Data.Maybe ( Maybe(..), maybe, isJust, isNothing ) import Data.Maybe ( Maybe(..), maybe )
import Data.Tuple ( Tuple(..) ) import Data.Tuple ( Tuple(..) )
import Data.Tuple.Nested ( (/\) ) import Data.Tuple.Nested ( (/\) )
import DOM.Simple.Console (log, log2) import DOM.Simple.Console (log2)
import DOM.Simple.Event as DE import DOM.Simple.Event as DE
import Effect ( Effect ) import Effect ( Effect )
import Reactix as R import Reactix as R
...@@ -27,7 +27,6 @@ import Gargantext.Components.Annotation.Utils ( termBootstrapClass ) ...@@ -27,7 +27,6 @@ import Gargantext.Components.Annotation.Utils ( termBootstrapClass )
import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram) import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram)
import Gargantext.Components.Annotation.Menu ( AnnotationMenu, annotationMenu, MenuType(..) ) import Gargantext.Components.Annotation.Menu ( AnnotationMenu, annotationMenu, MenuType(..) )
import Gargantext.Utils.Selection as Sel import Gargantext.Utils.Selection as Sel
import Gargantext.Utils.Reactix as R2
thisModule :: String thisModule :: String
thisModule = "Gargantext.Components.Annotation.AnnotatedField" thisModule = "Gargantext.Components.Annotation.AnnotatedField"
...@@ -58,11 +57,11 @@ annotatedFieldComponent = R.hooksComponentWithModule thisModule "annotatedField" ...@@ -58,11 +57,11 @@ annotatedFieldComponent = R.hooksComponentWithModule thisModule "annotatedField"
onSelect :: String -> Maybe TermList -> MouseEvent -> Effect Unit onSelect :: String -> Maybe TermList -> MouseEvent -> Effect Unit
onSelect text' Nothing event = do onSelect text' Nothing event = do
log2 "[onSelect] text'" text' --log2 "[onSelect] text'" text'
maybeShowMenu setMenu menuRef setTermList ngrams event maybeShowMenu setMenu menuRef setTermList ngrams event
onSelect text' (Just list) event = do onSelect text' (Just list) event = do
log2 "[onSelect] text'" text' --log2 "[onSelect] text'" text'
log2 "[onSelect] list" list --log2 "[onSelect] list" (show list)
let x = E.clientX event let x = E.clientX event
y = E.clientY event y = E.clientY event
setList t = do setList t = do
...@@ -77,8 +76,8 @@ annotatedFieldComponent = R.hooksComponentWithModule thisModule "annotatedField" ...@@ -77,8 +76,8 @@ annotatedFieldComponent = R.hooksComponentWithModule thisModule "annotatedField"
, onClose: \_ -> R.setRef menuRef Nothing , onClose: \_ -> R.setRef menuRef Nothing
, setList , setList
} }
--setMenu (const $ menu)
R.setRef menuRef menu R.setRef menuRef menu
setMenu $ const menu
mapCompile (Tuple t l) = {text: t, list: l, onSelect} mapCompile (Tuple t l) = {text: t, list: l, onSelect}
compiled = map mapCompile $ compile ngrams text compiled = map mapCompile $ compile ngrams text
...@@ -105,8 +104,8 @@ addMenuCpt = R.hooksComponentWithModule thisModule "addMenu" cpt ...@@ -105,8 +104,8 @@ addMenuCpt = R.hooksComponentWithModule thisModule "addMenu" cpt
R.useEffect' $ do R.useEffect' $ do
let m = R.readRef menuRef let m = R.readRef menuRef
log2 "[addMenu] menuRef" m --log2 "[addMenu] menuRef" m
log2 "[addMenu] mMenu" mMenu --log2 "[addMenu] mMenu" mMenu
setmMenu $ const m setmMenu $ const m
pure $ case mMenu of pure $ case mMenu of
...@@ -116,7 +115,7 @@ addMenuCpt = R.hooksComponentWithModule thisModule "addMenu" cpt ...@@ -116,7 +115,7 @@ addMenuCpt = R.hooksComponentWithModule thisModule "addMenu" cpt
-- forall e. IsMouseEvent e => R.Setter (Maybe AnnotationMenu) -> R.Setter ? -> ? -> e -> Effect Unit -- forall e. IsMouseEvent e => R.Setter (Maybe AnnotationMenu) -> R.Setter ? -> ? -> e -> Effect Unit
maybeShowMenu setMenu menuRef setTermList ngrams event = do maybeShowMenu setMenu menuRef setTermList ngrams event = do
s <- Sel.getSelection s <- Sel.getSelection
log2 "[maybeShowMenu] s" s --log2 "[maybeShowMenu] s" s
case s of case s of
Just sel -> do Just sel -> do
case Sel.selectionToString sel of case Sel.selectionToString sel of
...@@ -128,11 +127,11 @@ maybeShowMenu setMenu menuRef setTermList ngrams event = do ...@@ -128,11 +127,11 @@ maybeShowMenu setMenu menuRef setTermList ngrams event = do
list = findNgramTermList ngrams n list = findNgramTermList ngrams n
setList t = do setList t = do
setTermList n list t setTermList n list t
--setMenu (const Nothing)
R.setRef menuRef Nothing R.setRef menuRef Nothing
--setMenu (const Nothing)
E.preventDefault event E.preventDefault event
range <- Sel.getRange sel 0 range <- Sel.getRange sel 0
log2 "[maybeShowMenu] selection range" $ Sel.rangeToTuple range --log2 "[maybeShowMenu] selection range" $ Sel.rangeToTuple range
let menu = Just { let menu = Just {
x x
, y , y
...@@ -141,8 +140,8 @@ maybeShowMenu setMenu menuRef setTermList ngrams event = do ...@@ -141,8 +140,8 @@ maybeShowMenu setMenu menuRef setTermList ngrams event = do
, onClose: \_ -> R.setRef menuRef Nothing , onClose: \_ -> R.setRef menuRef Nothing
, setList , setList
} }
--setMenu (const $ menu)
R.setRef menuRef menu R.setRef menuRef menu
setMenu $ const $ menu
Nothing -> pure unit Nothing -> pure unit
-- Nothing -> do -- Nothing -> do
-- R.setRef menuRef Nothing -- R.setRef menuRef Nothing
......
...@@ -121,8 +121,9 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where ...@@ -121,8 +121,9 @@ appCpt = R.hooksComponentWithModule thisModule "app" cpt where
--, treeReload --, treeReload
} }
RouteFile sid nodeId -> withSession sid $ \session -> forested $ fileLayout { nodeId, session } RouteFile sid nodeId -> withSession sid $ \session -> forested $ fileLayout { nodeId, session }
RouteFrameCalc sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session } RouteFrameCalc sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session, nodeType: GT.NodeFrameCalc }
RouteFrameWrite sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session } RouteFrameCode sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session, nodeType: GT.NodeFrameCode }
RouteFrameWrite sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session, nodeType: GT.NodeFrameWrite}
Team sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session } Team sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
Texts sid nodeId -> withSession sid $ \session -> forested $ textsLayout { frontends, nodeId, session, sessionUpdate } Texts sid nodeId -> withSession sid $ \session -> forested $ textsLayout { frontends, nodeId, session, sessionUpdate }
UserPage sid nodeId -> withSession sid $ \session -> forested $ userLayout { asyncTasks, frontends, nodeId, session } UserPage sid nodeId -> withSession sid $ \session -> forested $ userLayout { asyncTasks, frontends, nodeId, session }
......
This diff is collapsed.
...@@ -126,6 +126,7 @@ settingsBox Team = ...@@ -126,6 +126,7 @@ settingsBox Team =
, Annuaire , Annuaire
, NodeFrameWrite , NodeFrameWrite
, NodeFrameCalc , NodeFrameCalc
, NodeFrameCode
] ]
, Share , Share
, Delete , Delete
...@@ -316,6 +317,22 @@ settingsBox NodeFrameCalc = ...@@ -316,6 +317,22 @@ settingsBox NodeFrameCalc =
] ]
} }
settingsBox NodeFrameCode =
SettingsBox { show : true
, edit : true
, doc : Documentation NodeFrameCode
, buttons : [ Add [ NodeFrameCalc
, NodeFrameWrite
, NodeFrameCode
]
, Move moveFrameParameters
, Delete
]
}
settingsBox NodeFile = settingsBox NodeFile =
SettingsBox { show: true SettingsBox { show: true
......
...@@ -235,7 +235,7 @@ sigmaSettings = ...@@ -235,7 +235,7 @@ sigmaSettings =
, defaultHoverLabelBGColor: "#fff" , defaultHoverLabelBGColor: "#fff"
, defaultHoverLabelColor: "#000" , defaultHoverLabelColor: "#000"
, defaultLabelColor: "#000" -- labels text color , defaultLabelColor: "#000" -- labels text color
, defaultLabelSize: 8.0 -- (old tina: showLabelsIfZoom) , defaultLabelSize: 15.0 -- (old tina: showLabelsIfZoom)
, defaultNodeBorderColor : "#000" -- <- if nodeBorderColor = 'default' , defaultNodeBorderColor : "#000" -- <- if nodeBorderColor = 'default'
, defaultNodeColor: "#FFF" , defaultNodeColor: "#FFF"
, doubleClickEnabled: false -- indicates whether or not the graph can be zoomed on double-click , doubleClickEnabled: false -- indicates whether or not the graph can be zoomed on double-click
......
This diff is collapsed.
...@@ -17,7 +17,12 @@ import Reactix as R ...@@ -17,7 +17,12 @@ import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.NgramsTable.Core (Action(..), Dispatch, NgramsElement, NgramsPatch(..), NgramsTable, NgramsTablePatch, NgramsTerm, Replace, _NgramsElement, _NgramsRepoElement, _PatchMap, _children, _list, _ngrams, _occurrences, ngramsTermText, replace, singletonNgramsTablePatch) import Gargantext.Components.NgramsTable.Core ( Action(..), Dispatch, NgramsElement, NgramsPatch(..)
, NgramsTable, NgramsTablePatch, NgramsTerm, Replace
, _NgramsElement, _NgramsRepoElement, _PatchMap, _children
, _list, _ngrams, _occurrences, ngramsTermText, replace
, singletonNgramsTablePatch, setTermListA
)
import Gargantext.Components.Table as Tbl import Gargantext.Components.Table as Tbl
import Gargantext.Types as T import Gargantext.Types as T
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -207,7 +212,7 @@ renderNgramsItemCpt = R.hooksComponentWithModule thisModule "renderNgramsItem" c ...@@ -207,7 +212,7 @@ renderNgramsItemCpt = R.hooksComponentWithModule thisModule "renderNgramsItem" c
ngramsStyle = [termStyle termList ngramsOpacity] ngramsStyle = [termStyle termList ngramsOpacity]
ngramsEdit = Just <<< dispatch <<< SetParentResetChildren <<< Just <<< view _ngrams ngramsEdit = Just <<< dispatch <<< SetParentResetChildren <<< Just <<< view _ngrams
ngramsClick ngramsClick
= Just <<< dispatch <<< cycleTermListItem <<< view _ngrams = Just <<< dispatch <<< CoreAction <<< cycleTermListItem <<< view _ngrams
-- ^ This is the old behavior it is nicer to use since one can -- ^ This is the old behavior it is nicer to use since one can
-- rapidly change the ngram list without waiting for confirmation. -- rapidly change the ngram list without waiting for confirmation.
-- However this might expose bugs. One of them can be reproduced -- However this might expose bugs. One of them can be reproduced
...@@ -226,7 +231,7 @@ renderNgramsItemCpt = R.hooksComponentWithModule thisModule "renderNgramsItem" c ...@@ -226,7 +231,7 @@ renderNgramsItemCpt = R.hooksComponentWithModule thisModule "renderNgramsItem" c
in in
H.input { checked: chkd H.input { checked: chkd
, className: "checkbox" , className: "checkbox"
, on: { change: const $ dispatch $ , on: { change: const $ dispatch $ CoreAction $
setTermListA ngrams (replace termList termList'') } setTermListA ngrams (replace termList termList'') }
, readOnly: ngramsTransient , readOnly: ngramsTransient
, type: "checkbox" } , type: "checkbox" }
...@@ -245,13 +250,6 @@ termStyle T.StopTerm opacity = DOM.style { color: "red", opacity ...@@ -245,13 +250,6 @@ termStyle T.StopTerm opacity = DOM.style { color: "red", opacity
, textDecoration: "line-through" } , textDecoration: "line-through" }
termStyle T.CandidateTerm opacity = DOM.style { color: "black", opacity } termStyle T.CandidateTerm opacity = DOM.style { color: "black", opacity }
setTermListA :: NgramsTerm -> Replace T.TermList -> Action
setTermListA n patch_list =
CommitPatch $
singletonNgramsTablePatch n $
NgramsPatch { patch_list, patch_children: mempty }
tablePatchHasNgrams :: NgramsTablePatch -> NgramsTerm -> Boolean tablePatchHasNgrams :: NgramsTablePatch -> NgramsTerm -> Boolean
tablePatchHasNgrams ngramsTablePatch ngrams = tablePatchHasNgrams ngramsTablePatch ngrams =
isJust $ ngramsTablePatch.ngramsPatches ^. _PatchMap <<< at ngrams isJust $ ngramsTablePatch.ngramsPatches ^. _PatchMap <<< at ngrams
......
...@@ -91,13 +91,14 @@ annuaireCpt = R.hooksComponentWithModule thisModule "annuaire" cpt ...@@ -91,13 +91,14 @@ annuaireCpt = R.hooksComponentWithModule thisModule "annuaire" cpt
cpt {session, path, info: info@(AnnuaireInfo {name, date: date'}), frontends} _ = do cpt {session, path, info: info@(AnnuaireInfo {name, date: date'}), frontends} _ = do
pagePath <- R.useState' $ initialPagePath (fst path) pagePath <- R.useState' $ initialPagePath (fst path)
cacheState <- R.useState' NT.CacheOn cacheState <- R.useState' NT.CacheOff
pure $ R.fragment pure $ R.fragment
[ T.tableHeaderLayout { afterCacheStateChange: \_ -> launchAff_ $ clearCache unit [ T.tableHeaderLayout { afterCacheStateChange: \_ -> launchAff_ $ clearCache unit
, cacheState , cacheState
, date , date
, desc: name , desc: name
, key: "annuaire-" <> (show $ fst cacheState)
, query: "" , query: ""
, title: name , title: name
, user: "" } , user: "" }
......
...@@ -26,7 +26,6 @@ import Gargantext.Prelude (Unit, bind, const, discard, pure, show, unit, ($), (+ ...@@ -26,7 +26,6 @@ import Gargantext.Prelude (Unit, bind, const, discard, pure, show, unit, ($), (+
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, get, put, sessionId) import Gargantext.Sessions (Session, get, put, sessionId)
import Gargantext.Types (NodeType(..)) import Gargantext.Types (NodeType(..))
import Gargantext.Utils.Reactix as R2
thisModule :: String thisModule :: String
thisModule = "Gargantext.Components.Nodes.Annuaire.User.Contacts" thisModule = "Gargantext.Components.Nodes.Annuaire.User.Contacts"
......
...@@ -18,7 +18,6 @@ import Gargantext.Components.Nodes.Lists.Types as NTypes ...@@ -18,7 +18,6 @@ import Gargantext.Components.Nodes.Lists.Types as NTypes
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (TabType(..), TabSubType(..), CTabNgramType(..), PTabNgramType(..)) import Gargantext.Types (TabType(..), TabSubType(..), CTabNgramType(..), PTabNgramType(..))
import Gargantext.Utils.Reactix as R2
thisModule :: String thisModule :: String
thisModule = "Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs" thisModule = "Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs"
...@@ -78,11 +77,17 @@ tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt ...@@ -78,11 +77,17 @@ tabsCpt = R.hooksComponentWithModule thisModule "tabs" cpt
chart = mempty chart = mempty
totalRecords = 4736 -- TODO totalRecords = 4736 -- TODO
docs = DT.docViewLayout docs = DT.docViewLayout
{ frontends, session, nodeId, chart, totalRecords { cacheState
, tabType: TabPairing TabDocs , chart
, listId: defaultListId
, corpusId: Nothing , corpusId: Nothing
, showSearch: true } , frontends
, listId: defaultListId
, nodeId
, session
, showSearch: true
, tabType: TabPairing TabDocs
, totalRecords
}
type NgramsViewTabsProps = ( type NgramsViewTabsProps = (
......
...@@ -427,7 +427,7 @@ loadCorpus {nodeId, session} = do ...@@ -427,7 +427,7 @@ loadCorpus {nodeId, session} = do
loadCorpusWithChild :: Record LoadProps -> Aff CorpusData loadCorpusWithChild :: Record LoadProps -> Aff CorpusData
loadCorpusWithChild {nodeId:childId, session} = do loadCorpusWithChild { nodeId: childId, session } = do
-- fetch corpus via lists parentId -- fetch corpus via lists parentId
(NodePoly {parentId: corpusId} :: NodePoly {}) <- get session $ listNodeRoute childId "" (NodePoly {parentId: corpusId} :: NodePoly {}) <- get session $ listNodeRoute childId ""
corpusNode <- get session $ corpusNodeRoute corpusId "" corpusNode <- get session $ corpusNodeRoute corpusId ""
...@@ -435,7 +435,7 @@ loadCorpusWithChild {nodeId:childId, session} = do ...@@ -435,7 +435,7 @@ loadCorpusWithChild {nodeId:childId, session} = do
:: forall a. DecodeJson a => AffTableResult (NodePoly a) :: forall a. DecodeJson a => AffTableResult (NodePoly a)
case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of
Just (NodePoly { id: defaultListId }) -> Just (NodePoly { id: defaultListId }) ->
pure {corpusId, corpusNode, defaultListId} pure { corpusId, corpusNode, defaultListId }
Nothing -> Nothing ->
throwError $ error "Missing default list" throwError $ error "Missing default list"
where where
......
...@@ -88,8 +88,8 @@ dashboardLayoutLoadedCpt = R.hooksComponentWithModule thisModule "dashboardLayou ...@@ -88,8 +88,8 @@ dashboardLayoutLoadedCpt = R.hooksComponentWithModule thisModule "dashboardLayou
where where
cpt props@{ charts, corpusId, defaultListId, onChange, session } _ = do cpt props@{ charts, corpusId, defaultListId, onChange, session } _ = do
pure $ pure $
H.div {} ([ H.div {} ([ H.h1 {} [ H.text "Board" ]
H.h1 {} [ H.text "DashBoard" ] , H.p {} [ H.text "Summary of all your charts here" ]
] <> chartsEls <> [addNew]) ] <> chartsEls <> [addNew])
where where
addNew = H.div { className: "row" } [ addNew = H.div { className: "row" } [
......
This diff is collapsed.
...@@ -8,6 +8,7 @@ import Data.Generic.Rep (class Generic) ...@@ -8,6 +8,7 @@ import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Gargantext.Components.Node (NodePoly) import Gargantext.Components.Node (NodePoly)
import Gargantext.Prelude import Gargantext.Prelude
......
...@@ -51,6 +51,7 @@ instance encodeJsonHyperdata :: Argonaut.EncodeJson Hyperdata where ...@@ -51,6 +51,7 @@ instance encodeJsonHyperdata :: Argonaut.EncodeJson Hyperdata where
type Props = type Props =
( nodeId :: Int ( nodeId :: Int
, session :: Session , session :: Session
, nodeType :: NodeType
) )
type Reload = R.State Int type Reload = R.State Int
...@@ -66,10 +67,10 @@ frameLayout props = R.createElement frameLayoutCpt props [] ...@@ -66,10 +67,10 @@ frameLayout props = R.createElement frameLayoutCpt props []
frameLayoutCpt :: R.Component Props frameLayoutCpt :: R.Component Props
frameLayoutCpt = R.hooksComponentWithModule thisModule "frameLayout" cpt frameLayoutCpt = R.hooksComponentWithModule thisModule "frameLayout" cpt
where where
cpt {nodeId, session} _ = do cpt {nodeId, session, nodeType} _ = do
let sid = sessionId session let sid = sessionId session
pure $ frameLayoutWithKey { key: show sid <> "-" <> show nodeId, nodeId, session } pure $ frameLayoutWithKey { key: show sid <> "-" <> show nodeId, nodeId, session, nodeType}
frameLayoutWithKey :: Record KeyProps -> R.Element frameLayoutWithKey :: Record KeyProps -> R.Element
frameLayoutWithKey props = R.createElement frameLayoutWithKeyCpt props [] frameLayoutWithKey props = R.createElement frameLayoutWithKeyCpt props []
...@@ -77,11 +78,11 @@ frameLayoutWithKey props = R.createElement frameLayoutWithKeyCpt props [] ...@@ -77,11 +78,11 @@ frameLayoutWithKey props = R.createElement frameLayoutWithKeyCpt props []
frameLayoutWithKeyCpt :: R.Component KeyProps frameLayoutWithKeyCpt :: R.Component KeyProps
frameLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "frameLayoutWithKey" cpt frameLayoutWithKeyCpt = R.hooksComponentWithModule thisModule "frameLayoutWithKey" cpt
where where
cpt { nodeId, session } _ = do cpt { nodeId, session, nodeType} _ = do
reload <- R.useState' 0 reload <- R.useState' 0
useLoader {nodeId, reload: fst reload, session} loadframeWithReload $ useLoader {nodeId, reload: fst reload, session} loadframeWithReload $
\frame -> frameLayoutView {frame, nodeId, reload, session} \frame -> frameLayoutView {frame, nodeId, reload, session, nodeType}
type ViewProps = type ViewProps =
( frame :: NodePoly Hyperdata ( frame :: NodePoly Hyperdata
...@@ -90,12 +91,12 @@ type ViewProps = ...@@ -90,12 +91,12 @@ type ViewProps =
) )
data FrameType = Calc | Write
type Base = String type Base = String
type FrameId = String type FrameId = String
hframeUrl :: Base -> FrameId -> String hframeUrl :: NodeType -> Base -> FrameId -> String
hframeUrl base frame_id = base <> "/" <> frame_id <> "?both" hframeUrl NodeFrameCode _ frame_id = frame_id -- Temp fix : frame_id is currently the whole url created
hframeUrl _ base frame_id = base <> "/" <> frame_id <> "?both"
frameLayoutView :: Record ViewProps -> R.Element frameLayoutView :: Record ViewProps -> R.Element
frameLayoutView props = R.createElement frameLayoutViewCpt props [] frameLayoutView props = R.createElement frameLayoutViewCpt props []
...@@ -103,9 +104,9 @@ frameLayoutView props = R.createElement frameLayoutViewCpt props [] ...@@ -103,9 +104,9 @@ frameLayoutView props = R.createElement frameLayoutViewCpt props []
frameLayoutViewCpt :: R.Component ViewProps frameLayoutViewCpt :: R.Component ViewProps
frameLayoutViewCpt = R.hooksComponentWithModule thisModule "frameLayoutView" cpt frameLayoutViewCpt = R.hooksComponentWithModule thisModule "frameLayoutView" cpt
where where
cpt {frame: (NodePoly {hyperdata: Hyperdata {base, frame_id}}), nodeId, reload, session} _ = do cpt {frame: (NodePoly {hyperdata: Hyperdata {base, frame_id}}), nodeId, reload, session, nodeType} _ = do
pure $ H.div { className : "frame" } pure $ H.div { className : "frame" }
[ H.iframe { src: hframeUrl base frame_id [ H.iframe { src: hframeUrl nodeType base frame_id
, width: "100%" , width: "100%"
, height: "100%" , height: "100%"
} [] } []
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
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