aboutsummaryrefslogtreecommitdiff
path: root/client/src
diff options
context:
space:
mode:
Diffstat (limited to 'client/src')
-rw-r--r--client/src/Component.hs10
-rw-r--r--client/src/Component/Button.hs56
-rw-r--r--client/src/Component/Form.hs6
-rw-r--r--client/src/Component/Input.hs79
-rw-r--r--client/src/Component/Link.hs6
-rw-r--r--client/src/Component/Modal.hs14
-rw-r--r--client/src/Component/ModalForm.hs61
-rw-r--r--client/src/Component/Pages.hs45
-rw-r--r--client/src/Component/Select.hs56
-rw-r--r--client/src/Component/Table.hs45
-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
28 files changed, 685 insertions, 717 deletions
diff --git a/client/src/Component.hs b/client/src/Component.hs
deleted file mode 100644
index fa4e4ea..0000000
--- a/client/src/Component.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-module Component (module X) where
-
-import Component.Button as X
-import Component.Form as X
-import Component.Input as X
-import Component.Link as X
-import Component.ModalForm as X
-import Component.Pages as X
-import Component.Select as X
-import Component.Table as X
diff --git a/client/src/Component/Button.hs b/client/src/Component/Button.hs
index b1175d7..6faecef 100644
--- a/client/src/Component/Button.hs
+++ b/client/src/Component/Button.hs
@@ -1,8 +1,8 @@
module Component.Button
- ( ButtonIn(..)
- , ButtonOut(..)
- , button
- , defaultButtonIn
+ ( In(..)
+ , Out(..)
+ , view
+ , defaultIn
) where
import qualified Data.Map as M
@@ -14,44 +14,44 @@ import qualified Reflex.Dom as R
import qualified View.Icon as Icon
-data ButtonIn t m = ButtonIn
- { _buttonIn_class :: Dynamic t Text
- , _buttonIn_content :: m ()
- , _buttonIn_waiting :: Event t Bool
- , _buttonIn_tabIndex :: Maybe Int
- , _buttonIn_submit :: Bool
+data In t m = In
+ { _in_class :: Dynamic t Text
+ , _in_content :: m ()
+ , _in_waiting :: Event t Bool
+ , _in_tabIndex :: Maybe Int
+ , _in_submit :: Bool
}
-defaultButtonIn :: MonadWidget t m => m () -> ButtonIn t m
-defaultButtonIn content = ButtonIn
- { _buttonIn_class = R.constDyn ""
- , _buttonIn_content = content
- , _buttonIn_waiting = R.never
- , _buttonIn_tabIndex = Nothing
- , _buttonIn_submit = False
+defaultIn :: MonadWidget t m => m () -> In t m
+defaultIn content = In
+ { _in_class = R.constDyn ""
+ , _in_content = content
+ , _in_waiting = R.never
+ , _in_tabIndex = Nothing
+ , _in_submit = False
}
-data ButtonOut t = ButtonOut
- { _buttonOut_clic :: Event t ()
+data Out t = Out
+ { _out_clic :: Event t ()
}
-button :: forall t m. MonadWidget t m => ButtonIn t m -> m (ButtonOut t)
-button buttonIn = do
- dynWaiting <- R.holdDyn False $ _buttonIn_waiting buttonIn
+view :: forall t m. MonadWidget t m => In t m -> m (Out t)
+view input = do
+ dynWaiting <- R.holdDyn False $ _in_waiting input
let attr = do
- buttonClass <- _buttonIn_class buttonIn
+ buttonClass <- _in_class input
waiting <- dynWaiting
return . M.fromList . catMaybes $
- [ Just ("type", if _buttonIn_submit buttonIn then "submit" else "button")
- , (\i -> ("tabindex", T.pack . show $ i)) <$> _buttonIn_tabIndex buttonIn
+ [ Just ("type", if _in_submit input then "submit" else "button")
+ , (\i -> ("tabindex", T.pack . show $ i)) <$> _in_tabIndex input
, Just ("class", T.intercalate " " [ buttonClass, if waiting then "waiting" else "" ])
]
(e, _) <- R.elDynAttr' "button" attr $ do
Icon.loading
- R.divClass "content" $ _buttonIn_content buttonIn
+ R.divClass "content" $ _in_content input
- return $ ButtonOut
- { _buttonOut_clic = R.domEvent R.Click e
+ return $ Out
+ { _out_clic = R.domEvent R.Click e
}
diff --git a/client/src/Component/Form.hs b/client/src/Component/Form.hs
index 6ea02fa..6878e68 100644
--- a/client/src/Component/Form.hs
+++ b/client/src/Component/Form.hs
@@ -1,12 +1,12 @@
module Component.Form
- ( form
+ ( view
) where
import qualified Data.Map as M
import Reflex.Dom (MonadWidget)
import qualified Reflex.Dom as R
-form :: forall t m a. MonadWidget t m => m a -> m a
-form content =
+view :: forall t m a. MonadWidget t m => m a -> m a
+view content =
R.elAttr "form" (M.singleton "onsubmit" "event.preventDefault()") $
content
diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs
index 9ab4d58..37020da 100644
--- a/client/src/Component/Input.hs
+++ b/client/src/Component/Input.hs
@@ -1,8 +1,8 @@
module Component.Input
- ( InputIn(..)
- , InputOut(..)
- , input
- , defaultInputIn
+ ( In(..)
+ , Out(..)
+ , view
+ , defaultIn
) where
import qualified Data.Map as M
@@ -17,40 +17,39 @@ import Reflex.Dom (Dynamic, Event, MonadWidget, Reflex,
import qualified Reflex.Dom as R
import qualified Common.Util.Validation as ValidationUtil
-import Component.Button (ButtonIn (..), ButtonOut (..))
import qualified Component.Button as Button
import qualified View.Icon as Icon
-data InputIn a = InputIn
- { _inputIn_hasResetButton :: Bool
- , _inputIn_label :: Text
- , _inputIn_initialValue :: Text
- , _inputIn_inputType :: Text
- , _inputIn_validation :: Text -> Validation Text a
+data In a = In
+ { _in_hasResetButton :: Bool
+ , _in_label :: Text
+ , _in_initialValue :: Text
+ , _in_inputType :: Text
+ , _in_validation :: Text -> Validation Text a
}
-defaultInputIn :: InputIn Text
-defaultInputIn = InputIn
- { _inputIn_hasResetButton = True
- , _inputIn_label = ""
- , _inputIn_initialValue = ""
- , _inputIn_inputType = "text"
- , _inputIn_validation = V.Success
+defaultIn :: In Text
+defaultIn = In
+ { _in_hasResetButton = True
+ , _in_label = ""
+ , _in_initialValue = ""
+ , _in_inputType = "text"
+ , _in_validation = V.Success
}
-data InputOut t a = InputOut
- { _inputOut_raw :: Dynamic t Text
- , _inputOut_value :: Dynamic t (Validation Text a)
- , _inputOut_enter :: Event t ()
+data Out t a = Out
+ { _out_raw :: Dynamic t Text
+ , _out_value :: Dynamic t (Validation Text a)
+ , _out_enter :: Event t ()
}
-input
+view
:: forall t m a b. MonadWidget t m
- => InputIn a
+ => In a
-> Event t Text -- reset
-> Event t b -- validate
- -> m (InputOut t a)
-input inputIn reset validate = do
+ -> m (Out t a)
+view input reset validate = do
rec
let resetValue = R.leftmost
[ reset
@@ -58,7 +57,7 @@ input inputIn reset validate = do
]
inputAttr = R.ffor value (\v ->
- if T.null v && _inputIn_inputType inputIn /= "date"
+ if T.null v && _in_inputType input /= "date"
then M.empty
else M.singleton "class" "filled")
@@ -70,7 +69,7 @@ input inputIn reset validate = do
, if Maybe.isJust e then "error" else ""
])
- let valueWithValidation = R.ffor value (\v -> (v, _inputIn_validation inputIn $ v))
+ let valueWithValidation = R.ffor value (\v -> (v, _in_validation input $ v))
inputError <- getInputError valueWithValidation validate
(textInput, resetClic) <- R.elDynAttr "div" containerAttr $ do
@@ -79,21 +78,21 @@ input inputIn reset validate = do
textInput <- R.textInput $ R.def
& R.attributes .~ inputAttr
& R.setValue .~ resetValue
- & R.textInputConfig_initialValue .~ (_inputIn_initialValue inputIn)
- & R.textInputConfig_inputType .~ (_inputIn_inputType inputIn)
+ & R.textInputConfig_initialValue .~ (_in_initialValue input)
+ & R.textInputConfig_inputType .~ (_in_inputType input)
R.divClass "label" $
- R.text (_inputIn_label inputIn)
+ R.text (_in_label input)
return textInput
resetClic <-
- if _inputIn_hasResetButton inputIn
+ if _in_hasResetButton input
then
- _buttonOut_clic <$> (Button.button $
- (Button.defaultButtonIn Icon.cross)
- { _buttonIn_class = R.constDyn "reset"
- , _buttonIn_tabIndex = Just (-1)
+ Button._out_clic <$> (Button.view $
+ (Button.defaultIn Icon.cross)
+ { Button._in_class = R.constDyn "reset"
+ , Button._in_tabIndex = Just (-1)
})
else
return R.never
@@ -105,10 +104,10 @@ input inputIn reset validate = do
let enter = fmap (const ()) $ R.ffilter ((==) 13) . R._textInput_keypress $ textInput
- return $ InputOut
- { _inputOut_raw = value
- , _inputOut_value = fmap snd valueWithValidation
- , _inputOut_enter = enter
+ return $ Out
+ { _out_raw = value
+ , _out_value = fmap snd valueWithValidation
+ , _out_enter = enter
}
getInputError
diff --git a/client/src/Component/Link.hs b/client/src/Component/Link.hs
index 7e8558b..1fd620e 100644
--- a/client/src/Component/Link.hs
+++ b/client/src/Component/Link.hs
@@ -1,5 +1,5 @@
module Component.Link
- ( link
+ ( view
) where
import Data.Map (Map)
@@ -9,8 +9,8 @@ import qualified Data.Text as T
import Reflex.Dom (Dynamic, MonadWidget)
import qualified Reflex.Dom as R
-link :: forall t m a. MonadWidget t m => Text -> Dynamic t (Map Text Text) -> Text -> m ()
-link href inputAttrs content =
+view :: forall t m a. MonadWidget t m => Text -> Dynamic t (Map Text Text) -> Text -> m ()
+view href inputAttrs content =
R.elDynAttr "a" attrs (R.text content)
where
diff --git a/client/src/Component/Modal.hs b/client/src/Component/Modal.hs
index 96c2679..50af469 100644
--- a/client/src/Component/Modal.hs
+++ b/client/src/Component/Modal.hs
@@ -1,5 +1,5 @@
module Component.Modal
- ( Input(..)
+ ( In(..)
, Content
, view
) where
@@ -22,15 +22,15 @@ import qualified Util.Reflex as ReflexUtil
-- Content = CurtainClickEvent -> (CancelEvent, ConfirmEvent)
type Content t m a = Event t () -> m (Event t (), Event t a)
-data Input t m a = Input
- { _input_show :: Event t ()
- , _input_content :: Content t m a
+data In t m a = In
+ { _in_show :: Event t ()
+ , _in_content :: Content t m a
}
-view :: forall t m a. MonadWidget t m => Input t m a -> m (Event t a)
+view :: forall t m a. MonadWidget t m => In t m a -> m (Event t a)
view input = do
rec
- let show = Show <$ (_input_show input)
+ let show = Show <$ (_in_show input)
startHiding =
R.attachWithMaybe
@@ -61,7 +61,7 @@ view input = do
(do
(curtain, _) <- R.elAttr' "div" (M.singleton "class" "g-Modal__Curtain") $ R.blank
let curtainClick = R.domEvent R.Click curtain
- (hide, content) <- R.divClass "g-Modal__Content" (_input_content input curtainClick)
+ (hide, content) <- R.divClass "g-Modal__Content" (_in_content input curtainClick)
return (curtainClick, hide, content))
diff --git a/client/src/Component/ModalForm.hs b/client/src/Component/ModalForm.hs
index 63cb1d2..ea53beb 100644
--- a/client/src/Component/ModalForm.hs
+++ b/client/src/Component/ModalForm.hs
@@ -1,7 +1,7 @@
module Component.ModalForm
- ( modalForm
- , ModalFormIn(..)
- , ModalFormOut(..)
+ ( view
+ , In(..)
+ , Out(..)
) where
import Data.Aeson (ToJSON)
@@ -14,57 +14,56 @@ import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
import qualified Common.Msg as Msg
-import Component.Button (ButtonIn (..))
import qualified Component.Button as Button
import qualified Util.Either as EitherUtil
import qualified Util.Validation as ValidationUtil
import qualified Util.WaitFor as WaitFor
-data ModalFormIn m t a b e = ModalFormIn
- { _modalFormIn_headerLabel :: Text
- , _modalFormIn_form :: m (Dynamic t (Validation e a))
- , _modalFormIn_ajax :: Event t a -> m (Event t (Either Text b))
+data In m t a b e = In
+ { _in_headerLabel :: Text
+ , _in_form :: m (Dynamic t (Validation e a))
+ , _in_ajax :: Event t a -> m (Event t (Either Text b))
}
-data ModalFormOut t a = ModalFormOut
- { _modalFormOut_hide :: Event t ()
- , _modalFormOut_cancel :: Event t ()
- , _modalFormOut_confirm :: Event t ()
- , _modalFormOut_validate :: Event t a
+data Out t a = Out
+ { _out_hide :: Event t ()
+ , _out_cancel :: Event t ()
+ , _out_confirm :: Event t ()
+ , _out_validate :: Event t a
}
-modalForm :: forall t m a b e. (MonadWidget t m, ToJSON a) => ModalFormIn m t a b e -> m (ModalFormOut t b)
-modalForm modalFormIn =
+view :: forall t m a b e. (MonadWidget t m, ToJSON a) => In m t a b e -> m (Out t b)
+view input =
R.divClass "form" $ do
R.divClass "formHeader" $
- R.text (_modalFormIn_headerLabel modalFormIn)
+ R.text (_in_headerLabel input)
R.divClass "formContent" $ do
rec
- form <- _modalFormIn_form modalFormIn
+ form <- _in_form input
(validate, cancel, confirm) <- R.divClass "buttons" $ do
rec
- cancel <- Button._buttonOut_clic <$> (Button.button $
- (Button.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" })
- confirm <- Button._buttonOut_clic <$> (Button.button $
- (Button.defaultButtonIn (R.text $ Msg.get Msg.Dialog_Confirm))
- { _buttonIn_class = R.constDyn "confirm"
- , _buttonIn_waiting = waiting
- , _buttonIn_submit = True
+ confirm <- Button._out_clic <$> (Button.view $
+ (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Confirm))
+ { Button._in_class = R.constDyn "confirm"
+ , Button._in_waiting = waiting
+ , Button._in_submit = True
})
(validate, waiting) <- WaitFor.waitFor
- (_modalFormIn_ajax modalFormIn)
+ (_in_ajax input)
(ValidationUtil.fireValidation form confirm)
return (R.fmapMaybe EitherUtil.eitherToMaybe validate, cancel, confirm)
- return ModalFormOut
- { _modalFormOut_hide = R.leftmost [ cancel, () <$ validate ]
- , _modalFormOut_cancel = cancel
- , _modalFormOut_confirm = confirm
- , _modalFormOut_validate = validate
+ return Out
+ { _out_hide = R.leftmost [ cancel, () <$ validate ]
+ , _out_cancel = cancel
+ , _out_confirm = confirm
+ , _out_validate = validate
}
diff --git a/client/src/Component/Pages.hs b/client/src/Component/Pages.hs
index 7843ef6..7284a36 100644
--- a/client/src/Component/Pages.hs
+++ b/client/src/Component/Pages.hs
@@ -1,41 +1,40 @@
module Component.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 Component.Button (ButtonIn (..), ButtonOut (..))
import qualified Component.Button as Button
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 <$> (Button.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/Component/Select.hs b/client/src/Component/Select.hs
index 102f554..375ae06 100644
--- a/client/src/Component/Select.hs
+++ b/client/src/Component/Select.hs
@@ -1,7 +1,7 @@
module Component.Select
- ( SelectIn(..)
- , SelectOut(..)
- , select
+ ( view
+ , In(..)
+ , Out(..)
) where
import Data.Map (Map)
@@ -15,58 +15,58 @@ import qualified Reflex.Dom as R
import qualified Util.Validation as ValidationUtil
-data (Reflex t) => SelectIn t a b c = SelectIn
- { _selectIn_label :: Text
- , _selectIn_initialValue :: a
- , _selectIn_value :: Event t a
- , _selectIn_values :: Dynamic t (Map a Text)
- , _selectIn_reset :: Event t b
- , _selectIn_isValid :: a -> Validation Text a
- , _selectIn_validate :: Event t c
+data (Reflex t) => In t a b c = In
+ { _in_label :: Text
+ , _in_initialValue :: a
+ , _in_value :: Event t a
+ , _in_values :: Dynamic t (Map a Text)
+ , _in_reset :: Event t b
+ , _in_isValid :: a -> Validation Text a
+ , _in_validate :: Event t c
}
-data SelectOut t a = SelectOut
- { _selectOut_raw :: Dynamic t a
- , _selectOut_value :: Dynamic t (Validation Text a)
+data Out t a = Out
+ { _out_raw :: Dynamic t a
+ , _out_value :: Dynamic t (Validation Text a)
}
-select :: forall t m a b c. (Ord a, MonadWidget t m) => SelectIn t a b c -> m (SelectOut t a)
-select selectIn = do
+view :: forall t m a b c. (Ord a, MonadWidget t m) => In t a b c -> m (Out t a)
+view input = do
rec
let containerAttr = R.ffor showedError (\e ->
M.singleton "class" $ T.intercalate " "
- [ "selectInput"
+ [ "input"
, if Maybe.isJust e then "error" else ""
])
validatedValue =
- fmap (_selectIn_isValid selectIn) value
+ fmap (_in_isValid input) value
maybeError =
fmap ValidationUtil.maybeError validatedValue
showedError <- R.holdDyn Nothing $ R.leftmost
- [ Nothing <$ _selectIn_reset selectIn
+ [ Nothing <$ _in_reset input
, R.updated maybeError
- , R.attachWith const (R.current maybeError) (_selectIn_validate selectIn)
+ , R.attachWith const (R.current maybeError) (_in_validate input)
]
value <- R.elDynAttr "div" containerAttr $ do
- let initialValue = _selectIn_initialValue selectIn
+ let initialValue = _in_initialValue input
let setValue = R.leftmost
- [ initialValue <$ (_selectIn_reset selectIn)
- , _selectIn_value selectIn
+ [ initialValue <$ (_in_reset input)
+ , _in_value input
]
value <- R.el "label" $ do
R.divClass "label" $
- R.text (_selectIn_label selectIn)
+ R.text (_in_label input)
R._dropdown_value <$>
R.dropdown
initialValue
- (_selectIn_values selectIn)
+ (_in_values input)
(R.def { R._dropdownConfig_setValue = setValue })
R.divClass "errorMessage" . R.dynText $
@@ -74,7 +74,7 @@ select selectIn = do
return value
- return SelectOut
- { _selectOut_raw = value
- , _selectOut_value = validatedValue
+ return Out
+ { _out_raw = value
+ , _out_value = validatedValue
}
diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs
index b431c14..bf76566 100644
--- a/client/src/Component/Table.hs
+++ b/client/src/Component/Table.hs
@@ -1,29 +1,28 @@
module Component.Table
- ( table
- , TableIn(..)
- , TableOut(..)
+ ( view
+ , In(..)
+ , Out(..)
) where
import Data.Text (Text)
import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
-import Component.Pages (PagesIn (..), PagesOut (..))
import qualified Component.Pages as Pages
-data TableIn h r t = TableIn
- { _tableIn_headerLabel :: h -> Text
- , _tableIn_rows :: Dynamic t [r]
- , _tableIn_cell :: h -> r -> Text
- , _tableIn_perPage :: Int
- , _tableIn_resetPage :: Event t ()
+data In h r t = In
+ { _in_headerLabel :: h -> Text
+ , _in_rows :: Dynamic t [r]
+ , _in_cell :: h -> r -> Text
+ , _in_perPage :: Int
+ , _in_resetPage :: Event t ()
}
-data TableOut = TableOut
+data Out = Out
{}
-table :: forall t m h r. (MonadWidget t m, Bounded h, Enum h) => TableIn h r t -> m (TableOut)
-table tableIn =
+view :: forall t m h r. (MonadWidget t m, Bounded h, Enum h) => In h r t -> m (Out)
+view input =
R.divClass "table" $ do
rec
R.divClass "lines" $ do
@@ -31,29 +30,29 @@ table tableIn =
R.divClass "header" $
flip mapM_ [minBound..] $ \header ->
R.divClass "cell" . R.text $
- _tableIn_headerLabel tableIn header
+ _in_headerLabel input header
let rows = getRange
- (_tableIn_perPage tableIn)
- <$> (_pagesOut_currentPage pages)
- <*> (_tableIn_rows tableIn)
+ (_in_perPage input)
+ <$> (Pages._out_currentPage pages)
+ <*> (_in_rows input)
R.simpleList rows $ \r ->
R.divClass "row" $
flip mapM_ [minBound..] $ \h ->
R.divClass "cell name" $
R.dynText $
- R.ffor r (_tableIn_cell tableIn h)
+ R.ffor r (_in_cell input h)
- pages <- Pages.widget $ PagesIn
- { _pagesIn_total = length <$> (_tableIn_rows tableIn)
- , _pagesIn_perPage = _tableIn_perPage tableIn
- , _pagesIn_reset = _tableIn_resetPage tableIn
+ pages <- Pages.view $ Pages.In
+ { Pages._in_total = length <$> (_in_rows input)
+ , Pages._in_perPage = _in_perPage input
+ , Pages._in_reset = _in_resetPage input
}
return ()
- return $ TableOut
+ return $ Out
{}
getRange :: forall a. Int -> Int -> [a] -> [a]
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")