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
...@@ -9,7 +9,7 @@ import Data.Array as A ...@@ -9,7 +9,7 @@ import Data.Array as A
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.List as List import Data.List as List
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (Tuple(..), fst, snd) import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2) import DOM.Simple.Console (log2)
import Effect (Effect) import Effect (Effect)
...@@ -83,7 +83,8 @@ corpusLayoutViewCpt = here.component "corpusLayoutView" cpt ...@@ -83,7 +83,8 @@ corpusLayoutViewCpt = here.component "corpusLayoutView" cpt
where where
cpt {corpus: (NodePoly {hyperdata: Hyperdata {fields}}), nodeId, reload, session} _ = do cpt {corpus: (NodePoly {hyperdata: Hyperdata {fields}}), nodeId, reload, 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
fields' <- T.useLive T.unequal fieldsS
fieldsRef <- R.useRef fields fieldsRef <- R.useRef fields
-- handle props change of fields -- handle props change of fields
...@@ -92,12 +93,12 @@ corpusLayoutViewCpt = here.component "corpusLayoutView" cpt ...@@ -92,12 +93,12 @@ corpusLayoutViewCpt = here.component "corpusLayoutView" cpt
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 $ H.div {} pure $ H.div {}
[ 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 {fields: fieldsS, nodeId, reload, session} } , on: { click: onClickSave {fields: fields', nodeId, reload, session} }
} }
[ H.span { className: "fa fa-floppy-o" } [ ] [ H.span { className: "fa fa-floppy-o" } [ ]
] ]
...@@ -115,27 +116,27 @@ corpusLayoutViewCpt = here.component "corpusLayoutView" cpt ...@@ -115,27 +116,27 @@ corpusLayoutViewCpt = here.component "corpusLayoutView" cpt
] ]
] ]
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. { fields :: R.State FTFieldsWithIndex onClickSave :: forall e. { fields :: FTFieldsWithIndex
, nodeId :: Int , nodeId :: Int
, reload :: T2.ReloadS , reload :: T2.ReloadS
, session :: Session } -> e -> Effect Unit , session :: Session } -> e -> Effect Unit
onClickSave {fields: (fieldsS /\ _), nodeId, reload, session} _ = do onClickSave {fields, nodeId, reload, session} _ = do
launchAff_ do launchAff_ do
saveCorpus $ { hyperdata: Hyperdata {fields: (\(Tuple _ f) -> f) <$> fieldsS} saveCorpus $ { hyperdata: Hyperdata {fields: (\(Tuple _ f) -> f) <$> fields}
, nodeId , nodeId
, session } , session }
liftEffect $ T2.reload reload liftEffect $ T2.reload reload
onClickAdd :: forall e. R.State FTFieldsWithIndex -> e -> Effect Unit onClickAdd :: forall e. T.Box FTFieldsWithIndex -> e -> Effect Unit
onClickAdd (_ /\ setFieldsS) _ = do onClickAdd fieldsS _ = do
setFieldsS $ \fieldsS -> List.snoc fieldsS $ Tuple (List.length fieldsS) defaultField T.modify_ (\fields -> List.snoc fields $ Tuple (List.length fields) defaultField) fieldsS
type FieldsCodeEditorProps = type FieldsCodeEditorProps =
( (
fields :: R.State FTFieldsWithIndex fields :: T.Box FTFieldsWithIndex
| LoadProps | LoadProps
) )
...@@ -145,50 +146,49 @@ fieldsCodeEditor = R.createElement fieldsCodeEditorCpt ...@@ -145,50 +146,49 @@ fieldsCodeEditor = R.createElement fieldsCodeEditorCpt
fieldsCodeEditorCpt :: R.Component FieldsCodeEditorProps fieldsCodeEditorCpt :: R.Component FieldsCodeEditorProps
fieldsCodeEditorCpt = here.component "fieldsCodeEditorCpt" cpt fieldsCodeEditorCpt = here.component "fieldsCodeEditorCpt" cpt
where 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.useBox T2.newReload
masterKey' <- T.useLive T.unequal masterKey masterKey' <- T.useLive T.unequal masterKey
pure $ H.div {} $ List.toUnfoldable (editors masterKey masterKey') let editorsMap (Tuple idx field) =
where fieldCodeEditorWrapper { canMoveDown: idx < (List.length fields' - 1)
editors masterKey masterKey' =
(\(Tuple idx field) ->
fieldCodeEditorWrapper { canMoveDown: idx < (List.length fields - 1)
, canMoveUp: idx > 0 , canMoveUp: idx > 0
, field , field
, key: (show masterKey') <> "-" <> (show idx) , key: (show masterKey') <> "-" <> (show idx)
, onChange: onChange fS idx , onChange: onChange idx
, onMoveDown: onMoveDown masterKey fS idx , onMoveDown: onMoveDown masterKey idx
, onMoveUp: onMoveUp masterKey fS idx , onMoveUp: onMoveUp masterKey idx
, onRemove: onRemove fS idx , onRemove: onRemove idx
, onRename: onRename fS idx , onRename: onRename idx
}) <$> fields }
onChange :: R.State FTFieldsWithIndex -> Index -> FieldType -> Effect Unit pure $ H.div {} $ List.toUnfoldable (editorsMap <$> fields')
onChange (_ /\ setFields) idx typ = do where
setFields $ \fields -> onChange :: Index -> FieldType -> Effect Unit
fromMaybe fields $ onChange idx typ = do
List.modifyAt idx (\(Tuple _ (Field f)) -> Tuple idx (Field $ f { typ = typ })) fields T.modify_ (\fs ->
fromMaybe fs $
onMoveDown :: T2.ReloadS -> R.State FTFieldsWithIndex -> Index -> Unit -> Effect Unit List.modifyAt idx (\(Tuple _ (Field f)) -> Tuple idx (Field $ f { typ = typ })) fs) fields
onMoveDown masterKey (_ /\ setFields) idx _ = do
T2.reload masterKey onMoveDown :: T2.ReloadS -> Index -> Unit -> Effect Unit
setFields $ recomputeIndices <<< (GDA.swapList idx (idx + 1)) onMoveDown masterKey idx _ = do
T2.reload masterKey
onMoveUp :: T2.ReloadS -> R.State FTFieldsWithIndex -> Index -> Unit -> Effect Unit T.modify_ (recomputeIndices <<< (GDA.swapList idx (idx + 1))) fields
onMoveUp masterKey (_ /\ setFields) idx _ = do
T2.reload masterKey onMoveUp :: T2.ReloadS -> Index -> Unit -> Effect Unit
setFields $ recomputeIndices <<< (GDA.swapList idx (idx - 1)) onMoveUp masterKey idx _ = do
T2.reload masterKey
onRemove :: R.State FTFieldsWithIndex -> Index -> Unit -> Effect Unit T.modify_ (recomputeIndices <<< (GDA.swapList idx (idx - 1))) fields
onRemove (_ /\ setFields) idx _ = do
setFields $ \fields -> onRemove :: Index -> Unit -> Effect Unit
fromMaybe fields $ List.deleteAt idx fields 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 onRename :: Index -> String -> Effect Unit
setFields $ \fields -> onRename idx newName = do
fromMaybe fields $ List.modifyAt idx (\(Tuple _ (Field f)) -> Tuple idx (Field $ f { name = newName })) fields T.modify_ (\fs ->
fromMaybe fs $ List.modifyAt idx (\(Tuple _ (Field f)) -> Tuple idx (Field $ f { name = newName })) fs) fields
recomputeIndices :: FTFieldsWithIndex -> FTFieldsWithIndex recomputeIndices :: FTFieldsWithIndex -> FTFieldsWithIndex
recomputeIndices = List.mapWithIndex $ \idx -> \(Tuple _ t) -> Tuple idx t recomputeIndices = List.mapWithIndex $ \idx -> \(Tuple _ t) -> Tuple idx t
...@@ -199,14 +199,14 @@ hash (Tuple idx f) = Crypto.hash $ "--idx--" <> (show idx) <> "--field--" <> (sh ...@@ -199,14 +199,14 @@ hash (Tuple idx f) = Crypto.hash $ "--idx--" <> (show idx) <> "--field--" <> (sh
type FieldCodeEditorProps = type FieldCodeEditorProps =
( (
canMoveDown :: Boolean canMoveDown :: Boolean
, canMoveUp :: Boolean , canMoveUp :: Boolean
, field :: FTField , field :: FTField
, key :: String , key :: String
, onChange :: FieldType -> Effect Unit , onChange :: FieldType -> Effect Unit
, onMoveDown :: Unit -> Effect Unit , onMoveDown :: Unit -> Effect Unit
, onMoveUp :: Unit -> Effect Unit , onMoveUp :: Unit -> Effect Unit
, onRemove :: Unit -> Effect Unit , onRemove :: Unit -> Effect Unit
, onRename :: String -> Effect Unit , onRename :: String -> Effect Unit
) )
fieldCodeEditorWrapper :: Record FieldCodeEditorProps -> R.Element fieldCodeEditorWrapper :: Record FieldCodeEditorProps -> R.Element
...@@ -272,8 +272,8 @@ renameableCpt :: R.Component RenameableProps ...@@ -272,8 +272,8 @@ renameableCpt :: R.Component RenameableProps
renameableCpt = here.component "renameableCpt" cpt renameableCpt = here.component "renameableCpt" cpt
where where
cpt {onRename, text} _ = do cpt {onRename, text} _ = do
isEditing <- R.useState' false isEditing <- T.useBox false
state <- R.useState' text state <- T.useBox text
textRef <- R.useRef text textRef <- R.useRef text
-- handle props change of text -- handle props change of text
...@@ -282,7 +282,7 @@ renameableCpt = here.component "renameableCpt" cpt ...@@ -282,7 +282,7 @@ renameableCpt = here.component "renameableCpt" cpt
pure unit pure unit
else do else do
R.setRef textRef text R.setRef textRef text
snd state $ const text T.write_ text state
pure $ H.div { className: "renameable" } [ pure $ H.div { className: "renameable" } [
renameableText { isEditing, onRename, state } renameableText { isEditing, onRename, state }
...@@ -290,9 +290,9 @@ renameableCpt = here.component "renameableCpt" cpt ...@@ -290,9 +290,9 @@ renameableCpt = here.component "renameableCpt" cpt
type RenameableTextProps = type RenameableTextProps =
( (
isEditing :: R.State Boolean isEditing :: T.Box Boolean
, onRename :: String -> Effect Unit , onRename :: String -> Effect Unit
, state :: R.State String , state :: T.Box String
) )
renameableText :: Record RenameableTextProps -> R.Element renameableText :: Record RenameableTextProps -> R.Element
...@@ -301,37 +301,41 @@ renameableText props = R.createElement renameableTextCpt props [] ...@@ -301,37 +301,41 @@ renameableText props = R.createElement renameableTextCpt props []
renameableTextCpt :: R.Component RenameableTextProps renameableTextCpt :: R.Component RenameableTextProps
renameableTextCpt = here.component "renameableTextCpt" cpt renameableTextCpt = here.component "renameableTextCpt" cpt
where where
cpt {isEditing: (false /\ setIsEditing), state: (text /\ _)} _ = do cpt { isEditing, onRename, state } _ = do
pure $ H.div { className: "input-group" } isEditing' <- T.useLive T.unequal isEditing
[ H.input { className: "form-control" state' <- T.useLive T.unequal state
, defaultValue: text
, disabled: 1 pure $ if isEditing' then
, type: "text" } H.div { className: "input-group" }
, H.div { className: "btn input-group-append" [ inputWithEnter {
, on: { click: \_ -> setIsEditing $ const true } } autoFocus: false
[ H.span { className: "fa fa-pencil" } [] , className: "form-control text"
] , defaultValue: state'
] , onBlur: \st -> T.write_ st state
cpt {isEditing: (true /\ setIsEditing), onRename, state: (text /\ setText)} _ = do , onEnter: submit state'
pure $ H.div { className: "input-group" } , onValueChanged: \st -> T.write_ st state
[ inputWithEnter { , placeholder: ""
autoFocus: false , type: "text"
, className: "form-control text" }
, defaultValue: text , H.div { className: "btn input-group-append"
, onBlur: setText <<< const , on: { click: submit state' } }
, onEnter: submit [ H.span { className: "fa fa-floppy-o" } []
, onValueChanged: setText <<< const ]
, placeholder: "" ]
, type: "text" else
} H.div { className: "input-group" }
, H.div { className: "btn input-group-append" [ H.input { className: "form-control"
, on: { click: submit } } , defaultValue: state'
[ H.span { className: "fa fa-floppy-o" } [] , disabled: 1
] , type: "text" }
] , H.div { className: "btn input-group-append"
, on: { click: \_ -> T.write_ true isEditing } }
[ H.span { className: "fa fa-pencil" } []
]
]
where where
submit _ = do submit text _ = do
setIsEditing $ const false T.write_ false isEditing
onRename text onRename text
fieldCodeEditor :: Record FieldCodeEditorProps -> R.Element fieldCodeEditor :: Record FieldCodeEditorProps -> R.Element
......
...@@ -125,10 +125,10 @@ dashboardLayoutLoadedCpt = here.component "dashboardLayoutLoaded" cpt ...@@ -125,10 +125,10 @@ dashboardLayoutLoadedCpt = here.component "dashboardLayoutLoaded" cpt
, fields } , fields }
type CodeEditorProps = type CodeEditorProps =
( fields :: List.List FTField ( fields :: List.List FTField
, onChange :: List.List FTField -> Effect Unit , onChange :: List.List FTField -> Effect Unit
, nodeId :: NodeID , nodeId :: NodeID
, session :: Session , session :: Session
) )
dashboardCodeEditor :: R2.Component CodeEditorProps dashboardCodeEditor :: R2.Component CodeEditorProps
...@@ -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,15 +182,17 @@ menuElements = R.createElement menuElementsCpt ...@@ -182,15 +182,17 @@ 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"
, style: { display: "block" } } $ intercalate divider $ map (map liNav) elements , on: { click: \_ -> T.write_ false show }
where , style: { display: "block" } } $ intercalate divider $ map (map liNav) elements
divider :: Array R.Element else
divider = [H.li {className: "dropdown-divider"} []] H.div {} []
divider :: Array R.Element
divider = [H.li {className: "dropdown-divider"} []]
-- | surgar for target : "blank" -- | surgar for target : "blank"
--data LiNav_ = LiNav_ { title :: String --data LiNav_ = LiNav_ { title :: String
......
...@@ -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