module Desktop.Portal.FileChooser
  ( -- * Common Types
    Filter (..),
    FilterFileType (..),
    ChoiceCombo (..),
    ChoiceComboOption (..),
    ChoiceComboSelection (..),

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

    -- * Save File
    SaveFileOptions (..),
    SaveFileResults (..),
    saveFile,
  )
where

import Control.Exception (throwIO)
import DBus (InterfaceName, Variant)
import DBus qualified
import DBus.Client qualified as DBus
import Data.Default.Class (Default (def))
import Data.Map (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (catMaybes, fromMaybe)
import Data.Text (Text, pack)
import Data.Word (Word32)
import Desktop.Portal.Internal (Client, Request, sendRequest)
import Desktop.Portal.Util (decodeFileUris, encodeNullTerminatedUtf8, mapJust, optionalFromVariant, toVariantPair, toVariantPair')

data Filter = Filter
  { Filter -> Text
name :: Text,
    Filter -> [FilterFileType]
fileTypes :: [FilterFileType]
  }
  deriving (Filter -> Filter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Filter -> Filter -> Bool
$c/= :: Filter -> Filter -> Bool
== :: Filter -> Filter -> Bool
$c== :: Filter -> Filter -> Bool
Eq, Int -> Filter -> ShowS
[Filter] -> ShowS
Filter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Filter] -> ShowS
$cshowList :: [Filter] -> ShowS
show :: Filter -> String
$cshow :: Filter -> String
showsPrec :: Int -> Filter -> ShowS
$cshowsPrec :: Int -> Filter -> ShowS
Show)

data FilterFileType
  = GlobFilter Text
  | MimeFilter Text
  deriving (FilterFileType -> FilterFileType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FilterFileType -> FilterFileType -> Bool
$c/= :: FilterFileType -> FilterFileType -> Bool
== :: FilterFileType -> FilterFileType -> Bool
$c== :: FilterFileType -> FilterFileType -> Bool
Eq, Int -> FilterFileType -> ShowS
[FilterFileType] -> ShowS
FilterFileType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilterFileType] -> ShowS
$cshowList :: [FilterFileType] -> ShowS
show :: FilterFileType -> String
$cshow :: FilterFileType -> String
showsPrec :: Int -> FilterFileType -> ShowS
$cshowsPrec :: Int -> FilterFileType -> ShowS
Show)

data ChoiceCombo = ChoiceCombo
  { ChoiceCombo -> Text
id :: Text,
    ChoiceCombo -> Text
label_ :: Text,
    ChoiceCombo -> [ChoiceComboOption]
choices :: [ChoiceComboOption],
    ChoiceCombo -> Text
defaultChoiceId :: Text
  }
  deriving (ChoiceCombo -> ChoiceCombo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChoiceCombo -> ChoiceCombo -> Bool
$c/= :: ChoiceCombo -> ChoiceCombo -> Bool
== :: ChoiceCombo -> ChoiceCombo -> Bool
$c== :: ChoiceCombo -> ChoiceCombo -> Bool
Eq, Int -> ChoiceCombo -> ShowS
[ChoiceCombo] -> ShowS
ChoiceCombo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChoiceCombo] -> ShowS
$cshowList :: [ChoiceCombo] -> ShowS
show :: ChoiceCombo -> String
$cshow :: ChoiceCombo -> String
showsPrec :: Int -> ChoiceCombo -> ShowS
$cshowsPrec :: Int -> ChoiceCombo -> ShowS
Show)

data ChoiceComboOption = ChoiceComboOption
  { ChoiceComboOption -> Text
id :: Text,
    ChoiceComboOption -> Text
label_ :: Text
  }
  deriving (ChoiceComboOption -> ChoiceComboOption -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChoiceComboOption -> ChoiceComboOption -> Bool
$c/= :: ChoiceComboOption -> ChoiceComboOption -> Bool
== :: ChoiceComboOption -> ChoiceComboOption -> Bool
$c== :: ChoiceComboOption -> ChoiceComboOption -> Bool
Eq, Int -> ChoiceComboOption -> ShowS
[ChoiceComboOption] -> ShowS
ChoiceComboOption -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChoiceComboOption] -> ShowS
$cshowList :: [ChoiceComboOption] -> ShowS
show :: ChoiceComboOption -> String
$cshow :: ChoiceComboOption -> String
showsPrec :: Int -> ChoiceComboOption -> ShowS
$cshowsPrec :: Int -> ChoiceComboOption -> ShowS
Show)

