module Desktop.Portal.Util
( optionalFromVariant,
mapJust,
toVariantPair,
toVariantPair',
encodeNullTerminated,
decodeNullTerminated,
decodeFileUri,
decodeFileUris,
)
where
import DBus (IsVariant, Variant)
import DBus qualified
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 System.OsPath (OsPath, OsString)
import System.OsPath qualified as OsPath
import System.OsPath.Data.ByteString.Short qualified as ShortByteString
import System.OsString.Internal.Types (OsString (..), PosixString (..))
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))
encodeNullTerminated :: OsString -> ByteString
encodeNullTerminated :: OsString -> ByteString
encodeNullTerminated (OsString (PosixString ShortByteString
txt)) =
ByteString -> ByteString
Bytes.fromStrict (ShortByteString -> ByteString
ShortByteString.fromShort (ShortByteString
txt forall a. Semigroup a => a -> a -> a
<> Word8 -> ShortByteString
ShortByteString.singleton Word8
0))
decodeNullTerminated :: ByteString -> OsString
decodeNullTerminated :: ByteString -> OsString
decodeNullTerminated =
PosixString -> OsString
OsString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> PosixString
PosixString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShortByteString
ShortByteString.toShort forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Bytes.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
Bytes.dropWhileEnd (forall a. Eq a => a -> a -> Bool
== Word8
0)
decodeFileUri :: Text -> Maybe OsPath
decodeFileUri :: Text -> Maybe OsString
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 (m :: * -> *). MonadThrow m => FilePath -> m OsString
OsPath.encodeUtf 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 [OsPath]
decodeFileUris :: [Text] -> Maybe [OsString]
decodeFileUris = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Text -> Maybe OsString
decodeFileUri