module Desktop.Portal.Util
( optionalFromVariant,
mapJust,
toVariantPair,
toVariantPair',
encodeNullTerminatedUtf8,
decodeNullTerminatedUtf8,
decodeFileUri,
decodeFileUris,
)
where
import DBus (IsVariant, Variant)
import DBus qualified
import Data.Binary.Builder qualified as Binary
import Data.ByteString.Lazy (ByteString)
import Data.ByteString.Lazy qualified as Bytes
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Text (Text, unpack)
import Data.Text.Encoding qualified as Encoding
import Text.URI (Authority (..), URI (..))
import Text.URI qualified as URI
optionalFromVariant :: forall a. IsVariant a => Text -> Map Text Variant -> Maybe (Maybe a)
optionalFromVariant :: forall a.
IsVariant a =>
Text -> Map Text Variant -> Maybe (Maybe a)
optionalFromVariant Text
key Map Text Variant
variants =
forall a b. (a -> Maybe b) -> Maybe a -> Maybe (Maybe b)
mapJust forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
key Map Text Variant
variants)
mapJust :: (a -> Maybe b) -> Maybe a -> Maybe (Maybe b)
mapJust :: forall a b. (a -> Maybe b) -> Maybe a -> Maybe (Maybe b)
mapJust a -> Maybe b
f = \case
Maybe a
Nothing -> forall a. a -> Maybe a
Just forall a. Maybe a
Nothing
Just a
x -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe b
f a
x
toVariantPair :: IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair :: forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair = forall b a.
IsVariant b =>
(a -> b) -> Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair' forall a. a -> a
id
toVariantPair' :: IsVariant b => (a -> b) -> Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair' :: forall b a.
IsVariant b =>
(a -> b) -> Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair' a -> b
f Text
key = \case
Maybe a
Nothing -> forall a. Maybe a
Nothing
Just a
x -> forall a. a -> Maybe a
Just (Text
key, forall a. IsVariant a => a -> Variant
DBus.toVariant (a -> b
f a
x))
encodeNullTerminatedUtf8 :: Text -> ByteString
encodeNullTerminatedUtf8 :: Text -> ByteString
encodeNullTerminatedUtf8 Text
txt =
Builder -> ByteString
Binary.toLazyByteString (Text -> Builder
Encoding.encodeUtf8Builder Text
txt forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
Binary.singleton Word8
0)
decodeNullTerminatedUtf8 :: ByteString -> Maybe Text
decodeNullTerminatedUtf8 :: ByteString -> Maybe Text
decodeNullTerminatedUtf8 ByteString
bytes =
case ByteString -> Either UnicodeException Text
Encoding.decodeUtf8' (ByteString -> ByteString
Bytes.toStrict ((Word8 -> Bool) -> ByteString -> ByteString
Bytes.dropWhileEnd (forall a. Eq a => a -> a -> Bool
== Word8
0) ByteString
bytes)) of
Left UnicodeException
_err -> forall a. Maybe a
Nothing
Right Text
t -> forall a. a -> Maybe a
Just Text
t
decodeFileUri :: Text -> Maybe FilePath
decodeFileUri :: Text -> Maybe FilePath
decodeFileUri Text
uri =
case forall (m :: * -> *). MonadThrow m => Text -> m URI
URI.mkURI Text
uri of
Just
URI
{ uriScheme :: URI -> Maybe (RText 'Scheme)
uriScheme = Just (forall (l :: RTextLabel). RText l -> Text
URI.unRText -> Text
"file"),
uriAuthority :: URI -> Either Bool Authority
uriAuthority = (Either Bool Authority -> Bool
validAuthority -> Bool
True),
uriPath :: URI -> Maybe (Bool, NonEmpty (RText 'PathPiece))
uriPath = Just (Bool
_trailingSlash, NonEmpty (RText 'PathPiece)
parts),
uriQuery :: URI -> [QueryParam]
uriQuery = [],
uriFragment :: URI -> Maybe (RText 'Fragment)
uriFragment = Maybe (RText 'Fragment)
Nothing
} -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
unpack forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Text
"/" forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l :: RTextLabel). RText l -> Text
URI.unRText) NonEmpty (RText 'PathPiece)
parts
Maybe URI
_ ->
forall a. Maybe a
Nothing
where
validAuthority :: Either Bool Authority -> Bool
validAuthority = \case
Left Bool
True -> Bool
True
Right
Authority
{ authUserInfo :: Authority -> Maybe UserInfo
authUserInfo = Maybe UserInfo
Nothing,
authHost :: Authority -> RText 'Host
authHost = (forall (l :: RTextLabel). RText l -> Text
URI.unRText -> Text
""),
authPort :: Authority -> Maybe Word
authPort = Maybe Word
Nothing
} -> Bool
True
Either Bool Authority
_ -> Bool
False
decodeFileUris :: [Text] -> Maybe [FilePath]
decodeFileUris :: [Text] -> Maybe [FilePath]
decodeFileUris = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Text -> Maybe FilePath
decodeFileUri