{- | timeutils Copyright (C) 2019 Jonathan Lamothe This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . -} module Data.Time.Utils ( -- * Types Timer (..), TimeParts (..), Countdown (..), Stopwatch (..), -- * Lenses -- ** Timer Lenses timerOffsetL, timerStartTimeL, -- ** TimeParts Lenses tpDaysL, tpHoursL, tpMinutesL, tpSecondsL, tpMillisL, -- ** Countdown Lenses countdownLengthL, countdownTimerL, -- ** Stopwatch Lenses stopwatchTimerL, stopwatchLapsL, -- * Constructors newTimer, newTimeParts, newCountdown, newStopwatch, -- * Impure Functions -- ** Timer Functions startTimer, stopTimer, timeElapsed, -- ** Countdown Functions startCountdown, stopCountdown, timeRemaining, countdownIsCompleted, -- ** Stopwatch Functions startStopwatch, stopStopwatch, newLap, currentLap, allLaps, totalStopwatchTime, -- * Pure Functions decomposeNDT, composeNDT, humanNDT, -- ** Timer Functions timerIsRunning, timerIsStarted, startTimerAt, stopTimerAt, timeElapsedAt, -- ** Countdown Functions countdownIsRunning, countdownIsStarted, startCountdownAt, stopCountdownAt, timeRemainingAt, countdownIsCompletedAt, -- ** Stopwatch Functions stopwatchIsRunning, stopwatchIsStarted, startStopwatchAt, stopStopwatchAt, newLapAt, currentLapAt, allLapsAt, totalStopwatchTimeAt ) where import Data.Maybe (isJust, isNothing) import Data.Time.Clock ( NominalDiffTime , UTCTime , diffUTCTime , getCurrentTime ) import Lens.Micro (Lens', lens) -- | A type that keeps track of the passage of time data Timer = Timer { timerOffset :: NominalDiffTime -- ^ The amount of time previously logged , timerStartTime :: Maybe UTCTime -- ^ The time the 'Timer' was last started ('Nothing' if not -- currently running) } deriving (Eq, Show) -- | Lens for the 'timerOffset' attribute timerOffsetL :: Lens' Timer NominalDiffTime timerOffsetL = lens timerOffset $ \t o -> t { timerOffset = o } -- | Lens for the 'timerStartTime' attribute timerStartTimeL :: Lens' Timer (Maybe UTCTime) timerStartTimeL = lens timerStartTime $ \t st -> t { timerStartTime = st } -- | Represents a 'NominalDiffTime' broken down into days, hours, -- minutes, seconds and milliseconds data TimeParts = TimeParts { tpDays :: Int -- ^ The number of days , tpHours :: Int -- ^ The number of hours , tpMinutes :: Int -- ^ The number of minutes , tpSeconds :: Int -- ^ The number of seconds , tpMillis :: Int -- ^ The number of milliseconds } deriving (Eq, Show) -- | Lens for the 'tpDays' attribute tpDaysL :: Lens' TimeParts Int tpDaysL = lens tpDays $ \tp d -> tp { tpDays = d } -- | Lens for the 'tpHours' attribute tpHoursL :: Lens' TimeParts Int tpHoursL = lens tpHours $ \tp h -> tp { tpHours = h } -- | Lens for the 'tpMinutes' attribute tpMinutesL :: Lens' TimeParts Int tpMinutesL = lens tpMinutes $ \tp m -> tp { tpMinutes = m } -- | Lens for the 'tpSeconds' attribute tpSecondsL :: Lens' TimeParts Int tpSecondsL = lens tpSeconds $ \tp s -> tp { tpSeconds = s } -- | Lens for the 'tpMillis' attribute tpMillisL :: Lens' TimeParts Int tpMillisL = lens tpMillis $ \tp ms -> tp { tpMillis = ms } -- | Represents a timed countdown data Countdown = Countdown { countdownLength :: NominalDiffTime -- ^ The length of time , countdownTimer :: Timer -- ^ The timer which runs the 'Countdown' } deriving (Eq, Show) -- | Lens for the 'countdownLength' attribute countdownLengthL :: Lens' Countdown NominalDiffTime countdownLengthL = lens countdownLength $ \cd l -> cd { countdownLength = l } -- | Lens for the 'countdownTimer' attribute countdownTimerL :: Lens' Countdown Timer countdownTimerL = lens countdownTimer $ \cd t -> cd { countdownTimer = t } -- | Tracks the time of multiple laps data Stopwatch = Stopwatch { stopwatchTimer :: Timer -- ^ The 'Timer' for the current lap , stopwatchLaps :: [NominalDiffTime] -- ^ The times of previous laps (most recent first) } deriving (Eq, Show) -- | Lens for the 'stopwatchTimer' attribute stopwatchTimerL :: Lens' Stopwatch Timer stopwatchTimerL = lens stopwatchTimer $ \sw t -> sw { stopwatchTimer = t } -- | Lens for the 'stopwatchLaps' attribute stopwatchLapsL :: Lens' Stopwatch [NominalDiffTime] stopwatchLapsL = lens stopwatchLaps $ \sw l -> sw { stopwatchLaps = l } -- | New instance of a 'Timer' newTimer :: Timer newTimer = Timer 0 Nothing -- | New instance of a 'TimeParts' value newTimeParts :: TimeParts newTimeParts = TimeParts 0 0 0 0 0 -- | New instance of a 'Countdown' newCountdown :: NominalDiffTime -- ^ The time length -> Countdown newCountdown l = Countdown l newTimer -- | New instance of a stopwatch newStopwatch :: Stopwatch newStopwatch = Stopwatch { stopwatchTimer = newTimer , stopwatchLaps = [] } -- | Starts a 'Timer' startTimer :: Timer -- ^ The 'Timer' being started -> IO Timer -- ^ The modified 'Timer' startTimer timer = startTimerAt <$> getCurrentTime <*> return timer -- | Stops a 'Timer' stopTimer :: Timer -- ^ The 'Timer' being stopped -> IO Timer -- ^ The modified 'Timer' stopTimer timer = stopTimerAt <$> getCurrentTime <*> return timer -- | Calculates the amount of time elapsed on a 'Timer' timeElapsed :: Timer -- ^ The 'Timer' being checked -> IO NominalDiffTime -- ^ The amount of time elapsed timeElapsed timer = timeElapsedAt <$> getCurrentTime <*> return timer -- | Starts a 'Countdown' startCountdown :: Countdown -- ^ The 'Countdown' being started -> IO Countdown -- ^ Returns the modified 'Countdown' startCountdown countdown = startCountdownAt <$> getCurrentTime <*> return countdown -- | Stops a 'Countdown' stopCountdown :: Countdown -- ^ The 'Countdown' being stopped -> IO Countdown -- ^ Returns the modified 'Countdown' stopCountdown countdown = stopCountdownAt <$> getCurrentTime <*> return countdown -- | Calculates the amount of time remaining in a 'Countdown' timeRemaining :: Countdown -- ^ The 'Countdown' being checked -> IO NominalDiffTime -- ^ The amount of time remaining timeRemaining countdown = timeRemainingAt <$> getCurrentTime <*> return countdown -- | Determines whether or not a 'Countdown' has completed. countdownIsCompleted :: Countdown -- ^ The 'Countdown' being checked -> IO Bool -- ^ Returns 'True' if the 'Countdown' has completed, 'False' -- otherwise countdownIsCompleted countdown = countdownIsCompletedAt <$> getCurrentTime <*> return countdown -- | Starts a 'Stopwatch' startStopwatch :: Stopwatch -- ^ The 'Stopwatch' being started -> IO Stopwatch -- ^ Returns the modified 'Stopwatch' startStopwatch stopwatch = startStopwatchAt <$> getCurrentTime <*> return stopwatch -- | Stops a 'Stopwatch' stopStopwatch :: Stopwatch -- ^ The 'Stopwatch' being stopped -> IO Stopwatch -- ^ Returns the modified 'Stopwatch' stopStopwatch stopwatch = stopStopwatchAt <$> getCurrentTime <*> return stopwatch -- | Starts a new lap newLap :: Stopwatch -- ^ The 'Stopwatch' being modified -> IO Stopwatch -- ^ Returns the 'Stopwatch' being modified newLap stopwatch = newLapAt <$> getCurrentTime <*> return stopwatch -- | Returns the time of the current lap from a 'Stopwatch' currentLap :: Stopwatch -- ^ The 'Stopwatch' being checked -> IO NominalDiffTime -- ^ Returns the amount of time elapsed in the current lap currentLap stopwatch = currentLapAt <$> getCurrentTime <*> return stopwatch -- | Returns the lap times for a 'Stopwatch' allLaps :: Stopwatch -- ^ The 'Stopwatch' being checked -> IO [NominalDiffTime] -- ^ Returns the lap times (most recent first) allLaps stopwatch = allLapsAt <$> getCurrentTime <*> return stopwatch -- | Calculates the total run time of a 'Stopwatch' totalStopwatchTime :: Stopwatch -- ^ The 'Stopwatch' being checked -> IO NominalDiffTime -- ^ Returns the total run time totalStopwatchTime stopwatch = totalStopwatchTimeAt <$> getCurrentTime <*> return stopwatch -- | Converts a 'NominalDiffTime' to a 'TimeParts' value decomposeNDT :: NominalDiffTime -> TimeParts decomposeNDT t = TimeParts { tpDays = days , tpHours = hours , tpMinutes = minutes , tpSeconds = seconds , tpMillis = millis } where days = h `quot` 24 hours = h - days * 24 minutes = m - h * 60 seconds = s - m * 60 millis = ms - s * 1000 h = m `quot` 60 m = s `quot` 60 s = ms `quot` 1000 ms = floor $ t * 1000 -- | Converts a 'TimeParts' value to a 'NominalDiffTime' composeNDT :: TimeParts -> NominalDiffTime composeNDT tp = fromInteger millis / 1000 where millis = seconds * 1000 + toInteger (tpMillis tp) seconds = minutes * 60 + toInteger (tpSeconds tp) minutes = hours * 60 + toInteger (tpMinutes tp) hours = toInteger (tpDays tp) * 24 + toInteger (tpHours tp) -- | Converts a 'NominalDiffTime' into a more human-readable format humanNDT :: NominalDiffTime -> String humanNDT t = sign ++ d ++ h ++ m ++ s ++ ms where sign = if t < 0 then "-" else "" d = show (tpDays tp) ++ "d " h = fix 2 (tpHours tp) ++ "h " m = fix 2 (tpMinutes tp) ++ "m " s = fix 2 (tpSeconds tp) ++ "." ms = fix 3 (tpMillis tp) ++ "s" tp = decomposeNDT $ abs t fix n x = let str = show x slen = length str plen = n - slen pad = replicate plen '0' in pad ++ str -- | Determines whether or not a 'Timer' is running timerIsRunning :: Timer -- ^ The 'Timer' being checked -> Bool timerIsRunning = isJust . timerStartTime -- | Determines whether or not a 'Timer' has been started (even if it -- is currently stopped) timerIsStarted :: Timer -- ^ The 'Timer' being checked -> Bool -- ^ 'True' if the timer has been started, 'False' otherwise timerIsStarted timer = timerIsRunning timer || timerOffset timer /= 0 -- | Starts a 'Timer' from a given time startTimerAt :: UTCTime -- ^ The current time -> Timer -- ^ The 'Timer' being started -> Timer -- ^ The modified 'Timer' startTimerAt t timer | isNothing (timerStartTime timer) = timer { timerStartTime = Just t } | otherwise = timer -- | Stops a 'Timer' from a given time stopTimerAt :: UTCTime -- ^ The current time -> Timer -- ^ The 'Timer' being stopped -> Timer -- ^ The modified 'Timer' stopTimerAt t timer = newTimer { timerOffset = offset } where offset = timeElapsedAt t timer -- | Calculates the amount of time elapsed on a 'Timer' from a given -- time timeElapsedAt :: UTCTime -- ^ The current time -> Timer -- ^ The 'Timer' being checked -> NominalDiffTime -- ^ The amount of time elapsed timeElapsedAt t timer = case timerStartTime timer of Nothing -> timerOffset timer Just st -> timerOffset timer + diffUTCTime t st -- | Determines whether or not a 'Countdown' is running countdownIsRunning :: Countdown -- ^ The 'Countdown' being checked -> Bool -- ^ 'True' if running, 'False' otherwise countdownIsRunning countdown = timerIsRunning timer where timer = countdownTimer countdown -- | Determines whether or not a 'Countdown' has been started (even if -- subsequently stopped) countdownIsStarted :: Countdown -- ^ The 'Countdown' being checked -> Bool -- ^ 'True' if it has been started, 'False' otherwise countdownIsStarted countdown = timerIsStarted timer where timer = countdownTimer countdown -- | Starts a 'Countdown' using a given time startCountdownAt :: UTCTime -- ^ The current time -> Countdown -- ^ The 'Countdown' being started -> Countdown -- ^ The modified 'Countdown' startCountdownAt t countdown = countdown { countdownTimer = timer' } where timer' = startTimerAt t timer timer = countdownTimer countdown -- | Stops a 'Countdown' using a given time stopCountdownAt :: UTCTime -- ^ The current time -> Countdown -- ^ The 'Countdown' being stopped -> Countdown -- ^ The modified 'Countdown' stopCountdownAt t countdown = countdown { countdownTimer = timer' } where timer' = stopTimerAt t timer timer = countdownTimer countdown -- | Calculates the amount of time remaining in a 'Countdown' at a -- given time timeRemainingAt :: UTCTime -- ^ The current time -> Countdown -- ^ The 'Countdown' being checked -> NominalDiffTime -- ^ The amount of time remaining timeRemainingAt t countdown = len - timeElapsedAt t timer where len = countdownLength countdown timer = countdownTimer countdown -- | Determines if a 'Countdown' is completed at a given time countdownIsCompletedAt :: UTCTime -- ^ The current time -> Countdown -- ^ The 'Countdown' being checked -> Bool -- ^ Returns 'True' if the 'Countdown' has completed, 'False' -- otherwise. countdownIsCompletedAt t countdown = timeRemainingAt t countdown <= 0 -- | Determines whether or not a 'Stopwatch' is running stopwatchIsRunning :: Stopwatch -- ^ The 'Stopwatch' being checked -> Bool -- ^ 'True' if the 'Stopwatch' is running, 'False' otherwise stopwatchIsRunning = timerIsRunning . stopwatchTimer -- | Determines whether or not a stopwatch has been started (even if -- subsequently stopped) stopwatchIsStarted :: Stopwatch -- ^ The 'Stopwatch' being checked -> Bool -- ^ 'True' if started, 'False' otherwise stopwatchIsStarted = (/= newStopwatch) -- | Starts a 'Stopwatch' at a given time startStopwatchAt :: UTCTime -- ^ The current time -> Stopwatch -- ^ The 'Stopwatch' being started -> Stopwatch -- ^ The modified 'Stopwatch' startStopwatchAt t stopwatch = stopwatch { stopwatchTimer = timer } where timer = startTimerAt t $ stopwatchTimer stopwatch -- | Stops a 'Stopwatch' at a given time stopStopwatchAt :: UTCTime -- ^ The current time -> Stopwatch -- ^ The 'Stopwatch' being stopped -> Stopwatch -- ^ The modified 'Stopwatch' stopStopwatchAt t stopwatch = stopwatch { stopwatchTimer = timer } where timer = stopTimerAt t $ stopwatchTimer stopwatch -- | Starts a new lap at a given time newLapAt :: UTCTime -- ^ The currebt time -> Stopwatch -- ^ The 'Stopwatch' being modified -> Stopwatch -- ^ The modified 'Stopwatch' newLapAt t stopwatch = Stopwatch { stopwatchTimer = startTimerAt t newTimer , stopwatchLaps = allLapsAt t stopwatch } -- | Determines the length of the current lap given a time currentLapAt :: UTCTime -- ^ The current time -> Stopwatch -- ^ The 'Stopwatch' being checkwd -> NominalDiffTime -- ^ The elapsed time for the current lap currentLapAt t stopwatch = timeElapsedAt t timer where timer = stopwatchTimer stopwatch -- | Returns the lap times from a 'Stopwatch' given a time allLapsAt :: UTCTime -- ^ The current time -> Stopwatch -- ^ The 'Stopwatch' being checked -> [NominalDiffTime] -- ^ The lap times (most recent first) allLapsAt t stopwatch = currentLapAt t stopwatch : stopwatchLaps stopwatch -- | Calculates the total runtime of a 'Stopwatch' given a time totalStopwatchTimeAt :: UTCTime -- ^ The current time -> Stopwatch -- ^ The 'Stopwatch' being checked -> NominalDiffTime -- ^ The total run time totalStopwatchTimeAt t stopwatch = sum $ allLapsAt t stopwatch -- jl