From fa992bc861deccaae81d2bf6afb3c73c5d3102af Mon Sep 17 00:00:00 2001
From: Danielle McLean <dani@00dani.me>
Date: Wed, 11 Oct 2017 23:34:36 +1100
Subject: [PATCH] Make entry names optional, since notes shouldn't have names
 and articles should

---
 config/models                |  2 +-
 src/Foundation.hs            |  3 ++-
 src/Handler/Entries.hs       |  3 ++-
 src/Handler/Feed.hs          |  3 ++-
 src/Model/Entry.hs           | 15 +++++++++++++++
 templates/mf2/h-entry.hamlet |  3 ++-
 6 files changed, 24 insertions(+), 5 deletions(-)
 create mode 100644 src/Model/Entry.hs

diff --git a/config/models b/config/models
index d7c3541..786b9cc 100644
--- a/config/models
+++ b/config/models
@@ -28,7 +28,7 @@ Profile
 Entry
     slug Slug Maybe maxlen=255
     kind EntryKind maxlen=255
-    name Text maxlen=255
+    name Text Maybe maxlen=255
     content Text sqltype=longtext
     published UTCTime
     updated UTCTime
diff --git a/src/Foundation.hs b/src/Foundation.hs
index e4cffcd..90e09c8 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -22,6 +22,7 @@ import qualified Yesod.Core.Unsafe as Unsafe
 
 import Package
 import Model.Cache ( getCached )
+import Model.Entry ( entryTitle )
 import Model.Entry.Kind ( EntryKind, allEntryKinds, pluralise )
 
 import Data.Aeson ( encode, object )
@@ -179,7 +180,7 @@ instance YesodBreadcrumbs App where
   breadcrumb (EntriesR kind) = return (pluralise kind, Just HomeR)
   breadcrumb (EntryR kind entryId) = do
     (Entity _ entry) <- getCached entryId
-    return (entryName entry, Just $ EntriesR kind)
+    return (entryTitle entry, Just $ EntriesR kind)
   breadcrumb (EntryWithSlugR kind entryId _) = breadcrumb $ EntryR kind entryId
   breadcrumb _ = return ("home", Nothing)
 
diff --git a/src/Handler/Entries.hs b/src/Handler/Entries.hs
index 950126e..dadea37 100644
--- a/src/Handler/Entries.hs
+++ b/src/Handler/Entries.hs
@@ -8,6 +8,7 @@ import Import
 import Yesod.AtomFeed ( atomLink )
 
 import Model.Cache ( getCached )
+import Model.Entry ( entryTitle )
 import Widget.Entry ( entryR, hEntry )
 import Widget.Feed ( hFeed )
 
@@ -36,5 +37,5 @@ renderEntry entry = do
     when (actualRoute /= Just correctRoute) $
         redirectWith movedPermanently301 correctRoute
     defaultLayout $ do
-        setTitle . toHtml . entryName . entityVal $ entry
+        setTitle . toHtml . entryTitle . entityVal $ entry
         $(widgetFile "entry")
diff --git a/src/Handler/Feed.hs b/src/Handler/Feed.hs
index 2eaf1a3..53f30b1 100644
--- a/src/Handler/Feed.hs
+++ b/src/Handler/Feed.hs
@@ -5,6 +5,7 @@ module Handler.Feed where
 import Import
 
 import Data.Time.Clock.POSIX ( posixSecondsToUTCTime )
+import Model.Entry ( entryTitle )
 import Widget.Entry ( entryR )
 
 import qualified Data.Text as T
@@ -47,7 +48,7 @@ toFeedEntry :: Entity Entry -> FeedEntry (Route App)
 toFeedEntry entry = FeedEntry
     { feedEntryLink = entryR entry
     , feedEntryUpdated = entryUpdated $ entityVal entry
-    , feedEntryTitle = entryName $ entityVal entry
+    , feedEntryTitle = entryTitle $ entityVal entry
     , feedEntryContent = toHtml . entryContent . entityVal $ entry
     , feedEntryEnclosure = Nothing
     }
diff --git a/src/Model/Entry.hs b/src/Model/Entry.hs
new file mode 100644
index 0000000..4d4ddf0
--- /dev/null
+++ b/src/Model/Entry.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Model.Entry where
+
+import Model ( Entry, entryName, entryContent )
+import Data.Maybe ( fromMaybe )
+
+import qualified Data.Text as T
+
+entryTitle :: Entry -> T.Text
+entryTitle = fromMaybe <$> shorten 30 . entryContent <*> entryName
+
+shorten :: Int -> T.Text -> T.Text
+shorten n t
+  | T.length t > n = flip T.append "..." . T.take (n - 1) $ t
+  | otherwise      = t
diff --git a/templates/mf2/h-entry.hamlet b/templates/mf2/h-entry.hamlet
index 1fc14e6..659024b 100644
--- a/templates/mf2/h-entry.hamlet
+++ b/templates/mf2/h-entry.hamlet
@@ -1,6 +1,7 @@
 <article .h-entry .card.bg-dark>
   <div .card-body>
-    <h4 .p-name .card-title>#{entryName entry}
+    $maybe name <- entryName entry
+      <h4 .p-name .card-title>#{name}
     <div .e-content>
       #{entryContent entry}
   <div .card-footer>