aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--client/client.cabal2
-rw-r--r--client/src/View/Income/Header.hs60
-rw-r--r--client/src/View/Income/Income.hs100
-rw-r--r--client/src/View/Income/Table.hs63
4 files changed, 137 insertions, 88 deletions
diff --git a/client/client.cabal b/client/client.cabal
index 8c25da7..06e77e0 100644
--- a/client/client.cabal
+++ b/client/client.cabal
@@ -65,7 +65,9 @@ Executable client
Util.WaitFor
View.App
View.Header
+ View.Income.Header
View.Income.Income
+ View.Income.Table
View.NotFound
View.Payment.Add
View.Payment.Clone
diff --git a/client/src/View/Income/Header.hs b/client/src/View/Income/Header.hs
new file mode 100644
index 0000000..b7170c9
--- /dev/null
+++ b/client/src/View/Income/Header.hs
@@ -0,0 +1,60 @@
+module View.Income.Header
+ ( view
+ , HeaderIn(..)
+ ) where
+
+import Control.Monad.IO.Class (liftIO)
+import qualified Data.Maybe as Maybe
+import qualified Data.Text as T
+import qualified Data.Time.Clock as Clock
+import Reflex.Dom (MonadWidget)
+import qualified Reflex.Dom as R
+
+import Common.Model (Income (..), Init (..), User (..))
+import qualified Common.Model as CM
+import qualified Common.Msg as Msg
+import qualified Common.View.Format as Format
+import qualified Util.Date as DateUtil
+
+data HeaderIn = HeaderIn
+ { _headerIn_init :: Init
+ }
+
+view :: forall t m. MonadWidget t m => HeaderIn -> m ()
+view headerIn =
+ R.divClass "withMargin" $ do
+
+ currentTime <- liftIO Clock.getCurrentTime
+
+ Maybe.fromMaybe R.blank $
+ flip fmap useIncomesFrom $ \since ->
+ R.el "div" $ do
+
+ R.el "h1" $ do
+ day <- liftIO $ DateUtil.utcToLocalDay since
+ R.text $ Msg.get (Msg.Income_CumulativeSince (Format.longDay day))
+
+ R.el "ul" $
+ flip mapM_ (_init_users init) $ \user ->
+ R.el "li" $
+ R.text $ do
+ let incomes = filter ((==) (_user_id user) . _income_userId) (_init_incomes init)
+ T.intercalate " "
+ [ _user_name user
+ , "−"
+ , Format.price (_init_currency init) $
+ CM.cumulativeIncomesSince currentTime since incomes
+ ]
+
+ R.divClass "titleButton" $
+ R.el "h1" $
+ R.text $
+ Msg.get Msg.Income_MonthlyNet
+
+ where
+ init = _headerIn_init headerIn
+
+ useIncomesFrom = CM.useIncomesFrom
+ (map _user_id $_init_users init)
+ (_init_incomes init)
+ (_init_payments init)
diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs
index 0fdd7d3..b0c6f0b 100644
--- a/client/src/View/Income/Income.hs
+++ b/client/src/View/Income/Income.hs
@@ -3,22 +3,14 @@ module View.Income.Income
, IncomeIn(..)
) where
-import Control.Monad.IO.Class (liftIO)
-import qualified Data.List as L
-import qualified Data.Maybe as Maybe
-import Data.Text (Text)
-import qualified Data.Text as T
-import qualified Data.Time.Clock as Clock
-import Reflex.Dom (MonadWidget)
-import qualified Reflex.Dom as R
+import Reflex.Dom (MonadWidget)
+import qualified Reflex.Dom as R
-import Common.Model (Income (..), Init (..), User (..))
-import qualified Common.Model as CM
-import qualified Common.Msg as Msg
-import qualified Common.View.Format as Format
-import Component (TableIn (..))
-import qualified Component
-import qualified Util.Date as DateUtil
+import Common.Model (Init)
+import View.Income.Header (HeaderIn (..))
+import qualified View.Income.Header as Header
+import View.Income.Table (IncomeTableIn (..))
+import qualified View.Income.Table as Table
data IncomeIn = IncomeIn
{ _incomeIn_init :: Init
@@ -28,80 +20,12 @@ view :: forall t m. MonadWidget t m => IncomeIn -> m ()
view incomeIn =
R.elClass "main" "income" $ do
- header (_incomeIn_init incomeIn)
+ Header.view $ HeaderIn
+ { _headerIn_init = _incomeIn_init incomeIn
+ }
- Component.table $ TableIn
- { _tableIn_headerLabel = headerLabel
- , _tableIn_rows =
- R.constDyn
- . reverse
- . L.sortOn _income_date
- . _init_incomes
- . _incomeIn_init
- $ incomeIn
- , _tableIn_cell = cell (_incomeIn_init incomeIn)
- , _tableIn_perPage = 7
- , _tableIn_resetPage = R.never
+ Table.view $ IncomeTableIn
+ { _tableIn_init = _incomeIn_init incomeIn
}
return ()
-
-header :: forall t m. MonadWidget t m => Init -> m ()
-header init =
- R.divClass "withMargin" $ do
-
- currentTime <- liftIO Clock.getCurrentTime
-
- Maybe.fromMaybe R.blank $
- flip fmap useIncomesFrom $ \since ->
- R.el "div" $ do
-
- R.el "h1" $ do
- day <- liftIO $ DateUtil.utcToLocalDay since
- R.text $ Msg.get (Msg.Income_CumulativeSince (Format.longDay day))
-
- R.el "ul" $
- flip mapM_ (_init_users init) $ \user ->
- R.el "li" $
- R.text $ do
- let incomes = filter ((==) (_user_id user) . _income_userId) (_init_incomes init)
- T.intercalate " "
- [ _user_name user
- , "−"
- , Format.price (_init_currency init) $
- CM.cumulativeIncomesSince currentTime since incomes
- ]
-
- R.divClass "titleButton" $
- R.el "h1" $
- R.text $
- Msg.get Msg.Income_MonthlyNet
-
- where
- useIncomesFrom = CM.useIncomesFrom
- (map _user_id $_init_users init)
- (_init_incomes init)
- (_init_payments init)
-
-data Header
- = UserHeader
- | AmountHeader
- | DateHeader
- deriving (Eq, Show, Bounded, Enum)
-
-headerLabel :: Header -> Text
-headerLabel UserHeader = Msg.get Msg.Income_Name
-headerLabel DateHeader = Msg.get Msg.Income_Date
-headerLabel AmountHeader = Msg.get Msg.Income_Amount
-
-cell :: Init -> Header -> Income -> Text
-cell init header income =
- case header of
- UserHeader ->
- Maybe.fromMaybe "" . fmap _user_name $ CM.findUser (_income_userId income) (_init_users init)
-
- DateHeader ->
- Format.longDay . _income_date $ income
-
- AmountHeader ->
- Format.price (_init_currency init) . _income_amount $ income
diff --git a/client/src/View/Income/Table.hs b/client/src/View/Income/Table.hs
new file mode 100644
index 0000000..2e8f4e6
--- /dev/null
+++ b/client/src/View/Income/Table.hs
@@ -0,0 +1,63 @@
+module View.Income.Table
+ ( view
+ , IncomeTableIn(..)
+ ) where
+
+import qualified Data.List as L
+import qualified Data.Maybe as Maybe
+import Data.Text (Text)
+import Reflex.Dom (MonadWidget)
+import qualified Reflex.Dom as R
+
+import Common.Model (Income (..), Init (..), User (..))
+import qualified Common.Model as CM
+import qualified Common.Msg as Msg
+import qualified Common.View.Format as Format
+import Component (TableIn (..))
+import qualified Component
+
+data IncomeTableIn = IncomeTableIn
+ { _tableIn_init :: Init
+ }
+
+view :: forall t m. MonadWidget t m => IncomeTableIn -> m ()
+view tableIn = do
+
+ Component.table $ TableIn
+ { _tableIn_headerLabel = headerLabel
+ , _tableIn_rows =
+ R.constDyn
+ . reverse
+ . L.sortOn _income_date
+ . _init_incomes
+ . _tableIn_init
+ $ tableIn
+ , _tableIn_cell = cell (_tableIn_init tableIn)
+ , _tableIn_perPage = 7
+ , _tableIn_resetPage = R.never
+ }
+
+ return ()
+
+data Header
+ = UserHeader
+ | AmountHeader
+ | DateHeader
+ deriving (Eq, Show, Bounded, Enum)
+
+headerLabel :: Header -> Text
+headerLabel UserHeader = Msg.get Msg.Income_Name
+headerLabel DateHeader = Msg.get Msg.Income_Date
+headerLabel AmountHeader = Msg.get Msg.Income_Amount
+
+cell :: Init -> Header -> Income -> Text
+cell init header income =
+ case header of
+ UserHeader ->
+ Maybe.fromMaybe "" . fmap _user_name $ CM.findUser (_income_userId income) (_init_users init)
+
+ DateHeader ->
+ Format.longDay . _income_date $ income
+
+ AmountHeader ->
+ Format.price (_init_currency init) . _income_amount $ income