diff options
Diffstat (limited to 'client/src')
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") |