Add slugs to entries and use them to create individual entry routes

src/Handler/Entries.hs

@@ -1,12 +1,36 @@
+{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE TemplateHaskell #-}
 module Handler.Entries where
 
 import Import
 
+import Web.Slug ( Slug )
+
 import qualified Entry.Kind as K
+import Widget.Entry ( hEntry )
 import Widget.Feed ( hFeed )
 
 getEntriesR :: K.EntryKind -> Handler Html
 getEntriesR kind = do
     entries <- runDB $ selectList [EntryKind ==. kind] [Desc EntryPublished]
     defaultLayout $(widgetFile "entries")
+
+entryR :: Entity Entry -> Route App
+entryR (Entity entryId entry) = EntryR (entryKind entry) entryId (entrySlug entry)
+
+checkMatching :: K.EntryKind -> Slug -> Entry -> Bool
+checkMatching kind slug entry = (kind == entryKind entry) && (slug == entrySlug entry)
+
+getEntryNoSlugR :: a -> EntryId -> Handler Html
+getEntryNoSlugR _ entryId = do
+    entry <- fmap (Entity entryId) . runDB . get404 $ entryId
+    redirectWith movedPermanently301 . entryR $ entry
+
+getEntryR :: K.EntryKind -> EntryId -> Slug -> Handler Html
+getEntryR kind entryId slug = do
+    entry <- fmap (Entity entryId) . runDB . get404 $ entryId
+    if checkMatching kind slug $ entityVal entry
+       then defaultLayout $ do
+           setTitle . toHtml . entryName . entityVal $ entry
+           $(widgetFile "entry")
+       else redirectWith movedPermanently301 $ entryR entry