module Desktop.Portal.Settings
  ( -- * Common Types
    SettingValue (..),
    StandardSetting (..),
    ColorScheme (..),

    -- * Read All
    ReadAllOptions (..),
    ReadAllResults (..),
    readAll,

    -- * Read
    ReadOptions (..),
    ReadResults (..),
    read,
  )
where

import Control.Exception (throwIO)
import DBus (InterfaceName, Variant)
import DBus qualified
import DBus.Client qualified as DBus
import Data.Default (Default (..))
import Data.Map.Strict qualified as Map
import Data.Text (Text)
import Data.Word (Word32)
import Desktop.Portal.Internal (Client, callMethod)
import Prelude hiding (read)

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

instance Default ReadAllOptions where
  def :: ReadAllOptions
def = ReadAllOptions {$sel:namespaces:ReadAllOptions :: [Text]
namespaces = []}

newtype ReadAllResults = ReadAllResults
  {ReadAllResults -> [SettingValue]
values :: [SettingValue]}
  deriving (ReadAllResults -> ReadAllResults -> Bool
(ReadAllResults -> ReadAllResults -> Bool)
-> (ReadAllResults -> ReadAllResults -> Bool) -> Eq ReadAllResults
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReadAllResults -> ReadAllResults -> Bool
== :: ReadAllResults -> ReadAllResults -> Bool
$c/= :: ReadAllResults -> ReadAllResults -> Bool
/= :: ReadAllResults -> ReadAllResults -> Bool
Eq, Int -> ReadAllResults -> ShowS
[ReadAllResults] -> ShowS
ReadAllResults -> String
(Int -> ReadAllResults -> ShowS)
-> (ReadAllResults -> String)
-> ([ReadAllResults] -> ShowS)
-> Show ReadAllResults
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReadAllResults -> ShowS
showsPrec :: Int -> ReadAllResults -> ShowS
$cshow :: ReadAllResults -> String
show :: ReadAllResults -> String
$cshowList :: [ReadAllResults] -> ShowS
showList :: [ReadAllResults] -> ShowS
Show)

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

data ReadResults = ReadResults
  { ReadResults -> Variant
value :: Variant,
    ReadResults -> Maybe StandardSetting
standardValue :: Maybe StandardSetting
  }
  deriving (ReadResults -> ReadResults -> Bool
(ReadResults -> ReadResults -> Bool)
-> (ReadResults -> ReadResults -> Bool) -> Eq ReadResults
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReadResults -> ReadResults -> Bool
== :: ReadResults -> ReadResults -> Bool
$c/= :: ReadResults -> ReadResults -> Bool
/= :: ReadResults -> ReadResults -> Bool
Eq, Int -> ReadResults -> ShowS
[ReadResults] -> ShowS
ReadResults -> String
(Int -> ReadResults -> ShowS)
-> (ReadResults -> String)
-> ([ReadResults] -> ShowS)
-> Show ReadResults
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReadResults -> ShowS
showsPrec :: Int -> ReadResults -> ShowS
$cshow :: ReadResults -> String
show :: ReadResults -> String
$cshowList :: [ReadResults] -> ShowS
showList :: [ReadResults] -> ShowS
Show)

data SettingValue = SettingValue
  { SettingValue -> Text
namespace :: Text,
    SettingValue -> Text
key :: Text,
    SettingValue -> Variant
value :: Variant,
    SettingValue -> Maybe StandardSetting
standardValue :: Maybe StandardSetting
  }
  deriving (SettingValue -> SettingValue -> Bool
(SettingValue -> SettingValue -> Bool)
-> (SettingValue -> SettingValue -> Bool) -> Eq SettingValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SettingValue -> SettingValue -> Bool
== :: SettingValue -> SettingValue -> Bool
$c/= :: SettingValue -> SettingValue -> Bool
/= :: SettingValue -> SettingValue -> Bool
Eq, Int -> SettingValue -> ShowS
[SettingValue] -> ShowS
SettingValue -> String
(Int -> SettingValue -> ShowS)
-> (SettingValue -> String)
-> ([SettingValue] -> ShowS)
-> Show SettingValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SettingValue -> ShowS
showsPrec :: Int -> SettingValue -> ShowS
$cshow :: SettingValue -> String
show :: SettingValue -> String
$cshowList :: [SettingValue] -> ShowS
showList :: [SettingValue] -> ShowS
Show)

