module Desktop.Portal.OpenURI
  ( -- * Open URI
    OpenURIOptions (..),
    openURIOptions,
    openURI,

    -- * Open File
    OpenFileOptions (..),
    openFileOptions,
    openFile,

    -- * Open Directory
    OpenDirectoryOptions (..),
    openDirectoryOptions,
    openDirectory,
  )
where

import DBus (InterfaceName, IsVariant (toVariant))
import Data.Map.Strict qualified as Map
import Data.Maybe (catMaybes, fromMaybe)
import Data.Text (Text)
import Desktop.Portal.Internal (Client, FileSpec, Request, sendRequest, withFd)
import Desktop.Portal.Util (toVariantPair)
import Text.URI (URI)
import Text.URI qualified as URI

data OpenURIOptions = OpenURIOptions
  { OpenURIOptions -> URI
uri :: URI,
    OpenURIOptions -> Maybe Text
parentWindow :: Maybe Text,
    OpenURIOptions -> Maybe Bool
writable :: Maybe Bool,
    OpenURIOptions -> Maybe Bool
ask :: Maybe Bool,
    OpenURIOptions -> Maybe Text
activationToken :: Maybe Text
  }
  deriving (OpenURIOptions -> OpenURIOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenURIOptions -> OpenURIOptions -> Bool
$c/= :: OpenURIOptions -> OpenURIOptions -> Bool
== :: OpenURIOptions -> OpenURIOptions -> Bool
$c== :: OpenURIOptions -> OpenURIOptions -> Bool
Eq, Int -> OpenURIOptions -> ShowS
[OpenURIOptions] -> ShowS
OpenURIOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenURIOptions] -> ShowS
$cshowList :: [OpenURIOptions] -> ShowS
show :: OpenURIOptions -> String
$cshow :: OpenURIOptions -> String
showsPrec :: Int -> OpenURIOptions -> ShowS
$cshowsPrec :: Int -> OpenURIOptions -> ShowS
Show)

data OpenFileOptions = OpenFileOptions
  { OpenFileOptions -> FileSpec
fileSpec :: FileSpec,
    OpenFileOptions -> Maybe Text
parentWindow :: Maybe Text,
    OpenFileOptions -> Maybe Bool
writable :: Maybe Bool,
    OpenFileOptions -> Maybe Bool
ask :: Maybe Bool,
    OpenFileOptions -> Maybe Text
activationToken :: Maybe Text
  }
  deriving (OpenFileOptions -> OpenFileOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenFileOptions -> OpenFileOptions -> Bool
$c/= :: OpenFileOptions -> OpenFileOptions -> Bool
== :: OpenFileOptions -> OpenFileOptions -> Bool
$c== :: OpenFileOptions -> OpenFileOptions -> Bool
Eq, Int -> OpenFileOptions -> ShowS
[OpenFileOptions] -> ShowS
OpenFileOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenFileOptions] -> ShowS
$cshowList :: [OpenFileOptions] -> ShowS
show :: OpenFileOptions -> String
$cshow :: OpenFileOptions -> String
showsPrec :: Int -> OpenFileOptions -> ShowS
$cshowsPrec :: Int -> OpenFileOptions -> ShowS
Show)

data OpenDirectoryOptions = OpenDirectoryOptions
  { OpenDirectoryOptions -> FileSpec
fileSpec :: FileSpec,
    OpenDirectoryOptions -> Maybe Text
parentWindow :: Maybe Text,
    OpenDirectoryOptions -> Maybe Text
activationToken :: Maybe Text
  }
  deriving (OpenDirectoryOptions -> OpenDirectoryOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenDirectoryOptions -> OpenDirectoryOptions -> Bool
$c/= :: OpenDirectoryOptions -> OpenDirectoryOptions -> Bool
== :: OpenDirectoryOptions -> OpenDirectoryOptions -> Bool
$c== :: OpenDirectoryOptions -> OpenDirectoryOptions -> Bool
Eq, Int -> OpenDirectoryOptions -> ShowS
[OpenDirectoryOptions] -> ShowS
OpenDirectoryOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenDirectoryOptions] -> ShowS
$cshowList :: [OpenDirectoryOptions] -> ShowS
show :: OpenDirectoryOptions -> String
$cshow :: OpenDirectoryOptions -> String
showsPrec :: Int -> OpenDirectoryOptions -> ShowS
$cshowsPrec :: Int -> OpenDirectoryOptions -> ShowS
Show)

openURIOptions ::
  -- | The URI to open.
  URI ->
  OpenURIOptions
openURIOptions :: URI -> OpenURIOptions
openURIOptions URI
uri =
  OpenURIOptions
    { URI
uri :: URI
$sel:uri:OpenURIOptions :: URI
uri,
      $sel:parentWindow:OpenURIOptions :: Maybe Text
parentWindow = forall a. Maybe a
Nothing,
      $sel:writable:OpenURIOptions :: Maybe Bool
writable = forall a. Maybe a
Nothing,
      $sel:ask:OpenURIOptions :: Maybe Bool
ask = forall a. Maybe a
Nothing,
      $sel:activationToken:OpenURIOptions :: Maybe Text
activationToken = forall a. Maybe a
Nothing
    }

openFileOptions ::
  -- | The file to open.
  FileSpec ->
  OpenFileOptions
