adding alarm functionality to watch

Lib/DecimalTime.hs

@@ -22,6 +22,7 @@
 module DecimalTime (
       setCurrentDate
     , localTimeToDecimal
+    , checkTimeStatus
 ) where
 
 import Types
@@ -30,10 +31,12 @@ import Types
     DecimalTime (..),
     Seconds (..),
     ValidDecimalTime (..),
+    TimeStatus (..),
     (><),
     currentDate,
     decimalTime,
-    extendedFlag)
+    extendedFlag,
+    alarmTime)
 import Data.Time
   ( LocalTime (localTimeOfDay),
     TimeOfDay (TimeOfDay),
@@ -106,3 +109,19 @@ localTimeToDecimal s = do
 {-# INLINE setCurrentDate #-}
 setCurrentDate :: ZonedTime -> ClockState -> ClockState
 setCurrentDate zt state = state & (currentDate ?~ zonedTimeToLocalTime zt)
+
+checkAlarmTime :: ClockState -> Maybe DecimalTime
+checkAlarmTime s = do
+  alarm <- s ^. alarmTime
+  decimal <- s ^. decimalTime >>= return . unVDT
+  if alarm == decimal
+    then Just decimal
+    else Nothing
+
+checkTimeStatus :: Either String ClockState -> TimeStatus
+checkTimeStatus (Left err) = Error err
+checkTimeStatus (Right state) = case checkAlarmTime state of
+  Just t -> AlarmReached t
+  Nothing -> case state ^. decimalTime of
+    Just _ -> Normal
+    Nothing -> Error "Error reading Decimal Time"

Lib/PrettyPrinter.hs

@@ -23,9 +23,11 @@ import Types
   ( ClockState (..),
     DecimalTime (..),
     ValidDecimalTime (..),
+    TimeStatus (..),
     extendedFlag,
     currentDate,
-    decimalTime)
+    decimalTime,
+    alarmTime)
 import Data.Time (LocalTime)
 import Control.Lens ((^.))
 import Control.Monad.IO.Class (liftIO)
@@ -51,20 +53,26 @@ renderTimeText s e =
 -- prop> fmt (Right $ ValidDecimalTime (DecimalTime 333)) == "Decimal time: 333"
 -- prop> fmt (Left "Time must be between 0 and 1000") == "Decimal time: Time must be between 0 and 1000"
 {-# INLINE formatTime #-}
-formatTime :: Either String ClockState -> T.Text
-formatTime = \case
-    Left err -> "Decimal time: " <> T.pack err
-    Right state -> renderTimeText state $ extendedInfo state
+formatTime :: TimeStatus -> Either String ClockState -> T.Text
+formatTime status state = case (status, state) of
+  (Error err, _) ->
+    "Decimal time: " <> T.pack err
+  (AlarmReached _, Right s) ->
+    baseTimeText s <> " ALARM!" -- Just append ALARM! to normal output
+  (Normal, Right s) ->
+    baseTimeText s
+  (_, _) ->
+    "Invalid state"
   where
+    baseTimeText s = renderTimeText s (extendedInfo s)
+
     {-# INLINE extendedInfo #-}
     extendedInfo :: ClockState -> T.Text
     extendedInfo s =
       if s ^. extendedFlag
-        then
-          ( case s ^. currentDate of
-              Just date -> " (" <> T.pack (fmtTime date) <> ")"
-              Nothing -> ""
-          )
+        then case s ^. currentDate of
+          Just date -> " (" <> T.pack (fmtTime date) <> ")"
+          Nothing -> ""
         else ""
 
     {-# INLINE fmtTime #-}

Lib/Types.hs

@@ -18,16 +18,19 @@ module Types (
   , DecimalTime(..)
   , ValidDecimalTime(..)
   , ClockState(..)
+  , TimeStatus(..)
   , extendedFlag
   , decimalTime
   , currentDate
+  , alarmTime
   , Lens
   , Lens''
   , (><)
 ) where
 
 import Data.Time (LocalTime)
 import qualified Control.Lens as L
+import System.Console.ANSI (ConsoleIntensity(NormalIntensity))
 
 -- | Infix operator for range checking where lower bound is 0
 infixr 5 ><
@@ -45,24 +48,33 @@ newtype DecimalTime = DecimalTime Integer
   deriving (Eq, Show, Ord, Num, Enum, Real, Integral)
 
 -- | Validation for our decimal time values
-newtype ValidDecimalTime = ValidDecimalTime DecimalTime
+newtype ValidDecimalTime = ValidDecimalTime { unVDT :: DecimalTime }
   deriving (Show, Eq)
 
+data TimeStatus
+  = Normal
+  | AlarmReached DecimalTime
+  | Error String
+
 data ClockState = ClockState
   { _extendedFlag :: Bool,
     _decimalTime  :: Maybe ValidDecimalTime,
-    _currentDate  :: Maybe LocalTime
+    _currentDate  :: Maybe LocalTime,
+    _alarmTime    :: Maybe DecimalTime
   }
   deriving (Eq, Show)
 
 type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
 type Lens'' s a = L.Lens s s a a
 
 extendedFlag :: Lens'' ClockState Bool
-extendedFlag k (ClockState e d c) = (\e' -> ClockState e' d c) <$> k e
+extendedFlag k (ClockState e d c a) = (\e' -> ClockState e' d c a) <$> k e
 
 decimalTime :: Lens'' ClockState (Maybe ValidDecimalTime)
-decimalTime k (ClockState e d c) = (\d' -> ClockState e d' c) <$> k d
+decimalTime k (ClockState e d c a) = (\d' -> ClockState e d' c a) <$> k d
 
 currentDate :: Lens'' ClockState (Maybe LocalTime)
-currentDate k (ClockState e d c) = (\c' -> ClockState e d c') <$> k c
+currentDate k (ClockState e d c a) = (\c' -> ClockState e d c' a) <$> k c
+
+alarmTime :: Lens'' ClockState (Maybe DecimalTime)
+alarmTime k (ClockState e d c a) = (\a' -> ClockState e d c a') <$> k a

README.md

@@ -17,15 +17,16 @@ You can type -v or --version to see program information or -e to print extended
 $ cabal run exe:dclock -- -h
 dclock - decimal time clock
 
-Usage: dclock [(-v|--version) | [-e|--extended] [-w|--watch]]
+Usage: dclock [(-v|--version) | [-e|--extended] [-w|--watch] [-a|--alarm TIME]]
 
   Decimal time clock that maps your day to 1000 decimal minutes
 
 Available options:
   -v,--version             Show version information
   -e,--extended            Show extended information including date
-  -w,--watch               Watch mode, view as a realtime decimal clock (updates
-                           every second)
+  -w,--watch               Watch mode
+  -a,--alarm TIME          Set alarm for decimal time (0-1000, only valid with
+                           watch mode)
   -h,--help                Show this help text
 $ cabal run
 Decimal time: 25

app/Main.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE LambdaCase #-}
 -----------------------------------------------------------------------------
 -- |
 -- Copyright   :  (c) Travis Montoya 2024
@@ -34,14 +35,16 @@ import qualified Data.Text.IO as TIO
 import qualified PrettyPrinter as Pretty (formatTime, displaySingleLine, spinner)
 import qualified DecimalTime as DT (
       localTimeToDecimal,
-      setCurrentDate)
-import Types (ClockState( .. ))
+      setCurrentDate,
+      checkTimeStatus)
+import Types (ClockState( .. ), DecimalTime( .. ))
 
 data RunMode = SingleRun | Watch
 
 data Config = Config
     { extended :: Bool
     , mode     :: RunMode
+    , alarm    :: Maybe Integer
     }
 
 data Command
@@ -59,18 +62,29 @@ parser = versionCmd <|> runCmd
             <> help "Show version information"
         )
 
-    runCmd = fmap Run $
-        Config <$> switch
-        ( long "extended"
-            <> short 'e'
-            <> help "Show extended information including date"
-        )
-        <*> flag
-        SingleRun
-        Watch
-        ( long "watch"
-            <> short 'w'
-            <> help "Watch mode, view as a realtime decimal clock (updates every second)"
+
+runCmd :: Parser Command
+runCmd =
+  Run
+    <$> ( Config
+            <$> switch
+              ( long "extended"
+                  <> short 'e'
+                  <> help "Show extended information including date"
+              )
+            <*> flag
+              SingleRun
+              Watch
+              ( long "watch"
+                  <> short 'w'
+                  <> help "Watch mode"
+              )
+            <*> (optional . option auto)
+              ( long "alarm"
+                  <> short 'a'
+                  <> metavar "TIME"
+                  <> help "Set alarm for decimal time (0-1000, only valid with watch mode)"
+              )
         )
 
 -- | Get platform information for version string
@@ -116,20 +130,22 @@ main = execParser opts >>= run
       where
         runWith :: Config -> IO ()
         runWith config' = case mode config' of
-          SingleRun -> runClock (extended config') >> TIO.putStrLn ""
-          Watch     -> watchClock (extended config')
-
-        runClock :: Bool -> IO ()
-        runClock e = do
-          let state = ClockState e Nothing Nothing
-          runT_ $
-            zonedTime
-              ~> M.mapping (`DT.setCurrentDate` state)
-              ~> M.mapping DT.localTimeToDecimal
-              ~> M.mapping Pretty.formatTime
-              ~> displayTimeText
-
-        watchClock :: Bool -> IO ()
-        watchClock extended' = bracket_ hideCursor 
-          showCursor (TIO.putStrLn "Press Ctrl-C to exit\n" >>
-              fix (\loop -> runClock extended' >> Pretty.spinner >> loop))
+            SingleRun -> runClock (extended config') (alarm config') >> TIO.putStrLn ""
+            Watch     -> watchClock (extended config') (alarm config')
+
+        runClock :: Bool -> Maybe Integer -> IO ()
+        runClock e alarm' = do
+            let state = ClockState e Nothing Nothing (fmap DecimalTime alarm')
+            runT_ $
+                zonedTime
+                ~> M.mapping (`DT.setCurrentDate` state)
+                ~> M.mapping DT.localTimeToDecimal
+                ~> M.mapping (\a -> Pretty.formatTime (DT.checkTimeStatus a) a)
+                ~> displayTimeText
+
+        watchClock :: Bool -> Maybe Integer -> IO ()
+        watchClock extended' alarm'' = bracket_ 
+            hideCursor
+            showCursor 
+            (TIO.putStrLn "Press Ctrl-C to exit\n" >>
+                fix (\loop -> runClock extended' alarm'' >> Pretty.spinner >> loop))