nek0/yammat
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

reduced data overhead with notifications

Browse source
This commit is contained in:
nek0 2015-04-10 17:00:19 +02:00
parent 9642e5a745
commit 1d19538a83
3 changed files with 17 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
Handler/Buy.hs
View file

@ -55,12 +55,10 @@ postBuyR uId bId = do
notifyUser :: User -> Beverage -> Int -> App -> IO () notifyUser :: User -> Beverage -> Int -> App -> IO ()
notifyUser user bev price master = do notifyUser user bev price master = do
case userNotify user of case userEmail user of
True -> Just email ->
case userEmail user of liftIO $ sendMail email "Einkauf beim Matematen"
Just email -> [stext|
liftIO $ sendMail email "Einkauf beim Matematen"
[stext|
Hallo #{userIdent user}, Hallo #{userIdent user},
Du hast gerade beim Matematen für #{formatIntCurrency price}#{appCurrency $ appSettings master} #{beverageIdent bev} eingekauft. Du hast gerade beim Matematen für #{formatIntCurrency price}#{appCurrency $ appSettings master} #{beverageIdent bev} eingekauft.
@ -68,10 +66,8 @@ Du hast gerade beim Matematen für #{formatIntCurrency price}#{appCurrency $ app
Viele Grüsse, Viele Grüsse,
Der Matemat Der Matemat
|] |]
Nothing -> Nothing ->
return ()
False ->
return () return ()
getBuyCashR :: BeverageId -> Handler Html getBuyCashR :: BeverageId -> Handler Html

25
Handler/NewUser.hs
View file

@ -32,8 +32,7 @@ newUserForm secs = renderDivs $ User
<$> areq textField "Nickname" Nothing <$> areq textField "Nickname" Nothing
<*> pure 0 <*> pure 0
<*> pure secs <*> pure secs
<*> aopt emailField "E-mail" Nothing <*> aopt emailField "E-mail eintragen, falls Benachrichtigungen erwünscht" Nothing
<*> areq boolField "Benachrichtigung bei Kauf" (Just False)
data UserConf = UserConf data UserConf = UserConf
{ userConfEmail :: Maybe Text { userConfEmail :: Maybe Text
@ -59,12 +58,11 @@ postModifyUserR uId = do
Just user -> do Just user -> do
((res, _), _) <- runFormPost $ modifyUserForm user ((res, _), _) <- runFormPost $ modifyUserForm user
case res of case res of
FormSuccess conf -> do FormSuccess email -> do
runDB $ update uId runDB $ update uId
[ UserEmail =. userConfEmail conf [ UserEmail =. email
, UserNotify =. userConfNotify conf
] ]
liftIO $ notify user conf liftIO $ notify user email
setMessage "Nutzerdaten aktualisiert" setMessage "Nutzerdaten aktualisiert"
redirect $ SelectR uId redirect $ SelectR uId
_ -> do _ -> do
@ -74,16 +72,15 @@ postModifyUserR uId = do
setMessage "Nutzer unbekannt" setMessage "Nutzer unbekannt"
redirect $ HomeR redirect $ HomeR
modifyUserForm :: User -> Form UserConf modifyUserForm :: User -> Form (Maybe Text)
modifyUserForm user = renderDivs $ UserConf modifyUserForm user = renderDivs $
<$> aopt emailField "E-Mail" (Just $ userEmail user) aopt emailField "E-Mail eintragen, falls Benchrichtigungen erwünscht" (Just $ userEmail user)
<*> areq boolField "Benachrichtigung bei Kauf" (Just $ userNotify user)
notify :: User -> UserConf -> IO () notify :: User -> Maybe Text -> IO ()
notify user conf notify user email
| (userEmail user) == (userConfEmail conf) && (userNotify user) == (userConfNotify conf) = return () | (userEmail user) == email = return ()
| otherwise = case userEmail user of | otherwise = case userEmail user of
Just email -> sendMail email "Profiländerung" Just address -> sendMail address "Profiländerung"
[stext| [stext|
Hallo #{userIdent user}, Hallo #{userIdent user},

1
config/models
View file

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