adding profile page and prepared upload
This commit is contained in:
parent
cfad7cc3c8
commit
97f72aca36
12 changed files with 53 additions and 8 deletions
|
@ -31,6 +31,8 @@ import Handler.Home
|
|||
import Handler.Signup
|
||||
import Handler.Login
|
||||
import Handler.Activate
|
||||
import Handler.Profile
|
||||
import Handler.Upload
|
||||
|
||||
-- This line actually creates our YesodDispatch instance. It is the second half
|
||||
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the
|
||||
|
|
|
@ -20,6 +20,7 @@ import Text.Hamlet (hamletFile)
|
|||
import Yesod.Core.Types (Logger)
|
||||
-- costom imports
|
||||
import Data.Maybe
|
||||
import Data.Text
|
||||
|
||||
-- | The site argument for your application. This can be a good place to
|
||||
-- keep settings and values requiring initialization before your application
|
||||
|
|
|
@ -1,11 +1,10 @@
|
|||
module Handler.Activate where
|
||||
|
||||
import Import as I
|
||||
import Data.Text as T
|
||||
|
||||
getActivateR :: String -> Handler Html
|
||||
getActivateR :: Text -> Handler Html
|
||||
getActivateR token = do
|
||||
t <- runDB $ selectList [TokenToken ==. (T.pack token)] []
|
||||
t <- runDB $ selectList [TokenToken ==. token] []
|
||||
case t of
|
||||
[] -> do
|
||||
setMessage $ [shamlet|<pre>Invalid Token!|]
|
||||
|
|
|
@ -12,7 +12,7 @@ import Import
|
|||
-- inclined, or create a single monolithic file.
|
||||
getHomeR :: Handler Html
|
||||
getHomeR = do
|
||||
recentMedia <- runDB $ selectList [] [Desc MediaTime]
|
||||
recentMedia <- runDB $ selectList [] [Desc MediumTime]
|
||||
defaultLayout $ do
|
||||
$(widgetFile "home")
|
||||
|
||||
|
|
10
Handler/Profile.hs
Normal file
10
Handler/Profile.hs
Normal file
|
@ -0,0 +1,10 @@
|
|||
module Handler.Profile where
|
||||
|
||||
import Import
|
||||
|
||||
getProfileR :: Text -> Handler Html
|
||||
getProfileR username = do
|
||||
msu <- lookupSession "username"
|
||||
userMedia <- runDB $ selectList [MediumOwner ==. username] [Desc MediumTime]
|
||||
defaultLayout $ do
|
||||
$(widgetFile "profile")
|
|
@ -23,7 +23,7 @@ postSignupR = do
|
|||
True -> do
|
||||
tokenString <- liftIO generateString
|
||||
uId <- runDB $ insert $ Token tokenString user
|
||||
activateLink <- ($ ActivateR $ T.unpack tokenString) <$> getUrlRender
|
||||
activateLink <- ($ ActivateR tokenString) <$> getUrlRender
|
||||
sendMail (userEmail user) "Please activate your account!" $
|
||||
[shamlet|
|
||||
<h1> Welcome to Eidolon!
|
||||
|
|
9
Handler/Upload.hs
Normal file
9
Handler/Upload.hs
Normal file
|
@ -0,0 +1,9 @@
|
|||
module Handler.Upload where
|
||||
|
||||
import Import
|
||||
|
||||
getUploadR :: Handler Html
|
||||
getUploadR = error "Not yet implemented: getUploadR"
|
||||
|
||||
postUploadR :: Handler Html
|
||||
postUploadR = error "Not yet implemented: postUploadR"
|
|
@ -6,13 +6,17 @@ User
|
|||
Token
|
||||
token Text
|
||||
user User
|
||||
Media
|
||||
Album
|
||||
title Text
|
||||
owner Text
|
||||
content [MediumId]
|
||||
Medium
|
||||
title Text
|
||||
path FilePath
|
||||
thumbPath FilePath
|
||||
time UTCTime
|
||||
owner Text
|
||||
description Text
|
||||
tags Texts
|
||||
tags [Text]
|
||||
|
||||
-- By default this file is used in Model.hs (which is imported by Foundation.hs)
|
||||
|
|
|
@ -7,4 +7,6 @@
|
|||
/signup SignupR GET POST
|
||||
/login LoginR GET POST
|
||||
/logout LogoutR GET
|
||||
/activate/#String ActivateR GET
|
||||
/activate/#Text ActivateR GET
|
||||
/user/#Text ProfileR GET
|
||||
/upload UploadR GET POST
|
||||
|
|
|
@ -23,6 +23,8 @@ library
|
|||
Handler.Signup
|
||||
Handler.Login
|
||||
Handler.Activate
|
||||
Handler.Profile
|
||||
Handler.Upload
|
||||
|
||||
if flag(dev) || flag(library-only)
|
||||
cpp-options: -DDEVELOPMENT
|
||||
|
|
|
@ -5,6 +5,8 @@
|
|||
Logged in as #{fromJust msu}
|
||||
<li>
|
||||
<a href=@{LogoutR}>Logout
|
||||
<li>
|
||||
<a href=@{UploadR}>Upload image
|
||||
$nothing
|
||||
<li>
|
||||
<a href=@{LoginR}>Login
|
||||
|
|
14
templates/profile.hamlet
Normal file
14
templates/profile.hamlet
Normal file
|
@ -0,0 +1,14 @@
|
|||
$newline always
|
||||
<h3>Profile of #{username}
|
||||
|
||||
$if msu == (Just username)
|
||||
Coming soon: create new album
|
||||
<br>
|
||||
|
||||
$if null userMedia
|
||||
Dieser Benutzer hat noch keine Medien hochgeladen.
|
||||
$else
|
||||
Neueste Medien:
|
||||
$forall (Entity mediaId medium) <- userMedia
|
||||
<div class="thumbnails">
|
||||
<div class="single">
|
Loading…
Reference in a new issue