From 878eea774d5888af24a97e34d0f64727effdddab Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Sun, 12 May 2024 23:35:14 +0100 Subject: [PATCH] core: save app themes as map with any text key (#4159) * core: save app themes as map with any text key * remove theme preset name * list of themes * theme id * theme IDs * moar * colors * default to dark * fix --- src/Simplex/Chat/AppSettings.hs | 9 ++- src/Simplex/Chat/Messages.hs | 1 + src/Simplex/Chat/Types.hs | 4 -- src/Simplex/Chat/Types/UITheme.hs | 116 ++++++++++++++++-------------- src/Simplex/Chat/Types/Util.hs | 5 ++ 5 files changed, 75 insertions(+), 60 deletions(-) diff --git a/src/Simplex/Chat/AppSettings.hs b/src/Simplex/Chat/AppSettings.hs index 6996cc1d87..62fc900bd0 100644 --- a/src/Simplex/Chat/AppSettings.hs +++ b/src/Simplex/Chat/AppSettings.hs @@ -9,6 +9,7 @@ import Control.Applicative ((<|>)) import Data.Aeson (FromJSON (..), (.:?)) import qualified Data.Aeson as J import qualified Data.Aeson.TH as JQ +import Data.Map.Strict (Map) import Data.Maybe (fromMaybe) import Data.Text (Text) import Simplex.Chat.Types.UITheme @@ -48,7 +49,8 @@ data AppSettings = AppSettings uiProfileImageCornerRadius :: Maybe Double, uiColorScheme :: Maybe UIColorScheme, uiDarkColorScheme :: Maybe DarkColorScheme, - uiThemes :: Maybe UIThemes + uiCurrentThemeIds :: Maybe (Map ThemeColorScheme Text), + uiThemes :: Maybe [UITheme] } deriving (Show) @@ -78,6 +80,7 @@ defaultAppSettings = uiProfileImageCornerRadius = Just 22.5, uiColorScheme = Just UCSSystem, uiDarkColorScheme = Just DCSSimplex, + uiCurrentThemeIds = Nothing, uiThemes = Nothing } @@ -107,6 +110,7 @@ defaultParseAppSettings = uiProfileImageCornerRadius = Nothing, uiColorScheme = Nothing, uiDarkColorScheme = Nothing, + uiCurrentThemeIds = Nothing, uiThemes = Nothing } @@ -136,6 +140,7 @@ combineAppSettings platformDefaults storedSettings = uiProfileImageCornerRadius = p uiProfileImageCornerRadius, uiColorScheme = p uiColorScheme, uiDarkColorScheme = p uiDarkColorScheme, + uiCurrentThemeIds = p uiCurrentThemeIds, uiThemes = p uiThemes } where @@ -177,6 +182,7 @@ instance FromJSON AppSettings where uiProfileImageCornerRadius <- p "uiProfileImageCornerRadius" uiColorScheme <- p "uiColorScheme" uiDarkColorScheme <- p "uiDarkColorScheme" + uiCurrentThemeIds <- p "uiCurrentThemeIds" uiThemes <- p "uiThemes" pure AppSettings @@ -203,6 +209,7 @@ instance FromJSON AppSettings where uiProfileImageCornerRadius, uiColorScheme, uiDarkColorScheme, + uiCurrentThemeIds, uiThemes } where diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index a6d5761b5f..b1c314c04b 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -45,6 +45,7 @@ import Simplex.Chat.Messages.CIContent import Simplex.Chat.Protocol import Simplex.Chat.Types import Simplex.Chat.Types.Preferences +import Simplex.Chat.Types.Util (textParseJSON) import Simplex.Messaging.Agent.Protocol (AgentMsgId, MsgMeta (..), MsgReceiptStatus (..)) import Simplex.Messaging.Crypto.File (CryptoFile (..)) import qualified Simplex.Messaging.Crypto.File as CF diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 0d07d5e3cb..4d8e954312 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -27,7 +27,6 @@ import Data.Aeson (FromJSON (..), ToJSON (..)) import qualified Data.Aeson as J import qualified Data.Aeson.Encoding as JE import qualified Data.Aeson.TH as JQ -import qualified Data.Aeson.Types as JT import qualified Data.Attoparsec.ByteString.Char8 as A import Data.ByteString.Char8 (ByteString, pack, unpack) import Data.Int (Int64) @@ -1480,9 +1479,6 @@ serializeIntroStatus = \case GMIntroToConnected -> "to-con" GMIntroConnected -> "con" -textParseJSON :: TextEncoding a => String -> J.Value -> JT.Parser a -textParseJSON name = J.withText name $ maybe (fail $ "bad " <> name) pure . textDecode - data NetworkStatus = NSUnknown | NSConnected diff --git a/src/Simplex/Chat/Types/UITheme.hs b/src/Simplex/Chat/Types/UITheme.hs index 9f9c106d1f..ed92caea0e 100644 --- a/src/Simplex/Chat/Types/UITheme.hs +++ b/src/Simplex/Chat/Types/UITheme.hs @@ -7,26 +7,21 @@ module Simplex.Chat.Types.UITheme where import Data.Aeson (FromJSON (..), ToJSON (..)) import qualified Data.Aeson as J +import qualified Data.Aeson.Encoding as JE +import qualified Data.Aeson.Key as JK import qualified Data.Aeson.TH as JQ -import qualified Data.Attoparsec.ByteString.Char8 as A import Data.Char (toLower) import Data.Maybe (fromMaybe) +import Data.Text (Text) import Database.SQLite.Simple.FromField (FromField (..)) import Database.SQLite.Simple.ToField (ToField (..)) import Simplex.Chat.Types.Util import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_) -import Simplex.Messaging.Util ((<$?>)) - -data UIThemes = UIThemes - { light :: Maybe UITheme, - dark :: Maybe UITheme, - simplex :: Maybe UITheme - } - deriving (Eq, Show) data UITheme = UITheme - { base :: ThemeColorScheme, + { themeId :: Text, + base :: ThemeColorScheme, wallpaper :: Maybe ChatWallpaper, colors :: UIColors } @@ -48,40 +43,72 @@ data UIThemeEntityOverride = UIThemeEntityOverride } deriving (Eq, Show) -data ThemeColorScheme = TCSLight | TCSDark | TCSSimplex - deriving (Eq, Show) +data DarkColorScheme = DCSDark | DCSBlack | DCSSimplex + deriving (Eq, Ord, Show) -data UIColorScheme - = UCSSystem - | UCSLight - | UCSDark - | UCSSimplex - deriving (Show) +data ThemeColorScheme = TCSLight | TCSDark DarkColorScheme + deriving (Eq, Ord, Show) -data DarkColorScheme = DCSDark | DCSSimplex - deriving (Show) +data UIColorScheme = UCSSystem | UCSFixed ThemeColorScheme + deriving (Eq, Ord, Show) -instance StrEncoding ThemeColorScheme where - strEncode = \case +instance TextEncoding DarkColorScheme where + textEncode = \case + DCSDark -> "DARK" + DCSBlack -> "BLACK" + DCSSimplex -> "SIMPLEX" + textDecode s = + Just $ case s of + "DARK" -> DCSDark + "BLACK" -> DCSBlack + "SIMPLEX" -> DCSSimplex + _ -> DCSDark + +instance TextEncoding ThemeColorScheme where + textEncode = \case TCSLight -> "LIGHT" - TCSDark -> "DARK" - TCSSimplex -> "SIMPLEX" - strDecode = \case - "LIGHT" -> Right TCSLight - "DARK" -> Right TCSDark - "SIMPLEX" -> Right TCSSimplex - _ -> Left "bad ColorScheme" - strP = strDecode <$?> A.takeTill (== ' ') + TCSDark s -> textEncode s + textDecode = \case + "LIGHT" -> Just TCSLight + s -> TCSDark <$> textDecode s + +instance TextEncoding UIColorScheme where + textEncode = \case + UCSSystem -> "SYSTEM" + UCSFixed s -> textEncode s + textDecode = \case + "SYSTEM" -> Just UCSSystem + s -> UCSFixed <$> textDecode s + +instance FromJSON DarkColorScheme where + parseJSON = textParseJSON "DarkColorScheme" + +instance ToJSON DarkColorScheme where + toJSON = J.String . textEncode + toEncoding = JE.text . textEncode instance FromJSON ThemeColorScheme where - parseJSON = strParseJSON "ThemeColorScheme" + parseJSON = textParseJSON "ThemeColorScheme" instance ToJSON ThemeColorScheme where - toJSON = strToJSON - toEncoding = strToJEncoding + toJSON = J.String . textEncode + toEncoding = JE.text . textEncode + +instance FromJSON UIColorScheme where + parseJSON = textParseJSON "UIColorScheme" + +instance ToJSON UIColorScheme where + toJSON = J.String . textEncode + toEncoding = JE.text . textEncode + +instance J.FromJSONKey ThemeColorScheme where + fromJSONKey = J.FromJSONKeyText $ fromMaybe (TCSDark DCSDark) . textDecode + +instance J.ToJSONKey ThemeColorScheme where + toJSONKey = J.ToJSONKeyText (JK.fromText . textEncode) (JE.text . textEncode) data ChatWallpaper = ChatWallpaper - { preset :: Maybe ChatWallpaperPreset, + { preset :: Maybe Text, imageFile :: Maybe FilePath, background :: Maybe UIColor, tint :: Maybe UIColor, @@ -109,19 +136,6 @@ data UIColors = UIColors defaultUIColors :: UIColors defaultUIColors = UIColors Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing -data ChatWallpaperPreset - = CWPKids - | CWPCats - | CWPPets - | CWPFlowers - | CWPHearts - | CWPSocial - | CWPTravel - | CWPInternet - | CWPSpace - | CWPSchool - deriving (Eq, Show) - newtype UIColor = UIColor String deriving (Eq, Show) @@ -137,16 +151,10 @@ instance ToJSON UIColor where toJSON (UIColor t) = J.toJSON t toEncoding (UIColor t) = J.toEncoding t -$(JQ.deriveJSON (enumJSON $ dropPrefix "DCS") ''DarkColorScheme) - $(JQ.deriveJSON (enumJSON $ dropPrefix "UCM") ''UIColorMode) -$(JQ.deriveJSON (enumJSON $ dropPrefix "UCS") ''UIColorScheme) - $(JQ.deriveJSON (enumJSON $ dropPrefix "CWS") ''ChatWallpaperScale) -$(JQ.deriveJSON (enumJSON $ dropPrefix "CWP") ''ChatWallpaperPreset) - $(JQ.deriveJSON defaultJSON ''ChatWallpaper) $(JQ.deriveJSON defaultJSON ''UIColors) @@ -157,8 +165,6 @@ $(JQ.deriveJSON defaultJSON ''UIThemeEntityOverrides) $(JQ.deriveJSON defaultJSON ''UITheme) -$(JQ.deriveJSON defaultJSON ''UIThemes) - instance ToField UIThemeEntityOverrides where toField = toField . encodeJSON diff --git a/src/Simplex/Chat/Types/Util.hs b/src/Simplex/Chat/Types/Util.hs index 0f41931acf..e19d48caba 100644 --- a/src/Simplex/Chat/Types/Util.hs +++ b/src/Simplex/Chat/Types/Util.hs @@ -4,6 +4,7 @@ module Simplex.Chat.Types.Util where import Data.Aeson (FromJSON, ToJSON) import qualified Data.Aeson as J +import qualified Data.Aeson.Types as JT import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy.Char8 as LB import Data.Text (Text) @@ -13,6 +14,7 @@ import Database.SQLite.Simple (ResultError (..), SQLData (..)) import Database.SQLite.Simple.FromField (FieldParser, returnError) import Database.SQLite.Simple.Internal (Field (..)) import Database.SQLite.Simple.Ok (Ok (Ok)) +import Simplex.Messaging.Encoding.String import Simplex.Messaging.Util (safeDecodeUtf8) encodeJSON :: ToJSON a => a -> Text @@ -21,6 +23,9 @@ encodeJSON = safeDecodeUtf8 . LB.toStrict . J.encode decodeJSON :: FromJSON a => Text -> Maybe a decodeJSON = J.decode . LB.fromStrict . encodeUtf8 +textParseJSON :: TextEncoding a => String -> J.Value -> JT.Parser a +textParseJSON name = J.withText name $ maybe (fail $ "bad " <> name) pure . textDecode + fromBlobField_ :: Typeable k => (ByteString -> Either String k) -> FieldParser k fromBlobField_ p = \case f@(Field (SQLBlob b) _) ->