aboutsummaryrefslogtreecommitdiff
path: root/client/src/View
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/View')
-rw-r--r--client/src/View/App.hs27
-rw-r--r--client/src/View/Header.hs82
-rw-r--r--client/src/View/Income/Add.hs19
-rw-r--r--client/src/View/Income/Form.hs83
-rw-r--r--client/src/View/Income/Header.hs43
-rw-r--r--client/src/View/Income/Income.hs34
-rw-r--r--client/src/View/Income/Table.hs29
-rw-r--r--client/src/View/NotFound.hs12
-rw-r--r--client/src/View/Payment/Add.hs40
-rw-r--r--client/src/View/Payment/Clone.hs46
-rw-r--r--client/src/View/Payment/Delete.hs57
-rw-r--r--client/src/View/Payment/Edit.hs46
-rw-r--r--client/src/View/Payment/Form.hs129
-rw-r--r--client/src/View/Payment/Header.hs96
-rw-r--r--client/src/View/Payment/Pages.hs57
-rw-r--r--client/src/View/Payment/Payment.hs75
-rw-r--r--client/src/View/Payment/Table.hs121
-rw-r--r--client/src/View/SignIn.hs28
18 files changed, 503 insertions, 521 deletions
diff --git a/client/src/View/App.hs b/client/src/View/App.hs
index b468e56..e0a52e2 100644
--- a/client/src/View/App.hs
+++ b/client/src/View/App.hs
@@ -13,12 +13,9 @@ import qualified Common.Msg as Msg
import Model.Route (Route (..))
import qualified Util.Router as Router
-import View.Header (HeaderIn (..))
import qualified View.Header as Header
-import View.Income.Income (IncomeIn (..))
import qualified View.Income.Income as Income
import qualified View.NotFound as NotFound
-import View.Payment.Payment (PaymentIn (..))
import qualified View.Payment.Payment as Payment
import qualified View.SignIn as SignIn
@@ -28,17 +25,17 @@ widget initResult =
route <- getRoute
- headerOut <- Header.view $ HeaderIn
- { _headerIn_initResult = initResult
- , _headerIn_isInitSuccess =
+ header <- Header.view $ Header.In
+ { Header._in_initResult = initResult
+ , Header._in_isInitSuccess =
case initResult of
InitSuccess _ -> True
_ -> False
- , _headerIn_route = route
+ , Header._in_route = route
}
let signOut =
- Header._headerOut_signOut headerOut
+ Header._out_signOut header
mainContent =
case initResult of
@@ -63,17 +60,17 @@ signedWidget init route = do
R.dyn . R.ffor route $ \case
RootRoute -> do
paymentInit <- Payment.init
- Payment.view $ PaymentIn
- { _paymentIn_currentUser = _init_currentUser init
- , _paymentIn_currency = _init_currency init
- , _paymentIn_init = paymentInit
+ Payment.view $ Payment.In
+ { Payment._in_currentUser = _init_currentUser init
+ , Payment._in_currency = _init_currency init
+ , Payment._in_init = paymentInit
}
IncomeRoute -> do
incomeInit <- Income.init
- Income.view $ IncomeIn
- { _incomeIn_currency = _init_currency init
- , _incomeIn_init = incomeInit
+ Income.view $ Income.In
+ { Income._in_currency = _init_currency init
+ , Income._in_init = incomeInit
}
NotFoundRoute ->
diff --git a/client/src/View/Header.hs b/client/src/View/Header.hs
index 68329eb..3f58dd5 100644
--- a/client/src/View/Header.hs
+++ b/client/src/View/Header.hs
@@ -1,40 +1,40 @@
module View.Header
( view
- , HeaderIn(..)
- , HeaderOut(..)
+ , In(..)
+ , Out(..)
) where
-import Data.Map (Map)
-import qualified Data.Map as M
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Time (NominalDiffTime)
-import Prelude hiding (error, init)
-import Reflex.Dom (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom as R
-
-import Common.Model (Init (..), InitResult (..), User (..))
-import qualified Common.Model as CM
-import qualified Common.Msg as Msg
-import Component (ButtonIn (..))
-import qualified Component as Component
-import Model.Route (Route (..))
-import qualified Util.Css as CssUtil
-import qualified Util.Reflex as ReflexUtil
-import qualified View.Icon as Icon
-
-data HeaderIn t = HeaderIn
- { _headerIn_initResult :: InitResult
- , _headerIn_isInitSuccess :: Bool
- , _headerIn_route :: Dynamic t Route
+import Data.Map (Map)
+import qualified Data.Map as M
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Time (NominalDiffTime)
+import Prelude hiding (error, init)
+import Reflex.Dom (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom as R
+
+import Common.Model (Init (..), InitResult (..), User (..))
+import qualified Common.Model as CM
+import qualified Common.Msg as Msg
+import qualified Component.Button as Button
+import qualified Component.Link as Link
+import Model.Route (Route (..))
+import qualified Util.Css as CssUtil
+import qualified Util.Reflex as ReflexUtil
+import qualified View.Icon as Icon
+
+data In t = In
+ { _in_initResult :: InitResult
+ , _in_isInitSuccess :: Bool
+ , _in_route :: Dynamic t Route
}
-data HeaderOut t = HeaderOut
- { _headerOut_signOut :: Event t ()
+data Out t = Out
+ { _out_signOut :: Event t ()
}
-view :: forall t m. MonadWidget t m => (HeaderIn t) -> m (HeaderOut t)
-view headerIn =
+view :: forall t m. MonadWidget t m => (In t) -> m (Out t)
+view input =
R.el "header" $ do
R.divClass "title" $
@@ -42,23 +42,23 @@ view headerIn =
signOut <- R.el "div" $ do
rec
- showLinks <- R.foldDyn const (_headerIn_isInitSuccess headerIn) (False <$ signOut)
- ReflexUtil.visibleIfDyn showLinks R.blank (links $ _headerIn_route headerIn)
- signOut <- nameSignOut $ _headerIn_initResult headerIn
+ showLinks <- R.foldDyn const (_in_isInitSuccess input) (False <$ signOut)
+ ReflexUtil.visibleIfDyn showLinks R.blank (links $ _in_route input)
+ signOut <- nameSignOut $ _in_initResult input
return signOut
- return $ HeaderOut
- { _headerOut_signOut = signOut
+ return $ Out
+ { _out_signOut = signOut
}
links :: forall t m. MonadWidget t m => Dynamic t Route -> m ()
links route = do
- Component.link
+ Link.view
"/"
(R.ffor route (attrs RootRoute))
(Msg.get Msg.Payment_Title)
- Component.link
+ Link.view
"/income"
(R.ffor route (attrs IncomeRoute))
(Msg.get Msg.Income_Title)
@@ -92,12 +92,12 @@ nameSignOut initResult = case initResult of
signOutButton :: forall t m. MonadWidget t m => m (Event t ())
signOutButton = do
rec
- signOut <- Component.button $
- (Component.defaultButtonIn Icon.signOut)
- { _buttonIn_class = R.constDyn "signOut item"
- , _buttonIn_waiting = waiting
+ signOut <- Button.view $
+ (Button.defaultIn Icon.signOut)
+ { Button._in_class = R.constDyn "signOut item"
+ , Button._in_waiting = waiting
}
- let signOutClic = Component._buttonOut_clic signOut
+ let signOutClic = Button._out_clic signOut
waiting = R.leftmost
[ fmap (const True) signOutClic
, fmap (const False) signOutSuccess
diff --git a/client/src/View/Income/Add.hs b/client/src/View/Income/Add.hs
index 0b1bd04..f8f107f 100644
--- a/client/src/View/Income/Add.hs
+++ b/client/src/View/Income/Add.hs
@@ -13,7 +13,6 @@ import qualified Common.Util.Time as TimeUtil
import qualified Component.Modal as Modal
import qualified Util.Ajax as Ajax
import qualified Util.Reflex as ReflexUtil
-import View.Income.Form (FormIn (..), FormOut (..))
import qualified View.Income.Form as Form
view :: forall t m. MonadWidget t m => Modal.Content t m Income
@@ -22,16 +21,16 @@ view cancel = do
currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay
form <- R.dyn $
- return $ Form.view $ FormIn
- { _formIn_cancel = cancel
- , _formIn_headerLabel = Msg.get Msg.Income_AddLong
- , _formIn_amount = ""
- , _formIn_date = currentDay
- , _formIn_mkPayload = CreateIncomeForm
- , _formIn_ajax = Ajax.post
+ return $ Form.view $ Form.In
+ { Form._in_cancel = cancel
+ , Form._in_headerLabel = Msg.get Msg.Income_AddLong
+ , Form._in_amount = ""
+ , Form._in_date = currentDay
+ , Form._in_mkPayload = CreateIncomeForm
+ , Form._in_ajax = Ajax.post
}
- hide <- ReflexUtil.flatten (_formOut_hide <$> form)
- addIncome <- ReflexUtil.flatten (_formOut_addIncome <$> form)
+ hide <- ReflexUtil.flatten (Form._out_hide <$> form)
+ addIncome <- ReflexUtil.flatten (Form._out_addIncome <$> form)
return (hide, addIncome)
diff --git a/client/src/View/Income/Form.hs b/client/src/View/Income/Form.hs
index 824bb0a..917edf1 100644
--- a/client/src/View/Income/Form.hs
+++ b/client/src/View/Income/Form.hs
@@ -1,7 +1,7 @@
module View.Income.Form
( view
- , FormIn(..)
- , FormOut(..)
+ , In(..)
+ , Out(..)
) where
import Data.Aeson (FromJSON, ToJSON)
@@ -17,42 +17,41 @@ import qualified Reflex.Dom as R
import Common.Model (Income)
import qualified Common.Msg as Msg
import qualified Common.Validation.Income as IncomeValidation
-import Component (InputIn (..), InputOut (..),
- ModalFormIn (..), ModalFormOut (..))
-import qualified Component as Component
+import qualified Component.Input as Input
+import qualified Component.ModalForm as ModalForm
-data FormIn m t a = FormIn
- { _formIn_cancel :: Event t ()
- , _formIn_headerLabel :: Text
- , _formIn_amount :: Text
- , _formIn_date :: Day
- , _formIn_mkPayload :: Text -> Text -> a
- , _formIn_ajax :: Text -> Event t a -> m (Event t (Either Text Income))
+data In m t a = In
+ { _in_cancel :: Event t ()
+ , _in_headerLabel :: Text
+ , _in_amount :: Text
+ , _in_date :: Day
+ , _in_mkPayload :: Text -> Text -> a
+ , _in_ajax :: Text -> Event t a -> m (Event t (Either Text Income))
}
-data FormOut t = FormOut
- { _formOut_hide :: Event t ()
- , _formOut_addIncome :: Event t Income
+data Out t = Out
+ { _out_hide :: Event t ()
+ , _out_addIncome :: Event t Income
}
-view :: forall t m a. (MonadWidget t m, ToJSON a) => FormIn m t a -> m (FormOut t)
-view formIn = do
+view :: forall t m a. (MonadWidget t m, ToJSON a) => In m t a -> m (Out t)
+view input = do
rec
let reset = R.leftmost
- [ "" <$ _modalFormOut_cancel modalForm
- , "" <$ _modalFormOut_validate modalForm
- , "" <$ _formIn_cancel formIn
+ [ "" <$ ModalForm._out_cancel modalForm
+ , "" <$ ModalForm._out_validate modalForm
+ , "" <$ _in_cancel input
]
- modalForm <- Component.modalForm $ ModalFormIn
- { _modalFormIn_headerLabel = _formIn_headerLabel formIn
- , _modalFormIn_ajax = _formIn_ajax formIn "/api/income"
- , _modalFormIn_form = form reset (_modalFormOut_confirm modalForm)
+ modalForm <- ModalForm.view $ ModalForm.In
+ { ModalForm._in_headerLabel = _in_headerLabel input
+ , ModalForm._in_ajax = _in_ajax input "/api/income"
+ , ModalForm._in_form = form reset (ModalForm._out_confirm modalForm)
}
- return $ FormOut
- { _formOut_hide = _modalFormOut_hide modalForm
- , _formOut_addIncome = _modalFormOut_validate modalForm
+ return $ Out
+ { _out_hide = ModalForm._out_hide modalForm
+ , _out_addIncome = ModalForm._out_validate modalForm
}
where
@@ -61,24 +60,24 @@ view formIn = do
-> Event t ()
-> m (Dynamic t (Validation Text a))
form reset confirm = do
- amount <- _inputOut_raw <$> (Component.input
- (Component.defaultInputIn
- { _inputIn_label = Msg.get Msg.Income_Amount
- , _inputIn_initialValue = _formIn_amount formIn
- , _inputIn_validation = IncomeValidation.amount
+ amount <- Input._out_raw <$> (Input.view
+ (Input.defaultIn
+ { Input._in_label = Msg.get Msg.Income_Amount
+ , Input._in_initialValue = _in_amount input
+ , Input._in_validation = IncomeValidation.amount
})
- (_formIn_amount formIn <$ reset)
+ (_in_amount input <$ reset)
confirm)
- let initialDate = T.pack . Calendar.showGregorian . _formIn_date $ formIn
+ let initialDate = T.pack . Calendar.showGregorian . _in_date $ input
- date <- _inputOut_raw <$> (Component.input
- (Component.defaultInputIn
- { _inputIn_label = Msg.get Msg.Income_Date
- , _inputIn_initialValue = initialDate
- , _inputIn_inputType = "date"
- , _inputIn_hasResetButton = False
- , _inputIn_validation = IncomeValidation.date
+ date <- Input._out_raw <$> (Input.view
+ (Input.defaultIn
+ { Input._in_label = Msg.get Msg.Income_Date
+ , Input._in_initialValue = initialDate
+ , Input._in_inputType = "date"
+ , Input._in_hasResetButton = False
+ , Input._in_validation = IncomeValidation.date
})
(initialDate <$ reset)
confirm)
@@ -86,4 +85,4 @@ view formIn = do
return $ do
a <- amount
d <- date
- return . V.Success $ (_formIn_mkPayload formIn) a d
+ return . V.Success $ (_in_mkPayload input) a d
diff --git a/client/src/View/Income/Header.hs b/client/src/View/Income/Header.hs
index 4e08955..ae1174a 100644
--- a/client/src/View/Income/Header.hs
+++ b/client/src/View/Income/Header.hs
@@ -1,7 +1,7 @@
module View.Income.Header
( view
- , HeaderIn(..)
- , HeaderOut(..)
+ , In(..)
+ , Out(..)
) where
import Control.Monad.IO.Class (liftIO)
@@ -16,25 +16,24 @@ import qualified Common.Model as CM
import qualified Common.Msg as Msg
import qualified Common.View.Format as Format
-import Component (ButtonOut (..))
-import qualified Component
+import qualified Component.Button as Button
import qualified Component.Modal as Modal
import qualified Util.Date as DateUtil
import qualified View.Income.Add as Add
import View.Income.Init (Init (..))
-data HeaderIn t = HeaderIn
- { _headerIn_init :: Init
- , _headerIn_currency :: Currency
- , _headerIn_incomes :: Dynamic t [Income]
+data In t = In
+ { _in_init :: Init
+ , _in_currency :: Currency
+ , _in_incomes :: Dynamic t [Income]
}
-data HeaderOut t = HeaderOut
- { _headerOut_addIncome :: Event t Income
+data Out t = Out
+ { _out_addIncome :: Event t Income
}
-view :: forall t m. MonadWidget t m => HeaderIn t -> m (HeaderOut t)
-view headerIn =
+view :: forall t m. MonadWidget t m => In t -> m (Out t)
+view input =
R.divClass "withMargin" $ do
currentTime <- liftIO Clock.getCurrentTime
@@ -58,7 +57,7 @@ view headerIn =
T.intercalate " "
[ _user_name user
, "−"
- , Format.price (_headerIn_currency headerIn) $
+ , Format.price (_in_currency input) $
CM.cumulativeIncomesSince currentTime since userIncomes
]
@@ -67,23 +66,23 @@ view headerIn =
R.text $
Msg.get Msg.Income_MonthlyNet
- addIncome <- _buttonOut_clic <$>
- (Component.button . Component.defaultButtonIn . R.text $
+ addIncome <- Button._out_clic <$>
+ (Button.view . Button.defaultIn . R.text $
Msg.get Msg.Income_AddLong)
- addIncome <- Modal.view $ Modal.Input
- { Modal._input_show = addIncome
- , Modal._input_content = Add.view
+ addIncome <- Modal.view $ Modal.In
+ { Modal._in_show = addIncome
+ , Modal._in_content = Add.view
}
- return $ HeaderOut
- { _headerOut_addIncome = addIncome
+ return $ Out
+ { _out_addIncome = addIncome
}
where
- init = _headerIn_init headerIn
+ init = _in_init input
- useIncomesFrom = R.ffor (_headerIn_incomes headerIn) $ \incomes ->
+ useIncomesFrom = R.ffor (_in_incomes input) $ \incomes ->
( CM.useIncomesFrom
(map _user_id $_init_users init)
incomes
diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs
index 18ebe7c..f8359bb 100644
--- a/client/src/View/Income/Income.hs
+++ b/client/src/View/Income/Income.hs
@@ -1,7 +1,7 @@
module View.Income.Income
( init
, view
- , IncomeIn(..)
+ , In(..)
) where
import Data.Aeson (FromJSON)
@@ -14,15 +14,13 @@ import Common.Model (Currency)
import Loadable (Loadable (..))
import qualified Loadable
import qualified Util.Ajax as AjaxUtil
-import View.Income.Header (HeaderIn (..), HeaderOut (..))
import qualified View.Income.Header as Header
import View.Income.Init (Init (..))
-import View.Income.Table (IncomeTableIn (..))
import qualified View.Income.Table as Table
-data IncomeIn t = IncomeIn
- { _incomeIn_currency :: Currency
- , _incomeIn_init :: Dynamic t (Loadable Init)
+data In t = In
+ { _in_currency :: Currency
+ , _in_init :: Dynamic t (Loadable Init)
}
init :: forall t m. MonadWidget t m => m (Dynamic t (Loadable Init))
@@ -36,9 +34,9 @@ init = do
ps <- payments
return $ Init <$> us <*> is <*> ps
-view :: forall t m. MonadWidget t m => IncomeIn t -> m ()
-view incomeIn = do
- R.dyn . R.ffor (_incomeIn_init incomeIn) . Loadable.view $ \init ->
+view :: forall t m. MonadWidget t m => In t -> m ()
+view input = do
+ R.dyn . R.ffor (_in_init input) . Loadable.view $ \init ->
R.elClass "main" "income" $ do
@@ -47,18 +45,18 @@ view incomeIn = do
incomes <- R.foldDyn
(:)
(_init_incomes init)
- (_headerOut_addIncome header)
+ (Header._out_addIncome header)
- header <- Header.view $ HeaderIn
- { _headerIn_init = init
- , _headerIn_currency = _incomeIn_currency incomeIn
- , _headerIn_incomes = incomes
+ header <- Header.view $ Header.In
+ { Header._in_init = init
+ , Header._in_currency = _in_currency input
+ , Header._in_incomes = incomes
}
- Table.view $ IncomeTableIn
- { _tableIn_init = init
- , _tableIn_currency = _incomeIn_currency incomeIn
- , _tableIn_incomes = incomes
+ Table.view $ Table.In
+ { Table._in_init = init
+ , Table._in_currency = _in_currency input
+ , Table._in_incomes = incomes
}
return ()
diff --git a/client/src/View/Income/Table.hs b/client/src/View/Income/Table.hs
index d42848b..9cb705f 100644
--- a/client/src/View/Income/Table.hs
+++ b/client/src/View/Income/Table.hs
@@ -1,6 +1,6 @@
module View.Income.Table
( view
- , IncomeTableIn(..)
+ , In(..)
) where
import qualified Data.List as L
@@ -14,25 +14,24 @@ 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 Component.Table as Table
import View.Income.Init (Init (..))
-data IncomeTableIn t = IncomeTableIn
- { _tableIn_init :: Init
- , _tableIn_currency :: Currency
- , _tableIn_incomes :: Dynamic t [Income]
+data In t = In
+ { _in_init :: Init
+ , _in_currency :: Currency
+ , _in_incomes :: Dynamic t [Income]
}
-view :: forall t m. MonadWidget t m => IncomeTableIn t -> m ()
-view tableIn = do
+view :: forall t m. MonadWidget t m => In t -> m ()
+view input = do
- Component.table $ TableIn
- { _tableIn_headerLabel = headerLabel
- , _tableIn_rows = R.ffor (_tableIn_incomes tableIn) $ reverse . L.sortOn _income_date
- , _tableIn_cell = cell (_tableIn_init tableIn) (_tableIn_currency tableIn)
- , _tableIn_perPage = 7
- , _tableIn_resetPage = R.never
+ Table.view $ Table.In
+ { Table._in_headerLabel = headerLabel
+ , Table._in_rows = R.ffor (_in_incomes input) $ reverse . L.sortOn _income_date
+ , Table._in_cell = cell (_in_init input) (_in_currency input)
+ , Table._in_perPage = 7
+ , Table._in_resetPage = R.never
}
return ()
diff --git a/client/src/View/NotFound.hs b/client/src/View/NotFound.hs
index 1d4e477..1597849 100644
--- a/client/src/View/NotFound.hs
+++ b/client/src/View/NotFound.hs
@@ -2,19 +2,19 @@ module View.NotFound
( view
) where
-import qualified Data.Map as M
-import Reflex.Dom (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom as R
+import qualified Data.Map as M
+import Reflex.Dom (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom as R
-import qualified Common.Msg as Msg
-import qualified Component as Component
+import qualified Common.Msg as Msg
+import qualified Component.Link as Link
view :: forall t m. MonadWidget t m => m ()
view =
R.divClass "notfound" $ do
R.text (Msg.get Msg.NotFound_Message)
- Component.link
+ Link.view
"/"
(R.constDyn $ M.singleton "class" "link")
(Msg.get Msg.NotFound_LinkMessage)
diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index 163a200..e983465 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -1,6 +1,6 @@
module View.Payment.Add
( view
- , Input(..)
+ , In(..)
) where
import Control.Monad (join)
@@ -21,32 +21,32 @@ import qualified Util.Ajax as Ajax
import qualified Util.Reflex as ReflexUtil
import qualified View.Payment.Form as Form
-data Input t = Input
- { _input_categories :: [Category]
- , _input_paymentCategories :: Dynamic t [PaymentCategory]
- , _input_frequency :: Dynamic t Frequency
+data In t = In
+ { _in_categories :: [Category]
+ , _in_paymentCategories :: Dynamic t [PaymentCategory]
+ , _in_frequency :: Dynamic t Frequency
}
-view :: forall t m. MonadWidget t m => Input t -> Modal.Content t m SavedPayment
+view :: forall t m. MonadWidget t m => In t -> Modal.Content t m SavedPayment
view input cancel = do
currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay
formOutput <- R.dyn $ do
- paymentCategories <- _input_paymentCategories input
- frequency <- _input_frequency input
- return $ Form.view $ Form.Input
- { Form._input_cancel = cancel
- , Form._input_headerLabel = Msg.get Msg.Payment_Add
- , Form._input_categories = _input_categories input
- , Form._input_paymentCategories = paymentCategories
- , Form._input_name = ""
- , Form._input_cost = ""
- , Form._input_date = currentDay
- , Form._input_category = -1
- , Form._input_frequency = frequency
- , Form._input_mkPayload = CreatePaymentForm
- , Form._input_ajax = Ajax.post
+ paymentCategories <- _in_paymentCategories input
+ frequency <- _in_frequency input
+ return $ Form.view $ Form.In
+ { Form._in_cancel = cancel
+ , Form._in_headerLabel = Msg.get Msg.Payment_Add
+ , Form._in_categories = _in_categories input
+ , Form._in_paymentCategories = paymentCategories
+ , Form._in_name = ""
+ , Form._in_cost = ""
+ , Form._in_date = currentDay
+ , Form._in_category = -1
+ , Form._in_frequency = frequency
+ , Form._in_mkPayload = CreatePaymentForm
+ , Form._in_ajax = Ajax.post
}
hide <- ReflexUtil.flatten (Form._output_hide <$> formOutput)
diff --git a/client/src/View/Payment/Clone.hs b/client/src/View/Payment/Clone.hs
index 2fa27f3..56a33d9 100644
--- a/client/src/View/Payment/Clone.hs
+++ b/client/src/View/Payment/Clone.hs
@@ -1,5 +1,5 @@
module View.Payment.Clone
- ( Input(..)
+ ( In(..)
, view
) where
@@ -21,35 +21,35 @@ import qualified Util.Ajax as Ajax
import qualified Util.Reflex as ReflexUtil
import qualified View.Payment.Form as Form
-data Input t = Input
- { _input_show :: Event t ()
- , _input_categories :: [Category]
- , _input_paymentCategories :: Dynamic t [PaymentCategory]
- , _input_payment :: Dynamic t Payment
- , _input_category :: Dynamic t CategoryId
+data In t = In
+ { _in_show :: Event t ()
+ , _in_categories :: [Category]
+ , _in_paymentCategories :: Dynamic t [PaymentCategory]
+ , _in_payment :: Dynamic t Payment
+ , _in_category :: Dynamic t CategoryId
}
-view :: forall t m. MonadWidget t m => Input t -> Modal.Content t m SavedPayment
+view :: forall t m. MonadWidget t m => In t -> Modal.Content t m SavedPayment
view input cancel = do
currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay
formOutput <- R.dyn $ do
- paymentCategories <- _input_paymentCategories input
- payment <- _input_payment input
- category <- _input_category input
- return . Form.view $ Form.Input
- { Form._input_cancel = cancel
- , Form._input_headerLabel = Msg.get Msg.Payment_CloneLong
- , Form._input_categories = _input_categories input
- , Form._input_paymentCategories = paymentCategories
- , Form._input_name = _payment_name payment
- , Form._input_cost = T.pack . show . _payment_cost $ payment
- , Form._input_date = currentDay
- , Form._input_category = category
- , Form._input_frequency = _payment_frequency payment
- , Form._input_mkPayload = CreatePaymentForm
- , Form._input_ajax = Ajax.post
+ paymentCategories <- _in_paymentCategories input
+ payment <- _in_payment input
+ category <- _in_category input
+ return . Form.view $ Form.In
+ { Form._in_cancel = cancel
+ , Form._in_headerLabel = Msg.get Msg.Payment_CloneLong
+ , Form._in_categories = _in_categories input
+ , Form._in_paymentCategories = paymentCategories
+ , Form._in_name = _payment_name payment
+ , Form._in_cost = T.pack . show . _payment_cost $ payment
+ , Form._in_date = currentDay
+ , Form._in_category = category
+ , Form._in_frequency = _payment_frequency payment
+ , Form._in_mkPayload = CreatePaymentForm
+ , Form._in_ajax = Ajax.post
}
hide <- ReflexUtil.flatten (Form._output_hide <$> formOutput)
diff --git a/client/src/View/Payment/Delete.hs b/client/src/View/Payment/Delete.hs
index dc7e395..471463c 100644
--- a/client/src/View/Payment/Delete.hs
+++ b/client/src/View/Payment/Delete.hs
@@ -1,28 +1,27 @@
module View.Payment.Delete
- ( Input(..)
+ ( In(..)
, view
) where
-import Data.Text (Text)
-import qualified Data.Text as T
-import Reflex.Dom (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom as R
-
-import Common.Model (Payment (..))
-import qualified Common.Msg as Msg
-import Component (ButtonIn (..), ButtonOut (..))
-import qualified Component as Component
-import qualified Component.Modal as Modal
-import qualified Component.Modal as Modal
-import qualified Util.Ajax as Ajax
-import qualified Util.Either as EitherUtil
-import qualified Util.WaitFor as WaitFor
-
-data Input t = Input
- { _input_payment :: Dynamic t Payment
+import Data.Text (Text)
+import qualified Data.Text as T
+import Reflex.Dom (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom as R
+
+import Common.Model (Payment (..))
+import qualified Common.Msg as Msg
+import qualified Component.Button as Button
+import qualified Component.Modal as Modal
+import qualified Component.Modal as Modal
+import qualified Util.Ajax as Ajax
+import qualified Util.Either as EitherUtil
+import qualified Util.WaitFor as WaitFor
+
+data In t = In
+ { _in_payment :: Dynamic t Payment
}
-view :: forall t m. MonadWidget t m => (Input t) -> Modal.Content t m Payment
+view :: forall t m. MonadWidget t m => (In t) -> Modal.Content t m Payment
view input _ =
R.divClass "delete" $ do
R.divClass "deleteHeader" $ R.text $ Msg.get Msg.Payment_DeleteConfirm
@@ -31,20 +30,20 @@ view input _ =
(confirm, cancel) <- R.divClass "buttons" $ do
- cancel <- Component._buttonOut_clic <$> (Component.button $
- (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Undo))
- { _buttonIn_class = R.constDyn "undo" })
+ cancel <- Button._out_clic <$> (Button.view $
+ (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Undo))
+ { Button._in_class = R.constDyn "undo" })
rec
- confirm <- Component._buttonOut_clic <$> (Component.button $
- (Component.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
- { _buttonIn_class = R.constDyn "confirm"
- , _buttonIn_submit = True
- , _buttonIn_waiting = waiting
+ confirm <- Button._out_clic <$> (Button.view $
+ (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Confirm))
+ { Button._in_class = R.constDyn "confirm"
+ , Button._in_submit = True
+ , Button._in_waiting = waiting
})
let url =
- R.ffor (_input_payment input) (\id ->
+ R.ffor (_in_payment input) (\id ->
T.concat ["/api/payment/", T.pack . show $ _payment_id id]
)
@@ -56,5 +55,5 @@ view input _ =
return $
( R.leftmost [ cancel, () <$ confirm ]
- , R.tag (R.current $ _input_payment input) confirm
+ , R.tag (R.current $ _in_payment input) confirm
)
diff --git a/client/src/View/Payment/Edit.hs b/client/src/View/Payment/Edit.hs
index 77841ce..5cb4537 100644
--- a/client/src/View/Payment/Edit.hs
+++ b/client/src/View/Payment/Edit.hs
@@ -1,5 +1,5 @@
module View.Payment.Edit
- ( Input(..)
+ ( In(..)
, view
) where
@@ -18,33 +18,33 @@ import qualified Util.Ajax as Ajax
import qualified Util.Reflex as ReflexUtil
import qualified View.Payment.Form as Form
-data Input t = Input
- { _input_show :: Event t ()
- , _input_categories :: [Category]
- , _input_paymentCategories :: Dynamic t [PaymentCategory]
- , _input_payment :: Dynamic t Payment
- , _input_category :: Dynamic t CategoryId
+data In t = In
+ { _in_show :: Event t ()
+ , _in_categories :: [Category]
+ , _in_paymentCategories :: Dynamic t [PaymentCategory]
+ , _in_payment :: Dynamic t Payment
+ , _in_category :: Dynamic t CategoryId
}
-view :: forall t m. MonadWidget t m => Input t -> Modal.Content t m SavedPayment
+view :: forall t m. MonadWidget t m => In t -> Modal.Content t m SavedPayment
view input cancel = do
formOutput <- R.dyn $ do
- paymentCategories <- _input_paymentCategories input
- payment <- _input_payment input
- category <- _input_category input
- return . Form.view $ Form.Input
- { Form._input_cancel = cancel
- , Form._input_headerLabel = Msg.get Msg.Payment_EditLong
- , Form._input_categories = _input_categories input
- , Form._input_paymentCategories = paymentCategories
- , Form._input_name = _payment_name payment
- , Form._input_cost = T.pack . show . _payment_cost $ payment
- , Form._input_date = _payment_date payment
- , Form._input_category = category
- , Form._input_frequency = _payment_frequency payment
- , Form._input_mkPayload = EditPaymentForm (_payment_id payment)
- , Form._input_ajax = Ajax.put
+ paymentCategories <- _in_paymentCategories input
+ payment <- _in_payment input
+ category <- _in_category input
+ return . Form.view $ Form.In
+ { Form._in_cancel = cancel
+ , Form._in_headerLabel = Msg.get Msg.Payment_EditLong
+ , Form._in_categories = _in_categories input
+ , Form._in_paymentCategories = paymentCategories
+ , Form._in_name = _payment_name payment
+ , Form._in_cost = T.pack . show . _payment_cost $ payment
+ , Form._in_date = _payment_date payment
+ , Form._in_category = category
+ , Form._in_frequency = _payment_frequency payment
+ , Form._in_mkPayload = EditPaymentForm (_payment_id payment)
+ , Form._in_ajax = Ajax.put
}
hide <- ReflexUtil.flatten (Form._output_hide <$> formOutput)
diff --git a/client/src/View/Payment/Form.hs b/client/src/View/Payment/Form.hs
index 1f068fd..29768aa 100644
--- a/client/src/View/Payment/Form.hs
+++ b/client/src/View/Payment/Form.hs
@@ -1,7 +1,7 @@
module View.Payment.Form
( view
- , Input(..)
- , Output(..)
+ , In(..)
+ , Out(..)
) where
import Data.Aeson (ToJSON)
@@ -25,49 +25,48 @@ import Common.Model (Category (..), CategoryId,
SavedPayment (..))
import qualified Common.Msg as Msg
import qualified Common.Validation.Payment as PaymentValidation
-import Component (InputIn (..), InputOut (..),
- ModalFormIn (..), ModalFormOut (..),
- SelectIn (..), SelectOut (..))
-import qualified Component as Component
+import qualified Component.Input as Input
+import qualified Component.ModalForm as ModalForm
+import qualified Component.Select as Select
import qualified Util.Validation as ValidationUtil
-data Input m t a = Input
- { _input_cancel :: Event t ()
- , _input_headerLabel :: Text
- , _input_categories :: [Category]
- , _input_paymentCategories :: [PaymentCategory]
- , _input_name :: Text
- , _input_cost :: Text
- , _input_date :: Day
- , _input_category :: CategoryId
- , _input_frequency :: Frequency
- , _input_mkPayload :: Text -> Text -> Text -> CategoryId -> Frequency -> a
- , _input_ajax :: Text -> Event t a -> m (Event t (Either Text SavedPayment))
+data In m t a = In
+ { _in_cancel :: Event t ()
+ , _in_headerLabel :: Text
+ , _in_categories :: [Category]
+ , _in_paymentCategories :: [PaymentCategory]
+ , _in_name :: Text
+ , _in_cost :: Text
+ , _in_date :: Day
+ , _in_category :: CategoryId
+ , _in_frequency :: Frequency
+ , _in_mkPayload :: Text -> Text -> Text -> CategoryId -> Frequency -> a
+ , _in_ajax :: Text -> Event t a -> m (Event t (Either Text SavedPayment))
}
-data Output t = Output
+data Out t = Out
{ _output_hide :: Event t ()
, _output_addPayment :: Event t SavedPayment
}
-view :: forall t m a. (MonadWidget t m, ToJSON a) => Input m t a -> m (Output t)
+view :: forall t m a. (MonadWidget t m, ToJSON a) => In m t a -> m (Out t)
view input = do
rec
let reset = R.leftmost
- [ "" <$ _modalFormOut_cancel modalForm
- , "" <$ _modalFormOut_validate modalForm
- , "" <$ _input_cancel input
+ [ "" <$ ModalForm._out_cancel modalForm
+ , "" <$ ModalForm._out_validate modalForm
+ , "" <$ _in_cancel input
]
- modalForm <- Component.modalForm $ ModalFormIn
- { _modalFormIn_headerLabel = _input_headerLabel input
- , _modalFormIn_ajax = _input_ajax input "/api/payment"
- , _modalFormIn_form = form reset (_modalFormOut_confirm modalForm)
+ modalForm <- ModalForm.view $ ModalForm.In
+ { ModalForm._in_headerLabel = _in_headerLabel input
+ , ModalForm._in_ajax = _in_ajax input "/api/payment"
+ , ModalForm._in_form = form reset (ModalForm._out_confirm modalForm)
}
- return $ Output
- { _output_hide = _modalFormOut_hide modalForm
- , _output_addPayment = _modalFormOut_validate modalForm
+ return $ Out
+ { _output_hide = ModalForm._out_hide modalForm
+ , _output_addPayment = ModalForm._out_validate modalForm
}
where
@@ -76,63 +75,63 @@ view input = do
-> Event t ()
-> m (Dynamic t (Validation (NonEmpty Text) a))
form reset confirm = do
- name <- Component.input
- (Component.defaultInputIn
- { _inputIn_label = Msg.get Msg.Payment_Name
- , _inputIn_initialValue = _input_name input
- , _inputIn_validation = PaymentValidation.name
+ name <- Input.view
+ (Input.defaultIn
+ { Input._in_label = Msg.get Msg.Payment_Name
+ , Input._in_initialValue = _in_name input
+ , Input._in_validation = PaymentValidation.name
})
- (_input_name input <$ reset)
+ (_in_name input <$ reset)
confirm
- cost <- _inputOut_raw <$> (Component.input
- (Component.defaultInputIn
- { _inputIn_label = Msg.get Msg.Payment_Cost
- , _inputIn_initialValue = _input_cost input
- , _inputIn_validation = PaymentValidation.cost
+ cost <- Input._out_raw <$> (Input.view
+ (Input.defaultIn
+ { Input._in_label = Msg.get Msg.Payment_Cost
+ , Input._in_initialValue = _in_cost input
+ , Input._in_validation = PaymentValidation.cost
})
- (_input_cost input <$ reset)
+ (_in_cost input <$ reset)
confirm)
- let initialDate = T.pack . Calendar.showGregorian . _input_date $ input
+ let initialDate = T.pack . Calendar.showGregorian . _in_date $ input
- date <- _inputOut_raw <$> (Component.input
- (Component.defaultInputIn
- { _inputIn_label = Msg.get Msg.Payment_Date
- , _inputIn_initialValue = initialDate
- , _inputIn_inputType = "date"
- , _inputIn_hasResetButton = False
- , _inputIn_validation = PaymentValidation.date
+ date <- Input._out_raw <$> (Input.view
+ (Input.defaultIn
+ { Input._in_label = Msg.get Msg.Payment_Date
+ , Input._in_initialValue = initialDate
+ , Input._in_inputType = "date"
+ , Input._in_hasResetButton = False
+ , Input._in_validation = PaymentValidation.date
})
(initialDate <$ reset)
confirm)
let setCategory =
R.fmapMaybe id . R.updated $
- R.ffor (_inputOut_raw name) $ \name ->
- findCategory name (_input_paymentCategories input)
-
- category <- _selectOut_value <$> (Component.select $ SelectIn
- { _selectIn_label = Msg.get Msg.Payment_Category
- , _selectIn_initialValue = _input_category input
- , _selectIn_value = setCategory
- , _selectIn_values = R.constDyn categories
- , _selectIn_reset = _input_category input <$ reset
- , _selectIn_isValid = PaymentValidation.category (map _category_id $ _input_categories input)
- , _selectIn_validate = confirm
+ R.ffor (Input._out_raw name) $ \name ->
+ findCategory name (_in_paymentCategories input)
+
+ category <- Select._out_value <$> (Select.view $ Select.In
+ { Select._in_label = Msg.get Msg.Payment_Category
+ , Select._in_initialValue = _in_category input
+ , Select._in_value = setCategory
+ , Select._in_values = R.constDyn categories
+ , Select._in_reset = _in_category input <$ reset
+ , Select._in_isValid = PaymentValidation.category (map _category_id $ _in_categories input)
+ , Select._in_validate = confirm
})
return $ do
- n <- _inputOut_value name
+ n <- Input._out_value name
c <- cost
d <- date
cat <- category
- return ((_input_mkPayload input)
+ return ((_in_mkPayload input)
<$> ValidationUtil.nelError n
<*> V.Success c
<*> V.Success d
<*> ValidationUtil.nelError cat
- <*> V.Success (_input_frequency input))
+ <*> V.Success (_in_frequency input))
frequencies =
M.fromList
@@ -140,7 +139,7 @@ view input = do
, (Monthly, Msg.get Msg.Payment_MonthlyMale)
]
- categories = M.fromList . flip map (_input_categories input) $ \c ->
+ categories = M.fromList . flip map (_in_categories input) $ \c ->
(_category_id c, _category_name c)
findCategory :: Text -> [PaymentCategory] -> Maybe CategoryId
diff --git a/client/src/View/Payment/Header.hs b/client/src/View/Payment/Header.hs
index 9ad90a9..00987a3 100644
--- a/client/src/View/Payment/Header.hs
+++ b/client/src/View/Payment/Header.hs
@@ -1,7 +1,7 @@
module View.Payment.Header
- ( widget
- , HeaderIn(..)
- , HeaderOut(..)
+ ( view
+ , In(..)
+ , Out(..)
) where
import Control.Monad (forM_)
@@ -27,31 +27,30 @@ import qualified Common.Model as CM
import qualified Common.Msg as Msg
import qualified Common.View.Format as Format
-import Component (ButtonIn (..), ButtonOut (..),
- InputIn (..), InputOut (..),
- SelectIn (..), SelectOut (..))
-import qualified Component as Component
+import qualified Component.Button as Button
+import qualified Component.Input as Input
import qualified Component.Modal as Modal
+import qualified Component.Select as Select
import qualified Util.List as L
import qualified View.Payment.Add as Add
import View.Payment.Init (Init (..))
-data HeaderIn t = HeaderIn
- { _headerIn_init :: Init
- , _headerIn_currency :: Currency
- , _headerIn_payments :: Dynamic t [Payment]
- , _headerIn_searchPayments :: Dynamic t [Payment]
- , _headerIn_paymentCategories :: Dynamic t [PaymentCategory]
+data In t = In
+ { _in_init :: Init
+ , _in_currency :: Currency
+ , _in_payments :: Dynamic t [Payment]
+ , _in_searchPayments :: Dynamic t [Payment]
+ , _in_paymentCategories :: Dynamic t [PaymentCategory]
}
-data HeaderOut t = HeaderOut
- { _headerOut_searchName :: Dynamic t Text
- , _headerOut_searchFrequency :: Dynamic t Frequency
- , _headerOut_addPayment :: Event t SavedPayment
+data Out t = Out
+ { _out_searchName :: Dynamic t Text
+ , _out_searchFrequency :: Dynamic t Frequency
+ , _out_addPayment :: Event t SavedPayment
}
-widget :: forall t m. MonadWidget t m => HeaderIn t -> m (HeaderOut t)
-widget headerIn =
+view :: forall t m. MonadWidget t m => In t -> m (Out t)
+view input =
R.divClass "header" $ do
rec
addPayment <-
@@ -66,22 +65,22 @@ widget headerIn =
let resetSearchName = fmap (const ()) $ addPayment
(searchName, searchFrequency) <- searchLine resetSearchName
- infos (_headerIn_searchPayments headerIn) users currency
+ infos (_in_searchPayments input) users currency
- return $ HeaderOut
- { _headerOut_searchName = searchName
- , _headerOut_searchFrequency = searchFrequency
- , _headerOut_addPayment = addPayment
+ return $ Out
+ { _out_searchName = searchName
+ , _out_searchFrequency = searchFrequency
+ , _out_addPayment = addPayment
}
where
- init = _headerIn_init headerIn
+ init = _in_init input
incomes = _init_incomes init
initPayments = _init_payments init
- payments = _headerIn_payments headerIn
+ payments = _in_payments input
users = _init_users init
categories = _init_categories init
- currency = _headerIn_currency headerIn
- paymentCategories = _headerIn_paymentCategories headerIn
+ currency = _in_currency input
+ paymentCategories = _in_paymentCategories input
payerAndAdd
:: forall t m. MonadWidget t m
@@ -113,18 +112,18 @@ payerAndAdd incomes payments users categories paymentCategories currency frequen
R.dynText . R.ffor exceedingPayer $ \ep ->
Format.price currency $ _exceedingPayer_amount ep
- addPayment <- _buttonOut_clic <$>
- (Component.button $
- (Component.defaultButtonIn (R.text $ Msg.get Msg.Payment_Add))
- { _buttonIn_class = R.constDyn "addPayment"
+ addPayment <- Button._out_clic <$>
+ (Button.view $
+ (Button.defaultIn (R.text $ Msg.get Msg.Payment_Add))
+ { Button._in_class = R.constDyn "addPayment"
})
- Modal.view $ Modal.Input
- { Modal._input_show = addPayment
- , Modal._input_content = Add.view $ Add.Input
- { Add._input_categories = categories
- , Add._input_paymentCategories = paymentCategories
- , Add._input_frequency = frequency
+ Modal.view $ Modal.In
+ { Modal._in_show = addPayment
+ , Modal._in_content = Add.view $ Add.In
+ { Add._in_categories = categories
+ , Add._in_paymentCategories = paymentCategories
+ , Add._in_frequency = frequency
}
}
@@ -134,8 +133,8 @@ searchLine
-> m (Dynamic t Text, Dynamic t Frequency)
searchLine reset = do
R.divClass "searchLine" $ do
- searchName <- _inputOut_raw <$> (Component.input
- ( Component.defaultInputIn { _inputIn_label = Msg.get Msg.Search_Name })
+ searchName <- Input._out_raw <$> (Input.view
+ ( Input.defaultIn { Input._in_label = Msg.get Msg.Search_Name })
("" <$ reset)
R.never)
@@ -144,15 +143,14 @@ searchLine reset = do
, (Monthly, Msg.get Msg.Payment_MonthlyMale)
]
- searchFrequency <- _selectOut_raw <$> (Component.select $
- SelectIn
- { _selectIn_label = ""
- , _selectIn_initialValue = Punctual
- , _selectIn_value = R.never
- , _selectIn_values = R.constDyn frequencies
- , _selectIn_reset = R.never
- , _selectIn_isValid = V.Success
- , _selectIn_validate = R.never
+ searchFrequency <- Select._out_raw <$> (Select.view $ Select.In
+ { Select._in_label = ""
+ , Select._in_initialValue = Punctual
+ , Select._in_value = R.never
+ , Select._in_values = R.constDyn frequencies
+ , Select._in_reset = R.never
+ , Select._in_isValid = V.Success
+ , Select._in_validate = R.never
})
return (searchName, searchFrequency)
diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
index 5681935..9a1902c 100644
--- a/client/src/View/Payment/Pages.hs
+++ b/client/src/View/Payment/Pages.hs
@@ -1,41 +1,40 @@
module View.Payment.Pages
- ( widget
- , PagesIn(..)
- , PagesOut(..)
+ ( view
+ , In(..)
+ , Out(..)
) where
-import qualified Data.Text as T
-import Reflex.Dom (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom as R
+import qualified Data.Text as T
+import Reflex.Dom (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom as R
-import Component (ButtonIn (..), ButtonOut (..))
-import qualified Component as Component
+import qualified Component.Button as Button
-import qualified Util.Reflex as ReflexUtil
-import qualified View.Icon as Icon
+import qualified Util.Reflex as ReflexUtil
+import qualified View.Icon as Icon
-data PagesIn t = PagesIn
- { _pagesIn_total :: Dynamic t Int
- , _pagesIn_perPage :: Int
- , _pagesIn_reset :: Event t ()
+data In t = In
+ { _in_total :: Dynamic t Int
+ , _in_perPage :: Int
+ , _in_reset :: Event t ()
}
-data PagesOut t = PagesOut
- { _pagesOut_currentPage :: Dynamic t Int
+data Out t = Out
+ { _out_currentPage :: Dynamic t Int
}
-widget :: forall t m. MonadWidget t m => PagesIn t -> m (PagesOut t)
-widget pagesIn = do
+view :: forall t m. MonadWidget t m => In t -> m (Out t)
+view input = do
currentPage <- ReflexUtil.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage reset
- return $ PagesOut
- { _pagesOut_currentPage = currentPage
+ return $ Out
+ { _out_currentPage = currentPage
}
where
- total = _pagesIn_total pagesIn
- perPage = _pagesIn_perPage pagesIn
- reset = _pagesIn_reset pagesIn
+ total = _in_total input
+ perPage = _in_perPage input
+ reset = _in_reset input
pageButtons :: forall t m. MonadWidget t m => Dynamic t Int -> Int -> Event t () -> m (Dynamic t Int)
pageButtons total perPage reset = do
@@ -75,14 +74,14 @@ range currentPage maxPage = [start..end]
pageButton :: forall t m. MonadWidget t m => Dynamic t (Maybe Int) -> Dynamic t Int -> m () -> m (Event t Int)
pageButton currentPage page content = do
- clic <- _buttonOut_clic <$> (Component.button $ ButtonIn
- { _buttonIn_class = do
+ clic <- Button._out_clic <$> (Button.view $ Button.In
+ { Button._in_class = do
cp <- currentPage
p <- page
if cp == Just p then "page current" else "page"
- , _buttonIn_content = content
- , _buttonIn_waiting = R.never
- , _buttonIn_tabIndex = Nothing
- , _buttonIn_submit = False
+ , Button._in_content = content
+ , Button._in_waiting = R.never
+ , Button._in_tabIndex = Nothing
+ , Button._in_submit = False
})
return . fmap fst $ R.attach (R.current page) clic
diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs
index 5f0d03c..f86acd8 100644
--- a/client/src/View/Payment/Payment.hs
+++ b/client/src/View/Payment/Payment.hs
@@ -1,7 +1,7 @@
module View.Payment.Payment
( init
, view
- , PaymentIn(..)
+ , In(..)
) where
import Data.Text (Text)
@@ -20,12 +20,9 @@ import qualified Common.Util.Text as T
import Loadable (Loadable (..))
import qualified Loadable
import qualified Util.Ajax as AjaxUtil
-import View.Payment.Header (HeaderIn (..), HeaderOut (..))
import qualified View.Payment.Header as Header
import View.Payment.Init (Init (..))
-import View.Payment.Pages (PagesIn (..), PagesOut (..))
import qualified View.Payment.Pages as Pages
-import View.Payment.Table (TableIn (..), TableOut (..))
import qualified View.Payment.Table as Table
init :: forall t m. MonadWidget t m => m (Dynamic t (Loadable Init))
@@ -44,21 +41,21 @@ init = do
return $ Init <$> us <*> ps <*> is <*> cs <*> pcs
-data PaymentIn t = PaymentIn
- { _paymentIn_currentUser :: UserId
- , _paymentIn_currency :: Currency
- , _paymentIn_init :: Dynamic t (Loadable Init)
+data In t = In
+ { _in_currentUser :: UserId
+ , _in_currency :: Currency
+ , _in_init :: Dynamic t (Loadable Init)
}
-view :: forall t m. MonadWidget t m => PaymentIn t -> m ()
-view paymentIn = do
- R.dyn . R.ffor (_paymentIn_init paymentIn) . Loadable.view $ \init ->
+view :: forall t m. MonadWidget t m => In t -> m ()
+view input = do
+ R.dyn . R.ffor (_in_init input) . Loadable.view $ \init ->
R.elClass "main" "payment" $ do
rec
let addPayment = R.leftmost
- [ _headerOut_addPayment header
- , _tableOut_addPayment table
+ [ Header._out_addPayment header
+ , Table._out_addPayment table
]
paymentsPerPage = 7
@@ -66,46 +63,46 @@ view paymentIn = do
payments <- reducePayments
(_init_payments init)
(_savedPayment_payment <$> addPayment)
- (_savedPayment_payment <$> _tableOut_editPayment table)
- (_tableOut_deletePayment table)
+ (_savedPayment_payment <$> Table._out_editPayment table)
+ (Table._out_deletePayment table)
paymentCategories <- reducePaymentCategories
(_init_paymentCategories init)
payments
(_savedPayment_paymentCategory <$> addPayment)
- (_savedPayment_paymentCategory <$> _tableOut_editPayment table)
- (_tableOut_deletePayment table)
+ (_savedPayment_paymentCategory <$> Table._out_editPayment table)
+ (Table._out_deletePayment table)
(searchNameEvent, searchName) <-
- debounceSearchName (_headerOut_searchName header)
+ debounceSearchName (Header._out_searchName header)
let searchPayments =
- getSearchPayments searchName (_headerOut_searchFrequency header) payments
-
- header <- Header.widget $ HeaderIn
- { _headerIn_init = init
- , _headerIn_currency = _paymentIn_currency paymentIn
- , _headerIn_payments = payments
- , _headerIn_searchPayments = searchPayments
- , _headerIn_paymentCategories = paymentCategories
+ getSearchPayments searchName (Header._out_searchFrequency header) payments
+
+ header <- Header.view $ Header.In
+ { Header._in_init = init
+ , Header._in_currency = _in_currency input
+ , Header._in_payments = payments
+ , Header._in_searchPayments = searchPayments
+ , Header._in_paymentCategories = paymentCategories
}
- table <- Table.widget $ TableIn
- { _tableIn_init = init
- , _tableIn_currency = _paymentIn_currency paymentIn
- , _tableIn_currentUser = _paymentIn_currentUser paymentIn
- , _tableIn_currentPage = _pagesOut_currentPage pages
- , _tableIn_payments = searchPayments
- , _tableIn_perPage = paymentsPerPage
- , _tableIn_paymentCategories = paymentCategories
+ table <- Table.view $ Table.In
+ { Table._in_init = init
+ , Table._in_currency = _in_currency input
+ , Table._in_currentUser = _in_currentUser input
+ , Table._in_currentPage = Pages._out_currentPage pages
+ , Table._in_payments = searchPayments
+ , Table._in_perPage = paymentsPerPage
+ , Table._in_paymentCategories = paymentCategories
}
- pages <- Pages.widget $ PagesIn
- { _pagesIn_total = length <$> searchPayments
- , _pagesIn_perPage = paymentsPerPage
- , _pagesIn_reset = R.leftmost $
+ pages <- Pages.view $ Pages.In
+ { Pages._in_total = length <$> searchPayments
+ , Pages._in_perPage = paymentsPerPage
+ , Pages._in_reset = R.leftmost $
[ () <$ searchNameEvent
- , () <$ _headerOut_addPayment header
+ , () <$ Header._out_addPayment header
]
}
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index 3a0a4bf..0793836 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -1,7 +1,7 @@
module View.Payment.Table
- ( widget
- , TableIn(..)
- , TableOut(..)
+ ( view
+ , In(..)
+ , Out(..)
) where
import qualified Data.List as L
@@ -20,8 +20,7 @@ import Common.Model (Category (..), Currency,
import qualified Common.Model as CM
import qualified Common.Msg as Msg
import qualified Common.View.Format as Format
-import Component (ButtonIn (..), ButtonOut (..))
-import qualified Component as Component
+import qualified Component.Button as Button
import qualified Component.Modal as Modal
import qualified View.Payment.Clone as Clone
import qualified View.Payment.Delete as Delete
@@ -31,25 +30,25 @@ import View.Payment.Init (Init (..))
import qualified Util.Reflex as ReflexUtil
import qualified View.Icon as Icon
-data TableIn t = TableIn
- { _tableIn_init :: Init
- , _tableIn_currency :: Currency
- , _tableIn_currentUser :: UserId
- , _tableIn_currentPage :: Dynamic t Int
- , _tableIn_payments :: Dynamic t [Payment]
- , _tableIn_perPage :: Int
- , _tableIn_paymentCategories :: Dynamic t [PaymentCategory]
- , _tableIn_categories :: [Category]
+data In t = In
+ { _in_init :: Init
+ , _in_currency :: Currency
+ , _in_currentUser :: UserId
+ , _in_currentPage :: Dynamic t Int
+ , _in_payments :: Dynamic t [Payment]
+ , _in_perPage :: Int
+ , _in_paymentCategories :: Dynamic t [PaymentCategory]
+ , _in_categories :: [Category]
}
-data TableOut t = TableOut
- { _tableOut_addPayment :: Event t SavedPayment
- , _tableOut_editPayment :: Event t SavedPayment
- , _tableOut_deletePayment :: Event t Payment
+data Out t = Out
+ { _out_addPayment :: Event t SavedPayment
+ , _out_editPayment :: Event t SavedPayment
+ , _out_deletePayment :: Event t Payment
}
-widget :: forall t m. MonadWidget t m => TableIn t -> m (TableOut t)
-widget tableIn = do
+view :: forall t m. MonadWidget t m => In t -> m (Out t)
+view input = do
R.divClass "table" $ do
(addPayment, editPayment, deletePayment) <- R.divClass "lines" $ do
@@ -75,20 +74,20 @@ widget tableIn = do
ReflexUtil.divClassVisibleIf (null <$> payments) "emptyTableMsg" $
R.text $ Msg.get Msg.Payment_Empty
- return $ TableOut
- { _tableOut_addPayment = addPayment
- , _tableOut_editPayment = editPayment
- , _tableOut_deletePayment = deletePayment
+ return $ Out
+ { _out_addPayment = addPayment
+ , _out_editPayment = editPayment
+ , _out_deletePayment = deletePayment
}
where
- init = _tableIn_init tableIn
- currency = _tableIn_currency tableIn
- currentUser = _tableIn_currentUser tableIn
- currentPage = _tableIn_currentPage tableIn
- payments = _tableIn_payments tableIn
- paymentRange = getPaymentRange (_tableIn_perPage tableIn) <$> payments <*> currentPage
- paymentCategories = _tableIn_paymentCategories tableIn
+ init = _in_init input
+ currency = _in_currency input
+ currentUser = _in_currentUser input
+ currentPage = _in_currentPage input
+ payments = _in_payments input
+ paymentRange = getPaymentRange (_in_perPage input) <$> payments <*> currentPage
+ paymentCategories = _in_paymentCategories input
getPaymentRange :: Int -> [Payment] -> Int -> [Payment]
getPaymentRange perPage payments currentPage =
@@ -150,19 +149,19 @@ paymentRow init currency currentUser paymentCategories payment =
clonePayment <-
R.divClass "cell button" $
- _buttonOut_clic <$> (Component.button $
- Component.defaultButtonIn Icon.clone)
+ Button._out_clic <$> (Button.view $
+ Button.defaultIn Icon.clone)
paymentCloned <-
- Modal.view $ Modal.Input
- { Modal._input_show = clonePayment
- , Modal._input_content =
- Clone.view $ Clone.Input
- { Clone._input_show = clonePayment
- , Clone._input_categories = _init_categories init
- , Clone._input_paymentCategories = paymentCategories
- , Clone._input_payment = payment
- , Clone._input_category = categoryId
+ Modal.view $ Modal.In
+ { Modal._in_show = clonePayment
+ , Modal._in_content =
+ Clone.view $ Clone.In
+ { Clone._in_show = clonePayment
+ , Clone._in_categories = _init_categories init
+ , Clone._in_paymentCategories = paymentCategories
+ , Clone._in_payment = payment
+ , Clone._in_category = categoryId
}
}
@@ -174,36 +173,36 @@ paymentRow init currency currentUser paymentCategories payment =
editPayment <-
R.divClass "cell button" $
ReflexUtil.divVisibleIf isFromCurrentUser $
- _buttonOut_clic <$> (Component.button $
- Component.defaultButtonIn Icon.edit)
+ Button._out_clic <$> (Button.view $
+ Button.defaultIn Icon.edit)
paymentEdited <-
- Modal.view $ Modal.Input
- { Modal._input_show = editPayment
- , Modal._input_content =
- Edit.view $ Edit.Input
- { Edit._input_show = editPayment
- , Edit._input_categories = _init_categories init
- , Edit._input_paymentCategories = paymentCategories
- , Edit._input_payment = payment
- , Edit._input_category = categoryId
+ Modal.view $ Modal.In
+ { Modal._in_show = editPayment
+ , Modal._in_content =
+ Edit.view $ Edit.In
+ { Edit._in_show = editPayment
+ , Edit._in_categories = _init_categories init
+ , Edit._in_paymentCategories = paymentCategories
+ , Edit._in_payment = payment
+ , Edit._in_category = categoryId
}
}
deletePayment <-
R.divClass "cell button" $
ReflexUtil.divVisibleIf isFromCurrentUser $
- _buttonOut_clic <$> (Component.button $
- (Component.defaultButtonIn Icon.delete)
- { _buttonIn_class = R.constDyn "deletePayment"
+ Button._out_clic <$> (Button.view $
+ (Button.defaultIn Icon.delete)
+ { Button._in_class = R.constDyn "deletePayment"
})
paymentDeleted <-
- Modal.view $ Modal.Input
- { Modal._input_show = deletePayment
- , Modal._input_content =
- Delete.view $ Delete.Input
- { Delete._input_payment = payment
+ Modal.view $ Modal.In
+ { Modal._in_show = deletePayment
+ , Modal._in_content =
+ Delete.view $ Delete.In
+ { Delete._in_payment = payment
}
}
diff --git a/client/src/View/SignIn.hs b/client/src/View/SignIn.hs
index 4fe495b..a589fc3 100644
--- a/client/src/View/SignIn.hs
+++ b/client/src/View/SignIn.hs
@@ -15,9 +15,9 @@ import Common.Model (SignInForm (SignInForm))
import qualified Common.Msg as Msg
import qualified Common.Validation.SignIn as SignInValidation
-import Component (ButtonIn (..), ButtonOut (..),
- InputIn (..), InputOut (..))
-import qualified Component as Component
+import qualified Component.Button as Button
+import qualified Component.Form as Form
+import qualified Component.Input as Input
import qualified Util.Ajax as Ajax
import qualified Util.Validation as ValidationUtil
import qualified Util.WaitFor as WaitFor
@@ -30,24 +30,24 @@ data SignInMessage =
view :: forall t m. MonadWidget t m => SignInMessage -> m ()
view signInMessage =
R.divClass "signIn" $
- Component.form $ do
+ Form.view $ do
rec
- input <- (Component.input
- (Component.defaultInputIn
- { _inputIn_label = Msg.get Msg.SignIn_EmailLabel
- , _inputIn_validation = SignInValidation.email
+ input <- (Input.view
+ (Input.defaultIn
+ { Input._in_label = Msg.get Msg.SignIn_EmailLabel
+ , Input._in_validation = SignInValidation.email
})
("" <$ R.ffilter Either.isRight signInResult)
validate)
- validate <- _buttonOut_clic <$> (Component.button $
- (Component.defaultButtonIn (R.text $ Msg.get Msg.SignIn_Button))
- { _buttonIn_class = R.constDyn "validate"
- , _buttonIn_waiting = waiting
- , _buttonIn_submit = True
+ validate <- Button._out_clic <$> (Button.view $
+ (Button.defaultIn (R.text $ Msg.get Msg.SignIn_Button))
+ { Button._in_class = R.constDyn "validate"
+ , Button._in_waiting = waiting
+ , Button._in_submit = True
})
- let form = SignInForm <$> _inputOut_raw input
+ let form = SignInForm <$> Input._out_raw input
(signInResult, waiting) <- WaitFor.waitFor
(Ajax.post "/api/askSignIn")