data ChoiceComboSelection = ChoiceComboSelection
  { ChoiceComboSelection -> Text
comboId :: Text,
    ChoiceComboSelection -> Text
optionId :: Text
  }
  deriving (ChoiceComboSelection -> ChoiceComboSelection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChoiceComboSelection -> ChoiceComboSelection -> Bool
$c/= :: ChoiceComboSelection -> ChoiceComboSelection -> Bool
== :: ChoiceComboSelection -> ChoiceComboSelection -> Bool
$c== :: ChoiceComboSelection -> ChoiceComboSelection -> Bool
Eq, Int -> ChoiceComboSelection -> ShowS
[ChoiceComboSelection] -> ShowS
ChoiceComboSelection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChoiceComboSelection] -> ShowS
$cshowList :: [ChoiceComboSelection] -> ShowS
show :: ChoiceComboSelection -> String
$cshow :: ChoiceComboSelection -> String
showsPrec :: Int -> ChoiceComboSelection -> ShowS
$cshowsPrec :: Int -> ChoiceComboSelection -> ShowS
Show)

data OpenFileOptions = OpenFileOptions
  { OpenFileOptions -> Maybe Text
parentWindow :: Maybe Text,
    OpenFileOptions -> Maybe Text
title :: Maybe Text,
    OpenFileOptions -> Maybe Text
acceptLabel :: Maybe Text,
    OpenFileOptions -> Maybe Bool
modal :: Maybe Bool,
    OpenFileOptions -> Maybe Bool
multiple :: Maybe Bool,
    OpenFileOptions -> Maybe Bool
directory :: Maybe Bool,
    OpenFileOptions -> Maybe [Filter]
filters :: Maybe [Filter],
    OpenFileOptions -> Maybe Filter
currentFilter :: Maybe Filter,
    OpenFileOptions -> Maybe [ChoiceCombo]
choices :: Maybe [ChoiceCombo]
  }
  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)

instance Default OpenFileOptions where
  def :: OpenFileOptions
def =
    OpenFileOptions
      { $sel:parentWindow:OpenFileOptions :: Maybe Text
parentWindow = forall a. Maybe a
Nothing,
        $sel:title:OpenFileOptions :: Maybe Text
title = forall a. Maybe a
Nothing,
        $sel:acceptLabel:OpenFileOptions :: Maybe Text
acceptLabel = forall a. Maybe a
Nothing,
        $sel:modal:OpenFileOptions :: Maybe Bool
modal = forall a. Maybe a
Nothing,
        $sel:multiple:OpenFileOptions :: Maybe Bool
multiple = forall a. Maybe a
Nothing,
        $sel:directory:OpenFileOptions :: Maybe Bool
directory = forall a. Maybe a
Nothing,
        $sel:filters:OpenFileOptions :: Maybe [Filter]
filters = forall a. Maybe a
Nothing,
        $sel:currentFilter:OpenFileOptions :: Maybe Filter
currentFilter = forall a. Maybe a
Nothing,
        $sel:choices:OpenFileOptions :: Maybe [ChoiceCombo]
choices = forall a. Maybe a
Nothing
      }

data OpenFileResults = OpenFileResults
  { OpenFileResults -> [String]
uris :: [FilePath],
    OpenFileResults -> Maybe [ChoiceComboSelection]
choices :: Maybe [ChoiceComboSelection],
    OpenFileResults -> Maybe Filter
currentFilter :: Maybe Filter
  }
  deriving (OpenFileResults -> OpenFileResults -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenFileResults -> OpenFileResults -> Bool
$c/= :: OpenFileResults -> OpenFileResults -> Bool
== :: OpenFileResults -> OpenFileResults -> Bool
$c== :: OpenFileResults -> OpenFileResults -> Bool
Eq, Int -> OpenFileResults -> ShowS
[OpenFileResults] -> ShowS
OpenFileResults -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenFileResults] -> ShowS
$cshowList :: [OpenFileResults] -> ShowS
show :: OpenFileResults -> String
$cshow :: OpenFileResults -> String
showsPrec :: Int -> OpenFileResults -> ShowS
$cshowsPrec :: Int -> OpenFileResults -> ShowS
Show)

