From 7cebf9235693d4a7f5c2b936a860385b947a7532 Mon Sep 17 00:00:00 2001
From: Danielle McLean <dani@00dani.me>
Date: Mon, 9 Oct 2017 09:02:42 +1100
Subject: [PATCH] Add permalinks to h-entries

---
 src/Handler/Entries.hs       | 5 +----
 src/Widget/Entry.hs          | 5 ++++-
 templates/mf2/h-entry.hamlet | 5 +++--
 3 files changed, 8 insertions(+), 7 deletions(-)

diff --git a/src/Handler/Entries.hs b/src/Handler/Entries.hs
index b9d735a..ca96624 100644
--- a/src/Handler/Entries.hs
+++ b/src/Handler/Entries.hs
@@ -7,7 +7,7 @@ import Import
 import Web.Slug ( Slug )
 
 import qualified Entry.Kind as K
-import Widget.Entry ( hEntry )
+import Widget.Entry ( entryR, hEntry )
 import Widget.Feed ( hFeed )
 
 getEntriesR :: K.EntryKind -> Handler Html
@@ -15,9 +15,6 @@ 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)
 
diff --git a/src/Widget/Entry.hs b/src/Widget/Entry.hs
index ecf731c..dbf1a06 100644
--- a/src/Widget/Entry.hs
+++ b/src/Widget/Entry.hs
@@ -1,10 +1,13 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
-module Widget.Entry ( hEntry ) where
+module Widget.Entry ( entryR, hEntry ) where
 
 import Import
 
+entryR :: Entity Entry -> Route App
+entryR (Entity entryId entry) = EntryR (entryKind entry) entryId (entrySlug entry)
+
 hEntry :: Entity Entry -> Widget
 hEntry (Entity entryId entry) = do
     maybeAuthor <- handlerToWidget . runDB . get . entryAuthorId $ entry
diff --git a/templates/mf2/h-entry.hamlet b/templates/mf2/h-entry.hamlet
index d5edbca..20a984a 100644
--- a/templates/mf2/h-entry.hamlet
+++ b/templates/mf2/h-entry.hamlet
@@ -1,7 +1,8 @@
 <article .h-entry>
-  <h1.p-name>#{entryName entry}
+  <h1 .p-name>#{entryName entry}
+  <a .u-url href="@{entryR (Entity entryId entry)}">permalink
   <p>
-    Published
+    published
     $maybe author <- maybeAuthor
       \ by
       <a .p-author.h-card href=@{HomeR}>