git.iko.soy/vty
on master help sign in
Remove Monoid and Semigroup instances for Attr and MaybeDefault (relevant to brick/#351)

This change removes the aforementioned instances because they were misbehaved; merging Attr and MaybeDefault values with these instances resulted in field value losses. For example, before this change, (defAttr `withForeColor` blue) <> (defAttr `withBackColor` green) would result in just (defAttr `withBackColor` green) because the instances were designed to favor the right-hand arguments' fields even if they had not been explicitly set (a consequence of the MaybeDefault Semigroup instance). While that behavior was sensible specifically in the context of Graphics.Vty.Inline, it wasn't a useful user-facing API and it made for surprising instance behavior. Since there is actually no good way to handle this in a Semigroup instance for Attr -- some choices have to be made about how to merge two attributes' foreground colors, and that won't be much better than what we had -- the instance was just removed. I suspect that the risk of this impacting users negatively is very low, given that the instance behavior was not very useful.

commitf8f45c2af5aaeeeb12b8fae8568a307c5d89ef38 authorJonathan Daugherty <cygnus@foobox.com> dateTue 23 Nov 2021, 15:33 (5 years ago) parent67b2515
4 files changed+3−87
compare with master
unifiedsplit
src/Graphics/Vty/Attributes.hs−27 src/Graphics/Vty/Inline.hs+3−3 test/VerifyAttributes.hs−30 vty.cabal−27
src/Graphics/Vty/Attributes.hs−27
@@ -61,9 +61,6 @@ where
6161
6262import Control.DeepSeq
6363import Data.Bits
64−#if !(MIN_VERSION_base(4,11,0))
65−import Data.Semigroup
66−#endif
6764import Data.Text (Text)
6865import Data.Word
6966import GHC.Generics
@@ -116,19 +113,6 @@ data Attr = Attr
116113-- Then the foreground color encoded into 8 bits.
117114-- Then the background color encoded into 8 bits.
118115
119−instance Semigroup Attr where
120− attr0 <> attr1 =
121− Attr ( attrStyle attr0 <> attrStyle attr1 )
122− ( attrForeColor attr0 <> attrForeColor attr1 )
123− ( attrBackColor attr0 <> attrBackColor attr1 )
124− ( attrURL attr0 <> attrURL attr1 )
125−
126−instance Monoid Attr where
127− mempty = Attr mempty mempty mempty mempty
128−#if !(MIN_VERSION_base(4,11,0))
129− mappend = (<>)
130−#endif
131−
132116-- | Specifies the display attributes such that the final style and
133117-- color values do not depend on the previously applied display
134118-- attribute. The display attributes can still depend on the terminal's
@@ -151,17 +135,6 @@ instance (NFData v) => NFData (MaybeDefault v) where
151135 rnf KeepCurrent = ()
152136 rnf (SetTo v) = rnf v
153137
154−instance Semigroup (MaybeDefault v) where
155− _ <> v@(SetTo _) = v
156− x <> KeepCurrent = x
157− _ <> Default = Default
158−
159−instance Monoid ( MaybeDefault v ) where
160− mempty = KeepCurrent
161−#if !(MIN_VERSION_base(4,11,0))
162− mappend = (<>)
163−#endif
164−
165138-- | Styles are represented as an 8 bit word. Each bit in the word is 1
166139-- if the style attribute assigned to that bit should be applied and 0
167140-- if the style attribute should not be applied.
src/Graphics/Vty/Inline.hs+3−3
@@ -56,13 +56,13 @@ data InlineState =
5656-- | Set the background color to the provided 'Color'.
5757backColor :: Color -> InlineM ()
5858backColor c = modify $ \s ->
59− s { inlineAttr = inlineAttr s `mappend` (currentAttr `withBackColor` c)
59+ s { inlineAttr = inlineAttr s `withBackColor` c
6060 }
6161
6262-- | Set the foreground color to the provided 'Color'.
6363foreColor :: Color -> InlineM ()
6464foreColor c = modify $ \s ->
65− s { inlineAttr = inlineAttr s `mappend` (currentAttr `withForeColor` c)
65+ s { inlineAttr = inlineAttr s `withForeColor` c
6666 }
6767
6868-- | Attempt to change the 'Style' of the following text..
@@ -71,7 +71,7 @@ foreColor c = modify $ \s ->
7171-- produced. The style can still be removed.
7272applyStyle :: Style -> InlineM ()
7373applyStyle st = modify $ \s ->
74− s { inlineAttr = inlineAttr s `mappend` (currentAttr `withStyle` st)
74+ s { inlineAttr = inlineAttr s `withStyle` st
7575 }
7676
7777-- | Attempt to remove the specified 'Style' from the display of the
test/VerifyAttributes.hsdeleted−30
@@ -1,30 +0,0 @@
1−module VerifyAttributes where
2−
3−import Verify
4−
5−import Data.Semigroup((<>))
6−
7−import Graphics.Vty.Attributes(MaybeDefault(Default, KeepCurrent, SetTo))
8−
9−instance Arbitrary a => Arbitrary (MaybeDefault a) where
10− arbitrary = oneof [pure Default, pure KeepCurrent, SetTo <$> arbitrary]
11−
12−oldSem :: MaybeDefault a -> MaybeDefault a -> MaybeDefault a
13−oldSem Default Default = Default
14−oldSem Default KeepCurrent = Default
15−oldSem Default (SetTo v) = SetTo v
16−oldSem KeepCurrent Default = Default
17−oldSem KeepCurrent KeepCurrent = KeepCurrent
18−oldSem KeepCurrent (SetTo v) = SetTo v
19−oldSem (SetTo _v) Default = Default
20−oldSem (SetTo v) KeepCurrent = SetTo v
21−oldSem (SetTo _) (SetTo v) = SetTo v
22−
23−sameSemigroupValue :: MaybeDefault Int -> MaybeDefault Int -> Bool
24−sameSemigroupValue xa xb = xa <> xb == oldSem xa xb
25−
26−tests :: IO [Test]
27−tests = return
28− [ verify "check that the new Semigroup of MaybeDefault is equivalent to the old one" sameSemigroupValue
29− ]
30−
vty.cabal−27
@@ -554,33 +554,6 @@ test-suite verify-color-mapping
554554 utf8-string >= 0.3 && < 1.1,
555555 vector >= 0.7
556556
557−test-suite verify-semigroup-maybedefault
558− default-language: Haskell2010
559− default-extensions: ScopedTypeVariables
560−
561− type: detailed-0.9
562−
563− hs-source-dirs: test
564−
565− test-module: VerifyAttributes
566−
567− other-modules: Verify
568−
569− build-depends: vty,
570− Cabal >= 1.20,
571− QuickCheck >= 2.7,
572− random >= 1.0 && < 1.3,
573− base >= 4.8 && < 5,
574− bytestring,
575− containers,
576− deepseq >= 1.1 && < 1.5,
577− mtl >= 1.1.1.0 && < 2.3,
578− text >= 0.11.3,
579− unix,
580− utf8-string >= 0.3 && < 1.1,
581− vector >= 0.7
582−
583−
584557test-suite verify-utf8-width
585558 default-language: Haskell2010
586559 default-extensions: ScopedTypeVariables