data SaveFileOptions = SaveFileOptions
  { SaveFileOptions -> Maybe Text
parentWindow :: Maybe Text,
    SaveFileOptions -> Maybe Text
title :: Maybe Text,
    SaveFileOptions -> Maybe Text
acceptLabel :: Maybe Text,
    SaveFileOptions -> Maybe Bool
modal :: Maybe Bool,
    SaveFileOptions -> Maybe [Filter]
filters :: Maybe [Filter],
    SaveFileOptions -> Maybe Filter
currentFilter :: Maybe Filter,
    SaveFileOptions -> Maybe [ChoiceCombo]
choices :: Maybe [ChoiceCombo],
    SaveFileOptions -> Maybe Text
currentName :: Maybe Text,
    SaveFileOptions -> Maybe String
currentFolder :: Maybe FilePath,
    SaveFileOptions -> Maybe String
currentFile :: Maybe FilePath
  }
  deriving (SaveFileOptions -> SaveFileOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SaveFileOptions -> SaveFileOptions -> Bool
$c/= :: SaveFileOptions -> SaveFileOptions -> Bool
== :: SaveFileOptions -> SaveFileOptions -> Bool
$c== :: SaveFileOptions -> SaveFileOptions -> Bool
Eq, Int -> SaveFileOptions -> ShowS
[SaveFileOptions] -> ShowS
SaveFileOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SaveFileOptions] -> ShowS
$cshowList :: [SaveFileOptions] -> ShowS
show :: SaveFileOptions -> String
$cshow :: SaveFileOptions -> String
showsPrec :: Int -> SaveFileOptions -> ShowS
$cshowsPrec :: Int -> SaveFileOptions -> ShowS
Show)

instance Default SaveFileOptions where
  def :: SaveFileOptions
def =
    SaveFileOptions
      { $sel:parentWindow:SaveFileOptions :: Maybe Text
parentWindow = forall a. Maybe a
Nothing,
        $sel:title:SaveFileOptions :: Maybe Text
title = forall a. Maybe a
Nothing,
        $sel:acceptLabel:SaveFileOptions :: Maybe Text
acceptLabel = forall a. Maybe a
Nothing,
        $sel:modal:SaveFileOptions :: Maybe Bool
modal = forall a. Maybe a
Nothing,
        $sel:filters:SaveFileOptions :: Maybe [Filter]
filters = forall a. Maybe a
Nothing,
        $sel:currentFilter:SaveFileOptions :: Maybe Filter
currentFilter = forall a. Maybe a
Nothing,
        $sel:choices:SaveFileOptions :: Maybe [ChoiceCombo]
choices = forall a. Maybe a
Nothing,
        $sel:currentName:SaveFileOptions :: Maybe Text
currentName = forall a. Maybe a
Nothing,
        $sel:currentFolder:SaveFileOptions :: Maybe String
currentFolder = forall a. Maybe a
Nothing,
        $sel:currentFile:SaveFileOptions :: Maybe String
currentFile = forall a. Maybe a
Nothing
      }

data SaveFileResults = SaveFileResults
  { SaveFileResults -> [String]
uris :: [FilePath],
    SaveFileResults -> Maybe [ChoiceComboSelection]
choices :: Maybe [ChoiceComboSelection],
    SaveFileResults -> Maybe Filter
currentFilter :: Maybe Filter
  }
  deriving (SaveFileResults -> SaveFileResults -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SaveFileResults -> SaveFileResults -> Bool
$c/= :: SaveFileResults -> SaveFileResults -> Bool
== :: SaveFileResults -> SaveFileResults -> Bool
$c== :: SaveFileResults -> SaveFileResults -> Bool
Eq, Int -> SaveFileResults -> ShowS
[SaveFileResults] -> ShowS
SaveFileResults -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SaveFileResults] -> ShowS
$cshowList :: [SaveFileResults] -> ShowS
show :: SaveFileResults -> String
$cshow :: SaveFileResults -> String
showsPrec :: Int -> SaveFileResults -> ShowS
$cshowsPrec :: Int -> SaveFileResults -> ShowS
Show)

fileChooserInterface :: InterfaceName
fileChooserInterface :: InterfaceName
fileChooserInterface = InterfaceName
"org.freedesktop.portal.FileChooser"

openFile :: Client -> OpenFileOptions -> IO (Request OpenFileResults)
openFile :: Client -> OpenFileOptions -> IO (Request OpenFileResults)
openFile Client
client OpenFileOptions
options =
  forall a.
Client
-> InterfaceName
-> MemberName
-> [Variant]
-> Map Text Variant
-> (Map Text Variant -> IO a)
-> IO (Request a)
sendRequest Client
client InterfaceName
fileChooserInterface MemberName
"OpenFile" [Variant]
args Map Text Variant
optionsArg Map Text Variant -> IO OpenFileResults
parseOpenFileResponse
  where
    args :: [Variant]
args = [forall a. IsVariant a => a -> Variant
DBus.toVariant Text
parentWindow, forall a. IsVariant a => a -> Variant
DBus.toVariant Text
title]
    parentWindow :: Text
parentWindow = forall a. a -> Maybe a -> a
fromMaybe Text
"" OpenFileOptions
options.parentWindow
    title :: Text