newtype StandardSetting
  = SettingColorScheme ColorScheme
  deriving (StandardSetting -> StandardSetting -> Bool
(StandardSetting -> StandardSetting -> Bool)
-> (StandardSetting -> StandardSetting -> Bool)
-> Eq StandardSetting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StandardSetting -> StandardSetting -> Bool
== :: StandardSetting -> StandardSetting -> Bool
$c/= :: StandardSetting -> StandardSetting -> Bool
/= :: StandardSetting -> StandardSetting -> Bool
Eq, Int -> StandardSetting -> ShowS
[StandardSetting] -> ShowS
StandardSetting -> String
(Int -> StandardSetting -> ShowS)
-> (StandardSetting -> String)
-> ([StandardSetting] -> ShowS)
-> Show StandardSetting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StandardSetting -> ShowS
showsPrec :: Int -> StandardSetting -> ShowS
$cshow :: StandardSetting -> String
show :: StandardSetting -> String
$cshowList :: [StandardSetting] -> ShowS
showList :: [StandardSetting] -> ShowS
Show)

data ColorScheme
  = ColorSchemeNoPreference
  | ColorSchemeDark
  | ColorSchemeLight
  deriving (ColorScheme -> ColorScheme -> Bool
(ColorScheme -> ColorScheme -> Bool)
-> (ColorScheme -> ColorScheme -> Bool) -> Eq ColorScheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColorScheme -> ColorScheme -> Bool
== :: ColorScheme -> ColorScheme -> Bool
$c/= :: ColorScheme -> ColorScheme -> Bool
/= :: ColorScheme -> ColorScheme -> Bool
Eq, Int -> ColorScheme -> ShowS
[ColorScheme] -> ShowS
ColorScheme -> String
(Int -> ColorScheme -> ShowS)
-> (ColorScheme -> String)
-> ([ColorScheme] -> ShowS)
-> Show ColorScheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColorScheme -> ShowS
showsPrec :: Int -> ColorScheme -> ShowS
$cshow :: ColorScheme -> String
show :: ColorScheme -> String
$cshowList :: [ColorScheme] -> ShowS
showList :: [ColorScheme] -> ShowS
Show)

settingsInterface :: InterfaceName
settingsInterface :: InterfaceName
settingsInterface = InterfaceName
"org.freedesktop.portal.Settings"

readAll :: Client -> ReadAllOptions -> IO ReadAllResults
readAll :: Client -> ReadAllOptions -> IO ReadAllResults
readAll Client
client ReadAllOptions
options =
  Client -> InterfaceName -> MemberName -> [Variant] -> IO [Variant]
callMethod Client
client InterfaceName
settingsInterface MemberName
"ReadAll" [Variant]
args IO [Variant]
-> ([Variant] -> IO ReadAllResults) -> IO ReadAllResults
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Variant] -> IO ReadAllResults
parseResponse
  where
    args :: [Variant]
args = [[Text] -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant ReadAllOptions
options.namespaces]
    parseResponse :: [Variant] -> IO ReadAllResults
parseResponse = \case
      [Variant
resVal] | Just Map Text (Map Text Variant)
namespaceKeyMap <- Variant -> Maybe (Map Text (Map Text Variant))
forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant Variant
resVal -> do
        ReadAllResults -> IO ReadAllResults
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReadAllResults -> IO ReadAllResults)
-> ([SettingValue] -> ReadAllResults)
-> [SettingValue]
-> IO ReadAllResults
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SettingValue] -> ReadAllResults
ReadAllResults ([SettingValue] -> IO ReadAllResults)
-> [SettingValue] -> IO ReadAllResults
forall a b. (a -> b) -> a -> b
$
          ((Text -> Map Text Variant -> [SettingValue])
 -> Map Text (Map Text Variant) -> [SettingValue])
-> Map Text (Map Text Variant)
-> (Text -> Map Text Variant -> [SettingValue])
-> [SettingValue]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text -> Map Text Variant -> [SettingValue])
-> Map Text (Map Text Variant) -> [SettingValue]
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey Map Text (Map Text Variant)
namespaceKeyMap ((Text -> Map Text Variant -> [SettingValue]) -> [SettingValue])
-> (Text -> Map Text Variant -> [SettingValue]) -> [SettingValue]
forall a b. (a -> b) -> a -> b
$ \Text
namespace Map Text Variant
keyMap ->
            ((Text -> Variant -> [SettingValue])
 -> Map Text Variant -> [SettingValue])
