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

-- | Returns @Just Nothing@ if the field does not exist, @Just (Just x)@ if it does exist and
-- can be turned into the expected type, or @Nothing@ if the field exists with the wrong type.
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