From 97f72aca36985b075e632862a17a01e1f3c9aede Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 12 Aug 2014 23:45:33 +0200 Subject: [PATCH] adding profile page and prepared upload --- Application.hs | 2 ++ Foundation.hs | 1 + Handler/Activate.hs | 5 ++--- Handler/Home.hs | 2 +- Handler/Profile.hs | 10 ++++++++++ Handler/Signup.hs | 2 +- Handler/Upload.hs | 9 +++++++++ config/models | 8 ++++++-- config/routes | 4 +++- eidolon.cabal | 2 ++ templates/default-layout.hamlet | 2 ++ templates/profile.hamlet | 14 ++++++++++++++ 12 files changed, 53 insertions(+), 8 deletions(-) create mode 100644 Handler/Profile.hs create mode 100644 Handler/Upload.hs create mode 100644 templates/profile.hamlet diff --git a/Application.hs b/Application.hs index 4729d58..3e4cea3 100644 --- a/Application.hs +++ b/Application.hs @@ -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 diff --git a/Foundation.hs b/Foundation.hs index be4db98..48b1da0 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -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 diff --git a/Handler/Activate.hs b/Handler/Activate.hs index c44e6f3..b347973 100644 --- a/Handler/Activate.hs +++ b/Handler/Activate.hs @@ -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|
Invalid Token!|]
diff --git a/Handler/Home.hs b/Handler/Home.hs
index cdec41c..cfb15d8 100644
--- a/Handler/Home.hs
+++ b/Handler/Home.hs
@@ -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")
 
diff --git a/Handler/Profile.hs b/Handler/Profile.hs
new file mode 100644
index 0000000..83e8ad3
--- /dev/null
+++ b/Handler/Profile.hs
@@ -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")
diff --git a/Handler/Signup.hs b/Handler/Signup.hs
index b835514..491fcdb 100644
--- a/Handler/Signup.hs
+++ b/Handler/Signup.hs
@@ -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|
               

Welcome to Eidolon! diff --git a/Handler/Upload.hs b/Handler/Upload.hs new file mode 100644 index 0000000..f30f7a6 --- /dev/null +++ b/Handler/Upload.hs @@ -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" diff --git a/config/models b/config/models index 459f505..519887f 100644 --- a/config/models +++ b/config/models @@ -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) diff --git a/config/routes b/config/routes index 3674938..bf6afa4 100644 --- a/config/routes +++ b/config/routes @@ -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 diff --git a/eidolon.cabal b/eidolon.cabal index 9553427..c9d4549 100644 --- a/eidolon.cabal +++ b/eidolon.cabal @@ -23,6 +23,8 @@ library Handler.Signup Handler.Login Handler.Activate + Handler.Profile + Handler.Upload if flag(dev) || flag(library-only) cpp-options: -DDEVELOPMENT diff --git a/templates/default-layout.hamlet b/templates/default-layout.hamlet index b2cf2e5..5409ec0 100644 --- a/templates/default-layout.hamlet +++ b/templates/default-layout.hamlet @@ -5,6 +5,8 @@ Logged in as #{fromJust msu}
  • Logout +
  • + Upload image $nothing
  • Login diff --git a/templates/profile.hamlet b/templates/profile.hamlet new file mode 100644 index 0000000..77ab9d1 --- /dev/null +++ b/templates/profile.hamlet @@ -0,0 +1,14 @@ +$newline always +

    Profile of #{username} + +$if msu == (Just username) + Coming soon: create new album +
    + +$if null userMedia + Dieser Benutzer hat noch keine Medien hochgeladen. +$else + Neueste Medien: + $forall (Entity mediaId medium) <- userMedia +
    +