title = forall a. a -> Maybe a -> a
fromMaybe Text
"" OpenFileOptions
options.title
    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
"accept_label" OpenFileOptions
options.acceptLabel,
          forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"modal" OpenFileOptions
options.modal,
          forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"multiple" OpenFileOptions
options.multiple,
          forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"directory" OpenFileOptions
options.directory,
          forall b a.
IsVariant b =>
(a -> b) -> Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Filter -> (Text, [(Word32, Text)])
encodeFilter) Text
"filters" OpenFileOptions
options.filters,
          forall b a.
IsVariant b =>
(a -> b) -> Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair' Filter -> (Text, [(Word32, Text)])
encodeFilter Text
"current_filter" OpenFileOptions
options.currentFilter,
          forall b a.
IsVariant b =>
(a -> b) -> Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ChoiceCombo -> (Text, Text, [(Text, Text)], Text)
encodeCombo) Text
"choices" OpenFileOptions
options.choices
        ]

saveFile :: Client -> SaveFileOptions -> IO (Request SaveFileResults)
saveFile :: Client -> SaveFileOptions -> IO (Request SaveFileResults)
saveFile Client
client SaveFileOptions
options =
  forall a.
Client
-> InterfaceName
-> MemberName
-> [Variant]
-> Map Text Variant
-> (Map Text Variant -> IO a)
-> IO (Request a)
sendRequest Client
client InterfaceName
fileChooserInterface MemberName
"SaveFile" [Variant]
args Map Text Variant
optionsArgs Map Text Variant -> IO SaveFileResults
parseResponse
  where
    args :: [Variant]
args = [forall a. IsVariant a => a -> Variant
DBus.toVariant Text
parentWindow, forall a. IsVariant a => a -> Variant
DBus.toVariant Text
title]
    parentWindow :: Text
parentWindow = forall a. a -> Maybe a -> a
fromMaybe Text
"" SaveFileOptions
options.parentWindow
    title :: Text
title = forall a. a -> Maybe a -> a
fromMaybe Text
"" SaveFileOptions
options.title
    optionsArgs :: Map Text Variant
optionsArgs =
      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
"accept_label" SaveFileOptions
options.acceptLabel,
          forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"modal" SaveFileOptions
options.modal,
          forall b a.
IsVariant b =>
(a -> b) -> Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Filter -> (Text, [(Word32, Text)])
encodeFilter) Text
"filters" SaveFileOptions
options.filters,
          forall b a.
IsVariant b =>
(a -> b) -> Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair' Filter -> (Text, [(Word32, Text)])
encodeFilter Text
"current_filter" SaveFileOptions
options.currentFilter,
          forall b a.
IsVariant b =>
(a -> b) -> Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ChoiceCombo -> (Text, Text, [(Text, Text)], Text)
encodeCombo) Text
"choices" SaveFileOptions
options.choices,
          forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"current_name" SaveFileOptions
options.currentName,
          forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"current_folder" (Text -> ByteString
encodeNullTerminatedUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SaveFileOptions
options.currentFolder),
          forall a. IsVariant a => Text -> Maybe a -> Maybe (Text, Variant)
toVariantPair Text
"current_file" (Text -> ByteString
encodeNullTerminatedUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SaveFileOptions
options.currentFile)
        ]

    parseResponse :: Map Text Variant -> IO SaveFileResults
parseResponse Map Text Variant
resMap = do
      OpenFileResults {[String]
uris :: [String]
$sel:uris:OpenFileResults :: OpenFileResults -> [String]
uris, Maybe [ChoiceComboSelection]
choices :: Maybe [ChoiceComboSelection]
$sel:choices:OpenFileResults :: OpenFileResults -> Maybe [ChoiceComboSelection]
choices, Maybe Filter
currentFilter :: Maybe Filter
$sel:currentFilter:OpenFileResults :: OpenFileResults -> Maybe Filter
currentFilter} <- Map Text Variant -> IO OpenFileResults
parseOpenFileResponse Map Text Variant
resMap
      forall (f :: * -> *) a. Applicative f => a -> f a
pure SaveFileResults {[String]
uris :: [String]
$sel:uris:SaveFileResults :: [String]
uris, Maybe [ChoiceComboSelection]
choices :: Maybe [ChoiceComboSelection]
$sel:choices:SaveFileResults :: Maybe [ChoiceComboSelection]
choices, Maybe Filter
currentFilter :: Maybe Filter
$sel:currentFilter:SaveFileResults :: Maybe Filter
currentFilter}

parseOpenFileResponse :: Map Text Variant -> IO OpenFileResults
parseOpenFileResponse :: Map Text Variant -> IO OpenFileResults
parseOpenFileResponse = \case
  Map Text Variant
