f8f45c2 · vty · git.iko.soy

src/Graphics/Vty/Attributes.hs−27

compare with master

unifiedsplit

@@ -61,9 +61,6 @@ where

61

62import Control.DeepSeq

63import Data.Bits

64−#if !(MIN_VERSION_base(4,11,0))

65−import Data.Semigroup

66−#endif

67import Data.Text (Text)

64import Data.Text (Text)

68import Data.Word

65import Data.Word

69import GHC.Generics

66import GHC.Generics

@@ -116,19 +113,6 @@ data Attr = Attr

116-- Then the foreground color encoded into 8 bits.

113-- Then the foreground color encoded into 8 bits.

117-- Then the background color encoded into 8 bits.

114-- Then the background color encoded into 8 bits.

118

115

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−

132-- | Specifies the display attributes such that the final style and

116-- | Specifies the display attributes such that the final style and

133-- color values do not depend on the previously applied display

117-- color values do not depend on the previously applied display

134-- attribute. The display attributes can still depend on the terminal's

118-- attribute. The display attributes can still depend on the terminal's

@@ -151,17 +135,6 @@ instance (NFData v) => NFData (MaybeDefault v) where

151 rnf KeepCurrent = ()

135 rnf KeepCurrent = ()

152 rnf (SetTo v) = rnf v

136 rnf (SetTo v) = rnf v

153

137

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−

165-- | Styles are represented as an 8 bit word. Each bit in the word is 1

138-- | Styles are represented as an 8 bit word. Each bit in the word is 1

166-- if the style attribute assigned to that bit should be applied and 0

139-- if the style attribute assigned to that bit should be applied and 0

167-- if the style attribute should not be applied.

140-- if the style attribute should not be applied.

src/Graphics/Vty/Inline.hs+3−3

@@ -56,13 +56,13 @@ data InlineState =

56-- | Set the background color to the provided 'Color'.

57backColor :: Color -> InlineM ()

58backColor c = modify $ \s ->

59− s { inlineAttr = inlineAttr s `mappend` (currentAttr `withBackColor` c)

59+ s { inlineAttr = inlineAttr s `withBackColor` c

60 }

61

62-- | Set the foreground color to the provided 'Color'.

63foreColor :: Color -> InlineM ()

64foreColor c = modify $ \s ->

65− s { inlineAttr = inlineAttr s `mappend` (currentAttr `withForeColor` c)

65+ s { inlineAttr = inlineAttr s `withForeColor` c

66 }

67

68-- | Attempt to change the 'Style' of the following text..

@@ -71,7 +71,7 @@ foreColor c = modify $ \s ->

71-- produced. The style can still be removed.

72applyStyle :: Style -> InlineM ()

73applyStyle st = modify $ \s ->

74− s { inlineAttr = inlineAttr s `mappend` (currentAttr `withStyle` st)

74+ s { inlineAttr = inlineAttr s `withStyle` st

75 }

76

77-- | 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

554 utf8-string >= 0.3 && < 1.1,

555 vector >= 0.7

556

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−

584test-suite verify-utf8-width

557test-suite verify-utf8-width

585 default-language: Haskell2010

558 default-language: Haskell2010

586 default-extensions: ScopedTypeVariables

559 default-extensions: ScopedTypeVariables