now user notification on buy

This commit is contained in:
nek0 2015-04-07 22:03:21 +02:00
parent 64881460b5
commit 1f3e59e643
7 changed files with 83 additions and 8 deletions

View File

@ -4,6 +4,7 @@ import Import
import Handler.Common
import qualified Data.Text as T
import Text.Blaze.Internal
import Text.Shakespeare.Text
getBuyR :: UserId -> BeverageId -> Handler Html
getBuyR uId bId = do
@ -33,6 +34,8 @@ postBuyR uId bId = do
runDB $ update uId [UserBalance -=. price]
runDB $ update bId [BeverageAmount -=. quant]
checkAlert bId
master <- getYesod
liftIO $ notifyUser user bev price master
case sw of
False -> do
setMessage "Viel Vergnügen"
@ -50,6 +53,27 @@ postBuyR uId bId = do
setMessage "Benutzer oder Artikel unbekannt"
redirect $ HomeR
notifyUser :: User -> Beverage -> Int -> App -> IO ()
notifyUser user bev price master = do
case userNotify user of
True ->
case userEmail user of
Just email ->
sendMail email "Einkauf beim Matematen"
[stext|
Hallo #{userIdent user},
Du hast gerade beim Matematen für #{formatIntCurrency price}#{appCurrency $ appSettings master} #{beverageIdent bev} eingekauft.
Viele Grüsse,
Der Matemat
|]
Nothing ->
return ()
False ->
return ()
getBuyCashR :: BeverageId -> Handler Html
getBuyCashR bId = do
mBev <- runDB $ get bId

View File

@ -82,14 +82,14 @@ checkAlert bId = do
to <- return $ appEmail $ appSettings master
sendMail to "Niedriger Bestand"
[stext|
Hallo,
Hallo,
Der Bestand an #{beverageIdent bev} ist unterhalb der Warnschwelle von #{beverageAlertAmount bev}.
Der momentane Bestand ist bei #{beverageAmount bev} Artikeln.
Der Bestand an #{beverageIdent bev} ist unterhalb der Warnschwelle von #{beverageAlertAmount bev}.
Der momentane Bestand ist bei #{beverageAmount bev} Artikeln.
Viele Grüße,
Viele Grüße,
der Matemat
der Matemat
|]
False -> return () -- do nothing

View File

@ -1,6 +1,6 @@
module Handler.NewUser where
import Import
import Import as I
import Text.Read
getNewUserR :: Handler Html
@ -30,3 +30,48 @@ newUserForm secs = renderDivs $ User
<$> areq textField "Nickname" Nothing
<*> pure 0
<*> pure secs
<*> aopt emailField "E-mail" Nothing
<*> areq boolField "Benachrichtigung bei Kauf" (Just False)
data UserConf = UserConf
{ userConfEmail :: Maybe Text
, userConfNotify :: Bool
}
getModifyUserR :: UserId -> Handler Html
getModifyUserR uId = do
mUser <- runDB $ I.get uId
case mUser of
Just user -> do
(modifyUserWidget, enctype) <- generateFormPost $ modifyUserForm user
defaultLayout $ do
$(widgetFile "modifyUser")
Nothing -> do
setMessage "Benutzer unbekannt"
redirect $ HomeR
postModifyUserR :: UserId -> Handler Html
postModifyUserR uId = do
mUser <- runDB $ I.get uId
case mUser of
Just user -> do
((res, _), _) <- runFormPost $ modifyUserForm user
case res of
FormSuccess conf -> do
runDB $ update uId
[ UserEmail =. userConfEmail conf
, UserNotify =. userConfNotify conf
]
setMessage "Nutzerdaten aktualisiert"
redirect $ SelectR uId
_ -> do
setMessage "Nutzerdatenaktualisierung nicht erfolgreich"
redirect $ SelectR uId
Nothing -> do
setMessage "Nutzer unbekannt"
redirect $ HomeR
modifyUserForm :: User -> Form UserConf
modifyUserForm user = renderDivs $ UserConf
<$> aopt emailField "E-Mail" (Just $ userEmail user)
<*> areq boolField "Benachrichtigung bei Kauf" (Just $ userNotify user)

View File

@ -2,6 +2,8 @@ User
ident Text
balance Int
timestamp Int
email Text Maybe
notify Bool default=False
UniqueUser ident
deriving Typeable Show
Beverage

View File

@ -9,6 +9,7 @@
/user/#UserId SelectR GET
!/user/cash SelectCashR GET
/user/#UserId/recharge RechargeR GET POST
/user/#UserId/modify ModifyUserR GET POST
/newuser NewUserR GET POST
/restock RestockR GET
/upstock/#BeverageId UpstockR GET POST

View File

@ -7,5 +7,5 @@ $doctype 5
<div>
<input type=submit value="Absenden">
<p>
<a href=@{DeleteBeverageR bId}>Artikel löschen
<a href=@{ModifyR bId}>
Artikel löschen

View File

@ -7,6 +7,9 @@ $doctype 5
<li>
<a href=@{RechargeR uId}>
Guthaben aufladen
<li>
<a href=@{ModifyUserR uId}>
Nutzerdaten akutalisieren
<h3>Wähle deinen Artikel, #{userIdent user}