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
(OpenURIOptions -> OpenURIOptions -> Bool)
-> (OpenURIOptions -> OpenURIOptions -> Bool) -> Eq OpenURIOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpenURIOptions -> OpenURIOptions -> Bool
== :: OpenURIOptions -> OpenURIOptions -> Bool
$c/= :: OpenURIOptions -> OpenURIOptions -> Bool
/= :: OpenURIOptions -> OpenURIOptions -> Bool
Eq, Int -> OpenURIOptions -> ShowS
[OpenURIOptions] -> ShowS
OpenURIOptions -> String
(Int -> OpenURIOptions -> ShowS)
-> (OpenURIOptions -> String)
-> ([OpenURIOptions] -> ShowS)
-> Show OpenURIOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpenURIOptions -> ShowS
showsPrec :: Int -> OpenURIOptions -> ShowS
$cshow :: OpenURIOptions -> String
show :: OpenURIOptions -> String
$cshowList :: [OpenURIOptions] -> ShowS
showList :: [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
(OpenFileOptions -> OpenFileOptions -> Bool)
-> (OpenFileOptions -> OpenFileOptions -> Bool)
-> Eq OpenFileOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpenFileOptions -> OpenFileOptions -> Bool
== :: OpenFileOptions -> OpenFileOptions -> Bool
$c/= :: OpenFileOptions -> OpenFileOptions -> Bool
/= :: OpenFileOptions -> OpenFileOptions -> Bool
Eq, Int -> OpenFileOptions -> ShowS
[OpenFileOptions] -> ShowS
OpenFileOptions -> String
(Int -> OpenFileOptions -> ShowS)
-> (OpenFileOptions -> String)
-> ([OpenFileOptions] -> ShowS)
-> Show OpenFileOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpenFileOptions -> ShowS
showsPrec :: Int -> OpenFileOptions -> ShowS
$cshow :: OpenFileOptions -> String
show :: OpenFileOptions -> String
$cshowList :: [OpenFileOptions] -> ShowS
showList :: [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
(OpenDirectoryOptions -> OpenDirectoryOptions -> Bool)
-> (OpenDirectoryOptions -> OpenDirectoryOptions -> Bool)
-> Eq OpenDirectoryOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpenDirectoryOptions -> OpenDirectoryOptions -> Bool
== :: OpenDirectoryOptions -> OpenDirectoryOptions -> Bool
$c/= :: OpenDirectoryOptions -> OpenDirectoryOptions -> Bool
/= :: OpenDirectoryOptions -> OpenDirectoryOptions -> Bool
Eq, Int -> OpenDirectoryOptions -> ShowS
[OpenDirectoryOptions] -> ShowS
OpenDirectoryOptions -> String
(Int -> OpenDirectoryOptions -> ShowS)
-> (OpenDirectoryOptions -> String)
-> ([OpenDirectoryOptions] -> ShowS)
-> Show OpenDirectoryOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpenDirectoryOptions -> ShowS
showsPrec :: Int -> OpenDirectoryOptions -> ShowS
$cshow :: OpenDirectoryOptions -> String
show :: OpenDirectoryOptions -> String
$cshowList :: [OpenDirectoryOptions] -> ShowS
showList :: [OpenDirectoryOptions] -> ShowS
Show)

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

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

openDirectoryOptions ::
  -- | The directory to open.
  FileSpec ->
  OpenDirectoryOptions
openDirectoryOptions :: FileSpec -> OpenDirectoryOptions
openDirectoryOptions FileSpec
fileSpec =
  OpenDirectoryOptions
    { FileSpec
$sel:fileSpec:OpenDirectoryOptions :: FileSpec
fileSpec :: FileSpec
fileSpec,
      $sel:parentWindow:OpenDirectoryOptions :: Maybe Text
parentWindow = Maybe Text
forall a. Maybe a
Nothing,
      $sel:activationToken:OpenDirectoryOptions :: Maybe Text
activationToken = Maybe Text
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 =
  Client
-> InterfaceName
-> MemberName
-> [Variant]
-> Map Text Variant
-> (Map Text Variant -> IO ())
-> IO (Request ())
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 Map Text Variant -> IO ()
forall a. a -> IO ()
parseUnitResponse
  where
    args :: [Variant]
args = [Text -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant Text
parentWindow, Text -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant (URI -> Text
URI.render OpenURIOptions
options.uri)]
    parentWindow :: Text
parentWindow = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" OpenURIOptions
options.parentWindow
    optionsArg :: Map Text Variant
optionsArg =
      [(Text, Variant)] -> Map Text Variant
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Variant)] -> Map Text Variant)
-> ([Maybe (Text, Variant)] -> [(Text, Variant)])
-> [Maybe (Text, Variant)]
-> Map Text Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Text, Variant)] -> [(Text, Variant)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Text, Variant)] -> Map Text Variant)
-> [Maybe (Text, Variant)] -> Map Text Variant
forall a b. (a -> b) -> a -> b
$
        [ Text -> Maybe Bool -> Maybe (Text, Variant)
forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"writable" OpenURIOptions
options.writable,
          Text -> Maybe Bool -> Maybe (Text, Variant)
forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"ask" OpenURIOptions
options.ask,
          Text -> Maybe Text -> Maybe (Text, Variant)
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 =
  FileSpec -> (Fd -> IO (Request ())) -> IO (Request ())
forall a. FileSpec -> (Fd -> IO a) -> IO a
withFd OpenFileOptions
options.fileSpec ((Fd -> IO (Request ())) -> IO (Request ()))
-> (Fd -> IO (Request ())) -> IO (Request ())
forall a b. (a -> b) -> a -> b
$ \Fd
fd ->
    Client
-> InterfaceName
-> MemberName
-> [Variant]
-> Map Text Variant
-> (Map Text Variant -> IO ())
-> IO (Request ())
forall a.
Client
-> InterfaceName
-> MemberName
-> [Variant]
-> Map Text Variant
-> (Map Text Variant -> IO a)
-> IO (Request a)
sendRequest Client
client InterfaceName
openURIInterface MemberName
"OpenFile" (Fd -> [Variant]
forall {a}. IsVariant a => a -> [Variant]
args Fd
fd) Map Text Variant
optionsArg Map Text Variant -> IO ()
forall a. a -> IO ()
parseUnitResponse
  where
    args :: a -> [Variant]
args a
fd = [Text -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant Text
parentWindow, a -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant a
fd]
    parentWindow :: Text
parentWindow = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" OpenFileOptions
options.parentWindow
    optionsArg :: Map Text Variant
optionsArg =
      [(Text, Variant)] -> Map Text Variant
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Variant)] -> Map Text Variant)
-> ([Maybe (Text, Variant)] -> [(Text, Variant)])
-> [Maybe (Text, Variant)]
-> Map Text Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Text, Variant)] -> [(Text, Variant)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Text, Variant)] -> Map Text Variant)
-> [Maybe (Text, Variant)] -> Map Text Variant
forall a b. (a -> b) -> a -> b
$
        [ Text -> Maybe Bool -> Maybe (Text, Variant)
forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"writable" OpenFileOptions
options.writable,
          Text -> Maybe Bool -> Maybe (Text, Variant)
forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"ask" OpenFileOptions
options.ask,
          Text -> Maybe Text -> Maybe (Text, Variant)
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 =
  FileSpec -> (Fd -> IO (Request ())) -> IO (Request ())
forall a. FileSpec -> (Fd -> IO a) -> IO a
withFd OpenDirectoryOptions
options.fileSpec ((Fd -> IO (Request ())) -> IO (Request ()))
-> (Fd -> IO (Request ())) -> IO (Request ())
forall a b. (a -> b) -> a -> b
$ \Fd
fd ->
    Client
-> InterfaceName
-> MemberName
-> [Variant]
-> Map Text Variant
-> (Map Text Variant -> IO ())
-> IO (Request ())
forall a.
Client
-> InterfaceName
-> MemberName
-> [Variant]
-> Map Text Variant
-> (Map Text Variant -> IO a)
-> IO (Request a)
sendRequest Client
client InterfaceName
openURIInterface MemberName
"OpenDirectory" (Fd -> [Variant]
forall {a}. IsVariant a => a -> [Variant]
args Fd
fd) Map Text Variant
optionsArg Map Text Variant -> IO ()
forall a. a -> IO ()
parseUnitResponse
  where
    args :: a -> [Variant]
args a
fd = [Text -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant Text
parentWindow, a -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant a
fd]
    parentWindow :: Text
parentWindow = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" OpenDirectoryOptions
options.parentWindow
    optionsArg :: Map Text Variant
optionsArg =
      [(Text, Variant)] -> Map Text Variant
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Variant)] -> Map Text Variant)
-> ([Maybe (Text, Variant)] -> [(Text, Variant)])
-> [Maybe (Text, Variant)]
-> Map Text Variant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Text, Variant)] -> [(Text, Variant)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Text, Variant)] -> Map Text Variant)
-> [Maybe (Text, Variant)] -> Map Text Variant
forall a b. (a -> b) -> a -> b
$
        [Text -> Maybe Text -> Maybe (Text, Variant)
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 = IO () -> a -> IO ()
forall a b. a -> b -> a
const (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())