00dani/lebd
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Add the main entry kinds to the navbar

Browse source
This commit is contained in:
Danielle McLean 2017-10-09 14:03:42 +11:00
parent 1b8a07a5f6
commit 41375abdd4
Signed by: 00dani
GPG key ID: 5A5D2D1AFF12EEC5
2 changed files with 8 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
src/Entry/Kind.hs
View file

@ -11,9 +11,12 @@ import Text.Read ( readMaybe )
data EntryKind = Note | Article | Photo | Video | Audio data EntryKind = Note | Article | Photo | Video | Audio
| Reply | Repost | Like | Favourite | Bookmark | Quote | Rsvp | Reply | Repost | Like | Favourite | Bookmark | Quote | Rsvp
| Listen | Jam | Watch | Play | Read | Listen | Jam | Watch | Play | Read
deriving (Eq, Read, Show) deriving (Enum, Eq, Read, Show)
derivePersistField "EntryKind" derivePersistField "EntryKind"
allEntryKinds :: [EntryKind]
allEntryKinds = [Note ..]
singularise :: T.Text -> Maybe EntryKind singularise :: T.Text -> Maybe EntryKind
singularise "replies" = Just Reply singularise "replies" = Just Reply
singularise "watches" = Just Watch singularise "watches" = Just Watch

7
src/Foundation.hs
View file

@ -21,7 +21,7 @@ import Yesod.Core.Types (Logger)
import qualified Yesod.Core.Unsafe as Unsafe import qualified Yesod.Core.Unsafe as Unsafe
import Package import Package
import Entry.Kind ( EntryKind, pluralise ) import Entry.Kind ( EntryKind, allEntryKinds, pluralise )
import Data.Aeson ( encode, object ) import Data.Aeson ( encode, object )
import qualified Text.Blaze.Internal as B import qualified Text.Blaze.Internal as B
@ -152,7 +152,8 @@ instance Yesod App where
makeLogger = return . appLogger makeLogger = return . appLogger
leftMenuItems, rightMenuItems :: Maybe (UserId, User) -> [MenuItem] leftMenuItems, rightMenuItems :: Maybe (UserId, User) -> [MenuItem]
leftMenuItems _ = [] leftMenuItems _ = toMenuItem <$> take 5 allEntryKinds
where toMenuItem kind = pluralise kind `MenuItem` EntriesR kind
rightMenuItems = loggedOutItems `maybe` loggedInItems rightMenuItems = loggedOutItems `maybe` loggedInItems
where loggedOutItems = where loggedOutItems =
[ "log in" `MenuItem` AuthR LoginR [ "log in" `MenuItem` AuthR LoginR
@ -164,7 +165,7 @@ rightMenuItems = loggedOutItems `maybe` loggedInItems
-- Define breadcrumbs. -- Define breadcrumbs.
instance YesodBreadcrumbs App where instance YesodBreadcrumbs App where
breadcrumb (AuthR _) = return ("login", Just HomeR) breadcrumb (AuthR _) = return ("log in", Just HomeR)
breadcrumb (EntriesR kind) = return (pluralise kind, Just HomeR) breadcrumb (EntriesR kind) = return (pluralise kind, Just HomeR)
breadcrumb (EntryR kind entryId _) = do breadcrumb (EntryR kind entryId _) = do
entry <- runDB . get404 $ entryId entry <- runDB . get404 $ entryId