Commit b60d2351 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[toestand] more R.State refactoring

parent 7e57b345
...@@ -289,7 +289,7 @@ pageLayoutCpt = here.component "pageLayout" cpt where ...@@ -289,7 +289,7 @@ pageLayoutCpt = here.component "pageLayout" cpt where
, renderer: paint , renderer: paint
} }
NT.CacheOff -> do NT.CacheOff -> do
localCategories <- R.useState' (mempty :: LocalUserScore) localCategories <- T.useBox (mempty :: LocalUserScore)
paramsS <- T.useBox params paramsS <- T.useBox params
paramsS' <- T.useLive T.unequal paramsS paramsS' <- T.useLive T.unequal paramsS
let loader p = do let loader p = do
...@@ -337,7 +337,7 @@ pagePaintCpt = here.component "pagePaintCpt" cpt ...@@ -337,7 +337,7 @@ pagePaintCpt = here.component "pagePaintCpt" cpt
cpt { documents, layout, params } _ = do cpt { documents, layout, params } _ = do
params' <- T.useLive T.unequal params params' <- T.useLive T.unequal params
localCategories <- R.useState' (mempty :: LocalUserScore) localCategories <- T.useBox (mempty :: LocalUserScore)
pure $ pagePaintRaw { documents: A.fromFoldable (filteredRows params') pure $ pagePaintRaw { documents: A.fromFoldable (filteredRows params')
, layout , layout
, localCategories , localCategories
...@@ -356,10 +356,10 @@ pagePaintCpt = here.component "pagePaintCpt" cpt ...@@ -356,10 +356,10 @@ pagePaintCpt = here.component "pagePaintCpt" cpt
type PagePaintRawProps = ( type PagePaintRawProps = (
documents :: Array DocumentsView documents :: Array DocumentsView
, layout :: Record PageLayoutProps , layout :: Record PageLayoutProps
, localCategories :: R.State LocalUserScore , localCategories :: T.Box LocalUserScore
, params :: T.Box TT.Params , params :: T.Box TT.Params
) )
pagePaintRaw :: R2.Component PagePaintRawProps pagePaintRaw :: R2.Component PagePaintRawProps
...@@ -380,12 +380,14 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where ...@@ -380,12 +380,14 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where
reload <- T.useBox T2.newReload reload <- T.useBox T2.newReload
localCategories' <- T.useLive T.unequal localCategories
pure $ TT.table pure $ TT.table
{ syncResetButton : [ H.div {} [] ] { syncResetButton : [ H.div {} [] ]
, colNames , colNames
, container: TT.defaultContainer { title: "Documents" } , container: TT.defaultContainer { title: "Documents" }
, params , params
, rows: rows reload localCategories , rows: rows reload localCategories'
, totalRecords , totalRecords
, wrapColElts , wrapColElts
} }
...@@ -401,10 +403,9 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where ...@@ -401,10 +403,9 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where
| otherwise = Routes.Document sid listId | otherwise = Routes.Document sid listId
colNames = TT.ColumnName <$> [ "Show", "Tag", "Date", "Title", "Source", "Score" ] colNames = TT.ColumnName <$> [ "Show", "Tag", "Date", "Title", "Source", "Score" ]
wrapColElts = const identity wrapColElts = const identity
getCategory (lc /\ _) {_id, category} = fromMaybe category (lc ^. at _id) rows reload localCategories' = row <$> A.toUnfoldable documents
rows reload lc@(_ /\ setLocalCategories) = row <$> A.toUnfoldable documents
where where
row dv@(DocumentsView r) = row dv@(DocumentsView r@{ _id, category }) =
{ row: { row:
TT.makeRow [ -- H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ] TT.makeRow [ -- H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ]
H.div { className: "" } H.div { className: "" }
...@@ -412,7 +413,11 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where ...@@ -412,7 +413,11 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where
] ]
--, H.div { className: "column-tag flex" } [ caroussel { category: cat, nodeId, row: dv, session, setLocalCategories } [] ] --, H.div { className: "column-tag flex" } [ caroussel { category: cat, nodeId, row: dv, session, setLocalCategories } [] ]
, H.div { className: "column-tag flex" } , H.div { className: "column-tag flex" }
[ rating { score: cat, nodeId, row: dv, session, setLocalCategories } [] ] [ rating { nodeId
, row: dv
, score: cat
, setLocalCategories: \lc -> T.modify_ lc localCategories
, session } [] ]
--, H.input { type: "checkbox", defaultValue: checked, on: {click: click Trash} } --, H.input { type: "checkbox", defaultValue: checked, on: {click: click Trash} }
-- TODO show date: Year-Month-Day only -- TODO show date: Year-Month-Day only
, H.div { className: tClassName } [ R2.showText r.date ] , H.div { className: tClassName } [ R2.showText r.date ]
...@@ -425,7 +430,7 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where ...@@ -425,7 +430,7 @@ pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where
] ]
, delete: true } , delete: true }
where where
cat = getCategory lc r cat = fromMaybe category (localCategories' ^. at _id)
-- checked = Star_1 == cat -- checked = Star_1 == cat
tClassName = trashClassName cat selected tClassName = trashClassName cat selected
className = gi cat className = gi cat
......
...@@ -128,7 +128,7 @@ docViewCpt :: R.Component Props ...@@ -128,7 +128,7 @@ docViewCpt :: R.Component Props
docViewCpt = here.component "docView" cpt docViewCpt = here.component "docView" cpt
where where
cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do
deletions <- R.useState' initialDeletions deletions <- T.useBox initialDeletions
path <- T.useBox $ initialPagePath {nodeId, listId, query, session} path <- T.useBox $ initialPagePath {nodeId, listId, query, session}
path' <- T.useLive T.unequal path path' <- T.useLive T.unequal path
...@@ -143,28 +143,29 @@ docViewCpt = here.component "docView" cpt ...@@ -143,28 +143,29 @@ docViewCpt = here.component "docView" cpt
[ R2.row [ R2.row
[ chart [ chart
, H.div { className: "col-md-12" } , H.div { className: "col-md-12" }
[ pageLayout { deletions, frontends, totalRecords, container, session, path } ] [ pageLayout { container, deletions, frontends, path, session, totalRecords } [] ]
{- , H.div { className: "col-md-12" } {- , H.div { className: "col-md-12" }
[ H.button { style: buttonStyle, on: { click: trashClick deletions } } [ H.button { style: buttonStyle, on: { click: trashClick deletions } }
[ H.i { className: "glyphitem fa fa-trash" [ H.i { className: "glyphitem fa fa-trash"
, style: { marginRight : "9px" }} [] , style: { marginRight : "9px" }} []
, H.text "Delete document!" ] , H.text "Delete document!" ]
] ]
-} ] -} ]
] ]
where where
buttonStyle = buttonStyle = { backgroundColor: "peru"
{ backgroundColor: "peru", padding: "9px", color: "white" , border: "white"
, border: "white", float: "right" } , color: "white"
trashClick deletions _ = performDeletions session nodeId deletions , float: "right"
, padding: "9px" }
performDeletions :: Session -> Int -> R.State Deletions -> Effect Unit
performDeletions session nodeId (deletions /\ setDeletions) = performDeletions :: Session -> Int -> T.Box Deletions -> Deletions -> Effect Unit
launchAff_ call *> setDeletions del performDeletions session nodeId deletions deletions' = do
launchAff_ $ deleteDocuments session nodeId (DeleteDocumentQuery q)
T.modify_ del deletions
where where
q = {documents: Set.toUnfoldable deletions.pending} q = { documents: Set.toUnfoldable deletions'.pending }
call = deleteDocuments session nodeId (DeleteDocumentQuery q) del { deleted, pending } = { deleted: deleted <> pending, pending: mempty }
del {pending, deleted} = {pending: mempty, deleted: deleted <> pending}
markCategory :: Session -> NodeID -> Category -> Array NodeID -> Effect Unit markCategory :: Session -> NodeID -> Category -> Array NodeID -> Effect Unit
markCategory session nodeId category nids = markCategory session nodeId category nids =
...@@ -183,10 +184,11 @@ docViewGraphCpt :: R.Component Props ...@@ -183,10 +184,11 @@ docViewGraphCpt :: R.Component Props
docViewGraphCpt = here.component "docViewGraph" cpt docViewGraphCpt = here.component "docViewGraph" cpt
where where
cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do
deletions <- R.useState' initialDeletions deletions <- T.useBox initialDeletions
deletions' <- T.useLive T.unequal deletions
let buttonStyle = { backgroundColor: "peru", padding : "9px" let buttonStyle = { backgroundColor: "peru", padding : "9px"
, color : "white", border : "white", float: "right"} , color : "white", border : "white", float: "right"}
let performClick = \_ -> performDeletions session nodeId deletions let performClick = \_ -> performDeletions session nodeId deletions deletions'
path <- T.useBox $ initialPagePath { nodeId, listId, query, session } path <- T.useBox $ initialPagePath { nodeId, listId, query, session }
pure $ R.fragment pure $ R.fragment
...@@ -197,7 +199,7 @@ docViewGraphCpt = here.component "docViewGraph" cpt ...@@ -197,7 +199,7 @@ docViewGraphCpt = here.component "docViewGraph" cpt
[ R2.row [ R2.row
[ chart [ chart
, H.div { className: "col-md-12" } , H.div { className: "col-md-12" }
[ pageLayout { frontends, totalRecords, deletions, container, session, path } [ pageLayout { container, deletions, frontends, path, session, totalRecords } []
, H.button { style: buttonStyle, on: { click: performClick } } , H.button { style: buttonStyle, on: { click: performClick } }
[ H.i { className: "glyphitem fa fa-trash" [ H.i { className: "glyphitem fa fa-trash"
, style: { marginRight : "9px" } } [] , style: { marginRight : "9px" } } []
...@@ -298,7 +300,7 @@ err2view message = ...@@ -298,7 +300,7 @@ err2view message =
type PageLayoutProps = type PageLayoutProps =
( frontends :: Frontends ( frontends :: Frontends
, totalRecords :: Int , totalRecords :: Int
, deletions :: R.State Deletions , deletions :: T.Box Deletions
, container :: Record T.TableContainerProps -> R.Element , container :: Record T.TableContainerProps -> R.Element
, session :: Session , session :: Session
, path :: T.Box PagePath , path :: T.Box PagePath
...@@ -307,33 +309,41 @@ type PageLayoutProps = ...@@ -307,33 +309,41 @@ type PageLayoutProps =
type PageProps = ( rowsLoaded :: Rows | PageLayoutProps ) type PageProps = ( rowsLoaded :: Rows | PageLayoutProps )
-- | Loads and renders a page -- | Loads and renders a page
pageLayout :: Record PageLayoutProps -> R.Element pageLayout :: R2.Component PageLayoutProps
pageLayout props = R.createElement pageLayoutCpt props [] pageLayout = R.createElement pageLayoutCpt
pageLayoutCpt :: R.Component PageLayoutProps pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = here.component "pageLayout" cpt pageLayoutCpt = here.component "pageLayout" cpt
where where
cpt {frontends, totalRecords, deletions, container, session, path} _ = do cpt { container, deletions, frontends, path, session, totalRecords } _ = do
path' <- T.useLive T.unequal path path' <- T.useLive T.unequal path
useLoader path' loadPage $ \rowsLoaded -> useLoader path' loadPage $ \rowsLoaded ->
page {frontends, totalRecords, deletions, container, session, path, rowsLoaded} page { container, deletions, frontends, path, rowsLoaded, session, totalRecords } []
page :: Record PageProps -> R.Element page :: R2.Component PageProps
page props = R.createElement pageCpt props [] page = R.createElement pageCpt
pageCpt :: R.Component PageProps pageCpt :: R.Component PageProps
pageCpt = here.component "page" cpt pageCpt = here.component "page" cpt
where where
cpt { frontends cpt { container
, totalRecords
, container
, deletions , deletions
, frontends
, path
, rowsLoaded , rowsLoaded
, session , session
, path } _ = do , totalRecords } _ = do
path'@{ nodeId, listId, query } <- T.useLive T.unequal path path'@{ nodeId, listId, query } <- T.useLive T.unequal path
params <- T.useFocused (_.params) (\a b -> b { params = a }) path params <- T.useFocused (_.params) (\a b -> b { params = a }) path
deletions' <- T.useLive T.unequal deletions
let isChecked id = Set.member id deletions'.pending
isDeleted (DocumentsView {id}) = Set.member id deletions'.deleted
rows path' = case rowsLoaded of
Docs {docs} -> docRow path' <$> Seq.filter (not <<< isDeleted) docs
Contacts {contacts} -> contactRow path' <$> contacts
pure $ T.table { colNames pure $ T.table { colNames
, container , container
...@@ -353,9 +363,6 @@ pageCpt = here.component "page" cpt ...@@ -353,9 +363,6 @@ pageCpt = here.component "page" cpt
gi Trash = "fa fa-star-empty" gi Trash = "fa fa-star-empty"
gi _ = "fa fa-star" gi _ = "fa fa-star"
isChecked id = Set.member id (fst deletions).pending
isDeleted (DocumentsView {id}) = Set.member id (fst deletions).deleted
documentUrl id { listId, nodeId } = documentUrl id { listId, nodeId } =
url frontends $ Routes.CorpusDocument (sessionId session) nodeId listId id url frontends $ Routes.CorpusDocument (sessionId session) nodeId listId id
...@@ -364,10 +371,6 @@ pageCpt = here.component "page" cpt ...@@ -364,10 +371,6 @@ pageCpt = here.component "page" cpt
where href = url session $ NodePath (sessionId session) NodeContact (Just id) where href = url session $ NodePath (sessionId session) NodeContact (Just id)
| otherwise = H.text label | otherwise = H.text label
rows path' = case rowsLoaded of
Docs {docs} -> docRow path' <$> Seq.filter (not <<< isDeleted) docs
Contacts {contacts} -> contactRow path' <$> contacts
contactRow path' (ContactsView { id, hyperdata: HyperdataRowContact { firstname, lastname, labs } contactRow path' (ContactsView { id, hyperdata: HyperdataRowContact { firstname, lastname, labs }
, score, annuaireId, delete , score, annuaireId, delete
}) = }) =
...@@ -390,18 +393,10 @@ pageCpt = here.component "page" cpt ...@@ -390,18 +393,10 @@ pageCpt = here.component "page" cpt
, maybeStricken delete [ H.text $ publicationDate dv ] , maybeStricken delete [ H.text $ publicationDate dv ]
, maybeStricken delete [ H.a {target: "_blank", href: documentUrl id path'} [ H.text title ] ] , maybeStricken delete [ H.a {target: "_blank", href: documentUrl id path'} [ H.text title ] ]
, maybeStricken delete [ H.text source ] , maybeStricken delete [ H.text source ]
-- , maybeStricken delete [ H.text authors ]
-- , maybeStricken $ intercalate [comma] (pairUrl <$> pairs)
{-, H.input { defaultChecked: isChecked id
, on: { click: toggleClick }
, type: "checkbox"
}
-}
] ]
, delete: true } , delete: true }
where where
markClick { nodeId } _ = markCategory session nodeId category [id] markClick { nodeId } _ = markCategory session nodeId category [id]
toggleClick _ = togglePendingDeletion deletions id
-- comma = H.span {} [ H.text ", " ] -- comma = H.span {} [ H.text ", " ]
maybeStricken delete maybeStricken delete
......
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