dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-05-25 02:05:40 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: ttl in feature chat items, view responses (#1595)

Browse Source 
* core: ttl in feature chat items, view responses

* fix tests

* fix test

* view

* refactor

* use prefChangedValue

* use groupPrefChangedValue

* use cupIntValue

* simplify types

* groupFeatureState

* groupPrefToText

* prefToText, view

* remove prefFeature

* rename intValue -> param

* int -> param

* timedTTLText

* remove pragma

* restore pragma

* simplify

* timedTTLText

* fix tests

* off, after

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
This commit is contained in:
JRoberts
2022-12-19 21:18:59 +04:00
committed by GitHub
parent ffa37b1684
commit 84e43c57f6
5 changed files with 150 additions and 76 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/View.hs
+14 -9
View File
@@ -26,7 +26,6 @@ import Data.Time.Clock (DiffTime, UTCTime)
import Data.Time.Format (defaultTimeLocale, formatTime)
import Data.Time.LocalTime (ZonedTime (..), localDay, localTimeOfDay, timeOfDayToTime, utcToZonedTime)
import GHC.Generics (Generic)
import GHC.Records.Compat
import qualified Network.HTTP.Types as Q
import Numeric (showFFloat)
import Simplex.Chat (maxImageSize)
@@ -797,7 +796,7 @@ viewContactPreferences user ct ct' cups =
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 $ chatFeature f) <> ": " <> plain (prefEnabledToText enabled) <> " (you allow: " <> viewCountactUserPref userPreference <> ", contact allows: " <> viewPreference contactPreference <> ")"
| otherwise = Just $ viewFeatureText f <> ": " <> plain (prefEnabledToText enabled) <> " (you allow: " <> viewCountactUserPref userPreference <> ", contact allows: " <> viewPreference contactPreference <> ")"
where
userPref = getPreference f userPrefs
userPref' = getPreference f userPrefs'
@@ -812,15 +811,15 @@ viewPrefsUpdated ps ps'
prefs = mapMaybe viewPref allChatFeatures
viewPref (ACF f)
| pref ps == pref ps' = Nothing
| otherwise = Just $ plain (chatFeatureToText $ chatFeature f) <> " allowed: " <> viewPreference (pref ps')
| otherwise = Just $ viewFeatureText f <> " allowed: " <> viewPreference (pref ps')
where
pref pss = getPreference f $ mergePreferences pss Nothing
viewFeatureText :: SChatFeature f -> StyledString
viewFeatureText f = plain . chatFeatureToText $ chatFeature f
viewPreference :: FeatureI f => FeaturePreference f -> StyledString
viewPreference p = case getField @"allow" p of
FAAlways -> "always"
FAYes -> "yes"
FANo -> "no"
viewPreference p = plain $ prefToText' p
viewCountactUserPref :: FeatureI f => ContactUserPref (FeaturePreference f) -> StyledString
viewCountactUserPref = \case
@@ -850,10 +849,16 @@ viewGroupUpdated
prefs = mapMaybe viewPref allGroupFeatures
viewPref (AGF f)
| pref gps == pref gps' = Nothing
| otherwise = Just $ plain (groupFeatureToText $ toGroupFeature f) <> " enabled: " <> plain (groupPrefToText $ pref gps')
| otherwise = Just $ viewGroupFeatureText f <> " enabled: " <> viewGroupPreference (pref gps')
where
pref = getGroupPreference f . mergeGroupPreferences
viewGroupFeatureText :: SGroupFeature f -> StyledString
viewGroupFeatureText f = plain . groupFeatureToText $ toGroupFeature f
viewGroupPreference :: GroupFeatureI f => GroupFeaturePreference f -> StyledString
viewGroupPreference p = plain $ groupPrefToText' p
viewGroupProfile :: GroupInfo -> [StyledString]
viewGroupProfile g@GroupInfo {groupProfile = GroupProfile {description, image, groupPreferences = gps}} =
[ttyFullGroup g]
@@ -861,7 +866,7 @@ viewGroupProfile g@GroupInfo {groupProfile = GroupProfile {description, image, g
<> maybe [] ((bold' "description:" :) . map plain . T.lines) description
<> (bold' "group preferences:" : map viewPref allGroupFeatures)
where
viewPref (AGF f) = plain (groupFeatureToText $ toGroupFeature f) <> " enabled: " <> plain (groupPrefToText $ pref gps)
viewPref (AGF f) = viewGroupFeatureText f <> " enabled: " <> viewGroupPreference (pref gps)
where
pref = getGroupPreference f . mergeGroupPreferences