aboutsummaryrefslogtreecommitdiff
path: root/client/src/View
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/View')
-rw-r--r--client/src/View/App.hs43
-rw-r--r--client/src/View/Category/Category.hs92
-rw-r--r--client/src/View/Category/Form.hs117
-rw-r--r--client/src/View/Category/Reducer.hs59
-rw-r--r--client/src/View/Category/Table.hs91
-rw-r--r--client/src/View/Header.hs5
-rw-r--r--client/src/View/Income/Form.hs2
-rw-r--r--client/src/View/Income/Header.hs3
-rw-r--r--client/src/View/Income/Income.hs1
-rw-r--r--client/src/View/Income/Init.hs11
-rw-r--r--client/src/View/Income/Table.hs11
-rw-r--r--client/src/View/Payment/Form.hs2
-rw-r--r--client/src/View/Payment/HeaderForm.hs2
-rw-r--r--client/src/View/Payment/Payment.hs2
-rw-r--r--client/src/View/Payment/Table.hs30
-rw-r--r--client/src/View/SignIn.hs2
16 files changed, 413 insertions, 60 deletions
diff --git a/client/src/View/App.hs b/client/src/View/App.hs
index 2b346af..460d499 100644
--- a/client/src/View/App.hs
+++ b/client/src/View/App.hs
@@ -2,22 +2,23 @@ module View.App
( widget
) where
-import qualified Data.Text as T
-import Prelude hiding (error, init)
-import Reflex.Dom (Dynamic, MonadWidget)
-import qualified Reflex.Dom as R
-
-import Common.Model (Currency, Init (..), InitResult (..),
- UserId)
-import qualified Common.Msg as Msg
-
-import Model.Route (Route (..))
-import qualified Util.Router as Router
-import qualified View.Header as Header
-import qualified View.Income.Income as Income
-import qualified View.NotFound as NotFound
-import qualified View.Payment.Payment as Payment
-import qualified View.SignIn as SignIn
+import qualified Data.Text as T
+import Prelude hiding (error, init)
+import Reflex.Dom (Dynamic, MonadWidget)
+import qualified Reflex.Dom as R
+
+import Common.Model (Currency, Init (..), InitResult (..),
+ UserId)
+import qualified Common.Msg as Msg
+
+import Model.Route (Route (..))
+import qualified Util.Router as Router
+import qualified View.Category.Category as Category
+import qualified View.Header as Header
+import qualified View.Income.Income as Income
+import qualified View.NotFound as NotFound
+import qualified View.Payment.Payment as Payment
+import qualified View.SignIn as SignIn
widget :: InitResult -> IO ()
widget initResult =
@@ -72,6 +73,13 @@ signedWidget init route = do
, Income._in_users = _init_users init
}
+ CategoryRoute ->
+ Category.view $ Category.In
+ { Category._in_currentUser = _init_currentUser init
+ , Category._in_currency = _init_currency init
+ , Category._in_users = _init_users init
+ }
+
NotFoundRoute ->
NotFound.view
@@ -87,5 +95,8 @@ getRoute = do
["income"] ->
IncomeRoute
+ ["category"] ->
+ CategoryRoute
+
_ ->
NotFoundRoute
diff --git a/client/src/View/Category/Category.hs b/client/src/View/Category/Category.hs
new file mode 100644
index 0000000..77a331a
--- /dev/null
+++ b/client/src/View/Category/Category.hs
@@ -0,0 +1,92 @@
+{-# 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 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_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 "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
diff --git a/client/src/View/Category/Form.hs b/client/src/View/Category/Form.hs
new file mode 100644
index 0000000..d91fc2e
--- /dev/null
+++ b/client/src/View/Category/Form.hs
@@ -0,0 +1,117 @@
+module View.Category.Form
+ ( view
+ , In(..)
+ , Operation(..)
+ ) where
+
+import Control.Monad.IO.Class (liftIO)
+import Data.Aeson (Value)
+import qualified Data.Aeson as Aeson
+import qualified Data.Maybe as Maybe
+import Data.Text (Text)
+import qualified Data.Text as T
+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 (Category (..),
+ CreateCategoryForm (..),
+ EditCategoryForm (..))
+import qualified Common.Msg as Msg
+import qualified Common.Util.Time as TimeUtil
+import qualified Common.Validation.Category as CategoryValidation
+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 = In
+ { _in_operation :: Operation
+ }
+
+data Operation
+ = New
+ | Clone Category
+ | Edit Category
+
+view :: forall t m a. MonadWidget t m => In -> Modal.Content t m
+view input cancel = do
+
+ rec
+ let reset = R.leftmost
+ [ "" <$ ModalForm._out_cancel modalForm
+ , "" <$ ModalForm._out_validate modalForm
+ , "" <$ cancel
+ ]
+
+ modalForm <- ModalForm.view $ ModalForm.In
+ { ModalForm._in_headerLabel = headerLabel
+ , ModalForm._in_ajax = ajax "/api/category"
+ , ModalForm._in_form = form reset (ModalForm._out_confirm modalForm)
+ }
+
+ return (ModalForm._out_hide modalForm, ModalForm._out_validate modalForm)
+
+ where
+
+ form
+ :: Event t String
+ -> Event t ()
+ -> m (Dynamic t (Validation Text Value))
+ form reset confirm = do
+ name <- Input._out_raw <$> (Input.view
+ (Input.defaultIn
+ { Input._in_label = Msg.get Msg.Category_Name
+ , Input._in_initialValue = name
+ , Input._in_validation = CategoryValidation.name
+ })
+ (name <$ reset)
+ confirm)
+
+ color <- Input._out_raw <$> (Input.view
+ (Input.defaultIn
+ { Input._in_label = Msg.get Msg.Category_Color
+ , Input._in_initialValue = color
+ , Input._in_inputType = "color"
+ , Input._in_hasResetButton = False
+ , Input._in_validation = CategoryValidation.color
+ })
+ (color <$ reset)
+ confirm)
+
+ return $ do
+ n <- name
+ c <- color
+ return . V.Success $ mkPayload n c
+
+ op = _in_operation input
+
+ name =
+ case op of
+ New -> ""
+ Clone c -> _category_name c
+ Edit c -> _category_name c
+
+ color =
+ case op of
+ New -> ""
+ Clone c -> _category_color c
+ Edit c -> _category_color c
+
+ ajax =
+ case op of
+ Edit _ -> Ajax.put
+ _ -> Ajax.post
+
+ headerLabel =
+ case op of
+ Edit _ -> Msg.get Msg.Category_Edit
+ _ -> Msg.get Msg.Category_Add
+
+ mkPayload =
+ case op of
+ Edit i -> \a b -> Aeson.toJSON $ EditCategoryForm (_category_id i) a b
+ _ -> \a b -> Aeson.toJSON $ CreateCategoryForm a b
diff --git a/client/src/View/Category/Reducer.hs b/client/src/View/Category/Reducer.hs
new file mode 100644
index 0000000..5ad0ddb
--- /dev/null
+++ b/client/src/View/Category/Reducer.hs
@@ -0,0 +1,59 @@
+module View.Category.Reducer
+ ( perPage
+ , reducer
+ , In(..)
+ ) 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 (CategoryPage)
+
+import Loadable (Loadable (..))
+import qualified Loadable as Loadable
+import qualified Util.Ajax as AjaxUtil
+import qualified Util.Either as EitherUtil
+
+perPage :: Int
+perPage = 7
+
+data In t a b c = In
+ { _in_page :: Event t Int
+ , _in_addCategory :: Event t a
+ , _in_editCategory :: Event t b
+ , _in_deleteCategory :: Event t c
+ }
+
+reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable CategoryPage))
+reducer input = do
+
+ postBuild <- R.getPostBuild
+
+ currentPage <- R.holdDyn 1 (_in_page input)
+
+ let loadPage =
+ R.leftmost
+ [ 1 <$ postBuild
+ , _in_page input
+ , 1 <$ _in_addCategory input
+ , R.tag (R.current currentPage) (_in_editCategory input)
+ , R.tag (R.current currentPage) (_in_deleteCategory input)
+ ]
+
+ getResult <- AjaxUtil.get $ fmap pageUrl loadPage
+
+ R.holdDyn
+ Loading
+ (R.leftmost
+ [ Loading <$ loadPage
+ , Loadable.fromEither <$> getResult
+ ])
+
+ where
+ pageUrl p =
+ "api/categories?page="
+ <> (T.pack . show $ p)
+ <> "&perPage="
+ <> (T.pack . show $ perPage)
diff --git a/client/src/View/Category/Table.hs b/client/src/View/Category/Table.hs
new file mode 100644
index 0000000..fbe76e9
--- /dev/null
+++ b/client/src/View/Category/Table.hs
@@ -0,0 +1,91 @@
+module View.Category.Table
+ ( view
+ , In(..)
+ , Out(..)
+ ) where
+
+import qualified Data.Maybe as Maybe
+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 (Category (..), Currency, User (..),
+ UserId)
+import qualified Common.Model as CM
+import qualified Common.Msg as Msg
+import qualified Common.View.Format as Format
+
+import qualified Component.ConfirmDialog as ConfirmDialog
+import qualified Component.Table as Table
+import qualified Component.Tag as Tag
+import qualified Util.Ajax as Ajax
+import qualified Util.Either as EitherUtil
+import qualified View.Category.Form as Form
+
+data In t = In
+ { _in_currentUser :: UserId
+ , _in_currency :: Currency
+ , _in_categories :: [Category]
+ , _in_users :: [User]
+ }
+
+data Out t = Out
+ { _out_add :: Event t ()
+ , _out_edit :: Event t ()
+ , _out_delete :: Event t ()
+ }
+
+view :: forall t m. MonadWidget t m => In t -> m (Out t)
+view input = do
+
+ table <- Table.view $ Table.In
+ { Table._in_headerLabel = headerLabel
+ , Table._in_rows = _in_categories input
+ , Table._in_cell = cell (_in_users input) (_in_currency input)
+ , Table._in_cloneModal = \category ->
+ Form.view $ Form.In
+ { Form._in_operation = Form.Clone category
+ }
+ , Table._in_editModal = \category ->
+ Form.view $ Form.In
+ { Form._in_operation = Form.Edit category
+ }
+ , Table._in_deleteModal = \category ->
+ ConfirmDialog.view $ ConfirmDialog.In
+ { ConfirmDialog._in_header = Msg.get Msg.Category_DeleteConfirm
+ , ConfirmDialog._in_confirm = \e -> do
+ res <- Ajax.delete
+ (R.constDyn $ T.concat ["/api/category/", T.pack . show $ _category_id category])
+ e
+ return $ () <$ R.fmapMaybe EitherUtil.eitherToMaybe res
+ }
+ , Table._in_isOwner = const True
+ }
+
+ return $ Out
+ { _out_add = Table._out_add table
+ , _out_edit = Table._out_edit table
+ , _out_delete = Table._out_delete table
+ }
+
+data Header
+ = NameHeader
+ | ColorHeader
+ deriving (Eq, Show, Bounded, Enum)
+
+headerLabel :: Header -> Text
+headerLabel NameHeader = Msg.get Msg.Category_Name
+headerLabel ColorHeader = Msg.get Msg.Category_Color
+
+cell :: forall t m. MonadWidget t m => [User] -> Currency -> Header -> Category -> m ()
+cell users currency header category =
+ case header of
+ NameHeader ->
+ R.text $ _category_name category
+
+ ColorHeader ->
+ Tag.view $ Tag.In
+ { Tag._in_text = _category_name category
+ , Tag._in_color = _category_color category
+ }
diff --git a/client/src/View/Header.hs b/client/src/View/Header.hs
index 3f58dd5..5910f52 100644
--- a/client/src/View/Header.hs
+++ b/client/src/View/Header.hs
@@ -63,6 +63,11 @@ links route = do
(R.ffor route (attrs IncomeRoute))
(Msg.get Msg.Income_Title)
+ Link.view
+ "/category"
+ (R.ffor route (attrs CategoryRoute))
+ (Msg.get Msg.Category_Title)
+
where
attrs linkRoute currentRoute =
M.singleton "class" $
diff --git a/client/src/View/Income/Form.hs b/client/src/View/Income/Form.hs
index ff6e55e..59f6a0d 100644
--- a/client/src/View/Income/Form.hs
+++ b/client/src/View/Income/Form.hs
@@ -36,7 +36,7 @@ data Operation
| Clone Income
| Edit Income
-view :: forall t m a. MonadWidget t m => In -> Modal.Content t m Income
+view :: forall t m a. MonadWidget t m => In -> Modal.Content t m
view input cancel = do
rec
diff --git a/client/src/View/Income/Header.hs b/client/src/View/Income/Header.hs
index 9e1c5b6..a26e16a 100644
--- a/client/src/View/Income/Header.hs
+++ b/client/src/View/Income/Header.hs
@@ -21,7 +21,6 @@ import qualified Common.View.Format as Format
import qualified Component.Button as Button
import qualified Component.Modal as Modal
import qualified View.Income.Form as Form
-import View.Income.Init (Init (..))
data In t = In
{ _in_users :: [User]
@@ -30,7 +29,7 @@ data In t = In
}
data Out t = Out
- { _out_add :: Event t Income
+ { _out_add :: Event t ()
}
view :: forall t m. MonadWidget t m => In t -> m (Out t)
diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs
index e83ba80..7be8091 100644
--- a/client/src/View/Income/Income.hs
+++ b/client/src/View/Income/Income.hs
@@ -21,7 +21,6 @@ import qualified Util.Ajax as AjaxUtil
import qualified Util.Reflex as ReflexUtil
import qualified Util.Reflex as ReflexUtil
import qualified View.Income.Header as Header
-import View.Income.Init (Init (..))
import qualified View.Income.Reducer as Reducer
import qualified View.Income.Table as Table
diff --git a/client/src/View/Income/Init.hs b/client/src/View/Income/Init.hs
deleted file mode 100644
index 4f3ef99..0000000
--- a/client/src/View/Income/Init.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-module View.Income.Init
- ( Init(..)
- ) where
-
-import Common.Model (Income, Payment, User)
-
-data Init = Init
- { _init_users :: [User]
- , _init_incomes :: [Income]
- , _init_payments :: [Payment]
- } deriving (Show)
diff --git a/client/src/View/Income/Table.hs b/client/src/View/Income/Table.hs
index c623acb..c7f172b 100644
--- a/client/src/View/Income/Table.hs
+++ b/client/src/View/Income/Table.hs
@@ -4,7 +4,6 @@ module View.Income.Table
, Out(..)
) where
-import qualified Data.List as L
import qualified Data.Maybe as Maybe
import Data.Text (Text)
import qualified Data.Text as T
@@ -31,9 +30,9 @@ data In t = In
}
data Out t = Out
- { _out_add :: Event t Income
- , _out_edit :: Event t Income
- , _out_delete :: Event t Income
+ { _out_add :: Event t ()
+ , _out_edit :: Event t ()
+ , _out_delete :: Event t ()
}
view :: forall t m. MonadWidget t m => In t -> m (Out t)
@@ -41,7 +40,7 @@ view input = do
table <- Table.view $ Table.In
{ Table._in_headerLabel = headerLabel
- , Table._in_rows = reverse . L.sortOn _income_date $ _in_incomes input
+ , Table._in_rows = _in_incomes input
, Table._in_cell = cell (_in_users input) (_in_currency input)
, Table._in_cloneModal = \income ->
Form.view $ Form.In
@@ -58,7 +57,7 @@ view input = do
res <- Ajax.delete
(R.constDyn $ T.concat ["/api/income/", T.pack . show $ _income_id income])
e
- return $ income <$ R.fmapMaybe EitherUtil.eitherToMaybe res
+ return $ () <$ R.fmapMaybe EitherUtil.eitherToMaybe res
}
, Table._in_isOwner = (== (_in_currentUser input)) . _income_userId
}
diff --git a/client/src/View/Payment/Form.hs b/client/src/View/Payment/Form.hs
index 064b5b3..6c31fad 100644
--- a/client/src/View/Payment/Form.hs
+++ b/client/src/View/Payment/Form.hs
@@ -51,7 +51,7 @@ data Operation t
| Clone Payment
| Edit Payment
-view :: forall t m a. MonadWidget t m => In t -> Modal.Content t m Payment
+view :: forall t m a. MonadWidget t m => In t -> Modal.Content t m
view input cancel = do
rec
let reset = R.leftmost
diff --git a/client/src/View/Payment/HeaderForm.hs b/client/src/View/Payment/HeaderForm.hs
index 0ee0cd3..1915841 100644
--- a/client/src/View/Payment/HeaderForm.hs
+++ b/client/src/View/Payment/HeaderForm.hs
@@ -29,7 +29,7 @@ data In t = In
data Out t = Out
{ _out_search :: Event t Text
, _out_frequency :: Event t Frequency
- , _out_addPayment :: Event t Payment
+ , _out_addPayment :: Event t ()
}
view :: forall t m. MonadWidget t m => In t -> m (Out t)
diff --git a/client/src/View/Payment/Payment.hs b/client/src/View/Payment/Payment.hs
index 8d0fee1..26444d7 100644
--- a/client/src/View/Payment/Payment.hs
+++ b/client/src/View/Payment/Payment.hs
@@ -36,7 +36,7 @@ data In t = In
view :: forall t m. MonadWidget t m => In t -> m ()
view input = do
- categories <- AjaxUtil.getNow "api/categories"
+ categories <- AjaxUtil.getNow "api/allCategories"
R.dyn . R.ffor categories . Loadable.viewHideValueWhileLoading $ \categories -> do
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index f9215bc..6744d3a 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -21,6 +21,7 @@ import qualified Common.View.Format as Format
import qualified Component.ConfirmDialog as ConfirmDialog
import qualified Component.Table as Table
+import qualified Component.Tag as Tag
import qualified Util.Ajax as Ajax
import qualified Util.Either as EitherUtil
import qualified View.Payment.Form as Form
@@ -35,9 +36,9 @@ data In t = In
}
data Out t = Out
- { _out_add :: Event t Payment
- , _out_edit :: Event t Payment
- , _out_delete :: Event t Payment
+ { _out_add :: Event t ()
+ , _out_edit :: Event t ()
+ , _out_delete :: Event t ()
}
view :: forall t m. MonadWidget t m => In t -> m (Out t)
@@ -45,7 +46,7 @@ view input = do
table <- Table.view $ Table.In
{ Table._in_headerLabel = headerLabel (_in_frequency input)
- , Table._in_rows = reverse . L.sortOn _payment_date $ _in_payments input
+ , Table._in_rows = _in_payments input
, Table._in_cell =
cell
(_in_users input)
@@ -71,7 +72,7 @@ view input = do
res <- Ajax.delete
(R.constDyn $ T.concat ["/api/payment/", T.pack . show $ _payment_id payment])
e
- return $ payment <$ R.fmapMaybe EitherUtil.eitherToMaybe res
+ return $ () <$ R.fmapMaybe EitherUtil.eitherToMaybe res
}
, Table._in_isOwner = (== (_in_currentUser input)) . _payment_user
}
@@ -122,21 +123,12 @@ cell users categories frequency currency header payment =
let
category =
L.find ((== (_payment_category payment)) . _category_id) categories
-
- attrs =
- case category of
- Just c ->
- M.fromList
- [ ("class", "tag")
- , ("style", T.concat [ "background-color: ", _category_color c ])
- ]
-
- Nothing ->
- M.singleton "display" "none"
in
- R.elAttr "span" attrs $
- R.text $
- Maybe.fromMaybe "" (_category_name <$> category)
+ Maybe.fromMaybe R.blank . flip fmap category $ \c ->
+ Tag.view $ Tag.In
+ { Tag._in_text = _category_name c
+ , Tag._in_color = _category_color c
+ }
DateHeader ->
if frequency == Punctual then
diff --git a/client/src/View/SignIn.hs b/client/src/View/SignIn.hs
index a589fc3..0a3b576 100644
--- a/client/src/View/SignIn.hs
+++ b/client/src/View/SignIn.hs
@@ -50,7 +50,7 @@ view signInMessage =
let form = SignInForm <$> Input._out_raw input
(signInResult, waiting) <- WaitFor.waitFor
- (Ajax.post "/api/askSignIn")
+ (Ajax.postAndParseResult "/api/askSignIn")
(ValidationUtil.fireMaybe
((\f -> f <$ SignInValidation.signIn f) <$> form)
validate)