mirror of
https://github.com/commercialhaskell/stackage-server.git
synced 2026-01-12 04:08:29 +01:00
44 lines
1.2 KiB
Haskell
44 lines
1.2 KiB
Haskell
module Handler.Profile where
|
|
|
|
import Import
|
|
import Data.Slug (slugField)
|
|
|
|
userForm :: User -> Form User
|
|
userForm user = renderBootstrap2 $ User
|
|
<$> areq slugField "User handle"
|
|
{ fsTooltip = Just "Used for URLs"
|
|
} (Just $ userHandle user)
|
|
<*> areq textField "Display name" (Just $ userDisplay user)
|
|
<*> pure (userToken user)
|
|
|
|
getProfileR :: Handler Html
|
|
getProfileR = do
|
|
Entity uid user <- requireAuth
|
|
((result, userWidget), enctype) <- runFormPost $ userForm user
|
|
case result of
|
|
FormSuccess user' -> do
|
|
runDB $ replace uid user'
|
|
setMessage "Profile updated"
|
|
redirect ProfileR
|
|
_ -> return ()
|
|
(emails, aliases) <- runDB $ (,)
|
|
<$> selectList [EmailUser ==. uid] [Asc EmailEmail]
|
|
<*> selectList [AliasUser ==. uid] [Asc AliasName]
|
|
defaultLayout $ do
|
|
setTitle "Your Profile"
|
|
$(combineStylesheets 'StaticR
|
|
[ css_bootstrap_css
|
|
, css_bootstrap_responsive_css
|
|
])
|
|
$(widgetFile "profile")
|
|
|
|
aliasToText :: Entity Alias -> Text
|
|
aliasToText (Entity _ (Alias _ name target)) = concat
|
|
[ toPathPiece name
|
|
, ": "
|
|
, toPathPiece target
|
|
]
|
|
|
|
putProfileR :: Handler Html
|
|
putProfileR = getProfileR
|