-> Map Text Variant
-> (Text -> Variant -> [SettingValue])
-> [SettingValue]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text -> Variant -> [SettingValue])
-> Map Text Variant -> [SettingValue]
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey Map Text Variant
keyMap ((Text -> Variant -> [SettingValue]) -> [SettingValue])
-> (Text -> Variant -> [SettingValue]) -> [SettingValue]
forall a b. (a -> b) -> a -> b
$ \Text
key Variant
value ->
              [SettingValue {Text
$sel:namespace:SettingValue :: Text
namespace :: Text
namespace, Text
$sel:key:SettingValue :: Text
key :: Text
key, Variant
$sel:value:SettingValue :: Variant
value :: Variant
value, $sel:standardValue:SettingValue :: Maybe StandardSetting
standardValue = Text -> Text -> Variant -> Maybe StandardSetting
decodeStandardSetting Text
namespace Text
key Variant
value}]
      [Variant]
res ->
        ClientError -> IO ReadAllResults
forall e a. Exception e => e -> IO a
throwIO (ClientError -> IO ReadAllResults)
-> (String -> ClientError) -> String -> IO ReadAllResults
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ClientError
DBus.clientError (String -> IO ReadAllResults) -> String -> IO ReadAllResults
forall a b. (a -> b) -> a -> b
$ String
"readAll: could not parse response: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Variant] -> String
forall a. Show a => a -> String
show [Variant]
res

read :: Client -> ReadOptions -> IO ReadResults
read :: Client -> ReadOptions -> IO ReadResults
read Client
client ReadOptions
options =
  Client -> InterfaceName -> MemberName -> [Variant] -> IO [Variant]
callMethod Client
client InterfaceName
settingsInterface MemberName
"Read" [Variant]
args IO [Variant] -> ([Variant] -> IO ReadResults) -> IO ReadResults
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Variant] -> IO ReadResults
parseResponse
  where
    args :: [Variant]
args = [Text -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant ReadOptions
options.namespace, Text -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant ReadOptions
options.key]
    parseResponse :: [Variant] -> IO ReadResults
parseResponse = \case
      [Variant
value] ->
        ReadResults -> IO ReadResults
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReadResults {Variant
$sel:value:ReadResults :: Variant
value :: Variant
value, $sel:standardValue:ReadResults :: Maybe StandardSetting
standardValue = Text -> Text -> Variant -> Maybe StandardSetting
decodeStandardSetting ReadOptions
options.namespace ReadOptions
options.key Variant
value}
      [Variant]
res ->
        ClientError -> IO ReadResults
forall e a. Exception e => e -> IO a
throwIO (ClientError -> IO ReadResults)
-> (String -> ClientError) -> String -> IO ReadResults
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ClientError
DBus.clientError (String -> IO ReadResults) -> String -> IO ReadResults
forall a b. (a -> b) -> a -> b
$ String
"read: could not parse response: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Variant] -> String
forall a. Show a => a -> String
show [Variant]
res

decodeStandardSetting :: Text -> Text -> Variant -> Maybe StandardSetting
decodeStandardSetting :: Text -> Text -> Variant -> Maybe StandardSetting
decodeStandardSetting Text
namespace Text
key Variant
value =
  case (Text
namespace, Text
key) of
    (Text
"org.freedesktop.appearance", Text
"color-scheme") -> StandardSetting -> Maybe StandardSetting
forall a. a -> Maybe a
Just (ColorScheme -> StandardSetting
SettingColorScheme (Variant -> ColorScheme
decodeColorScheme Variant
value))
    (Text, Text)
_ -> Maybe StandardSetting
forall a. Maybe a
Nothing
  where
    decodeColorScheme :: Variant -> ColorScheme
decodeColorScheme Variant
scheme
      | Variant
scheme Variant -> Variant -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant (Word32
1 :: Word32) = ColorScheme
ColorSchemeDark
      | Variant
scheme Variant -> Variant -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> Variant
forall a. IsVariant a => a -> Variant
DBus.toVariant (Word32
2 :: Word32) = ColorScheme
ColorSchemeLight
      | Bool
otherwise = ColorScheme
ColorSchemeNoPreference