{-# LANGUAGE CPP #-}
module Navi.Utils
(
getFieldOptArrayOf,
commandDecoder,
urgencyLevelOptDecoder,
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))
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
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)
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
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"
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
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