blade/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2024-12-17 17:20:21 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

core: different types for chat preferences, to allow parameters (#1565)

Browse Source
This commit is contained in:
Evgeny Poberezkin
2022-12-13 14:52:34 +00:00
committed by GitHub
parent bd4c7dffbf
commit 678dbec3e2
8 changed files with 190 additions and 100 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/View.hs
+17 -17
View File
@@ -50,6 +50,7 @@ import qualified Simplex.Messaging.Protocol as SMP
import Simplex.Messaging.Transport.Client (TransportHost (..))
import Simplex.Messaging.Util (bshow)
import System.Console.ANSI.Types
import GHC.Records.Compat
type CurrentTime = UTCTime
@@ -774,15 +775,15 @@ viewContactPreferences :: User -> Contact -> Contact -> ContactUserPreferences -
viewContactPreferences user ct ct' cups =
mapMaybe (viewContactPref (mergeUserChatPrefs user ct) (mergeUserChatPrefs user ct') (preferences' ct) cups) allChatFeatures
viewContactPref :: FullPreferences -> FullPreferences -> Maybe Preferences -> ContactUserPreferences -> ChatFeature -> Maybe StyledString
viewContactPref userPrefs userPrefs' ctPrefs cups pt
viewContactPref :: FullPreferences -> FullPreferences -> Maybe Preferences -> ContactUserPreferences -> AChatFeature -> Maybe StyledString
viewContactPref userPrefs userPrefs' ctPrefs cups (ACF f)
| userPref == userPref' && ctPref == contactPreference = Nothing
| otherwise = Just $ plain (chatFeatureToText pt) <> ": " <> plain (prefEnabledToText enabled) <> " (you allow: " <> viewCountactUserPref userPreference <> ", contact allows: " <> viewPreference contactPreference <> ")"
| otherwise = Just $ plain (chatFeatureToText $ chatFeature f) <> ": " <> plain (prefEnabledToText enabled) <> " (you allow: " <> viewCountactUserPref userPreference <> ", contact allows: " <> viewPreference contactPreference <> ")"
where
userPref = getPreference pt userPrefs
userPref' = getPreference pt userPrefs'
ctPref = getPreference pt ctPrefs
ContactUserPreference {enabled, userPreference, contactPreference} = getContactUserPreference pt cups
userPref = getPreference f userPrefs
userPref' = getPreference f userPrefs'
ctPref = getPreference f ctPrefs
ContactUserPreference {enabled, userPreference, contactPreference} = getContactUserPreference f cups
viewPrefsUpdated :: Maybe Preferences -> Maybe Preferences -> [StyledString]
viewPrefsUpdated ps ps'
@@ -790,20 +791,19 @@ viewPrefsUpdated ps ps'
| otherwise = "updated preferences:" : prefs
where
prefs = mapMaybe viewPref allChatFeatures
viewPref pt
viewPref (ACF f)
| pref ps == pref ps' = Nothing
| otherwise = Just $ plain (chatFeatureToText pt) <> " allowed: " <> viewPreference (pref ps')
| otherwise = Just $ plain (chatFeatureToText $ chatFeature f) <> " allowed: " <> viewPreference (pref ps')
where
pref pss = getPreference pt $ mergePreferences pss Nothing
pref pss = getPreference f $ mergePreferences pss Nothing
viewPreference :: Preference -> StyledString
viewPreference = \case
Preference {allow} -> case allow of
FAAlways -> "always"
FAYes -> "yes"
FANo -> "no"
viewPreference :: FeatureI f => FeaturePreference f -> StyledString
viewPreference p = case getField @"allow" p of
FAAlways -> "always"
FAYes -> "yes"
FANo -> "no"
viewCountactUserPref :: ContactUserPref -> StyledString
viewCountactUserPref :: FeatureI f => ContactUserPref (FeaturePreference f) -> StyledString
viewCountactUserPref = \case
CUPUser p -> "default (" <> viewPreference p <> ")"
CUPContact p -> viewPreference p