{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} module Widget.Entry ( entryR, hEntry ) where import Import import Database.Esqueleto ( (^.) ) import qualified Database.Esqueleto as E import Data.Time.Format ( defaultTimeLocale, formatTime, iso8601DateFormat ) import Data.Time.Format.Human ( humanReadableTime ) import Web.Slug ( mkSlug ) data FormattedTime = FormattedTime { timeUnfriendly :: String , timeFriendly :: String } deriving Eq toFormattedTime :: MonadIO m => UTCTime -> m FormattedTime toFormattedTime time = FormattedTime (unfriendly time) <$> friendly time where unfriendly = formatTime defaultTimeLocale . iso8601DateFormat . Just $ "%H:%M:%S%z" friendly = liftIO . humanReadableTime entryR :: Entity Entry -> Route App entryR (Entity entryId Entry {..}) = route (entryName >>= mkSlug) entryKind entryId where route (Just s) = \k i -> EntryWithSlugR k i s route Nothing = EntryR hEntry :: Entity Entry -> Widget hEntry (Entity entryId entry) = do published <- toFormattedTime . entryPublished $ entry updated <- toFormattedTime . entryUpdated $ entry posses <- handlerToWidget . runDB . E.select . E.from $ \(syndication `E.InnerJoin` profile `E.InnerJoin` site) -> do E.on $ profile ^. ProfileSiteId E.==. site ^. SiteId E.on $ syndication ^. SyndicationProfileId E.==. profile ^. ProfileId E.where_ $ syndication ^. SyndicationEntryId E.==. E.val entryId E.orderBy [E.asc $ site ^. SiteName] return (syndication ^. SyndicationUrl, site ^. SiteIcon, E.coalesceDefault [profile ^. ProfileDisplayName] (profile ^. ProfileUsername)) maybeAuthor <- handlerToWidget . runDB . get . entryAuthorId $ entry $(widgetFile "mf2/h-entry")