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

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

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

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

data ColorScheme
  = ColorSchemeNoPreference
  | ColorSchemeDark
  | ColorSchemeLight
  deriving (ColorScheme -> ColorScheme -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColorScheme -> ColorScheme -> Bool
$c/= :: ColorScheme -> ColorScheme -> Bool
== :: ColorScheme -> ColorScheme -> Bool
$c== :: ColorScheme -> ColorScheme -> Bool
Eq, Int -> ColorScheme -> ShowS
[ColorScheme] -> ShowS
ColorScheme -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColorScheme] -> ShowS
$cshowList :: [ColorScheme] -> ShowS
show :: ColorScheme -> String
$cshow :: ColorScheme -> String
showsPrec :: Int -> ColorScheme -> ShowS
$cshowsPrec :: Int -> 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Variant] -> IO ReadAllResults
parseResponse
  where
    args :: [Variant]
args = [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 <- forall a. IsVariant a => Variant -> Maybe a
DBus.fromVariant Variant
resVal -> do
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SettingValue] -> ReadAllResults
ReadAllResults forall a b. (a -> b) -> a -> b
$
          forall a b c. (a -> b -> c) -> b -> a -> c
flip forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey Map Text (Map Text Variant)
namespaceKeyMap forall a b. (a -> b) -> a -> b
$ \Text
namespace Map Text Variant
keyMap ->
            forall a b c. (a -> b -> c) -> b -> a -> c
flip forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey Map Text Variant
keyMap forall a b. (a -> b) -> a -> b
$ \Text
key Variant
value ->
              [SettingValue {Text
namespace :: Text
$sel:namespace:SettingValue :: Text
namespace, Text
key :: Text
$sel:key:SettingValue :: Text
key, Variant
value :: Variant
$sel:value:SettingValue :: Variant
value, $sel:standardValue:SettingValue :: Maybe StandardSetting
standardValue = Text -> Text -> Variant -> Maybe StandardSetting
decodeStandardSetting Text
namespace Text
key Variant
value}]
      [Variant]
res ->
        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
"readAll: could not parse response: " forall a. Semigroup a => a -> a -> a
<> 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Variant] -> IO ReadResults
parseResponse
  where
    args :: [Variant]
args = [forall a. IsVariant a => a -> Variant
DBus.toVariant ReadOptions
options.namespace, forall a. IsVariant a => a -> Variant
DBus.toVariant ReadOptions
options.key]
    parseResponse :: [Variant] -> IO ReadResults
parseResponse = \case
      [Variant
value] ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ReadResults {Variant
value :: Variant
$sel:value:ReadResults :: Variant
value, $sel:standardValue:ReadResults :: Maybe StandardSetting
standardValue = Text -> Text -> Variant -> Maybe StandardSetting
decodeStandardSetting ReadOptions
options.namespace ReadOptions
options.key Variant
value}
      [Variant]
res ->
        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
"read: could not parse response: " forall a. Semigroup a => a -> a -> a
<> 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") -> forall a. a -> Maybe a
Just (ColorScheme -> StandardSetting
SettingColorScheme (Variant -> ColorScheme
decodeColorScheme Variant
value))
    (Text, Text)
_ -> forall a. Maybe a
Nothing
  where
    decodeColorScheme :: Variant -> ColorScheme
decodeColorScheme Variant
scheme
      | Variant
scheme forall a. Eq a => a -> a -> Bool
== forall a. IsVariant a => a -> Variant
DBus.toVariant (Word32
1 :: Word32) = ColorScheme
ColorSchemeDark
      | Variant
scheme forall a. Eq a => a -> a -> Bool
== forall a. IsVariant a => a -> Variant
DBus.toVariant (Word32
2 :: Word32) = ColorScheme
ColorSchemeLight
      | Bool
otherwise = ColorScheme
ColorSchemeNoPreference