(#712) Implement Schedule.eventSummary

HyperNerd.cabal

@@ -87,6 +87,7 @@ executable HyperNerd
                      , Data.Either.Extra
                      , Data.Maybe.Extra
                      , Data.Bool.Extra
+                     , Data.Time.Extra
                      , Effect
                      , Entity
                      , HyperNerd.Comonad
@@ -225,6 +226,7 @@ test-suite HyperNerdTest
                      , Bot.FridayTest
                      , Bot.GitHub
                      , Data.Maybe.Extra
+                     , Data.Time.Extra
                      , Regexp
                      , Command
                      , CommandTest

src/Bot.hs

@@ -51,7 +51,7 @@ import qualified Network.URI.Encode as URI
 import Reaction
 import Regexp
 import Safe
-import Schedule (eventSummary, nextEvent)
+import Schedule (eventSummary, nextEvent, scheduleTimezone)
 import System.Random
 import Text.InterpolatedString.QM
 import Text.Read
@@ -520,8 +520,12 @@ nextStreamCommand :: Reaction Message a
 nextStreamCommand =
   cmapR (const "https://tsoding.github.io/schedule/schedule.json") $
   jsonHttpRequestReaction $
-  liftR (\schedule -> nextEvent schedule <$> now) $
-  replyLeft $ cmapR eventSummary $ Reaction replyMessage
+  liftR
+    (\schedule -> do
+       t <- now
+       return
+         (eventSummary (scheduleTimezone schedule) t <$> nextEvent schedule t)) $
+  replyLeft $ Reaction replyMessage
 
 signText :: T.Text -> Either String Int
 signText "-" = Right (-1)

src/Bot/Twitch.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
 
 module Bot.Twitch where
 
@@ -10,11 +9,11 @@ import Data.Aeson.Types
 import Data.Maybe
 import qualified Data.Text as T
 import Data.Time
+import Data.Time.Extra
 import Effect
 import Network.HTTP.Simple
 import qualified Network.URI.Encode as URI
 import Reaction
-import Text.InterpolatedString.QM
 import Text.Printf
 import Transport
 
@@ -48,28 +47,6 @@ twitchStreamByLogin login = do
     (return . listToMaybe . trData)
     (eitherDecode $ getResponseBody response)
 
-humanReadableDiffTime :: NominalDiffTime -> T.Text
-humanReadableDiffTime t =
-  T.pack $
-  unwords $
-  map (\(name, amount) -> [qms|{amount} {name}|]) $
-  filter ((> 0) . snd) components
-  where
-    s :: Int
-    s = round t
-    components :: [(T.Text, Int)]
-    components =
-      [ ("days" :: T.Text, s `div` secondsInDay)
-      , ("hours", (s `mod` secondsInDay) `div` secondsInHour)
-      , ( "minutes"
-        , ((s `mod` secondsInDay) `mod` secondsInHour) `div` secondsInMinute)
-      , ( "seconds"
-        , ((s `mod` secondsInDay) `mod` secondsInHour) `mod` secondsInMinute)
-      ]
-    secondsInDay = 24 * secondsInHour
-    secondsInHour = 60 * secondsInMinute
-    secondsInMinute = 60
-
 streamUptime :: TwitchStream -> Effect NominalDiffTime
 streamUptime twitchStream = do
   currentTime <- now

src/Data/Time/Extra.hs

@@ -0,0 +1,30 @@
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Data.Time.Extra where
+
+import qualified Data.Text as T
+import Data.Time
+import Text.InterpolatedString.QM
+
+humanReadableDiffTime :: NominalDiffTime -> T.Text
+humanReadableDiffTime t =
+  T.pack $
+  unwords $
+  map (\(name, amount) -> [qms|{amount} {name}|]) $
+  filter ((> 0) . snd) components
+  where
+    s :: Int
+    s = round t
+    components :: [(T.Text, Int)]
+    components =
+      [ ("days" :: T.Text, s `div` secondsInDay)
+      , ("hours", (s `mod` secondsInDay) `div` secondsInHour)
+      , ( "minutes"
+        , ((s `mod` secondsInDay) `mod` secondsInHour) `div` secondsInMinute)
+      , ( "seconds"
+        , ((s `mod` secondsInDay) `mod` secondsInHour) `mod` secondsInMinute)
+      ]
+    secondsInDay = 24 * secondsInHour
+    secondsInHour = 60 * secondsInMinute
+    secondsInMinute = 60

src/Schedule.hs

@@ -5,6 +5,7 @@ module Schedule
   ( nextEvent
   , eventSummary
   , dayOfWeek
+  , Schedule(..)
   ) where
 
 import Control.Monad
@@ -21,6 +22,7 @@ import qualified Data.Text as T
 import Data.Time
 import Data.Time.Calendar.WeekDate
 import Data.Time.Clock.POSIX
+import Data.Time.Extra
 import Data.Time.LocalTime (TimeZone)
 import Safe
 import Text.InterpolatedString.QM
@@ -80,9 +82,17 @@ eventUTCTime (ScheduleTimeZone timeZone) Event { eventDate = day
   where
     localTime = LocalTime day timeOfDay
 
--- TODO(#712): Schedule.eventSummary is not implemented
-eventSummary :: Event -> T.Text
-eventSummary = eventTitle
+eventSummary :: ScheduleTimeZone -> UTCTime -> Event -> T.Text
+eventSummary timezone now event = do
+  let t = eventUTCTime timezone event
+  -- TODO(#755): Diff time for past events in eventSummary should be `finished - (started + DURATION)`
+  if t >= now
+    then let d = diffUTCTime t now
+          in [qms|{eventTitle event}
+                  starts in {humanReadableDiffTime d}|]
+    else let d = diffUTCTime now t
+          in [qms|{eventTitle event}
+                  finished {humanReadableDiffTime d} ago|]
 
 newtype EventId =
   EventId Int

src/Sqlite/Compiler.hs

@@ -43,7 +43,7 @@ compileCondition cteId (E.PropertyEquals propertyName property) =
 compileCondition _ (E.ConditionAnd _) = undefined
 -- TODO(#563): E.PropertyGreater is not interpreted in Sqlite.Compiler.compileCondition
 compileCondition _ (E.PropertyGreater _ _) = undefined
--- TODO: E.PropertyMissing is not interpreted in Sqlite.Compiler.compileCondition
+-- TODO(#756): E.PropertyMissing is not interpreted in Sqlite.Compiler.compileCondition
 compileCondition _ (E.PropertyMissing _) = undefined
 
 -- TODO(#253): compileCteChain doesn't optimize common patterns like Sqlite.EntityPersistence.selectEntityIds