-- | Provides the 'TimerFormat' type.
module Shrun.Configuration.Data.ConsoleLogging.TimerFormat
  ( -- * Type
    TimerFormat (..),

    -- * Parsing
    parseTimerFormat,
    timerFormatStr,

    -- * Formatting
    formatRelativeTime,
    formatSeconds,
  )
where

import Data.String (IsString)
import Data.Text qualified as T
import Data.Time.Relative
  ( Format (MkFormat),
    FormatStyle (FormatStyleDigital, FormatStyleProse),
    FormatVerbosity
      ( FormatVerbosityCompact,
        FormatVerbosityFull
      ),
    RelativeTime,
  )
import Data.Time.Relative qualified as RT
import Shrun.Configuration.Default (Default (def))
import Shrun.Data.Text (UnlinedText (UnsafeUnlinedText))
import Shrun.Prelude

-- | Determines how to format the timer.
data TimerFormat
  = DigitalCompact
  | DigitalFull
  | ProseCompact
  | ProseFull
  deriving stock (TimerFormat -> TimerFormat -> Bool
(TimerFormat -> TimerFormat -> Bool)
-> (TimerFormat -> TimerFormat -> Bool) -> Eq TimerFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimerFormat -> TimerFormat -> Bool
== :: TimerFormat -> TimerFormat -> Bool
$c/= :: TimerFormat -> TimerFormat -> Bool
/= :: TimerFormat -> TimerFormat -> Bool
Eq, Int -> TimerFormat -> ShowS
[TimerFormat] -> ShowS
TimerFormat -> String
(Int -> TimerFormat -> ShowS)
-> (TimerFormat -> String)
-> ([TimerFormat] -> ShowS)
-> Show TimerFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimerFormat -> ShowS
showsPrec :: Int -> TimerFormat -> ShowS
$cshow :: TimerFormat -> String
show :: TimerFormat -> String
$cshowList :: [TimerFormat] -> ShowS
showList :: [TimerFormat] -> ShowS
Show)

instance DecodeTOML TimerFormat where
  tomlDecoder :: Decoder TimerFormat
tomlDecoder = Decoder Text -> Decoder TimerFormat
forall (m :: Type -> Type). MonadFail m => m Text -> m TimerFormat
parseTimerFormat Decoder Text
forall a. DecodeTOML a => Decoder a
tomlDecoder

instance Default TimerFormat where
  def :: TimerFormat
def = TimerFormat
ProseCompact

-- | Parse timer format.
parseTimerFormat :: (MonadFail m) => m Text -> m TimerFormat
parseTimerFormat :: forall (m :: Type -> Type). MonadFail m => m Text -> m TimerFormat
parseTimerFormat m Text
getTxt =
  m Text
getTxt m Text -> (Text -> m TimerFormat) -> m TimerFormat
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Text
"digital_compact" -> TimerFormat -> m TimerFormat
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TimerFormat
DigitalCompact
    Text
"digital_full" -> TimerFormat -> m TimerFormat
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TimerFormat
DigitalFull
    Text
"prose_compact" -> TimerFormat -> m TimerFormat
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TimerFormat
ProseCompact
    Text
"prose_full" -> TimerFormat -> m TimerFormat
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TimerFormat
ProseFull
    Text
bad -> String -> m TimerFormat
forall a. String -> m a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> m TimerFormat) -> String -> m TimerFormat
forall a b. (a -> b) -> a -> b
$ String
"Unrecognized timer-format: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
bad

-- | Available 'TimerFormat' strings.
timerFormatStr :: (IsString a) => a
timerFormatStr :: forall a. IsString a => a
timerFormatStr = a
"(digital_compact | digital_full | prose_compact | prose_full)"

-- NOTE: Time formatting does not include newlines, so using UnsafeUnlinedText
-- is safe. We use the constructor rather than unsafeUnlinedText.

-- | Formats a relative time.
formatRelativeTime :: TimerFormat -> RelativeTime -> UnlinedText
formatRelativeTime :: TimerFormat -> RelativeTime -> UnlinedText
formatRelativeTime TimerFormat
fmt =
  Text -> UnlinedText
UnsafeUnlinedText
    (Text -> UnlinedText)
-> (RelativeTime -> Text) -> RelativeTime -> UnlinedText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
    (String -> Text)
-> (RelativeTime -> String) -> RelativeTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> RelativeTime -> String
RT.formatRelativeTime (TimerFormat -> Format
toRelativeTimeFormat TimerFormat
fmt)

-- | Formats a relative time seconds.
formatSeconds :: TimerFormat -> Natural -> UnlinedText
formatSeconds :: TimerFormat -> Natural -> UnlinedText
formatSeconds TimerFormat
fmt =
  Text -> UnlinedText
UnsafeUnlinedText
    (Text -> UnlinedText)
-> (Natural -> Text) -> Natural -> UnlinedText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
    (String -> Text) -> (Natural -> String) -> Natural -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Natural -> String
RT.formatSeconds (TimerFormat -> Format
toRelativeTimeFormat TimerFormat
fmt)

toRelativeTimeFormat :: TimerFormat -> Format
toRelativeTimeFormat :: TimerFormat -> Format
toRelativeTimeFormat TimerFormat
DigitalCompact = FormatStyle -> FormatVerbosity -> Format
MkFormat FormatStyle
FormatStyleDigital FormatVerbosity
FormatVerbosityCompact
toRelativeTimeFormat TimerFormat
DigitalFull = FormatStyle -> FormatVerbosity -> Format
MkFormat FormatStyle
FormatStyleDigital FormatVerbosity
FormatVerbosityFull
toRelativeTimeFormat TimerFormat
ProseCompact = FormatStyle -> FormatVerbosity -> Format
MkFormat FormatStyle
FormatStyleProse FormatVerbosity
FormatVerbosityCompact
toRelativeTimeFormat TimerFormat
ProseFull = FormatStyle -> FormatVerbosity -> Format
MkFormat FormatStyle
FormatStyleProse FormatVerbosity
FormatVerbosityFull