Begin adding rudimentary support for posting new entries to the site - needs to be prettier and a lot smarter, but it exists now

src/Application.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Application
     ( getApplicationDev
@@ -48,6 +49,7 @@ import System.Log.FastLogger                (defaultBufSize, newStdoutLoggerSet,
 -- Import all relevant handler modules here.
 -- Don't forget to add new modules to your cabal file!
 import Handler.Common
+import Handler.Entries
 import Handler.Home
 
 -- This line actually creates our YesodDispatch instance. It is the second half

src/Entry/Kind.hs

@@ -0,0 +1,29 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Entry.Kind where
+
+import Database.Persist.TH ( derivePersistField )
+import Yesod.Core.Dispatch ( PathPiece, toPathPiece, fromPathPiece )
+
+import qualified Data.Text as T
+import Text.Read ( readMaybe )
+
+data EntryKind = Note | Article | Photo | Video | Audio
+               | Reply | Repost | Like | Favourite | Bookmark | Quote | Rsvp
+               | Listen | Jam | Watch | Play | Read
+              deriving (Eq, Read, Show)
+derivePersistField "EntryKind"
+
+singularise :: T.Text -> Maybe EntryKind
+singularise "replies" = Just Reply
+singularise "watches" = Just Watch
+singularise k = readMaybe . T.unpack . T.toTitle . T.init $ k
+
+pluralise :: EntryKind -> T.Text
+pluralise Reply = "replies"
+pluralise Watch = "watches"
+pluralise k = T.toLower . flip T.snoc 's' . T.pack . show $ k
+
+instance PathPiece EntryKind where
+    toPathPiece = pluralise
+    fromPathPiece = singularise

src/Foundation.hs

@@ -20,6 +20,7 @@ import Yesod.Core.Types     (Logger)
 import qualified Yesod.Core.Unsafe as Unsafe
 
 import Package
+import Entry.Kind ( EntryKind )
 
 -- | The foundation datatype for your application. This can be a good place to
 -- keep settings and values requiring initialization before your application

src/Handler/Entries.hs

@@ -0,0 +1,12 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Handler.Entries where
+
+import Import
+
+import qualified Entry.Kind as K
+import Widget.Feed ( hFeed )
+
+getEntriesR :: K.EntryKind -> Handler Html
+getEntriesR kind = do
+    entries <- runDB $ selectList [EntryKind ==. kind] [Desc EntryPublished]
+    defaultLayout $(widgetFile "entries")

src/Model.hs

@@ -13,6 +13,8 @@ import ClassyPrelude.Yesod
 import Database.Persist.Quasi
 import Yesod.Auth.HashDB ( HashDBUser(..) )
 
+import Entry.Kind ( EntryKind )
+
 -- You can define all of your database entities in the entities file.
 -- You can find more information on persistent and how to declare entities
 -- at:

src/Widget/Entry.hs

@@ -0,0 +1,11 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Widget.Entry ( hEntry ) where
+
+import Import
+
+hEntry :: Entity Entry -> Widget
+hEntry (Entity entryId entry) = do
+    maybeAuthor <- handlerToWidget . runDB . get . entryAuthorId $ entry
+    $(widgetFile "mf2/h-entry")

src/Widget/Feed.hs

@@ -0,0 +1,8 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Widget.Feed ( hFeed ) where
+
+import Import
+import Widget.Entry ( hEntry )
+
+hFeed :: [Entity Entry] -> Widget
+hFeed entries = $(widgetFile "mf2/h-feed")