lebd/src/Widget/Entry.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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 )

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) = EntryR (entryKind entry) entryId (entrySlug entry)

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")