diff options
Diffstat (limited to 'client')
| -rw-r--r-- | client/client.cabal | 2 | ||||
| -rw-r--r-- | client/src/Component/ModalForm.hs | 50 | ||||
| -rw-r--r-- | client/src/Component/Table.hs | 25 | ||||
| -rw-r--r-- | client/src/View/Income/Add.hs | 42 | ||||
| -rw-r--r-- | client/src/View/Income/Form.hs | 89 | ||||
| -rw-r--r-- | client/src/View/Income/Header.hs | 7 | ||||
| -rw-r--r-- | client/src/View/Income/Income.hs | 9 | ||||
| -rw-r--r-- | client/src/View/Income/Table.hs | 17 |
8 files changed, 132 insertions, 109 deletions
diff --git a/client/client.cabal b/client/client.cabal index 6163ab0..9a212e8 100644 --- a/client/client.cabal +++ b/client/client.cabal @@ -51,6 +51,7 @@ Executable client Component.Input Component.Link Component.Modal + Component.ModalForm Component.Pages Component.Select Component.Table @@ -68,7 +69,6 @@ Executable client View.App View.Header View.Icon - View.Income.Add View.Income.Form View.Income.Header View.Income.Income diff --git a/client/src/Component/ModalForm.hs b/client/src/Component/ModalForm.hs index ea53beb..f5bf287 100644 --- a/client/src/Component/ModalForm.hs +++ b/client/src/Component/ModalForm.hs @@ -15,6 +15,7 @@ import qualified Reflex.Dom as R import qualified Common.Msg as Msg import qualified Component.Button as Button +import qualified Component.Form as Form import qualified Util.Either as EitherUtil import qualified Util.Validation as ValidationUtil import qualified Util.WaitFor as WaitFor @@ -38,32 +39,33 @@ view input = R.divClass "formHeader" $ R.text (_in_headerLabel input) - R.divClass "formContent" $ do - rec - form <- _in_form input + Form.view $ + R.divClass "formContent" $ do + rec + form <- _in_form input - (validate, cancel, confirm) <- R.divClass "buttons" $ do - rec - cancel <- Button._out_clic <$> (Button.view $ - (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Undo)) - { Button._in_class = R.constDyn "undo" }) + (validate, cancel, confirm) <- R.divClass "buttons" $ do + rec + cancel <- Button._out_clic <$> (Button.view $ + (Button.defaultIn (R.text $ Msg.get Msg.Dialog_Undo)) + { Button._in_class = R.constDyn "undo" }) - 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 - }) + 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 - (_in_ajax input) - (ValidationUtil.fireValidation form confirm) + (validate, waiting) <- WaitFor.waitFor + (_in_ajax input) + (ValidationUtil.fireValidation form confirm) - return (R.fmapMaybe EitherUtil.eitherToMaybe validate, cancel, confirm) + return (R.fmapMaybe EitherUtil.eitherToMaybe validate, cancel, confirm) - return Out - { _out_hide = R.leftmost [ cancel, () <$ validate ] - , _out_cancel = cancel - , _out_confirm = confirm - , _out_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/Table.hs b/client/src/Component/Table.hs index b3c70a0..a02eaa7 100644 --- a/client/src/Component/Table.hs +++ b/client/src/Component/Table.hs @@ -21,12 +21,14 @@ data In m t h r a = In , _in_perPage :: Int , _in_resetPage :: Event t () , _in_cloneModal :: r -> Modal.Content t m a + , _in_editModal :: r -> Modal.Content t m a , _in_deleteModal :: r -> Modal.Content t m a , _in_isOwner :: r -> Bool } data Out t a = Out { _out_add :: Event t a + , _out_edit :: Event t a , _out_delete :: Event t a } @@ -43,6 +45,7 @@ view input = R.divClass "cell" $ R.blank R.divClass "cell" $ R.blank + R.divClass "cell" $ R.blank let rows = getRange (_in_perPage input) @@ -71,6 +74,20 @@ view input = let isOwner = R.ffor r (_in_isOwner input) + edit <- + R.divClass "cell button" $ + ReflexUtil.divVisibleIf isOwner $ + Button._out_clic <$> (Button.view $ + Button.defaultIn Icon.edit) + + edited <- + Modal.view $ Modal.In + { Modal._in_show = edit + , Modal._in_content = \curtainClick -> + (R.dyn . R.ffor r $ \r2 -> _in_editModal input r2 curtainClick) + >>= ReflexUtil.flattenTuple + } + delete <- R.divClass "cell button" $ ReflexUtil.divVisibleIf isOwner $ @@ -85,7 +102,7 @@ view input = >>= ReflexUtil.flattenTuple } - return (cloned, deleted) + return (cloned, edited, deleted) pages <- Pages.view $ Pages.In { Pages._in_total = length <$> _in_rows input @@ -93,11 +110,13 @@ view input = , Pages._in_reset = _in_resetPage input } - let add = R.switch . R.current . fmap (R.leftmost . map fst) $ result - delete = R.switch . R.current . fmap (R.leftmost . map snd) $ result + let add = R.switch . R.current . fmap (R.leftmost . map (\(a, _, _) -> a)) $ result + edit = R.switch . R.current . fmap (R.leftmost . map (\(_, a, _) -> a)) $ result + delete = R.switch . R.current . fmap (R.leftmost . map (\(_, _, a) -> a)) $ result return $ Out { _out_add = add + , _out_edit = edit , _out_delete = delete } diff --git a/client/src/View/Income/Add.hs b/client/src/View/Income/Add.hs deleted file mode 100644 index 7780d73..0000000 --- a/client/src/View/Income/Add.hs +++ /dev/null @@ -1,42 +0,0 @@ -module View.Income.Add - ( view - , In(..) - ) where - -import Control.Monad.IO.Class (liftIO) -import qualified Data.Maybe as Maybe -import qualified Data.Text as T -import qualified Data.Time.Clock as Time -import Reflex.Dom (MonadWidget) - -import Common.Model (CreateIncomeForm (..), Income (..)) -import qualified Common.Msg as Msg -import qualified Common.Util.Time as TimeUtil -import qualified Component.Form -import qualified Component.Modal as Modal -import qualified Util.Ajax as Ajax -import qualified View.Income.Form as Form - -data In t = In - { _in_income :: Maybe Income - } - -view :: forall t m. MonadWidget t m => In t -> Modal.Content t m Income -view input cancel = do - - currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay - - let amount = - Maybe.fromMaybe "" ((T.pack . show . _income_amount) <$> (_in_income input)) - - form <- - Component.Form.view $ Form.view $ Form.In - { Form._in_cancel = cancel - , Form._in_headerLabel = Msg.get Msg.Income_AddLong - , Form._in_amount = amount - , Form._in_date = currentDay - , Form._in_mkPayload = CreateIncomeForm - , Form._in_ajax = Ajax.post - } - - return (Form._out_hide form, Form._out_addIncome form) diff --git a/client/src/View/Income/Form.hs b/client/src/View/Income/Form.hs index 917edf1..5f354a2 100644 --- a/client/src/View/Income/Form.hs +++ b/client/src/View/Income/Form.hs @@ -1,60 +1,59 @@ module View.Income.Form ( view , In(..) - , Out(..) + , Operation(..) ) where -import Data.Aeson (FromJSON, ToJSON) +import Control.Monad.IO.Class (liftIO) +import Data.Aeson (ToJSON) +import qualified Data.Maybe as Maybe import Data.Text (Text) import qualified Data.Text as T -import Data.Time.Calendar (Day) import qualified Data.Time.Calendar as Calendar +import qualified Data.Time.Clock as Time import Data.Validation (Validation) import qualified Data.Validation as V import Reflex.Dom (Dynamic, Event, MonadWidget) import qualified Reflex.Dom as R -import Common.Model (Income) +import Common.Model (EditIncomeForm (..), Income (..)) import qualified Common.Msg as Msg +import qualified Common.Util.Time as TimeUtil import qualified Common.Validation.Income as IncomeValidation import qualified Component.Input as Input +import qualified Component.Modal as Modal import qualified Component.ModalForm as ModalForm +import qualified Util.Ajax as Ajax -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 In t a = In + { _in_operation :: Operation a } -data Out t = Out - { _out_hide :: Event t () - , _out_addIncome :: Event t Income - } +data Operation a + = New (Text -> Text -> a) + | Clone (Text -> Text -> a) Income + | Edit (Text -> Text -> a) Income + +view :: forall t m a. (MonadWidget t m, ToJSON a) => In t a -> Modal.Content t m Income +view input cancel = 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 [ "" <$ ModalForm._out_cancel modalForm , "" <$ ModalForm._out_validate modalForm - , "" <$ _in_cancel input + , "" <$ cancel ] modalForm <- ModalForm.view $ ModalForm.In - { ModalForm._in_headerLabel = _in_headerLabel input - , ModalForm._in_ajax = _in_ajax input "/api/income" + { ModalForm._in_headerLabel = headerLabel + , ModalForm._in_ajax = ajax "/api/income" , ModalForm._in_form = form reset (ModalForm._out_confirm modalForm) } - return $ Out - { _out_hide = ModalForm._out_hide modalForm - , _out_addIncome = ModalForm._out_validate modalForm - } + return (ModalForm._out_hide modalForm, ModalForm._out_validate modalForm) where + form :: Event t String -> Event t () @@ -63,13 +62,15 @@ view input = do amount <- Input._out_raw <$> (Input.view (Input.defaultIn { Input._in_label = Msg.get Msg.Income_Amount - , Input._in_initialValue = _in_amount input + , Input._in_initialValue = amount , Input._in_validation = IncomeValidation.amount }) - (_in_amount input <$ reset) + (amount <$ reset) confirm) - let initialDate = T.pack . Calendar.showGregorian . _in_date $ input + currentDay <- liftIO $ Time.getCurrentTime >>= TimeUtil.timeToDay + + let initialDate = T.pack . Calendar.showGregorian $ date currentDay date <- Input._out_raw <$> (Input.view (Input.defaultIn @@ -85,4 +86,36 @@ view input = do return $ do a <- amount d <- date - return . V.Success $ (_in_mkPayload input) a d + return . V.Success $ mkPayload a d + + op = _in_operation input + + amount = + case op of + New _ -> "" + Clone _ income -> T.pack . show . _income_amount $ income + Edit _ income -> T.pack . show . _income_amount $ income + + date currentDay = + case op of + New _ -> currentDay + Clone _ _ -> currentDay + Edit _ income -> _income_date income + + ajax = + case op of + New _ -> Ajax.post + Clone _ _ -> Ajax.post + Edit _ _ -> Ajax.put + + headerLabel = + case op of + New _ -> Msg.get Msg.Income_AddLong + Clone _ _ -> Msg.get Msg.Income_AddLong + Edit _ _ -> Msg.get Msg.Income_Edit + + mkPayload = + case op of + New f -> f + Clone f _ -> f + Edit f _ -> f diff --git a/client/src/View/Income/Header.hs b/client/src/View/Income/Header.hs index f17e774..182db33 100644 --- a/client/src/View/Income/Header.hs +++ b/client/src/View/Income/Header.hs @@ -11,7 +11,8 @@ import qualified Data.Time.Clock as Clock import Reflex.Dom (Dynamic, Event, MonadWidget) import qualified Reflex.Dom as R -import Common.Model (Currency, Income (..), User (..)) +import Common.Model (CreateIncomeForm (..), Currency, + Income (..), User (..)) import qualified Common.Model as CM import qualified Common.Msg as Msg import qualified Common.View.Format as Format @@ -19,7 +20,7 @@ import qualified Common.View.Format as Format 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 qualified View.Income.Form as Form import View.Income.Init (Init (..)) data In t = In @@ -72,7 +73,7 @@ view input = addIncome <- Modal.view $ Modal.In { Modal._in_show = addIncome - , Modal._in_content = Add.view $ Add.In { Add._in_income = Nothing } + , Modal._in_content = Form.view $ Form.In { Form._in_operation = Form.New CreateIncomeForm } } return $ Out diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs index 2784cac..90f1fde 100644 --- a/client/src/View/Income/Income.hs +++ b/client/src/View/Income/Income.hs @@ -50,6 +50,7 @@ view input = do incomes <- reduceIncomes (_init_incomes init) addIncome + (Table._out_edit table) (Table._out_delete table) header <- Header.view $ Header.In @@ -72,11 +73,13 @@ view input = do reduceIncomes :: forall t m. MonadWidget t m => [Income] - -> Event t Income -- add income - -> Event t Income -- delete income + -> Event t Income -- add + -> Event t Income -- edit + -> Event t Income -- delete -> m (Dynamic t [Income]) -reduceIncomes initIncomes add delete = +reduceIncomes initIncomes add edit delete = R.foldDyn id initIncomes $ R.leftmost [ (:) <$> add + , R.ffor edit (\p -> (p:) . filter ((/= (_income_id p)) . _income_id)) , R.ffor delete (\p -> filter ((/= (_income_id p)) . _income_id)) ] diff --git a/client/src/View/Income/Table.hs b/client/src/View/Income/Table.hs index 16ebf7c..f865fd9 100644 --- a/client/src/View/Income/Table.hs +++ b/client/src/View/Income/Table.hs @@ -11,8 +11,9 @@ import qualified Data.Text as T import Reflex.Dom (Dynamic, Event, MonadWidget) import qualified Reflex.Dom as R -import Common.Model (Currency, Income (..), User (..), - UserId) +import Common.Model (CreateIncomeForm (..), Currency, + EditIncomeForm (..), Income (..), + User (..), UserId) import qualified Common.Model as CM import qualified Common.Msg as Msg import qualified Common.View.Format as Format @@ -21,7 +22,7 @@ import qualified Component.ConfirmDialog as ConfirmDialog import qualified Component.Table as Table import qualified Util.Ajax as Ajax import qualified Util.Either as EitherUtil -import qualified View.Income.Add as Add +import qualified View.Income.Form as Form import View.Income.Init (Init (..)) data In t = In @@ -33,6 +34,7 @@ data In t = In data Out t = Out { _out_add :: Event t Income + , _out_edit :: Event t Income , _out_delete :: Event t Income } @@ -46,8 +48,12 @@ view input = do , Table._in_perPage = 7 , Table._in_resetPage = R.never , Table._in_cloneModal = \income -> - Add.view $ Add.In - { Add._in_income = Just income + Form.view $ Form.In + { Form._in_operation = Form.Clone CreateIncomeForm income + } + , Table._in_editModal = \income -> + Form.view $ Form.In + { Form._in_operation = Form.Edit (EditIncomeForm $ _income_id income) income } , Table._in_deleteModal = \income -> ConfirmDialog.view $ ConfirmDialog.In @@ -63,6 +69,7 @@ view input = do return $ Out { _out_add = Table._out_add table + , _out_edit = Table._out_edit table , _out_delete = Table._out_delete table } |