From fd55805e49d6e20ad38f0d406466a4c6bae73050 Mon Sep 17 00:00:00 2001 From: Travis Montoya Date: Wed, 13 Nov 2024 18:46:03 -0700 Subject: [PATCH] adding alarm functionality to watch --- Lib/DecimalTime.hs | 21 +++++++++++- Lib/PrettyPrinter.hs | 28 ++++++++++------ Lib/Types.hs | 22 ++++++++++--- README.md | 7 ++-- app/Main.hs | 78 ++++++++++++++++++++++++++------------------ 5 files changed, 106 insertions(+), 50 deletions(-) diff --git a/Lib/DecimalTime.hs b/Lib/DecimalTime.hs index 71dcda1..6737508 100644 --- a/Lib/DecimalTime.hs +++ b/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" \ No newline at end of file diff --git a/Lib/PrettyPrinter.hs b/Lib/PrettyPrinter.hs index 4e4b047..1be85fa 100644 --- a/Lib/PrettyPrinter.hs +++ b/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 #-} diff --git a/Lib/Types.hs b/Lib/Types.hs index ed9d4ee..1218776 100644 --- a/Lib/Types.hs +++ b/Lib/Types.hs @@ -18,9 +18,11 @@ module Types ( , DecimalTime(..) , ValidDecimalTime(..) , ClockState(..) + , TimeStatus(..) , extendedFlag , decimalTime , currentDate + , alarmTime , Lens , Lens'' , (><) @@ -28,6 +30,7 @@ module Types ( 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,13 +48,19 @@ 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) @@ -59,10 +68,13 @@ 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 \ No newline at end of file +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 \ No newline at end of file diff --git a/README.md b/README.md index d18db62..e7aae3e 100644 --- a/README.md +++ b/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 diff --git a/app/Main.hs b/app/Main.hs index 3834d9c..8ec9fd9 100644 --- a/app/Main.hs +++ b/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)) \ No newline at end of file + 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)) \ No newline at end of file