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)
import System.OsPath qualified as OsPath
import System.OsString.Data.ByteString.Short qualified as ShortByteString
import Text.URI (Authority (..), URI (..))
import Text.URI qualified as URI
import "os-string" System.OsString.Internal.Types (OsString (..), PosixString (..))

-- | 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 =
  (Variant -> Maybe a) -> Maybe Variant -> Maybe (Maybe a)
forall a b. (a -> Maybe b) -> Maybe a -> Maybe (Maybe b)
mapJust Variant -> Maybe a
forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant (Text -> Map Text Variant -> Maybe Variant
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 -> Maybe b -> Maybe (Maybe b)
forall a. a -> Maybe a
Just Maybe b
forall a. Maybe a
Nothing
  Just a
x -> b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> Maybe b -> Maybe (Maybe b)
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 = (a -> a) -> Text -> Maybe a -> Maybe (Text, Variant)
forall b a.
IsVariant b =>
(a -> b) -> Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair' a -> a
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 -> Maybe (Text, Variant)
forall a. Maybe a
Nothing
  Just a
x -> (Text, Variant) -> Maybe (Text, Variant)
forall a. a -> Maybe a
Just (Text
key, b -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant (a -> b
f a
x))

encodeNullTerminated :: OsString -> ByteString
encodeNullTerminated :: OsString -> ByteString
encodeNullTerminated (OsString (PosixString ShortByteString
txt)) =
  StrictByteString -> ByteString
Bytes.fromStrict (ShortByteString -> StrictByteString
ShortByteString.fromShort (ShortByteString
txt ShortByteString -> ShortByteString -> ShortByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ShortByteString
ShortByteString.singleton Word8
0))

decodeNullTerminated :: ByteString -> OsString
decodeNullTerminated :: ByteString -> OsString
decodeNullTerminated =
  PosixString -> OsString
OsString (PosixString -> OsString)
-> (ByteString -> PosixString) -> ByteString -> OsString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> PosixString
PosixString (ShortByteString -> PosixString)
-> (ByteString -> ShortByteString) -> ByteString -> PosixString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> ShortByteString
ShortByteString.toShort (StrictByteString -> ShortByteString)
-> (ByteString -> StrictByteString)
-> ByteString
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> StrictByteString
Bytes.toStrict (ByteString -> StrictByteString)
-> (ByteString -> ByteString) -> ByteString -> StrictByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> ByteString
Bytes.dropWhileEnd (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0)

decodeFileUri :: Text -> Maybe OsPath
decodeFileUri :: Text -> Maybe OsString
decodeFileUri Text
uri =
  case Text -> Maybe URI
forall (m :: * -> *). MonadThrow m => Text -> m URI
URI.mkURI Text
uri of
    Just
      URI
        { uriScheme :: URI -> Maybe (RText 'Scheme)
uriScheme = Just (RText 'Scheme -> Text
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
        } -> FilePath -> Maybe OsString
forall (m :: * -> *). MonadThrow m => FilePath -> m OsString
OsPath.encodeUtf (FilePath -> Maybe OsString)
-> (Text -> FilePath) -> Text -> Maybe OsString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
unpack (Text -> Maybe OsString) -> Text -> Maybe OsString
forall a b. (a -> b) -> a -> b
$ (RText 'PathPiece -> Text) -> NonEmpty (RText 'PathPiece) -> Text
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text)
-> (RText 'PathPiece -> Text) -> RText 'PathPiece -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RText 'PathPiece -> Text
forall (l :: RTextLabel). RText l -> Text
URI.unRText) NonEmpty (RText 'PathPiece)
parts
    Maybe URI
_ ->
      Maybe OsString
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 = (RText 'Host -> Text
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 = (Text -> Maybe OsString) -> [Text] -> Maybe [OsString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Text -> Maybe OsString
decodeFileUri