From e2ce096289ad0410fa465f1ea718991acef9fac0 Mon Sep 17 00:00:00 2001 From: towards-a-new-leftypol Date: Wed, 14 Feb 2024 11:40:25 -0500 Subject: [PATCH] Human readable time title attribute --- src/Component/Thread/Intro.hs | 33 +++++++++++++++++++++++++++++---- src/Component/Thread/Model.hs | 2 ++ src/Component/ThreadView.hs | 15 ++++++++++----- src/Main.hs | 2 +- 4 files changed, 42 insertions(+), 10 deletions(-) diff --git a/src/Component/Thread/Intro.hs b/src/Component/Thread/Intro.hs index 77c19fc..a3cf94f 100644 --- a/src/Component/Thread/Intro.hs +++ b/src/Component/Thread/Intro.hs @@ -18,18 +18,19 @@ import Miso import GHCJS.DOM.Types (JSString) import Data.Foldable (toList) import Miso.String (toMisoString) -import Data.Time.Clock (UTCTime) +import Data.Time.Clock (UTCTime, diffUTCTime) import Data.Time.Format (formatTime, defaultTimeLocale) import Network.PostType (Post) import qualified Network.PostType as Post + formatUTC :: UTCTime -> JSString formatUTC time = toMisoString $ formatTime defaultTimeLocale "%Y-%m-%d (%a) %T" time -intro :: Post -> View a -intro post = span_ +intro :: Post -> UTCTime -> View a +intro post current_time = span_ [ class_ "intro" ] ( subject ++ [ " " @@ -40,7 +41,7 @@ intro post = span_ , time_ [ textProp "datetime" $ toMisoString $ show $ creation_time , textProp "data-local" "true" - -- , title_ "14 days ago" + , title_ $ toMisoString $ timeAgo current_time creation_time ][ text $ formatUTC creation_time ] , " " , a_ @@ -68,3 +69,27 @@ intro post = span_ mkSubject s = span_ [ class_ "subject" ] [ text s ] + + +-- Convert UTCTime to a human-readable string +timeAgo :: UTCTime -> UTCTime -> String +timeAgo currentTime pastTime = + let diff = realToFrac $ diffUTCTime currentTime pastTime + in humanReadableTimeDiff diff + +-- Helper function to correctly format singular and plural units +formatTimeUnit :: (Integral a, Show a) => a -> String -> String +formatTimeUnit value unit + | value == 1 = show value ++ " " ++ unit ++ " ago" + | otherwise = show value ++ " " ++ unit ++ "s ago" + +-- Convert time difference in seconds to a human-readable format +humanReadableTimeDiff :: Double -> String +humanReadableTimeDiff diff + | diff < 60 = "Just now" + | diff < 3600 = formatTimeUnit (truncate (diff / 60) :: Int) "minute" + | diff < 86400 = formatTimeUnit (truncate (diff / 3600) :: Int) "hour" + | diff < 604800 = formatTimeUnit (truncate (diff / 86400) :: Int) "day" + | diff < 2592000 = formatTimeUnit (truncate (diff / 604800) :: Int) "week" + | diff < 31536000 = formatTimeUnit (truncate (diff / 2592000) :: Int) "month" + | otherwise = formatTimeUnit (truncate (diff / 31536000) :: Int) "year" diff --git a/src/Component/Thread/Model.hs b/src/Component/Thread/Model.hs index cc9bb37..7eb10d5 100644 --- a/src/Component/Thread/Model.hs +++ b/src/Component/Thread/Model.hs @@ -4,6 +4,7 @@ import GHCJS.DOM.Types (JSString) import Network.SiteType (Site) import Network.PostType (Post) import BodyParser (PostPart) +import Data.Time.Clock (UTCTime) type PostWithBody = (Post, [ PostPart ]) @@ -11,5 +12,6 @@ data Model = Model { site :: Site , media_root :: JSString , post_bodies :: [ PostWithBody ] + , current_time :: UTCTime } deriving Eq diff --git a/src/Component/ThreadView.hs b/src/Component/ThreadView.hs index 366c569..d0454fd 100644 --- a/src/Component/ThreadView.hs +++ b/src/Component/ThreadView.hs @@ -27,6 +27,8 @@ import Miso import Data.Text (Text) import Miso.String (toMisoString) import GHCJS.DOM.Types (JSString) +import Data.Time.Clock (UTCTime (..), secondsToDiffTime, getCurrentTime) +import Data.Time.Calendar (Day (..)) import Network.SiteType (Site) import qualified Network.SiteType as Site @@ -45,11 +47,12 @@ initialModel mroot s = Model { site = s , post_bodies = [] , media_root = mroot + , current_time = UTCTime (ModifiedJulianDay 0) (secondsToDiffTime 0) } data Action = RenderSite Site - | UpdatePostBodies [ PostWithBody ] + | UpdatePostBodies UTCTime [ PostWithBody ] data Interface a = Interface { passAction :: Action -> a } @@ -59,7 +62,9 @@ update iface (RenderSite s) m = m { site = s } <# do mapM_ (consoleLog . toMisoString . show) bodies - return $ passAction iface $ UpdatePostBodies $ zip posts bodies + now <- getCurrentTime + + return $ passAction iface $ UpdatePostBodies now $ zip posts bodies where getBody :: Maybe Text -> IO [ PostPart ] @@ -70,7 +75,7 @@ update iface (RenderSite s) m = m { site = s } <# do posts = Thread.posts $ head $ Board.threads $ head $ Site.boards s --update (RenderSite s) m = noEff (m { site = s }) -update _ (UpdatePostBodies pwbs) m = noEff m { post_bodies = pwbs } +update _ (UpdatePostBodies t pwbs) m = noEff m { post_bodies = pwbs, current_time = t } view :: Model -> View a @@ -113,7 +118,7 @@ op m op_post = , id_ $ toMisoString $ show $ Post.board_post_id op_post ] ++ multi op_post ) - [ intro op_post + [ intro op_post $ current_time m , div_ [ class_ "body" ] (body $ post_bodies m) @@ -145,7 +150,7 @@ reply m (post, parts) = div_ [ class_ "post reply" ] ++ multi post ) - [ intro post + [ intro post $ current_time m , files (media_root m) (site m) post , div_ [ class_ "body" ] diff --git a/src/Main.hs b/src/Main.hs index 885f484..80d3f7d 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -183,7 +183,7 @@ mainUpdate (HaveThread (Client.HttpResponse {..})) m = new_model <# do where new_model = m { thread_model = - body >>= Just . (Thread.initialModel (media_root_ m)) . head + body >>= Just . (Thread.initialModel $ media_root_ m) . head } mainUpdate GetLatest m = m <# Client.fetchLatest (client_model m) (iClient HaveLatest)