From 10d1d1913d9eef9e7a9f80c2436d2d1b10a91a7c Mon Sep 17 00:00:00 2001 From: Kitagaki Chihiro Date: Thu, 23 Oct 2014 13:59:49 +0900 Subject: [PATCH 1/3] Make access to article use permaLink --- Foundation.hs | 1 + Handler/Nomnichi.hs | 33 ++++++++++++++++++-------------- config/models | 1 + config/routes | 8 ++++---- templates/articles.hamlet | 4 ++-- templates/authedArticle.hamlet | 6 +++--- templates/editArticleForm.hamlet | 2 +- templates/homepage.hamlet | 4 ++-- 8 files changed, 33 insertions(+), 26 deletions(-) diff --git a/Foundation.hs b/Foundation.hs index 152b426..d44a0b6 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -15,6 +15,7 @@ import Database.Persist.Sql (SqlPersistT) import Settings.StaticFiles import Settings (widgetFile, Extra (..)) import Model +import Data.Text import Text.Jasmine (minifym) import Text.Hamlet (hamletFile) import Yesod.Core.Types (Logger) diff --git a/Handler/Nomnichi.hs b/Handler/Nomnichi.hs index fe20d71..bdf36ed 100644 --- a/Handler/Nomnichi.hs +++ b/Handler/Nomnichi.hs @@ -135,15 +135,16 @@ postCreateArticleR = do } articleId <- runDB $ insert article' setMessage $ toHtml (articleTitle article) <> " created." - redirect $ ArticleR articleId + redirect $ (ArticleR (articlePermaLink article)) _ -> defaultLayout $ do setTitle "Please correct your entry form." $(widgetFile "articleAddError") -- 記事表示 -getArticleR :: ArticleId -> Handler Html -getArticleR articleId = do +getArticleR :: Text -> Handler Html +getArticleR articlePL = do creds <- maybeAuthId + Entity articleId _article <- runDB $ getBy404 $ UniquePermaLink articlePL article <- runDB $ get404 articleId user <- runDB $ get (articleUser article) comments <- runDB $ selectList [CommentArticleId ==. articleId] [Asc CommentId] @@ -184,8 +185,9 @@ commentAuthorName (Entity _ comment) = do runDB $ get (commentUser comment) -- 記事更新 -postArticleR :: ArticleId -> Handler Html -postArticleR articleId = do +postArticleR :: Text -> Handler Html +postArticleR articlePL = do + Entity articleId _article <- runDB $ getBy404 $ UniquePermaLink articlePL beforeArticle <- runDB $ get404 articleId ((res, articleWidget), enctype) <- runFormPost (editForm (Just beforeArticle)) case res of @@ -202,14 +204,15 @@ postArticleR articleId = do , ArticlePromoteHeadline =. articlePromoteHeadline article ] setMessage $ toHtml $ (articleTitle article) <> " is updated." - redirect $ ArticleR articleId + redirect $ (ArticleR (articlePermaLink article)) _ -> defaultLayout $ do setTitle "Please correct your entry form." $(widgetFile "editArticleForm") -- 編集画面 -getEditArticleR :: ArticleId -> Handler Html -getEditArticleR articleId = do +getEditArticleR :: Text -> Handler Html +getEditArticleR articlePL = do + Entity articleId _article <- runDB $ getBy404 $ UniquePermaLink articlePL article <- runDB $ get404 articleId (articleWidget, enctype) <- generateFormPost $ editForm (Just article) defaultLayout $ do @@ -218,8 +221,9 @@ getEditArticleR articleId = do -- 記事削除 -postDeleteArticleR :: ArticleId -> Handler Html -postDeleteArticleR articleId = do +postDeleteArticleR :: Text -> Handler Html +postDeleteArticleR articlePL = do + Entity articleId _article <- runDB $ getBy404 $ UniquePermaLink articlePL runDB $ do delete articleId deleteWhere [ CommentArticleId ==. articleId ] @@ -232,17 +236,18 @@ postDeleteArticleR articleId = do -- コメント送信 -postCommentR :: ArticleId -> Handler Html -postCommentR articleId = do +postCommentR :: Text -> Handler Html +postCommentR articlePL = do + Entity articleId _article <- runDB $ getBy404 $ UniquePermaLink articlePL ((res, _), _) <- runFormPost $ commentForm articleId case res of FormSuccess comment -> do _ <- runDB $ insert comment setMessage "your comment was successfully posted." - redirect $ ArticleR articleId + redirect $ ArticleR articlePL _ -> do setMessage "please fill up your comment form." - redirect $ ArticleR articleId + redirect $ ArticleR articlePL -- 記事表示時の公開時刻の整形 formatToNomnichiTime :: Article -> String diff --git a/config/models b/config/models index e13ddc8..0670ebf 100644 --- a/config/models +++ b/config/models @@ -11,6 +11,7 @@ Article user UserId title Text permaLink Text + UniquePermaLink permaLink content Html createdOn UTCTime updatedOn UTCTime diff --git a/config/routes b/config/routes index c3c6ee1..33802a5 100644 --- a/config/routes +++ b/config/routes @@ -8,9 +8,9 @@ /lab/nom/nomnichi NomnichiR GET /lab/nom/nomnichi/create CreateArticleR GET POST -/lab/nom/nomnichi/#ArticleId/show ArticleR GET POST -/lab/nom/nomnichi/#ArticleId/edit EditArticleR GET -/lab/nom/nomnichi/#ArticleId/delete DeleteArticleR POST -/lab/nom/nomnichi/#ArticleId/comment CommentR POST +/lab/nom/nomnichi/#Text/show ArticleR GET POST +/lab/nom/nomnichi/#Text/edit EditArticleR GET +/lab/nom/nomnichi/#Text/delete DeleteArticleR POST +/lab/nom/nomnichi/#Text/comment CommentR POST /lab/nom/ourstatic/*Texts OurStaticR GET diff --git a/templates/articles.hamlet b/templates/articles.hamlet index e613503..9472910 100644 --- a/templates/articles.hamlet +++ b/templates/articles.hamlet @@ -7,7 +7,7 @@
  • - + #{articleTitle article} ^{lockedImg article}
    @@ -16,7 +16,7 @@
    #{takeHeadLine $ articleContent article} -
    ...    (続きを読む) +
    ...(続きを読む)
    ^{linkToOtherPageNumber calcPageNumber} ^{displayLinksforLoginedMember creds} diff --git a/templates/authedArticle.hamlet b/templates/authedArticle.hamlet index cd6f278..7e9189e 100644 --- a/templates/authedArticle.hamlet +++ b/templates/authedArticle.hamlet @@ -8,13 +8,13 @@
  • TOPへ
  • - 編集 + 編集
  • -
    + 削除
    - + ^{commentWidget}
    diff --git a/templates/editArticleForm.hamlet b/templates/editArticleForm.hamlet index 286fbd7..991bcda 100644 --- a/templates/editArticleForm.hamlet +++ b/templates/editArticleForm.hamlet @@ -1,5 +1,5 @@
    - + ^{articleWidget}
    diff --git a/templates/homepage.hamlet b/templates/homepage.hamlet index ea07513..0297210 100644 --- a/templates/homepage.hamlet +++ b/templates/homepage.hamlet @@ -32,11 +32,11 @@
  • - #{articleTitle article} + #{articleTitle article}
    #{showGregorian $ utctDay $ articlePublishedOn article} #{displayAuthorName user}
    #{takeHeadLine $ articleContent article} -
    ...    (続きを読む) +
    ...(続きを読む)
    \ No newline at end of file From 6a9d8534dc47c2d0d7293ddb905392cf0dcb5386 Mon Sep 17 00:00:00 2001 From: Kitagaki Chihiro Date: Thu, 23 Oct 2014 14:44:16 +0900 Subject: [PATCH 2/3] Rename articlePL to permalink --- Handler/Nomnichi.hs | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/Handler/Nomnichi.hs b/Handler/Nomnichi.hs index bdf36ed..d73f6c0 100644 --- a/Handler/Nomnichi.hs +++ b/Handler/Nomnichi.hs @@ -142,9 +142,9 @@ postCreateArticleR = do -- 記事表示 getArticleR :: Text -> Handler Html -getArticleR articlePL = do +getArticleR permalink = do creds <- maybeAuthId - Entity articleId _article <- runDB $ getBy404 $ UniquePermaLink articlePL + Entity articleId _article <- runDB $ getBy404 $ UniquePermaLink permalink article <- runDB $ get404 articleId user <- runDB $ get (articleUser article) comments <- runDB $ selectList [CommentArticleId ==. articleId] [Asc CommentId] @@ -186,8 +186,8 @@ commentAuthorName (Entity _ comment) = do -- 記事更新 postArticleR :: Text -> Handler Html -postArticleR articlePL = do - Entity articleId _article <- runDB $ getBy404 $ UniquePermaLink articlePL +postArticleR permalink = do + Entity articleId _article <- runDB $ getBy404 $ UniquePermaLink permalink beforeArticle <- runDB $ get404 articleId ((res, articleWidget), enctype) <- runFormPost (editForm (Just beforeArticle)) case res of @@ -211,8 +211,8 @@ postArticleR articlePL = do -- 編集画面 getEditArticleR :: Text -> Handler Html -getEditArticleR articlePL = do - Entity articleId _article <- runDB $ getBy404 $ UniquePermaLink articlePL +getEditArticleR permalink = do + Entity articleId _article <- runDB $ getBy404 $ UniquePermaLink permalink article <- runDB $ get404 articleId (articleWidget, enctype) <- generateFormPost $ editForm (Just article) defaultLayout $ do @@ -222,8 +222,8 @@ getEditArticleR articlePL = do -- 記事削除 postDeleteArticleR :: Text -> Handler Html -postDeleteArticleR articlePL = do - Entity articleId _article <- runDB $ getBy404 $ UniquePermaLink articlePL +postDeleteArticleR permalink = do + Entity articleId _article <- runDB $ getBy404 $ UniquePermaLink permalink runDB $ do delete articleId deleteWhere [ CommentArticleId ==. articleId ] @@ -237,17 +237,17 @@ postDeleteArticleR articlePL = do -- コメント送信 postCommentR :: Text -> Handler Html -postCommentR articlePL = do - Entity articleId _article <- runDB $ getBy404 $ UniquePermaLink articlePL +postCommentR permalink = do + Entity articleId _article <- runDB $ getBy404 $ UniquePermaLink permalink ((res, _), _) <- runFormPost $ commentForm articleId case res of FormSuccess comment -> do _ <- runDB $ insert comment setMessage "your comment was successfully posted." - redirect $ ArticleR articlePL + redirect $ ArticleR permalink _ -> do setMessage "please fill up your comment form." - redirect $ ArticleR articlePL + redirect $ ArticleR permalink -- 記事表示時の公開時刻の整形 formatToNomnichiTime :: Article -> String From f75a1e649137f8a64059130e9f2660fb389bab68 Mon Sep 17 00:00:00 2001 From: Kitagaki Chihiro Date: Thu, 23 Oct 2014 14:48:53 +0900 Subject: [PATCH 3/3] Rewrite parentheses to dollar function --- Handler/Nomnichi.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Handler/Nomnichi.hs b/Handler/Nomnichi.hs index d73f6c0..a49ad33 100644 --- a/Handler/Nomnichi.hs +++ b/Handler/Nomnichi.hs @@ -135,7 +135,7 @@ postCreateArticleR = do } articleId <- runDB $ insert article' setMessage $ toHtml (articleTitle article) <> " created." - redirect $ (ArticleR (articlePermaLink article)) + redirect $ ArticleR $ articlePermaLink article _ -> defaultLayout $ do setTitle "Please correct your entry form." $(widgetFile "articleAddError") @@ -204,7 +204,7 @@ postArticleR permalink = do , ArticlePromoteHeadline =. articlePromoteHeadline article ] setMessage $ toHtml $ (articleTitle article) <> " is updated." - redirect $ (ArticleR (articlePermaLink article)) + redirect $ ArticleR $ articlePermaLink article _ -> defaultLayout $ do setTitle "Please correct your entry form." $(widgetFile "editArticleForm")