aboutsummaryrefslogtreecommitdiff
path: root/client/src
diff options
context:
space:
mode:
Diffstat (limited to 'client/src')
-rw-r--r--client/src/Component/Pages.hs22
-rw-r--r--client/src/Component/Table.hs62
-rw-r--r--client/src/Loadable.hs17
-rw-r--r--client/src/Util/Reflex.hs1
-rw-r--r--client/src/View/Income/Income.hs65
-rw-r--r--client/src/View/Income/Table.hs4
6 files changed, 76 insertions, 95 deletions
diff --git a/client/src/Component/Pages.hs b/client/src/Component/Pages.hs
index a297222..d54cd3d 100644
--- a/client/src/Component/Pages.hs
+++ b/client/src/Component/Pages.hs
@@ -16,32 +16,26 @@ import qualified View.Icon as Icon
data In t = In
{ _in_total :: Dynamic t Int
, _in_perPage :: Int
+ , _in_page :: Int
}
data Out t = Out
{ _out_newPage :: Event t Int
- , _out_currentPage :: Dynamic t Int
}
view :: forall t m. MonadWidget t m => In t -> m (Out t)
view input = do
- (newPage, currentPage) <- ReflexUtil.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage
+ newPage <- ReflexUtil.divVisibleIf ((> 0) <$> (_in_total input)) $ pageButtons input
return $ Out
{ _out_newPage = newPage
- , _out_currentPage = currentPage
}
- where
- total = _in_total input
- perPage = _in_perPage input
-
pageButtons
:: forall t m. MonadWidget t m
- => Dynamic t Int
- -> Int
- -> m (Event t Int, Dynamic t Int)
-pageButtons total perPage = do
+ => In t
+ -> m (Event t Int)
+pageButtons input = do
R.divClass "pages" $ do
rec
let newPage = R.leftmost
@@ -52,7 +46,7 @@ pageButtons total perPage = do
, lastPageClic
]
- currentPage <- R.holdDyn 1 newPage
+ currentPage <- R.holdDyn (_in_page input) newPage
firstPageClic <- pageButton noCurrentPage (R.constDyn 1) Icon.doubleLeftBar
@@ -65,9 +59,9 @@ pageButtons total perPage = do
lastPageClic <- pageButton noCurrentPage maxPage Icon.doubleRightBar
- return (newPage, currentPage)
+ return newPage
- where maxPage = R.ffor total (\t -> ceiling $ toRational t / toRational perPage)
+ where maxPage = R.ffor (_in_total input) (\t -> ceiling $ toRational t / toRational (_in_perPage input))
pageEvent = R.switch . R.current . fmap R.leftmost
noCurrentPage = R.constDyn Nothing
diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs
index 7103abd..3b9ec24 100644
--- a/client/src/Component/Table.hs
+++ b/client/src/Component/Table.hs
@@ -4,8 +4,9 @@ module Component.Table
, Out(..)
) where
+import qualified Data.Map as M
import Data.Text (Text)
-import Reflex.Dom (Dynamic, Event, MonadWidget)
+import Reflex.Dom (Event, MonadWidget)
import qualified Reflex.Dom as R
import qualified Component.Button as Button
@@ -15,7 +16,7 @@ import qualified View.Icon as Icon
data In m t h r a = In
{ _in_headerLabel :: h -> Text
- , _in_rows :: Dynamic t [r]
+ , _in_rows :: [r]
, _in_cell :: h -> r -> Text
, _in_cloneModal :: r -> Modal.Content t m a
, _in_editModal :: r -> Modal.Content t m a
@@ -44,61 +45,60 @@ view input =
R.divClass "cell" $ R.blank
R.divClass "cell" $ R.blank
- R.simpleList (_in_rows input) $ \r ->
+ flip mapM (_in_rows input) $ \row ->
R.divClass "row" $ do
- flip mapM_ [minBound..] $ \h ->
+ flip mapM_ [minBound..] $ \header ->
R.divClass "cell" $
- R.dynText $
- R.ffor r (_in_cell input h)
+ R.text $
+ _in_cell input header row
- clone <-
+ cloneButton <-
R.divClass "cell button" $
Button._out_clic <$> (Button.view $
Button.defaultIn Icon.clone)
- cloned <-
+ clone <-
Modal.view $ Modal.In
- { Modal._in_show = clone
- , Modal._in_content = \curtainClick ->
- (R.dyn . R.ffor r $ \r2 -> _in_cloneModal input r2 curtainClick)
- >>= ReflexUtil.flattenTuple
+ { Modal._in_show = cloneButton
+ , Modal._in_content = _in_cloneModal input row
}
- let isOwner = R.ffor r (_in_isOwner input)
+ let isOwner = _in_isOwner input row
- edit <-
+ let visibleIf cond =
+ R.elAttr
+ "div"
+ (if cond then M.empty else M.singleton "style" "display:none")
+
+ editButton <-
R.divClass "cell button" $
- ReflexUtil.divVisibleIf isOwner $
+ visibleIf isOwner $
Button._out_clic <$> (Button.view $
Button.defaultIn Icon.edit)
- edited <-
+ edit <-
Modal.view $ Modal.In
- { Modal._in_show = edit
- , Modal._in_content = \curtainClick ->
- (R.dyn . R.ffor r $ \r2 -> _in_editModal input r2 curtainClick)
- >>= ReflexUtil.flattenTuple
+ { Modal._in_show = editButton
+ , Modal._in_content = _in_editModal input row
}
- delete <-
+ deleteButton <-
R.divClass "cell button" $
- ReflexUtil.divVisibleIf isOwner $
+ visibleIf isOwner $
Button._out_clic <$> (Button.view $
Button.defaultIn Icon.delete)
- deleted <-
+ delete <-
Modal.view $ Modal.In
- { Modal._in_show = delete
- , Modal._in_content = \curtainClick ->
- (R.dyn . R.ffor r $ \r2 -> _in_deleteModal input r2 curtainClick)
- >>= ReflexUtil.flattenTuple
+ { Modal._in_show = deleteButton
+ , Modal._in_content = _in_deleteModal input row
}
- return (cloned, edited, deleted)
+ return (clone, edit, delete)
- let add = R.switch . R.current . fmap (R.leftmost . map (\(a, _, _) -> a)) $ result
- edit = R.switch . R.current . fmap (R.leftmost . map (\(_, a, _) -> a)) $ result
- delete = R.switch . R.current . fmap (R.leftmost . map (\(_, _, a) -> a)) $ result
+ let add = R.leftmost . map (\(a, _, _) -> a) $ result
+ edit = R.leftmost . map (\(_, a, _) -> a) $ result
+ delete = R.leftmost . map (\(_, _, a) -> a) $ result
return $ Out
{ _out_add = add
diff --git a/client/src/Loadable.hs b/client/src/Loadable.hs
index a5c1d41..f57b99c 100644
--- a/client/src/Loadable.hs
+++ b/client/src/Loadable.hs
@@ -45,16 +45,7 @@ fromEvent =
)
Loading
-view :: forall t m a. MonadWidget t m => (a -> m ()) -> Loadable a -> m ()
-view _ (Loading) = R.divClass "pageSpinner" $ R.divClass "spinner" $ R.blank
-view _ (Error e) = R.text e
-view f (Loaded x) = f x
-
--- view :: forall t m a b. MonadWidget t m => (a -> m b) -> Loadable a -> m (Maybe b)
--- view _ (Loading) = do
--- R.divClass "pageSpinner" $ R.divClass "spinner" $ R.blank
--- return Nothing
--- view _ (Error e) = do
--- R.text e
--- return Nothing
--- view f (Loaded x) = Just <$> (f x)
+view :: forall t m a b. MonadWidget t m => (a -> m b) -> Loadable a -> m (Maybe b)
+view _ (Loading) = (R.divClass "pageSpinner" $ R.divClass "spinner" $ R.blank) >> return Nothing
+view _ (Error e) = R.text e >> return Nothing
+view f (Loaded x) = Just <$> f x
diff --git a/client/src/Util/Reflex.hs b/client/src/Util/Reflex.hs
index 9f51c5c..aa5cebb 100644
--- a/client/src/Util/Reflex.hs
+++ b/client/src/Util/Reflex.hs
@@ -45,7 +45,6 @@ flatten e = do
dyn <- R.holdDyn R.never e
return $ R.switchDyn dyn
-
flattenTuple
:: forall t m a b. MonadWidget t m
=> Event t (Event t a, Event t b)
diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs
index c48f325..fedf3d8 100644
--- a/client/src/View/Income/Income.hs
+++ b/client/src/View/Income/Income.hs
@@ -1,10 +1,14 @@
+{-# LANGUAGE ExplicitForAll #-}
+
module View.Income.Income
( init
, view
, In(..)
) where
+import qualified Data.Text as T
import Data.Aeson (FromJSON)
+import qualified Data.Maybe as Maybe
import Prelude hiding (init)
import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
@@ -41,45 +45,38 @@ init = do
view :: forall t m. MonadWidget t m => In t -> m ()
view input = do
- -- rec
- -- incomes <- Reducer.reducer
- -- { Reducer._in_newPage = ReflexUtil.flatten (Table._out_newPage <$> table)
- -- , Reducer._in_currentPage = ReflexUtil.flatten (Table._out_currentPage <$> table)
- -- , Reducer._in_addIncome = ReflexUtil.flatten (Table._out_add <$> table)
- -- , Reducer._in_editIncome = ReflexUtil.flatten (Table._out_edit <$> table)
- -- , Reducer._in_deleteIncome = ReflexUtil.flatten (Table._out_delete <$> table)
- -- }
-
rec
incomes <- Reducer.reducer $ Reducer.In
- { Reducer._in_newPage = Pages._out_newPage pages
- , Reducer._in_currentPage = Pages._out_currentPage pages
- , Reducer._in_addIncome = Table._out_add table
- , Reducer._in_editIncome = Table._out_edit table
- , Reducer._in_deleteIncome = Table._out_delete table
+ { Reducer._in_newPage = newPage
+ , Reducer._in_currentPage = currentPage
+ , Reducer._in_addIncome = addIncome
+ , Reducer._in_editIncome = editIncome
+ , Reducer._in_deleteIncome = deleteIncome
}
- table <- Table.view $ Table.In
- { Table._in_currentUser = _in_currentUser input
- , Table._in_currency = _in_currency input
- , Table._in_incomes = R.ffor incomes $ \case
- Loaded (IncomesAndCount xs _) -> xs
- _ -> []
- }
+ let eventFromResult :: forall a. ((Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a)
+ eventFromResult op = ReflexUtil.flatten . fmap (Maybe.fromMaybe R.never . fmap op) $ result
- pages <- Pages.view $ Pages.In
- { Pages._in_total = R.ffor incomes $ \case
- Loaded (IncomesAndCount _ n) -> n
- _ -> 0
- , Pages._in_perPage = Reducer.perPage
- }
+ newPage <- eventFromResult $ Pages._out_newPage . snd
+ currentPage <- R.holdDyn 1 newPage
+ addIncome <- eventFromResult $ Table._out_add . fst
+ editIncome <- eventFromResult $ Table._out_edit . fst
+ deleteIncome <- eventFromResult $ Table._out_delete . fst
+
+ result <- R.dyn . R.ffor ((,) <$> incomes <*> currentPage) $ \(is, p) ->
+ flip Loadable.view is $ \(IncomesAndCount incomes count) -> do
+ table <- Table.view $ Table.In
+ { Table._in_currentUser = _in_currentUser input
+ , Table._in_currency = _in_currency input
+ , Table._in_incomes = incomes
+ }
+
+ pages <- Pages.view $ Pages.In
+ { Pages._in_total = R.constDyn count
+ , Pages._in_perPage = Reducer.perPage
+ , Pages._in_page = p
+ }
- -- -- table :: Event t (Maybe (Table.Out t))
- -- table <- R.dyn . R.ffor incomes . Loadable.view $ \incomes ->
- -- Table.view $ Table.In
- -- { Table._in_currentUser = _in_currentUser input
- -- , Table._in_currency = _in_currency input
- -- , Table._in_incomes = incomes
- -- }
+ return (table, pages)
return ()
diff --git a/client/src/View/Income/Table.hs b/client/src/View/Income/Table.hs
index 6d69c19..9b2129f 100644
--- a/client/src/View/Income/Table.hs
+++ b/client/src/View/Income/Table.hs
@@ -26,7 +26,7 @@ import qualified View.Income.Form as Form
data In t = In
{ _in_currentUser :: UserId
, _in_currency :: Currency
- , _in_incomes :: Dynamic t [Income]
+ , _in_incomes :: [Income]
}
data Out t = Out
@@ -40,7 +40,7 @@ view input = do
table <- Table.view $ Table.In
{ Table._in_headerLabel = headerLabel
- , Table._in_rows = R.ffor (_in_incomes input) $ reverse . L.sortOn _income_date
+ , Table._in_rows = reverse . L.sortOn _income_date $ _in_incomes input
, Table._in_cell = cell [] (_in_currency input)
, Table._in_cloneModal = \income ->
Form.view $ Form.In
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 00:53:55 +0000