Commit 6536c6d5 authored by Christopher League's avatar Christopher League
Browse files

Add about box to user profile

parent d947e772
......@@ -15,26 +15,35 @@ import App.YamlStore
profileForm ::
Maybe Text ->
Text ->
Html ->
MForm Handler (FormResult (Maybe Text), Widget)
profileForm nickOpt extra = do
let fs = "" {fsAttrs = [("placeholder", "(Keep it professional)")]}
(nickRes, nickView) <- mopt textField fs (Just nickOpt)
MForm Handler (FormResult (Maybe Text, Text), Widget)
profileForm nickOpt about extra = do
let nickF = "" {fsAttrs = [("placeholder", "(Keep it professional)")]}
aboutF = "" {fsAttrs = [("rows", "5")]}
(nickRes, nickView) <- mopt textField nickF (Just nickOpt)
(aboutRes, aboutView) <- mopt textareaField aboutF (Just (Just (Textarea about)))
return
( nickRes,
( (,) <$> nickRes <*> (maybe "" unTextarea <$> aboutRes),
[whamlet|
#{extra}
<tr>
<th .align-middle>Nick name:
<td>
^{fvInput nickView}
<tr>
<th .align-top>About me:
<td>
^{fvInput aboutView}
|]
)
getProfileR :: Handler Html
getProfileR = do
(uid, user) <- requireAuth
((_, widget), enctype) <- runFormPost $ profileForm (user ^. userNickName)
((_, widget), enctype) <-
runFormPost $
profileForm (user ^. userNickName) (user ^. userAboutMe)
defaultLayout $ do
setTitle "Your profile"
[whamlet|
......@@ -89,13 +98,15 @@ getProfileR = do
postProfileR :: Handler TypedContent
postProfileR = do
uid <- requireAuthId
((res, _), _) <- runFormPost (profileForm Nothing)
((res, _), _) <- runFormPost (profileForm Nothing "")
case res of
FormSuccess nick -> do
FormSuccess (nick, about) -> do
runRw $ do
logMessage $ "update userNickName " <> userIdText uid
updatePureY_ uid $ userNickName .~ (nick >>= nonEmptyText)
addMessage "success" "Your name has been updated."
logMessage $ "update user profile " <> userIdText uid
updatePureY_ uid $
userNickName .~ (nick >>= nonEmptyText)
>>> userAboutMe .~ about
addMessage "success" "Your profile has been updated."
_ -> do
addMessage "error" "Name not updated."
redirect ProfileR
......@@ -29,6 +29,7 @@ module App.User
userMajor,
userSchool,
userYear,
userAboutMe,
userAvatar,
userReadPosts,
createSampleUsers,
......@@ -130,7 +131,8 @@ data User
_userMajor :: Text,
_userYear :: Text,
_userVerify :: Maybe UserVerify,
_userReadPosts :: Set PostId
_userReadPosts :: Set PostId,
_userAboutMe :: Text
}
deriving (Show, Generic)
......@@ -148,6 +150,7 @@ instance Default User where
mempty -- userYear
def -- userVerify
def -- userReadPosts
mempty -- userAboutMe
makeLenses ''User
......@@ -170,7 +173,15 @@ instance FromJSON UserVerify where
instance FromJSON User where
parseJSON = genericParseJSON userJsonOpts
instance YamlEntity UserId User
instance YamlEntity UserId User where
fieldOrder =
[ "lastName",
"firstName",
"nickName",
"email",
"major",
"studentId"
]
simpleUser :: Text -> Text -> Int -> Email -> User
simpleUser last first sid email =
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment