Human readable time title attribute

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 -> UTCTime -> View a
-intro post = span_
+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"

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
 

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

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)