resMap
    | Just [String]
uris <- [Text] -> Maybe [String]
decodeFileUris forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"uris" Map Text Variant
resMap,
      Just Maybe [(Text, Text)]
choicesRaw <- forall a.
IsVariant a =>
Text -> Map Text Variant -> Maybe (Maybe a)
optionalFromVariant Text
"choices" Map Text Variant
resMap,
      Maybe [ChoiceComboSelection]
choices <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Text) -> ChoiceComboSelection
decodeChoiceComboSelection forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [(Text, Text)]
choicesRaw,
      Just Maybe (Text, [(Word32, Text)])
currentFilterRaw <- forall a.
IsVariant a =>
Text -> Map Text Variant -> Maybe (Maybe a)
optionalFromVariant Text
"current_filter" Map Text Variant
resMap,
      Just Maybe Filter
currentFilter <- forall a b. (a -> Maybe b) -> Maybe a -> Maybe (Maybe b)
mapJust (Text, [(Word32, Text)]) -> Maybe Filter
decodeFilter Maybe (Text, [(Word32, Text)])
currentFilterRaw ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure OpenFileResults {[String]
uris :: [String]
$sel:uris:OpenFileResults :: [String]
uris, Maybe [ChoiceComboSelection]
choices :: Maybe [ChoiceComboSelection]
$sel:choices:OpenFileResults :: Maybe [ChoiceComboSelection]
choices, Maybe Filter
currentFilter :: Maybe Filter
$sel:currentFilter:OpenFileResults :: Maybe Filter
currentFilter}
  Map Text Variant
resMap ->
    forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ClientError
DBus.clientError forall a b. (a -> b) -> a -> b
$ String
"openFile: could not parse response: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Map Text Variant
resMap

encodeFilter :: Filter -> (Text, [(Word32, Text)])
encodeFilter :: Filter -> (Text, [(Word32, Text)])
encodeFilter Filter
filtr =
  (Filter
filtr.name, FilterFileType -> (Word32, Text)
encodeFilterFileType forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Filter
filtr.fileTypes)

decodeFilter :: (Text, [(Word32, Text)]) -> Maybe Filter
decodeFilter :: (Text, [(Word32, Text)]) -> Maybe Filter
decodeFilter (Text
name, [(Word32, Text)]
rawFileTypes) = do
  [FilterFileType]
fileTypes <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Word32, Text) -> Maybe FilterFileType
decodeFileType [(Word32, Text)]
rawFileTypes
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Filter {Text
name :: Text
$sel:name:Filter :: Text
name, [FilterFileType]
fileTypes :: [FilterFileType]
$sel:fileTypes:Filter :: [FilterFileType]
fileTypes}

encodeFilterFileType :: FilterFileType -> (Word32, Text)
encodeFilterFileType :: FilterFileType -> (Word32, Text)
encodeFilterFileType = \case
  GlobFilter Text
pat -> (Word32
0, Text
pat)
  MimeFilter Text
mime -> (Word32
1, Text
mime)

decodeFileType :: (Word32, Text) -> Maybe FilterFileType
decodeFileType :: (Word32, Text) -> Maybe FilterFileType
decodeFileType = \case
  (Word32
0, Text
pat) -> forall a. a -> Maybe a
Just (Text -> FilterFileType
GlobFilter Text
pat)
  (Word32
1, Text
mime) -> forall a. a -> Maybe a
Just (Text -> FilterFileType
MimeFilter Text
mime)
  (Word32, Text)
_ -> forall a. Maybe a
Nothing

encodeCombo :: ChoiceCombo -> (Text, Text, [(Text, Text)], Text)
encodeCombo :: ChoiceCombo -> (Text, Text, [(Text, Text)], Text)
encodeCombo ChoiceCombo
combo =
  ( ChoiceCombo
combo.id,
    ChoiceCombo
combo.label_,
    ChoiceComboOption -> (Text, Text)
encodeComboOption forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChoiceCombo
combo.choices,
    ChoiceCombo
combo.defaultChoiceId
  )

encodeComboOption :: ChoiceComboOption -> (Text, Text)
encodeComboOption :: ChoiceComboOption -> (Text, Text)
encodeComboOption ChoiceComboOption
option =
  (ChoiceComboOption
option.id, ChoiceComboOption
option.label_)

decodeChoiceComboSelection :: (Text, Text) -> ChoiceComboSelection
decodeChoiceComboSelection :: (Text, Text) -> ChoiceComboSelection
decodeChoiceComboSelection =
  forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> ChoiceComboSelection
ChoiceComboSelection