yammat/Handler/Supplier.hs

110 lines
3.5 KiB
Haskell
Raw Normal View History

2015-10-11 18:07:12 +00:00
module Handler.Supplier where
import Import
2015-10-22 21:57:27 +00:00
import Handler.Common
2015-10-11 18:07:12 +00:00
import Data.Maybe
getSupplierR :: Handler Html
getSupplierR = do
2015-10-11 20:19:15 +00:00
sups <- runDB $ selectList [] [Asc SupplierIdent]
2015-10-11 18:07:12 +00:00
defaultLayout $
$(widgetFile "supplier")
getNewSupplierR :: Handler Html
getNewSupplierR = do
2015-10-22 21:57:27 +00:00
(newSupplierWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm newSupplierForm
2015-10-11 18:07:12 +00:00
defaultLayout $
$(widgetFile "newSupplier")
postNewSupplierR :: Handler Html
postNewSupplierR = do
2015-10-22 21:57:27 +00:00
((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm newSupplierForm
2015-10-11 18:07:12 +00:00
case res of
FormSuccess sup -> do
runDB $ insert_ sup
setMessageI MsgSupplierCreated
redirect SupplierR
_ -> do
setMessageI MsgSupplierNotCreated
redirect SupplierR
2015-10-22 21:57:27 +00:00
newSupplierForm :: AForm Handler Supplier
newSupplierForm = Supplier
<$> areq textField (bfs MsgName) Nothing
<*> areq textareaField (bfs MsgAddress) Nothing
<*> areq textField (bfs MsgTelNr) Nothing
<*> areq emailField (bfs MsgEmail) Nothing
<*> areq textField (bfs MsgCustomerId) Nothing
<*> aopt (selectField avatars) (bfs MsgSelectAvatar) Nothing
<* bootstrapSubmit (msgToBSSubmit MsgSubmit)
2015-10-11 18:07:12 +00:00
where
avatars = do
ents <- runDB $ selectList [] [Asc AvatarIdent]
optionsPairs $ map (\ent -> ((avatarIdent $ entityVal ent), entityKey ent)) ents
data SupConf = SupConf
{ supConfIdent :: Text
, supConfAddr :: Textarea
2015-10-11 18:07:12 +00:00
, supConfTel :: Text
, supConfEmail :: Text
, supConfCustomerId :: Text
, supConfAvatar :: Maybe AvatarId
}
getModifySupplierR :: SupplierId -> Handler Html
getModifySupplierR sId = do
mSup <- runDB $ get sId
case mSup of
Just sup -> do
2015-10-22 21:57:27 +00:00
(modifySupplierWidget, enctype) <- generateFormPost
$ renderBootstrap3 BootstrapBasicForm
$ modifySupplierForm sup
2015-10-11 18:07:12 +00:00
defaultLayout $
$(widgetFile "modifySupplier")
Nothing -> do
setMessageI MsgSupplierUnknown
redirect $ SupplierR
postModifySupplierR :: SupplierId -> Handler Html
postModifySupplierR sId = do
mSup <- runDB $ get sId
case mSup of
Just sup -> do
2015-10-22 21:57:27 +00:00
((res, _), _) <- runFormPost
$ renderBootstrap3 BootstrapBasicForm
$ modifySupplierForm sup
2015-10-11 18:07:12 +00:00
case res of
FormSuccess msup -> do
runDB $ update sId
2017-02-12 10:59:18 +00:00
[ SupplierIdent =. supConfIdent msup
, SupplierAddress =. supConfAddr msup
2015-10-11 18:07:12 +00:00
, SupplierTel =. supConfTel msup
, SupplierEmail =. supConfEmail msup
, SupplierCustomerId =. supConfCustomerId msup
, SupplierAvatar =. supConfAvatar msup
]
setMessageI MsgSupplierEdited
redirect SupplierR
_ -> do
setMessageI MsgSupplierNotEdited
redirect SupplierR
Nothing -> do
setMessageI MsgSupplierUnknown
redirect SupplierR
2015-10-22 21:57:27 +00:00
modifySupplierForm :: Supplier -> AForm Handler SupConf
modifySupplierForm sup = SupConf
<$> areq textField (bfs MsgName) (Just $ supplierIdent sup)
<*> areq textareaField (bfs MsgAddress) (Just $ supplierAddress sup)
<*> areq textField (bfs MsgTelNr) (Just $ supplierTel sup)
<*> areq textField (bfs MsgEmail) (Just $ supplierEmail sup)
<*> areq textField (bfs MsgCustomerId) (Just $ supplierCustomerId sup)
<*> aopt (selectField avatars) (bfs MsgSelectAvatar) (Just $ supplierAvatar sup)
<* bootstrapSubmit (msgToBSSubmit MsgSubmit)
2015-10-11 18:07:12 +00:00
where
avatars = do
ents <- runDB $ selectList [] [Asc AvatarIdent]
optionsPairs $ map (\ent -> ((avatarIdent $ entityVal ent), entityKey ent)) ents