{-# LANGUAGE CPP #-}

-- | Provides utilities.
--
-- @since 0.1
module Navi.Utils
  ( -- * TOML

    -- ** Decoding utils
    getFieldOptArrayOf,

    -- ** Specific decoders
    commandDecoder,
    urgencyLevelOptDecoder,

    -- * Misc
    escapeDoubleQuotes,
    displayInner,
    whenJust,
  )
where

#if MIN_VERSION_base(4, 20, 0) && !MIN_VERSION_base(4, 21, 0)
import Control.Exception qualified as E
#endif
import DBus.Notify (UrgencyLevel (Critical, Low, Normal))
import Data.Text qualified as T
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Builder (Builder)
import Data.Text.Lazy.Builder qualified as TLB
import Navi.Prelude
import Pythia.Data.Command (Command (MkCommand))

-- | @since 0.1
whenJust :: (Applicative f) => Maybe a -> (a -> f ()) -> f ()
whenJust :: forall (f :: Type -> Type) a.
Applicative f =>
Maybe a -> (a -> f ()) -> f ()
whenJust Maybe a
m a -> f ()
action = f () -> (a -> f ()) -> Maybe a -> f ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> f ()
forall a. a -> f a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()) a -> f ()
action Maybe a
m

-- | Decodes an optional list. This is morally
--
-- @
-- getFieldOptWith (getArrayOf tomlDecoder) :: Text -> Decoder (Maybe [a])
-- @
--
-- except we return an empty list when the key is missing rather than
-- 'Nothing'.
--
-- @since 0.1
getFieldOptArrayOf :: (DecodeTOML a) => Text -> Decoder [a]
getFieldOptArrayOf :: forall a. DecodeTOML a => Text -> Decoder [a]
getFieldOptArrayOf =
  (Maybe [a] -> [a]) -> Decoder (Maybe [a]) -> Decoder [a]
forall a b. (a -> b) -> Decoder a -> Decoder b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ([a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe [])
    (Decoder (Maybe [a]) -> Decoder [a])
-> (Text -> Decoder (Maybe [a])) -> Text -> Decoder [a]
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
. Decoder [a] -> Text -> Decoder (Maybe [a])
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith (Decoder a -> Decoder [a]
forall a. Decoder a -> Decoder [a]
getArrayOf Decoder a
forall a. DecodeTOML a => Decoder a
tomlDecoder)

-- | TOML decoder for optional 'UrgencyLevel' with field name "urgency".
--
-- @since 0.1
urgencyLevelOptDecoder :: Decoder (Maybe UrgencyLevel)
urgencyLevelOptDecoder :: Decoder (Maybe UrgencyLevel)
urgencyLevelOptDecoder = Decoder UrgencyLevel -> Text -> Decoder (Maybe UrgencyLevel)
forall a. Decoder a -> Text -> Decoder (Maybe a)
getFieldOptWith Decoder UrgencyLevel
urgencyLevelDecoder Text
"urgency"

urgencyLevelDecoder :: Decoder UrgencyLevel
urgencyLevelDecoder :: Decoder UrgencyLevel
urgencyLevelDecoder = do
  Text
t <- Decoder Text
forall a. DecodeTOML a => Decoder a
tomlDecoder
  case Text
t of
    Text
"low" -> UrgencyLevel -> Decoder UrgencyLevel
forall a. a -> Decoder a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure UrgencyLevel
Low
    Text
"normal" -> UrgencyLevel -> Decoder UrgencyLevel
forall a. a -> Decoder a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure UrgencyLevel
Normal
    Text
"critical" -> UrgencyLevel -> Decoder UrgencyLevel
forall a. a -> Decoder a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure UrgencyLevel
Critical
    Text
bad -> String -> Decoder UrgencyLevel
forall a. String -> Decoder a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> Decoder UrgencyLevel) -> String -> Decoder UrgencyLevel
forall a b. (a -> b) -> a -> b
$ Text -> String
unpackText (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"Invalid value: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
bad

-- | TOML decoder for 'Command' with field name "command".
--
-- @since 0.1
commandDecoder :: Decoder Command
commandDecoder :: Decoder Command
commandDecoder = Text -> Command
MkCommand (Text -> Command) -> Decoder Text -> Decoder Command
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Decoder Text
forall a. DecodeTOML a => Text -> Decoder a
getField Text
"command"

-- | Escape double quotes in strings.
escapeDoubleQuotes :: Text -> Text
escapeDoubleQuotes :: Text -> Text
escapeDoubleQuotes = LazyText -> Text
TL.toStrict (LazyText -> Text) -> (Text -> LazyText) -> Text -> 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
. Builder -> LazyText
TLB.toLazyText (Builder -> LazyText) -> (Text -> Builder) -> Text -> LazyText
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
. (Builder -> Char -> Builder) -> Builder -> Text -> Builder
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' Builder -> Char -> Builder
go Builder
""
  where
    go :: Builder -> Char -> Builder
    go :: Builder -> Char -> Builder
go Builder
acc Char
'"' = Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\\\""
    go Builder
acc Char
c = Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
TLB.singleton Char
c

-- NOTE: For base 4.20 (GHC 9.10), there is a callstack on the SomeException
-- itself. We don't really want this as it clutters the output (and fails
-- a functional test). So in this case we walk the SomeException to avoid
-- the callstack.
--
-- In later base versions, the callstack is separate, so we have no problems.
displayInner :: (Exception e) => e -> String
#if MIN_VERSION_base(4, 20, 0) && !MIN_VERSION_base(4, 21, 0)
displayInner :: forall e. Exception e => e -> String
displayInner e
ex = case e -> SomeException
forall e. Exception e => e -> SomeException
E.toException e
ex of
  E.SomeException e
e -> e -> String
forall e. Exception e => e -> String
displayException (e -> String) -> e -> String
forall a b. (a -> b) -> a -> b
$ e
e
#else
displayInner = displayException
#endif