Commit 48aba6c2 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[toestand] more R.State refactoring

parent 3a2c002f
...@@ -17,7 +17,6 @@ import Data.String as Str ...@@ -17,7 +17,6 @@ import Data.String as Str
import Data.Symbol (SProxy(..)) import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..), fst) import Data.Tuple (Tuple(..), fst)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import DOM.Simple.Event as DE import DOM.Simple.Event as DE
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
...@@ -288,8 +287,8 @@ pageLayoutCpt = here.component "pageLayout" cpt where ...@@ -288,8 +287,8 @@ pageLayoutCpt = here.component "pageLayout" cpt where
let route = tableRouteWithPage (p { params = paramsS', query = query }) let route = tableRouteWithPage (p { params = paramsS', query = query })
res <- get session $ route res <- get session $ route
liftEffect $ do liftEffect $ do
log2 "[pageLayout] table route" route here.log2 "table route" route
log2 "[pageLayout] table res" res here.log2 "table res" res
pure $ handleResponse res pure $ handleResponse res
render (Tuple count documents) = pagePaintRaw { documents render (Tuple count documents) = pagePaintRaw { documents
, layout: props { params = paramsS' , layout: props { params = paramsS'
......
...@@ -8,6 +8,7 @@ import Effect.Aff (Aff, launchAff_, throwError) ...@@ -8,6 +8,7 @@ import Effect.Aff (Aff, launchAff_, throwError)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Exception (error) import Effect.Exception (error)
import Reactix as R import Reactix as R
import Toestand as T
import Gargantext.Prelude import Gargantext.Prelude
...@@ -33,35 +34,38 @@ type LoaderWithCacheAPIProps path res ret = ( ...@@ -33,35 +34,38 @@ type LoaderWithCacheAPIProps path res ret = (
) )
useLoaderWithCacheAPI :: forall path res ret. Eq path => DecodeJson res => useLoaderWithCacheAPI :: forall path res ret. Eq path => DecodeJson res => Eq ret =>
Record (LoaderWithCacheAPIProps path res ret) Record (LoaderWithCacheAPIProps path res ret)
-> R.Hooks R.Element -> R.Hooks R.Element
useLoaderWithCacheAPI { cacheEndpoint, handleResponse, mkRequest, path, renderer } = do useLoaderWithCacheAPI { cacheEndpoint, handleResponse, mkRequest, path, renderer } = do
state <- R.useState' Nothing state <- T.useBox Nothing
state' <- T.useLive T.unequal state
useCachedAPILoaderEffect { cacheEndpoint useCachedAPILoaderEffect { cacheEndpoint
, handleResponse , handleResponse
, mkRequest , mkRequest
, path , path
, state } , state }
pure $ maybe (loadingSpinner {}) renderer (fst state) pure $ maybe (loadingSpinner {}) renderer state'
type LoaderWithCacheAPIEffectProps path res ret = ( type LoaderWithCacheAPIEffectProps path res ret = (
cacheEndpoint :: path -> Aff Version cacheEndpoint :: path -> Aff Version
, handleResponse :: Versioned res -> ret , handleResponse :: Versioned res -> ret
, mkRequest :: path -> GUC.Request , mkRequest :: path -> GUC.Request
, path :: path , path :: path
, state :: R.State (Maybe ret) , state :: T.Box (Maybe ret)
) )
useCachedAPILoaderEffect :: forall path res ret. Eq path => DecodeJson res => useCachedAPILoaderEffect :: forall path res ret. Eq path => DecodeJson res => Eq ret =>
Record (LoaderWithCacheAPIEffectProps path res ret) Record (LoaderWithCacheAPIEffectProps path res ret)
-> R.Hooks Unit -> R.Hooks Unit
useCachedAPILoaderEffect { cacheEndpoint useCachedAPILoaderEffect { cacheEndpoint
, handleResponse , handleResponse
, mkRequest , mkRequest
, path , path
, state: state@(state' /\ setState) } = do , state: state } = do
oPath <- R.useRef path oPath <- R.useRef path
state' <- T.useLive T.unequal state
R.useEffect' $ do R.useEffect' $ do
if (R.readRef oPath == path) && (isJust state') then if (R.readRef oPath == path) && (isJust state') then
...@@ -90,4 +94,4 @@ useCachedAPILoaderEffect { cacheEndpoint ...@@ -90,4 +94,4 @@ useCachedAPILoaderEffect { cacheEndpoint
else else
throwError $ error $ "Fetched clean cache but hashes don't match: " <> show version <> " != " <> show cacheReal throwError $ error $ "Fetched clean cache but hashes don't match: " <> show version <> " != " <> show cacheReal
liftEffect $ do liftEffect $ do
setState $ const $ Just $ handleResponse val T.write_ (Just $ handleResponse val) state
This diff is collapsed.
...@@ -139,21 +139,22 @@ dashboardCodeEditorCpt = here.component "dashboardCodeEditor" cpt ...@@ -139,21 +139,22 @@ dashboardCodeEditorCpt = here.component "dashboardCodeEditor" cpt
where where
cpt props@{ fields, nodeId, onChange, session } _ = do cpt props@{ fields, nodeId, onChange, session } _ = do
let fieldsWithIndex = List.mapWithIndex (\idx -> \t -> Tuple idx t) fields let fieldsWithIndex = List.mapWithIndex (\idx -> \t -> Tuple idx t) fields
fieldsS <- R.useState' fieldsWithIndex fieldsS <- T.useBox fieldsWithIndex
fieldsRef <- R.useRef fields fields' <- T.useLive T.unequal fieldsS
fieldsRef <- R.useRef fields'
-- handle props change of fields -- handle props change of fields
R.useEffect1' fields $ do R.useEffect1' fields $ do
if R.readRef fieldsRef == fields then if R.readRef fieldsRef == fields' then
pure unit pure unit
else do else do
R.setRef fieldsRef fields R.setRef fieldsRef fields'
snd fieldsS $ const fieldsWithIndex T.write_ fieldsWithIndex fieldsS
pure $ R.fragment pure $ R.fragment
[ H.div { className: "row" } [ H.div { className: "row" }
[ H.div { className: "btn btn-primary " <> (saveEnabled fieldsWithIndex fieldsS) [ H.div { className: "btn btn-primary " <> (saveEnabled fieldsWithIndex fields')
, on: { click: onClickSave fieldsS } , on: { click: onClickSave fields' }
} }
[ H.span { className: "fa fa-floppy-o" } [ ] [ H.span { className: "fa fa-floppy-o" } [ ]
] ]
...@@ -162,7 +163,7 @@ dashboardCodeEditorCpt = here.component "dashboardCodeEditor" cpt ...@@ -162,7 +163,7 @@ dashboardCodeEditorCpt = here.component "dashboardCodeEditor" cpt
[ H.div { className: "col-12" } [ H.div { className: "col-12" }
[ fieldsCodeEditor { fields: fieldsS [ fieldsCodeEditor { fields: fieldsS
, nodeId , nodeId
, session} [] , session } []
] ]
] ]
, H.div { className: "row" } , H.div { className: "row" }
...@@ -174,11 +175,11 @@ dashboardCodeEditorCpt = here.component "dashboardCodeEditor" cpt ...@@ -174,11 +175,11 @@ dashboardCodeEditorCpt = here.component "dashboardCodeEditor" cpt
] ]
] ]
where where
saveEnabled :: FTFieldsWithIndex -> R.State FTFieldsWithIndex -> String saveEnabled :: FTFieldsWithIndex -> FTFieldsWithIndex -> String
saveEnabled fs (fsS /\ _) = if fs == fsS then "disabled" else "enabled" saveEnabled fs fsS = if fs == fsS then "disabled" else "enabled"
onClickSave :: forall e. R.State FTFieldsWithIndex -> e -> Effect Unit onClickSave :: forall e. FTFieldsWithIndex -> e -> Effect Unit
onClickSave (fields' /\ _) _ = do onClickSave fields' _ = do
here.log "saving (TODO)" here.log "saving (TODO)"
onChange $ snd <$> fields' onChange $ snd <$> fields'
-- launchAff_ do -- launchAff_ do
...@@ -186,9 +187,9 @@ dashboardCodeEditorCpt = here.component "dashboardCodeEditor" cpt ...@@ -186,9 +187,9 @@ dashboardCodeEditorCpt = here.component "dashboardCodeEditor" cpt
-- , nodeId -- , nodeId
-- , session } -- , session }
onClickAddField :: forall e. R.State FTFieldsWithIndex -> e -> Effect Unit onClickAddField :: forall e. T.Box FTFieldsWithIndex -> e -> Effect Unit
onClickAddField (_ /\ setFieldsS) _ = do onClickAddField fieldsS _ = do
setFieldsS $ \fieldsS -> List.snoc fieldsS $ Tuple (List.length fieldsS) defaultField T.modify_ (\fs -> List.snoc fs $ Tuple (List.length fs) defaultField) fieldsS
type PredefinedChartProps = type PredefinedChartProps =
( chart :: P.PredefinedChart ( chart :: P.PredefinedChart
......
...@@ -85,7 +85,7 @@ divDropdownLeftCpt :: R.Component () ...@@ -85,7 +85,7 @@ divDropdownLeftCpt :: R.Component ()
divDropdownLeftCpt = here.component "divDropdownLeft" cpt divDropdownLeftCpt = here.component "divDropdownLeft" cpt
where where
cpt {} _ = do cpt {} _ = do
show <- R.useState' false show <- T.useBox false
pure $ H.li { className: "nav-item dropdown" } [ pure $ H.li { className: "nav-item dropdown" } [
menuButton { element: menuElement, show } [] menuButton { element: menuElement, show } []
...@@ -151,7 +151,7 @@ divDropdownLeftCpt = here.component "divDropdownLeft" cpt ...@@ -151,7 +151,7 @@ divDropdownLeftCpt = here.component "divDropdownLeft" cpt
type MenuButtonProps = ( type MenuButtonProps = (
element :: LiNav element :: LiNav
, show :: R.State Boolean , show :: T.Box Boolean
) )
menuButton :: R2.Component MenuButtonProps menuButton :: R2.Component MenuButtonProps
...@@ -160,11 +160,11 @@ menuButton = R.createElement menuButtonCpt ...@@ -160,11 +160,11 @@ menuButton = R.createElement menuButtonCpt
menuButtonCpt :: R.Component MenuButtonProps menuButtonCpt :: R.Component MenuButtonProps
menuButtonCpt = here.component "menuButton" cpt menuButtonCpt = here.component "menuButton" cpt
where where
cpt { element: LiNav { title, href, icon, text }, show: (_ /\ setShow) } _ = do cpt { element: LiNav { title, href, icon, text }, show } _ = do
pure $ H.a { className: "dropdown-toggle navbar-text" pure $ H.a { className: "dropdown-toggle navbar-text"
-- , data: {toggle: "dropdown"} -- , data: {toggle: "dropdown"}
, href, title , href, title
, on: { click: \_ -> setShow $ not } , on: { click: \_ -> T.modify_ not show }
, role: "button" } [ , role: "button" } [
H.span { aria: {hidden : true}, className: icon } [] H.span { aria: {hidden : true}, className: icon } []
, H.text (" " <> text) , H.text (" " <> text)
...@@ -173,7 +173,7 @@ menuButtonCpt = here.component "menuButton" cpt ...@@ -173,7 +173,7 @@ menuButtonCpt = here.component "menuButton" cpt
-- | Menu in the sidebar, syntactic sugar -- | Menu in the sidebar, syntactic sugar
type MenuElementsProps = ( type MenuElementsProps = (
elements :: Array (Array LiNav) elements :: Array (Array LiNav)
, show :: R.State Boolean , show :: T.Box Boolean
) )
menuElements :: R2.Component MenuElementsProps menuElements :: R2.Component MenuElementsProps
...@@ -182,13 +182,15 @@ menuElements = R.createElement menuElementsCpt ...@@ -182,13 +182,15 @@ menuElements = R.createElement menuElementsCpt
menuElementsCpt :: R.Component MenuElementsProps menuElementsCpt :: R.Component MenuElementsProps
menuElementsCpt = here.component "menuElements" cpt menuElementsCpt = here.component "menuElements" cpt
where where
cpt { show: false /\ _ } _ = do cpt { elements, show } _ = do
pure $ H.div {} [] show' <- T.useLive T.unequal show
cpt { elements, show: (true /\ setShow) } _ = do
pure $ H.ul { className: "dropdown-menu" pure $ if show' then
, on: { click: setShow $ const false } H.ul { className: "dropdown-menu"
, on: { click: \_ -> T.write_ false show }
, style: { display: "block" } } $ intercalate divider $ map (map liNav) elements , style: { display: "block" } } $ intercalate divider $ map (map liNav) elements
where else
H.div {} []
divider :: Array R.Element divider :: Array R.Element
divider = [H.li {className: "dropdown-divider"} []] divider = [H.li {className: "dropdown-divider"} []]
......
...@@ -52,12 +52,14 @@ type Leaf p = Record p -> R.Element ...@@ -52,12 +52,14 @@ type Leaf p = Record p -> R.Element
type Here = type Here =
{ component :: forall p. String -> R.HooksComponent p -> R.Component p { component :: forall p. String -> R.HooksComponent p -> R.Component p
, log :: forall l. l -> Effect Unit } , log :: forall l. l -> Effect Unit
, log2 :: forall l. String -> l -> Effect Unit }
here :: Module -> Here here :: Module -> Here
here mod = here mod =
{ component: R.hooksComponentWithModule mod { component: R.hooksComponentWithModule mod
, log: log2 ("[" <> mod <> "]") } , log: log2 ("[" <> mod <> "]")
, log2: \msg -> log2 ("[" <> mod <> "] " <> msg) }
-- newtypes -- newtypes
type NTHooksComponent props = props -> Array R.Element -> R.Hooks R.Element type NTHooksComponent props = props -> Array R.Element -> R.Hooks R.Element
......
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