1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
{-# LANGUAGE ExplicitForAll #-}
module View.Category.Category
( view
, In(..)
) where
import Data.Aeson (FromJSON)
import qualified Data.Maybe as Maybe
import qualified Data.Text as T
import Reflex.Dom (Dynamic, Event, MonadWidget)
import qualified Reflex.Dom as R
import Common.Model (Category, CategoryPage (..), Currency,
User, UserId)
import qualified Common.Msg as Msg
import qualified Component.Button as Button
import qualified Component.Modal as Modal
import qualified Component.Pages as Pages
import Loadable (Loadable (..))
import qualified Loadable
import qualified Util.Ajax as AjaxUtil
import qualified Util.Reflex as ReflexUtil
import qualified Util.Reflex as ReflexUtil
import qualified View.Category.Form as Form
import qualified View.Category.Reducer as Reducer
import qualified View.Category.Table as Table
data In t = In
{ _in_users :: [User]
, _in_currentUser :: UserId
, _in_currency :: Currency
}
view :: forall t m. MonadWidget t m => In t -> m ()
view input = do
rec
categoryPage <- Reducer.reducer $ Reducer.In
{ Reducer._in_page = page
, Reducer._in_addCategory = R.leftmost [ headerAddCategory, tableAddCategory ]
, Reducer._in_editCategory = editCategory
, Reducer._in_deleteCategory = deleteCategory
}
let eventFromResult :: forall a. ((Event t (), Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a)
eventFromResult op = ReflexUtil.flatten $ (Maybe.fromMaybe R.never . fmap op) <$> result
page <- eventFromResult $ Pages._out_newPage . (\(_, _, c) -> c)
headerAddCategory <- eventFromResult $ (\(a, _, _) -> a)
tableAddCategory <- eventFromResult $ Table._out_add . (\(_, b, _) -> b)
editCategory <- eventFromResult $ Table._out_edit . (\(_, b, _) -> b)
deleteCategory <- eventFromResult $ Table._out_delete . (\(_, b, _) -> b)
result <- Loadable.viewShowValueWhileLoading categoryPage $
\(CategoryPage page categories usedCategories count) -> do
header <- headerView
table <- Table.view $ Table.In
{ Table._in_currentUser = _in_currentUser input
, Table._in_currency = _in_currency input
, Table._in_categories = categories
, Table._in_usedCategories = usedCategories
, Table._in_users = _in_users input
}
pages <- Pages.view $ Pages.In
{ Pages._in_total = R.constDyn count
, Pages._in_perPage = Reducer.perPage
, Pages._in_page = page
}
return (header, table, pages)
return ()
headerView :: forall t m. MonadWidget t m => m (Event t ())
headerView =
R.divClass "withMargin" $
R.divClass "titleButton" $ do
R.el "h1" $
R.text $
Msg.get Msg.Category_Title
addCategory <- Button._out_clic <$>
(Button.view . Button.defaultIn . R.text $
Msg.get Msg.Category_Add)
addCategory <- Modal.view $ Modal.In
{ Modal._in_show = addCategory
, Modal._in_content = Form.view $ Form.In { Form._in_operation = Form.New }
}
return addCategory
|
