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
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..), fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import DOM.Simple.Event as DE
import Effect (Effect)
import Effect.Aff (Aff)
......@@ -288,8 +287,8 @@ pageLayoutCpt = here.component "pageLayout" cpt where
let route = tableRouteWithPage (p { params = paramsS', query = query })
res <- get session $ route
liftEffect $ do
log2 "[pageLayout] table route" route
log2 "[pageLayout] table res" res
here.log2 "table route" route
here.log2 "table res" res
pure $ handleResponse res
render (Tuple count documents) = pagePaintRaw { documents
, layout: props { params = paramsS'
......
......@@ -8,6 +8,7 @@ import Effect.Aff (Aff, launchAff_, throwError)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Reactix as R
import Toestand as T
import Gargantext.Prelude
......@@ -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)
-> R.Hooks R.Element
useLoaderWithCacheAPI { cacheEndpoint, handleResponse, mkRequest, path, renderer } = do
state <- R.useState' Nothing
state <- T.useBox Nothing
state' <- T.useLive T.unequal state
useCachedAPILoaderEffect { cacheEndpoint
, handleResponse
, mkRequest
, path
, state }
pure $ maybe (loadingSpinner {}) renderer (fst state)
pure $ maybe (loadingSpinner {}) renderer state'
type LoaderWithCacheAPIEffectProps path res ret = (
cacheEndpoint :: path -> Aff Version
, handleResponse :: Versioned res -> ret
, mkRequest :: path -> GUC.Request
, 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)
-> R.Hooks Unit
useCachedAPILoaderEffect { cacheEndpoint
, handleResponse
, mkRequest
, path
, state: state@(state' /\ setState) } = do
, state: state } = do
oPath <- R.useRef path
state' <- T.useLive T.unequal state
R.useEffect' $ do
if (R.readRef oPath == path) && (isJust state') then
......@@ -90,4 +94,4 @@ useCachedAPILoaderEffect { cacheEndpoint
else
throwError $ error $ "Fetched clean cache but hashes don't match: " <> show version <> " != " <> show cacheReal
liftEffect $ do
setState $ const $ Just $ handleResponse val
T.write_ (Just $ handleResponse val) state
......@@ -9,7 +9,7 @@ import Data.Array as A
import Data.Either (Either(..))
import Data.List as List
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
......@@ -83,7 +83,8 @@ corpusLayoutViewCpt = here.component "corpusLayoutView" cpt
where
cpt {corpus: (NodePoly {hyperdata: Hyperdata {fields}}), nodeId, reload, session} _ = do
let fieldsWithIndex = List.mapWithIndex (\idx -> \t -> Tuple idx t) fields
fieldsS <- R.useState' fieldsWithIndex
fieldsS <- T.useBox fieldsWithIndex
fields' <- T.useLive T.unequal fieldsS
fieldsRef <- R.useRef fields
-- handle props change of fields
......@@ -92,12 +93,12 @@ corpusLayoutViewCpt = here.component "corpusLayoutView" cpt
pure unit
else do
R.setRef fieldsRef fields
snd fieldsS $ const fieldsWithIndex
T.write_ fieldsWithIndex fieldsS
pure $ H.div {}
[ H.div { className: "row" }
[ H.div { className: "btn btn-primary " <> (saveEnabled fieldsWithIndex fieldsS)
, on: { click: onClickSave {fields: fieldsS, nodeId, reload, session} }
[ H.div { className: "btn btn-primary " <> (saveEnabled fieldsWithIndex fields')
, on: { click: onClickSave {fields: fields', nodeId, reload, session} }
}
[ H.span { className: "fa fa-floppy-o" } [ ]
]
......@@ -115,27 +116,27 @@ corpusLayoutViewCpt = here.component "corpusLayoutView" cpt
]
]
saveEnabled :: FTFieldsWithIndex -> R.State FTFieldsWithIndex -> String
saveEnabled fs (fsS /\ _) = if fs == fsS then "disabled" else "enabled"
saveEnabled :: FTFieldsWithIndex -> FTFieldsWithIndex -> String
saveEnabled fs fsS = if fs == fsS then "disabled" else "enabled"
onClickSave :: forall e. { fields :: R.State FTFieldsWithIndex
onClickSave :: forall e. { fields :: FTFieldsWithIndex
, nodeId :: Int
, reload :: T2.ReloadS
, session :: Session } -> e -> Effect Unit
onClickSave {fields: (fieldsS /\ _), nodeId, reload, session} _ = do
onClickSave {fields, nodeId, reload, session} _ = do
launchAff_ do
saveCorpus $ { hyperdata: Hyperdata {fields: (\(Tuple _ f) -> f) <$> fieldsS}
saveCorpus $ { hyperdata: Hyperdata {fields: (\(Tuple _ f) -> f) <$> fields}
, nodeId
, session }
liftEffect $ T2.reload reload
onClickAdd :: forall e. R.State FTFieldsWithIndex -> e -> Effect Unit
onClickAdd (_ /\ setFieldsS) _ = do
setFieldsS $ \fieldsS -> List.snoc fieldsS $ Tuple (List.length fieldsS) defaultField
onClickAdd :: forall e. T.Box FTFieldsWithIndex -> e -> Effect Unit
onClickAdd fieldsS _ = do
T.modify_ (\fields -> List.snoc fields $ Tuple (List.length fields) defaultField) fieldsS
type FieldsCodeEditorProps =
(
fields :: R.State FTFieldsWithIndex
fields :: T.Box FTFieldsWithIndex
| LoadProps
)
......@@ -145,50 +146,49 @@ fieldsCodeEditor = R.createElement fieldsCodeEditorCpt
fieldsCodeEditorCpt :: R.Component FieldsCodeEditorProps
fieldsCodeEditorCpt = here.component "fieldsCodeEditorCpt" cpt
where
cpt {nodeId, fields: fS@(fields /\ _), session} _ = do
cpt { fields, nodeId, session } _ = do
fields' <- T.useLive T.unequal fields
masterKey <- T.useBox T2.newReload
masterKey' <- T.useLive T.unequal masterKey
pure $ H.div {} $ List.toUnfoldable (editors masterKey masterKey')
where
editors masterKey masterKey' =
(\(Tuple idx field) ->
fieldCodeEditorWrapper { canMoveDown: idx < (List.length fields - 1)
let editorsMap (Tuple idx field) =
fieldCodeEditorWrapper { canMoveDown: idx < (List.length fields' - 1)
, canMoveUp: idx > 0
, field
, key: (show masterKey') <> "-" <> (show idx)
, onChange: onChange fS idx
, onMoveDown: onMoveDown masterKey fS idx
, onMoveUp: onMoveUp masterKey fS idx
, onRemove: onRemove fS idx
, onRename: onRename fS idx
}) <$> fields
onChange :: R.State FTFieldsWithIndex -> Index -> FieldType -> Effect Unit
onChange (_ /\ setFields) idx typ = do
setFields $ \fields ->
fromMaybe fields $
List.modifyAt idx (\(Tuple _ (Field f)) -> Tuple idx (Field $ f { typ = typ })) fields
onMoveDown :: T2.ReloadS -> R.State FTFieldsWithIndex -> Index -> Unit -> Effect Unit
onMoveDown masterKey (_ /\ setFields) idx _ = do
, onChange: onChange idx
, onMoveDown: onMoveDown masterKey idx
, onMoveUp: onMoveUp masterKey idx
, onRemove: onRemove idx
, onRename: onRename idx
}
pure $ H.div {} $ List.toUnfoldable (editorsMap <$> fields')
where
onChange :: Index -> FieldType -> Effect Unit
onChange idx typ = do
T.modify_ (\fs ->
fromMaybe fs $
List.modifyAt idx (\(Tuple _ (Field f)) -> Tuple idx (Field $ f { typ = typ })) fs) fields
onMoveDown :: T2.ReloadS -> Index -> Unit -> Effect Unit
onMoveDown masterKey idx _ = do
T2.reload masterKey
setFields $ recomputeIndices <<< (GDA.swapList idx (idx + 1))
T.modify_ (recomputeIndices <<< (GDA.swapList idx (idx + 1))) fields
onMoveUp :: T2.ReloadS -> R.State FTFieldsWithIndex -> Index -> Unit -> Effect Unit
onMoveUp masterKey (_ /\ setFields) idx _ = do
onMoveUp :: T2.ReloadS -> Index -> Unit -> Effect Unit
onMoveUp masterKey idx _ = do
T2.reload masterKey
setFields $ recomputeIndices <<< (GDA.swapList idx (idx - 1))
T.modify_ (recomputeIndices <<< (GDA.swapList idx (idx - 1))) fields
onRemove :: R.State FTFieldsWithIndex -> Index -> Unit -> Effect Unit
onRemove (_ /\ setFields) idx _ = do
setFields $ \fields ->
fromMaybe fields $ List.deleteAt idx fields
onRemove :: Index -> Unit -> Effect Unit
onRemove idx _ = do
T.modify_ (\fs -> fromMaybe fs $ List.deleteAt idx fs) fields
onRename :: R.State FTFieldsWithIndex -> Index -> String -> Effect Unit
onRename (_ /\ setFields) idx newName = do
setFields $ \fields ->
fromMaybe fields $ List.modifyAt idx (\(Tuple _ (Field f)) -> Tuple idx (Field $ f { name = newName })) fields
onRename :: Index -> String -> Effect Unit
onRename idx newName = do
T.modify_ (\fs ->
fromMaybe fs $ List.modifyAt idx (\(Tuple _ (Field f)) -> Tuple idx (Field $ f { name = newName })) fs) fields
recomputeIndices :: FTFieldsWithIndex -> FTFieldsWithIndex
recomputeIndices = List.mapWithIndex $ \idx -> \(Tuple _ t) -> Tuple idx t
......@@ -272,8 +272,8 @@ renameableCpt :: R.Component RenameableProps
renameableCpt = here.component "renameableCpt" cpt
where
cpt {onRename, text} _ = do
isEditing <- R.useState' false
state <- R.useState' text
isEditing <- T.useBox false
state <- T.useBox text
textRef <- R.useRef text
-- handle props change of text
......@@ -282,7 +282,7 @@ renameableCpt = here.component "renameableCpt" cpt
pure unit
else do
R.setRef textRef text
snd state $ const text
T.write_ text state
pure $ H.div { className: "renameable" } [
renameableText { isEditing, onRename, state }
......@@ -290,9 +290,9 @@ renameableCpt = here.component "renameableCpt" cpt
type RenameableTextProps =
(
isEditing :: R.State Boolean
isEditing :: T.Box Boolean
, onRename :: String -> Effect Unit
, state :: R.State String
, state :: T.Box String
)
renameableText :: Record RenameableTextProps -> R.Element
......@@ -301,37 +301,41 @@ renameableText props = R.createElement renameableTextCpt props []
renameableTextCpt :: R.Component RenameableTextProps
renameableTextCpt = here.component "renameableTextCpt" cpt
where
cpt {isEditing: (false /\ setIsEditing), state: (text /\ _)} _ = do
pure $ H.div { className: "input-group" }
[ H.input { className: "form-control"
, defaultValue: text
, disabled: 1
, type: "text" }
, H.div { className: "btn input-group-append"
, on: { click: \_ -> setIsEditing $ const true } }
[ H.span { className: "fa fa-pencil" } []
]
]
cpt {isEditing: (true /\ setIsEditing), onRename, state: (text /\ setText)} _ = do
pure $ H.div { className: "input-group" }
cpt { isEditing, onRename, state } _ = do
isEditing' <- T.useLive T.unequal isEditing
state' <- T.useLive T.unequal state
pure $ if isEditing' then
H.div { className: "input-group" }
[ inputWithEnter {
autoFocus: false
, className: "form-control text"
, defaultValue: text
, onBlur: setText <<< const
, onEnter: submit
, onValueChanged: setText <<< const
, defaultValue: state'
, onBlur: \st -> T.write_ st state
, onEnter: submit state'
, onValueChanged: \st -> T.write_ st state
, placeholder: ""
, type: "text"
}
, H.div { className: "btn input-group-append"
, on: { click: submit } }
, on: { click: submit state' } }
[ H.span { className: "fa fa-floppy-o" } []
]
]
else
H.div { className: "input-group" }
[ H.input { className: "form-control"
, defaultValue: state'
, disabled: 1
, type: "text" }
, H.div { className: "btn input-group-append"
, on: { click: \_ -> T.write_ true isEditing } }
[ H.span { className: "fa fa-pencil" } []
]
]
where
submit _ = do
setIsEditing $ const false
submit text _ = do
T.write_ false isEditing
onRename text
fieldCodeEditor :: Record FieldCodeEditorProps -> R.Element
......
......@@ -139,21 +139,22 @@ dashboardCodeEditorCpt = here.component "dashboardCodeEditor" cpt
where
cpt props@{ fields, nodeId, onChange, session } _ = do
let fieldsWithIndex = List.mapWithIndex (\idx -> \t -> Tuple idx t) fields
fieldsS <- R.useState' fieldsWithIndex
fieldsRef <- R.useRef fields
fieldsS <- T.useBox fieldsWithIndex
fields' <- T.useLive T.unequal fieldsS
fieldsRef <- R.useRef fields'
-- handle props change of fields
R.useEffect1' fields $ do
if R.readRef fieldsRef == fields then
if R.readRef fieldsRef == fields' then
pure unit
else do
R.setRef fieldsRef fields
snd fieldsS $ const fieldsWithIndex
R.setRef fieldsRef fields'
T.write_ fieldsWithIndex fieldsS
pure $ R.fragment
[ H.div { className: "row" }
[ H.div { className: "btn btn-primary " <> (saveEnabled fieldsWithIndex fieldsS)
, on: { click: onClickSave fieldsS }
[ H.div { className: "btn btn-primary " <> (saveEnabled fieldsWithIndex fields')
, on: { click: onClickSave fields' }
}
[ H.span { className: "fa fa-floppy-o" } [ ]
]
......@@ -162,7 +163,7 @@ dashboardCodeEditorCpt = here.component "dashboardCodeEditor" cpt
[ H.div { className: "col-12" }
[ fieldsCodeEditor { fields: fieldsS
, nodeId
, session} []
, session } []
]
]
, H.div { className: "row" }
......@@ -174,11 +175,11 @@ dashboardCodeEditorCpt = here.component "dashboardCodeEditor" cpt
]
]
where
saveEnabled :: FTFieldsWithIndex -> R.State FTFieldsWithIndex -> String
saveEnabled fs (fsS /\ _) = if fs == fsS then "disabled" else "enabled"
saveEnabled :: FTFieldsWithIndex -> FTFieldsWithIndex -> String
saveEnabled fs fsS = if fs == fsS then "disabled" else "enabled"
onClickSave :: forall e. R.State FTFieldsWithIndex -> e -> Effect Unit
onClickSave (fields' /\ _) _ = do
onClickSave :: forall e. FTFieldsWithIndex -> e -> Effect Unit
onClickSave fields' _ = do
here.log "saving (TODO)"
onChange $ snd <$> fields'
-- launchAff_ do
......@@ -186,9 +187,9 @@ dashboardCodeEditorCpt = here.component "dashboardCodeEditor" cpt
-- , nodeId
-- , session }
onClickAddField :: forall e. R.State FTFieldsWithIndex -> e -> Effect Unit
onClickAddField (_ /\ setFieldsS) _ = do
setFieldsS $ \fieldsS -> List.snoc fieldsS $ Tuple (List.length fieldsS) defaultField
onClickAddField :: forall e. T.Box FTFieldsWithIndex -> e -> Effect Unit
onClickAddField fieldsS _ = do
T.modify_ (\fs -> List.snoc fs $ Tuple (List.length fs) defaultField) fieldsS
type PredefinedChartProps =
( chart :: P.PredefinedChart
......
......@@ -85,7 +85,7 @@ divDropdownLeftCpt :: R.Component ()
divDropdownLeftCpt = here.component "divDropdownLeft" cpt
where
cpt {} _ = do
show <- R.useState' false
show <- T.useBox false
pure $ H.li { className: "nav-item dropdown" } [
menuButton { element: menuElement, show } []
......@@ -151,7 +151,7 @@ divDropdownLeftCpt = here.component "divDropdownLeft" cpt
type MenuButtonProps = (
element :: LiNav
, show :: R.State Boolean
, show :: T.Box Boolean
)
menuButton :: R2.Component MenuButtonProps
......@@ -160,11 +160,11 @@ menuButton = R.createElement menuButtonCpt
menuButtonCpt :: R.Component MenuButtonProps
menuButtonCpt = here.component "menuButton" cpt
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"
-- , data: {toggle: "dropdown"}
, href, title
, on: { click: \_ -> setShow $ not }
, on: { click: \_ -> T.modify_ not show }
, role: "button" } [
H.span { aria: {hidden : true}, className: icon } []
, H.text (" " <> text)
......@@ -173,7 +173,7 @@ menuButtonCpt = here.component "menuButton" cpt
-- | Menu in the sidebar, syntactic sugar
type MenuElementsProps = (
elements :: Array (Array LiNav)
, show :: R.State Boolean
, show :: T.Box Boolean
)
menuElements :: R2.Component MenuElementsProps
......@@ -182,13 +182,15 @@ menuElements = R.createElement menuElementsCpt
menuElementsCpt :: R.Component MenuElementsProps
menuElementsCpt = here.component "menuElements" cpt
where
cpt { show: false /\ _ } _ = do
pure $ H.div {} []
cpt { elements, show: (true /\ setShow) } _ = do
pure $ H.ul { className: "dropdown-menu"
, on: { click: setShow $ const false }
cpt { elements, show } _ = do
show' <- T.useLive T.unequal show
pure $ if show' then
H.ul { className: "dropdown-menu"
, on: { click: \_ -> T.write_ false show }
, style: { display: "block" } } $ intercalate divider $ map (map liNav) elements
where
else
H.div {} []
divider :: Array R.Element
divider = [H.li {className: "dropdown-divider"} []]
......
......@@ -52,12 +52,14 @@ type Leaf p = Record p -> R.Element
type Here =
{ 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 mod =
{ component: R.hooksComponentWithModule mod
, log: log2 ("[" <> mod <> "]") }
, log: log2 ("[" <> mod <> "]")
, log2: \msg -> log2 ("[" <> mod <> "] " <> msg) }
-- newtypes
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