openFileOptions :: FileSpec -> OpenFileOptions
openFileOptions FileSpec
fileSpec =
  OpenFileOptions
    { FileSpec
fileSpec :: FileSpec
$sel:fileSpec:OpenFileOptions :: FileSpec
fileSpec,
      $sel:parentWindow:OpenFileOptions :: Maybe Text
parentWindow = forall a. Maybe a
Nothing,
      $sel:writable:OpenFileOptions :: Maybe Bool
writable = forall a. Maybe a
Nothing,
      $sel:ask:OpenFileOptions :: Maybe Bool
ask = forall a. Maybe a
Nothing,
      $sel:activationToken:OpenFileOptions :: Maybe Text
activationToken = forall a. Maybe a
Nothing
    }

openDirectoryOptions ::
  -- | The directory to open.
  FileSpec ->
  OpenDirectoryOptions
openDirectoryOptions :: FileSpec -> OpenDirectoryOptions
openDirectoryOptions FileSpec
fileSpec =
  OpenDirectoryOptions
    { FileSpec
fileSpec :: FileSpec
$sel:fileSpec:OpenDirectoryOptions :: FileSpec
fileSpec,
      $sel:parentWindow:OpenDirectoryOptions :: Maybe Text
parentWindow = forall a. Maybe a
Nothing,
      $sel:activationToken:OpenDirectoryOptions :: Maybe Text
activationToken = forall a. Maybe a
Nothing
    }

openURIInterface :: InterfaceName
openURIInterface :: InterfaceName
openURIInterface = InterfaceName
"org.freedesktop.portal.OpenURI"

openURI :: Client -> OpenURIOptions -> IO (Request ())
openURI :: Client -> OpenURIOptions -> IO (Request ())
openURI Client
client OpenURIOptions
options =
  forall a.
Client
-> InterfaceName
-> MemberName
-> [Variant]
-> Map Text Variant
-> (Map Text Variant -> IO a)
-> IO (Request a)
sendRequest Client
client InterfaceName
openURIInterface MemberName
"OpenURI" [Variant]
args Map Text Variant
optionsArg forall a. a -> IO ()
parseUnitResponse
  where
    args :: [Variant]
args = [forall a. IsVariant a => a -> Variant
DBus.toVariant Text
parentWindow, forall a. IsVariant a => a -> Variant
DBus.toVariant (URI -> Text
URI.render OpenURIOptions
options.uri)]
    parentWindow :: Text
parentWindow = forall a. a -> Maybe a -> a
fromMaybe Text
"" OpenURIOptions
options.parentWindow
    optionsArg :: Map Text Variant
optionsArg =
      forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
        [ forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"writable" OpenURIOptions
options.writable,
          forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"ask" OpenURIOptions
options.ask,
          forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"activation_token" OpenURIOptions
options.activationToken
        ]

openFile :: Client -> OpenFileOptions -> IO (Request ())
openFile :: Client -> OpenFileOptions -> IO (Request ())
openFile Client
client OpenFileOptions
options =
  forall a. FileSpec -> (Fd -> IO a) -> IO a
withFd OpenFileOptions
options.fileSpec forall a b. (a -> b) -> a -> b
$ \Fd
fd ->
    forall a.
Client
-> InterfaceName
-> MemberName
-> [Variant]
-> Map Text Variant
-> (Map Text Variant -> IO a)
-> IO (Request a)
sendRequest Client
client InterfaceName
openURIInterface MemberName
"OpenFile" (forall {a}. IsVariant a => a -> [Variant]
args Fd
fd) Map Text Variant
optionsArg forall a. a -> IO ()
parseUnitResponse
  where
    args :: a -> [Variant]
args a
fd = [forall a. IsVariant a => a -> Variant
DBus.toVariant Text
parentWindow, forall a. IsVariant a => a -> Variant
DBus.toVariant a
fd]
    parentWindow :: Text
parentWindow = forall a. a -> Maybe a -> a
fromMaybe Text
"" OpenFileOptions
options.parentWindow
    optionsArg :: Map Text Variant
optionsArg =
      forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
        [ forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"writable" OpenFileOptions
options.writable,
          forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"ask" OpenFileOptions
options.ask,
          forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"activation_token" OpenFileOptions
options.activationToken
        ]

openDirectory :: Client -> OpenDirectoryOptions -> IO (Request ())
openDirectory :: Client -> OpenDirectoryOptions -> IO (Request ())
openDirectory Client
client OpenDirectoryOptions
options =
  forall a. FileSpec -> (Fd -> IO a) -> IO a
withFd OpenDirectoryOptions
options.fileSpec forall a b. (a -> b) -> a -> b
$ \Fd
fd ->
    forall a.
Client
-> InterfaceName
-> MemberName
-> [Variant]
-> Map Text Variant
-> (Map Text Variant -> IO a)
-> IO (Request a)
sendRequest Client
client InterfaceName
openURIInterface MemberName
"OpenDirectory" (forall {a}. IsVariant a => a -> [Variant]
args Fd
fd) Map Text Variant
optionsArg forall a. a -> IO ()
parseUnitResponse
  where
    args :: a -> [Variant]
args a
fd = [forall a. IsVariant a => a -> Variant
DBus.toVariant Text
parentWindow, forall a. IsVariant a => a -> Variant
DBus.toVariant a
fd]
    parentWindow :: Text
parentWindow = forall a. a -> Maybe a -> a
fromMaybe Text
"" OpenDirectoryOptions
options.parentWindow
    optionsArg :: Map Text Variant
optionsArg =
      forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
        [forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"activation_token" OpenDirectoryOptions
options.activationToken]

parseUnitResponse :: a -> IO ()
parseUnitResponse :: forall a. a -> IO ()
parseUnitResponse = forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())