module Data.Time.Utils (
Timer (..),
TimeParts (..),
Countdown (..),
Stopwatch (..),
timerOffsetL,
timerStartTimeL,
tpDaysL,
tpHoursL,
tpMinutesL,
tpSecondsL,
tpMillisL,
countdownLengthL,
countdownTimerL,
stopwatchTimerL,
stopwatchLapsL,
newTimer,
newTimeParts,
newCountdown,
newStopwatch,
startTimer,
stopTimer,
timeElapsed,
startCountdown,
stopCountdown,
timeRemaining,
countdownIsCompleted,
startStopwatch,
stopStopwatch,
newLap,
currentLap,
allLaps,
totalStopwatchTime,
decomposeNDT,
composeNDT,
humanNDT,
timerIsRunning,
timerIsStarted,
startTimerAt,
stopTimerAt,
timeElapsedAt,
countdownIsRunning,
countdownIsStarted,
startCountdownAt,
stopCountdownAt,
timeRemainingAt,
countdownIsCompletedAt,
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)
data Timer = Timer
{ timerOffset :: NominalDiffTime
, timerStartTime :: Maybe UTCTime
} deriving (Eq, Show)
timerOffsetL :: Lens' Timer NominalDiffTime
timerOffsetL = lens timerOffset $
\t o -> t { timerOffset = o }
timerStartTimeL :: Lens' Timer (Maybe UTCTime)
timerStartTimeL = lens timerStartTime $
\t st -> t { timerStartTime = st }
data TimeParts = TimeParts
{ tpDays :: Int
, tpHours :: Int
, tpMinutes :: Int
, tpSeconds :: Int
, tpMillis :: Int
} deriving (Eq, Show)
tpDaysL :: Lens' TimeParts Int
tpDaysL = lens tpDays $
\tp d -> tp { tpDays = d }
tpHoursL :: Lens' TimeParts Int
tpHoursL = lens tpHours $
\tp h -> tp { tpHours = h }
tpMinutesL :: Lens' TimeParts Int
tpMinutesL = lens tpMinutes $
\tp m -> tp { tpMinutes = m }
tpSecondsL :: Lens' TimeParts Int
tpSecondsL = lens tpSeconds $
\tp s -> tp { tpSeconds = s }
tpMillisL :: Lens' TimeParts Int
tpMillisL = lens tpMillis $
\tp ms -> tp { tpMillis = ms }
data Countdown = Countdown
{ countdownLength :: NominalDiffTime
, countdownTimer :: Timer
} deriving (Eq, Show)
countdownLengthL :: Lens' Countdown NominalDiffTime
countdownLengthL = lens countdownLength $
\cd l -> cd { countdownLength = l }
countdownTimerL :: Lens' Countdown Timer
countdownTimerL = lens countdownTimer $
\cd t -> cd { countdownTimer = t }
data Stopwatch = Stopwatch
{ stopwatchTimer :: Timer
, stopwatchLaps :: [NominalDiffTime]
} deriving (Eq, Show)
stopwatchTimerL :: Lens' Stopwatch Timer
stopwatchTimerL = lens stopwatchTimer $
\sw t -> sw { stopwatchTimer = t }
stopwatchLapsL :: Lens' Stopwatch [NominalDiffTime]
stopwatchLapsL = lens stopwatchLaps $
\sw l -> sw { stopwatchLaps = l }
newTimer :: Timer
newTimer = Timer 0 Nothing
newTimeParts :: TimeParts
newTimeParts = TimeParts 0 0 0 0 0
newCountdown
:: NominalDiffTime
-> Countdown
newCountdown l = Countdown l newTimer
newStopwatch :: Stopwatch
newStopwatch = Stopwatch
{ stopwatchTimer = newTimer
, stopwatchLaps = []
}
startTimer
:: Timer
-> IO Timer
startTimer timer = startTimerAt
<$> getCurrentTime
<*> return timer
stopTimer
:: Timer
-> IO Timer
stopTimer timer = stopTimerAt
<$> getCurrentTime
<*> return timer
timeElapsed
:: Timer
-> IO NominalDiffTime
timeElapsed timer = timeElapsedAt
<$> getCurrentTime
<*> return timer
startCountdown
:: Countdown
-> IO Countdown
startCountdown countdown = startCountdownAt
<$> getCurrentTime
<*> return countdown
stopCountdown
:: Countdown
-> IO Countdown
stopCountdown countdown = stopCountdownAt
<$> getCurrentTime
<*> return countdown
timeRemaining
:: Countdown
-> IO NominalDiffTime
timeRemaining countdown = timeRemainingAt
<$> getCurrentTime
<*> return countdown
countdownIsCompleted
:: Countdown
-> IO Bool
countdownIsCompleted countdown = countdownIsCompletedAt
<$> getCurrentTime
<*> return countdown
startStopwatch
:: Stopwatch
-> IO Stopwatch
startStopwatch stopwatch = startStopwatchAt
<$> getCurrentTime
<*> return stopwatch
stopStopwatch
:: Stopwatch
-> IO Stopwatch
stopStopwatch stopwatch = stopStopwatchAt
<$> getCurrentTime
<*> return stopwatch
newLap
:: Stopwatch
-> IO Stopwatch
newLap stopwatch = newLapAt
<$> getCurrentTime
<*> return stopwatch
currentLap
:: Stopwatch
-> IO NominalDiffTime
currentLap stopwatch = currentLapAt
<$> getCurrentTime
<*> return stopwatch
allLaps
:: Stopwatch
-> IO [NominalDiffTime]
allLaps stopwatch = allLapsAt
<$> getCurrentTime
<*> return stopwatch
totalStopwatchTime
:: Stopwatch
-> IO NominalDiffTime
totalStopwatchTime stopwatch = totalStopwatchTimeAt
<$> getCurrentTime
<*> return stopwatch
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
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)
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
timerIsRunning
:: Timer
-> Bool
timerIsRunning = isJust . timerStartTime
timerIsStarted
:: Timer
-> Bool
timerIsStarted timer = timerIsRunning timer ||
timerOffset timer /= 0
startTimerAt
:: UTCTime
-> Timer
-> Timer
startTimerAt t timer
| isNothing (timerStartTime timer) =
timer { timerStartTime = Just t }
| otherwise = timer
stopTimerAt
:: UTCTime
-> Timer
-> Timer
stopTimerAt t timer = newTimer { timerOffset = offset }
where offset = timeElapsedAt t timer
timeElapsedAt
:: UTCTime
-> Timer
-> NominalDiffTime
timeElapsedAt t timer = case timerStartTime timer of
Nothing -> timerOffset timer
Just st -> timerOffset timer + diffUTCTime t st
countdownIsRunning
:: Countdown
-> Bool
countdownIsRunning countdown = timerIsRunning timer
where timer = countdownTimer countdown
countdownIsStarted
:: Countdown
-> Bool
countdownIsStarted countdown = timerIsStarted timer
where timer = countdownTimer countdown
startCountdownAt
:: UTCTime
-> Countdown
-> Countdown
startCountdownAt t countdown =
countdown { countdownTimer = timer' }
where
timer' = startTimerAt t timer
timer = countdownTimer countdown
stopCountdownAt
:: UTCTime
-> Countdown
-> Countdown
stopCountdownAt t countdown =
countdown { countdownTimer = timer' }
where
timer' = stopTimerAt t timer
timer = countdownTimer countdown
timeRemainingAt
:: UTCTime
-> Countdown
-> NominalDiffTime
timeRemainingAt t countdown = len - timeElapsedAt t timer
where
len = countdownLength countdown
timer = countdownTimer countdown
countdownIsCompletedAt
:: UTCTime
-> Countdown
-> Bool
countdownIsCompletedAt t countdown =
timeRemainingAt t countdown <= 0
stopwatchIsRunning
:: Stopwatch
-> Bool
stopwatchIsRunning = timerIsRunning . stopwatchTimer
stopwatchIsStarted
:: Stopwatch
-> Bool
stopwatchIsStarted = (/= newStopwatch)
startStopwatchAt
:: UTCTime
-> Stopwatch
-> Stopwatch
startStopwatchAt t stopwatch = stopwatch { stopwatchTimer = timer }
where timer = startTimerAt t $ stopwatchTimer stopwatch
stopStopwatchAt
:: UTCTime
-> Stopwatch
-> Stopwatch
stopStopwatchAt t stopwatch = stopwatch { stopwatchTimer = timer }
where timer = stopTimerAt t $ stopwatchTimer stopwatch
newLapAt
:: UTCTime
-> Stopwatch
-> Stopwatch
newLapAt t stopwatch = Stopwatch
{ stopwatchTimer = startTimerAt t newTimer
, stopwatchLaps = allLapsAt t stopwatch
}
currentLapAt
:: UTCTime
-> Stopwatch
-> NominalDiffTime
currentLapAt t stopwatch = timeElapsedAt t timer
where timer = stopwatchTimer stopwatch
allLapsAt
:: UTCTime
-> Stopwatch
-> [NominalDiffTime]
allLapsAt t stopwatch = currentLapAt t stopwatch :
stopwatchLaps stopwatch
totalStopwatchTimeAt
:: UTCTime
-> Stopwatch
-> NominalDiffTime
totalStopwatchTimeAt t stopwatch =
sum $ allLapsAt t stopwatch