Make access to article use permaLink

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)

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 permalink = do
   creds    <- maybeAuthId
+  Entity articleId _article <- runDB $ getBy404 $ UniquePermaLink permalink
   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 permalink = do
+  Entity articleId _article <- runDB $ getBy404 $ UniquePermaLink permalink
   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 permalink = do
+  Entity articleId _article <- runDB $ getBy404 $ UniquePermaLink permalink
   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 permalink = do
+  Entity articleId _article <- runDB $ getBy404 $ UniquePermaLink permalink
   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 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 articleId
+      redirect $ ArticleR permalink
     _ -> do
       setMessage "please fill up your comment form."
-      redirect $ ArticleR articleId
+      redirect $ ArticleR permalink
 
 -- 記事表示時の公開時刻の整形
 formatToNomnichiTime :: Article ->  String

config/models

@@ -11,6 +11,7 @@ Article
     user UserId
     title Text
     permaLink Text
+    UniquePermaLink permaLink
     content Html
     createdOn UTCTime
     updatedOn UTCTime

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

templates/articles.hamlet

@@ -7,7 +7,7 @@
       <div class="box">
         <li class="article_list_title">
           <div class="left">
-            <a class="article_title" href=@{ArticleR articleId}>
+            <a class="article_title" href=@{ArticleR (articlePermaLink article)}>
               #{articleTitle article}
             ^{lockedImg article}
           <div class="right">
@@ -16,7 +16,7 @@
           <div class="clear">
         <div>
           #{takeHeadLine $ articleContent article}
-          <br>...<a href=@{ArticleR articleId}>(続きを読む)</a>
+          <br>...<a href=@{ArticleR (articlePermaLink article)}>(続きを読む)</a>
     <hr>
     ^{linkToOtherPageNumber calcPageNumber}
 ^{displayLinksforLoginedMember creds}

templates/authedArticle.hamlet

@@ -8,13 +8,13 @@
     <li>
       <a href=@{NomnichiR}> TOPへ
     <li>
-      <a href=@{EditArticleR articleId}> 編集
+      <a href=@{EditArticleR (articlePermaLink article)}> 編集
     <li>
-      <form name=delete method="post" action=@{DeleteArticleR articleId}>
+      <form name=delete method="post" action=@{DeleteArticleR (articlePermaLink article)}>
         <input type=hidden value=削除>
         <a class=delete> 削除
 <hr>
-<form method=post action=@{CommentR articleId} enctype=#{enctype}>
+<form method=post action=@{CommentR (articlePermaLink article)} enctype=#{enctype}>
   ^{commentWidget}
   <div>
     <input type=submit value="コメント投稿">

templates/editArticleForm.hamlet

@@ -1,5 +1,5 @@
 <div class="article_form">
-  <form method=post action=@{ArticleR articleId} enctype=#{enctype}>
+  <form method=post action=@{ArticleR (articlePermaLink _article)} enctype=#{enctype}>
     ^{articleWidget}
     <div>
       <input type=submit value="Update">

templates/homepage.hamlet

@@ -32,11 +32,11 @@
       <div class="box">
         <li class="article_list_title">
           <div class="left">
-            <a class="article_title" href=@{ArticleR articleId}>#{articleTitle article}
+            <a class="article_title" href=@{ArticleR (articlePermaLink article)}>#{articleTitle article}
           <div class="right">
             #{showGregorian $ utctDay $ articlePublishedOn article} #{displayAuthorName user}
           <div class="clear">
         <div>
         #{takeHeadLine $ articleContent article}
-        <br>...<a href=@{ArticleR articleId}>(続きを読む)</a>
+        <br>...<a href=@{ArticleR (articlePermaLink article)}>(続きを読む)</a>
   <hr>