yammat/Handler/NewUser.hs

95 lines
2.5 KiB
Haskell
Raw Normal View History

2015-04-04 04:46:33 +00:00
module Handler.NewUser where
2015-04-07 20:03:21 +00:00
import Import as I
import Handler.Common
2015-04-04 04:46:33 +00:00
import Text.Read
import Text.Shakespeare.Text
2015-04-04 04:46:33 +00:00
getNewUserR :: Handler Html
getNewUserR = do
time <- liftIO getCurrentTime
secs <- return $ read $ formatTime defaultTimeLocale "%s" time
(newUserWidget, enctype) <- generateFormPost $ newUserForm secs
defaultLayout $ do
$(widgetFile "newUser")
postNewUserR :: Handler Html
postNewUserR = do
time <- liftIO getCurrentTime
secs <- return $ read $ formatTime defaultTimeLocale "%s" time
((res, _), _) <- runFormPost $ newUserForm secs
case res of
FormSuccess user -> do
_ <- runDB $ insert user
2015-04-09 22:40:58 +00:00
setMessageI MsgUserCreated
2015-04-04 04:46:33 +00:00
redirect $ HomeR
_ -> do
2015-04-09 22:40:58 +00:00
setMessageI MsgUserNotCreated
2015-04-04 04:46:33 +00:00
redirect $ NewUserR
newUserForm :: Int -> Form User
newUserForm secs = renderDivs $ User
2015-04-09 22:40:58 +00:00
<$> areq textField (fieldSettingsLabel MsgName) Nothing
2015-04-04 04:46:33 +00:00
<*> pure 0
<*> pure secs
<*> aopt emailField (fieldSettingsLabel MsgEmailNotify) Nothing
2015-04-07 20:03:21 +00:00
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
2015-04-09 22:40:58 +00:00
setMessageI MsgUserUnknown
2015-04-07 20:03:21 +00:00
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 email -> do
2015-04-07 20:03:21 +00:00
runDB $ update uId
[ UserEmail =. email
2015-04-07 20:03:21 +00:00
]
liftIO $ notify user email
2015-04-09 22:40:58 +00:00
setMessageI MsgUserEdited
2015-04-07 20:03:21 +00:00
redirect $ SelectR uId
_ -> do
2015-04-09 22:40:58 +00:00
setMessageI MsgUserNotEdited
2015-04-07 20:03:21 +00:00
redirect $ SelectR uId
Nothing -> do
2015-04-09 22:40:58 +00:00
setMessageI MsgUserUnknown
2015-04-07 20:03:21 +00:00
redirect $ HomeR
modifyUserForm :: User -> Form (Maybe Text)
modifyUserForm user = renderDivs $
aopt emailField (fieldSettingsLabel MsgEmailNotify) (Just $ userEmail user)
notify :: User -> Maybe Text -> IO ()
notify user email
| (userEmail user) == email = return ()
2015-04-09 21:18:47 +00:00
| otherwise = case userEmail user of
Just address -> sendMail address "Profiländerung"
2015-04-09 21:18:47 +00:00
[stext|
Hallo #{userIdent user},
deine Profileinstellungen wurden geändert.
Nur damit du Bescheid weißt.
Grüße,
der Matemat
2015-04-09 21:18:47 +00:00
|]
Nothing -> return ()