yammat/Handler/Supplier.hs

99 lines
3.3 KiB
Haskell
Executable file

module Handler.Supplier where
import Import
import Data.Maybe
getSupplierR :: Handler Html
getSupplierR = do
sups <- runDB $ selectList [] [Desc SupplierIdent]
defaultLayout $
$(widgetFile "supplier")
getNewSupplierR :: Handler Html
getNewSupplierR = do
(newSupplierWidget, enctype) <- generateFormPost newSupplierForm
defaultLayout $
$(widgetFile "newSupplier")
postNewSupplierR :: Handler Html
postNewSupplierR = do
((res, _), _) <- runFormPost newSupplierForm
case res of
FormSuccess sup -> do
runDB $ insert_ sup
setMessageI MsgSupplierCreated
redirect SupplierR
_ -> do
setMessageI MsgSupplierNotCreated
redirect SupplierR
newSupplierForm :: Form Supplier
newSupplierForm = renderDivs $ Supplier
<$> areq textField (fieldSettingsLabel MsgName) Nothing
<*> areq textareaField (fieldSettingsLabel MsgAddress) Nothing
<*> areq textField (fieldSettingsLabel MsgTelNr) Nothing
<*> areq emailField (fieldSettingsLabel MsgEmail) Nothing
<*> areq textField (fieldSettingsLabel MsgCustomerId) Nothing
<*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) Nothing
where
avatars = do
ents <- runDB $ selectList [] [Asc AvatarIdent]
optionsPairs $ map (\ent -> ((avatarIdent $ entityVal ent), entityKey ent)) ents
data SupConf = SupConf
{ supConfIdent :: Text
, supConfAddr :: Textarea
, 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
(modifySupplierWidget, enctype) <- generateFormPost $ modifySupplierForm sup
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
((res, _), _) <- runFormPost $ modifySupplierForm sup
case res of
FormSuccess msup -> do
runDB $ update sId
[ SupplierAddress =. supConfAddr msup
, 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
modifySupplierForm :: Supplier -> Form SupConf
modifySupplierForm sup = renderDivs $ SupConf
<$> areq textField (fieldSettingsLabel MsgName) (Just $ supplierIdent sup)
<*> areq textareaField (fieldSettingsLabel MsgAddress) (Just $ supplierAddress sup)
<*> areq textField (fieldSettingsLabel MsgTelNr) (Just $ supplierTel sup)
<*> areq textField (fieldSettingsLabel MsgEmail) (Just $ supplierEmail sup)
<*> areq textField (fieldSettingsLabel MsgCustomerId) (Just $ supplierCustomerId sup)
<*> aopt (selectField avatars) (fieldSettingsLabel MsgSelectAvatar) (Just $ supplierAvatar sup)
where
avatars = do
ents <- runDB $ selectList [] [Asc AvatarIdent]
optionsPairs $ map (\ent -> ((avatarIdent $ entityVal ent), entityKey ent)) ents