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

    -- * Parsing
    parseTimerFormat,
    timerFormatMeta,

    -- * Formatting
    formatRelativeTime,
    formatSeconds,
  )
where

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
import Shrun.Utils qualified as Utils

-- | Determines how to format the timer.
data TimerFormat
  = DigitalCompact
  | DigitalFull
  | ProseCompact
  | ProseFull
  deriving stock (TimerFormat
TimerFormat -> TimerFormat -> Bounded TimerFormat
forall a. a -> a -> Bounded a
$cminBound :: TimerFormat
minBound :: TimerFormat
$cmaxBound :: TimerFormat
maxBound :: TimerFormat
Bounded, Int -> TimerFormat
TimerFormat -> Int
TimerFormat -> [TimerFormat]
TimerFormat -> TimerFormat
TimerFormat -> TimerFormat -> [TimerFormat]
TimerFormat -> TimerFormat -> TimerFormat -> [TimerFormat]
(TimerFormat -> TimerFormat)
-> (TimerFormat -> TimerFormat)
-> (Int -> TimerFormat)
-> (TimerFormat -> Int)
-> (TimerFormat -> [TimerFormat])
-> (TimerFormat -> TimerFormat -> [TimerFormat])
-> (TimerFormat -> TimerFormat -> [TimerFormat])
-> (TimerFormat -> TimerFormat -> TimerFormat -> [TimerFormat])
-> Enum TimerFormat
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TimerFormat -> TimerFormat
succ :: TimerFormat -> TimerFormat
$cpred :: TimerFormat -> TimerFormat
pred :: TimerFormat -> TimerFormat
$ctoEnum :: Int -> TimerFormat
toEnum :: Int -> TimerFormat
$cfromEnum :: TimerFormat -> Int
fromEnum :: TimerFormat -> Int
$cenumFrom :: TimerFormat -> [TimerFormat]
enumFrom :: TimerFormat -> [TimerFormat]
$cenumFromThen :: TimerFormat -> TimerFormat -> [TimerFormat]
enumFromThen :: TimerFormat -> TimerFormat -> [TimerFormat]
$cenumFromTo :: TimerFormat -> TimerFormat -> [TimerFormat]
enumFromTo :: TimerFormat -> TimerFormat -> [TimerFormat]
$cenumFromThenTo :: TimerFormat -> TimerFormat -> TimerFormat -> [TimerFormat]
enumFromThenTo :: TimerFormat -> TimerFormat -> TimerFormat -> [TimerFormat]
Enum, 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

instance Pretty TimerFormat where
  pretty :: forall ann. TimerFormat -> Doc ann
pretty = \case
    TimerFormat
DigitalCompact -> Doc ann
"digital_compact"
    TimerFormat
DigitalFull -> Doc ann
"digital_full"
    TimerFormat
ProseCompact -> Doc ann
"prose_compact"
    TimerFormat
ProseFull -> Doc ann
"prose_full"

-- | Parse timer format.
parseTimerFormat :: (MonadFail m) => m Text -> m TimerFormat
parseTimerFormat :: forall (m :: Type -> Type). MonadFail m => m Text -> m TimerFormat
parseTimerFormat = (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
>>= Text -> (Bool, [Text]) -> Text -> m TimerFormat
forall a (m :: Type -> Type).
(Bounded a, Enum a, MonadFail m, Pretty a) =>
Text -> (Bool, [Text]) -> Text -> m a
Utils.inversePrettyFail Text
"timer-format" (Bool, [Text])
forall a. IsString a => (Bool, [a])
timerFormatMeta)
{-# INLINEABLE parseTimerFormat #-}

-- | Available 'TimerFormat' strings.
timerFormatMeta :: (IsString a) => Tuple2 Bool (List a)
timerFormatMeta :: forall a. IsString a => (Bool, [a])
timerFormatMeta = (Bool
False, [a
"digital_compact", a
"digital_full", a
"prose_compact", a
"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
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
T.pack
    (String -> Text)
-> (RelativeTime -> String) -> RelativeTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
T.pack
    (String -> Text) -> (Natural -> String) -> Natural -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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