433b5b7 · vty · git.iko.soy

git.iko.soy/vty

Add Semigroup instances

commit433b5b7f2d83de3e75b0f6c2a1514f5078709912 authorRyan Scott <ryan.gl.scott@gmail.com> dateSun 4 Feb 2018, 16:30 (9 years ago) parentf2be6a0

7 files changed+96−38

compare with master

unifiedsplit

src/Data/Terminfo/Parse.hs+14−5 src/Graphics/Vty.hs+5−1 src/Graphics/Vty/Attributes.hs+28−14 src/Graphics/Vty/Config.hs+22−13 src/Graphics/Vty/DisplayAttributes.hs+12−3 src/Graphics/Vty/Image/Internal.hs+12−2 vty.cabal+3

src/Data/Terminfo/Parse.hs+14−5

@@ -1,4 +1,5 @@

11{-# LANGUAGE BangPatterns #-}

2+{-# LANGUAGE CPP #-}

23{-# OPTIONS_HADDOCK hide #-}

34{-# LANGUAGE NoMonomorphismRestriction #-}

45{-# LANGUAGE NamedFieldPuns #-}

@@ -13,6 +14,9 @@ where

1314import Control.Monad ( liftM )

1415import Control.DeepSeq

1516

17+#if !(MIN_VERSION_base(4,11,0))

18+import Data.Semigroup (Semigroup(..))

19+#endif

1620import Data.Word

1721import qualified Data.Vector.Unboxed as Vector

1822

@@ -329,11 +333,16 @@ data BuildResults = BuildResults

329333 , outParamOps :: !ParamOps

330334 }

331335

332−instance Monoid BuildResults where

333− mempty = BuildResults 0 [] []

334− v0 `mappend` v1

336+instance Semigroup BuildResults where

337+ v0 <> v1

335338 = BuildResults

336339 { outParamCount = (outParamCount v0) `max` (outParamCount v1)

337− , outCapOps = (outCapOps v0) `mappend` (outCapOps v1)

338− , outParamOps = (outParamOps v0) `mappend` (outParamOps v1)

340+ , outCapOps = (outCapOps v0) <> (outCapOps v1)

341+ , outParamOps = (outParamOps v0) <> (outParamOps v1)

339342 }

343+

344+instance Monoid BuildResults where

345+ mempty = BuildResults 0 [] []

346+#if !(MIN_VERSION_base(4,11,0))

347+ mappend = (<>)

348+#endif

src/Graphics/Vty.hs+5−1

@@ -1,3 +1,5 @@

1+{-# LANGUAGE CPP #-}

13-- | Vty provides interfaces for both terminal input and terminal

24-- output.

35--

@@ -50,7 +52,9 @@ import Graphics.Vty.Attributes

5052import Control.Concurrent.STM

5153

5254import Data.IORef

53−import Data.Monoid

55+#if !(MIN_VERSION_base(4,11,0))

56+import Data.Semigroup ((<>))

57+#endif

5458

5559-- | A Vty value represents a handle to the Vty library that the

5660-- application must create in order to use Vty.

src/Graphics/Vty/Attributes.hs+28−14

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

12{-# LANGUAGE StandaloneDeriving #-}

23{-# LANGUAGE GADTs #-}

34{-# LANGUAGE RankNTypes #-}

@@ -60,6 +61,9 @@ module Graphics.Vty.Attributes

6061where

6162

6263import Data.Bits

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

65+import Data.Semigroup

66+#endif

6367import Data.Text (Text)

6468import Data.Word

6569

@@ -111,13 +115,18 @@ data Attr = Attr

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

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

113117

118+instance Semigroup Attr where

119+ attr0 <> attr1 =

120+ Attr ( attrStyle attr0 <> attrStyle attr1 )

121+ ( attrForeColor attr0 <> attrForeColor attr1 )

122+ ( attrBackColor attr0 <> attrBackColor attr1 )

123+ ( attrURL attr0 <> attrURL attr1 )

124+

114125instance Monoid Attr where

115126 mempty = Attr mempty mempty mempty mempty

116− mappend attr0 attr1 =

117− Attr ( attrStyle attr0 `mappend` attrStyle attr1 )

118− ( attrForeColor attr0 `mappend` attrForeColor attr1 )

119− ( attrBackColor attr0 `mappend` attrBackColor attr1 )

120− ( attrURL attr0 `mappend` attrURL attr1 )

127+#if !(MIN_VERSION_base(4,11,0))

128+ mappend = (<>)

129+#endif

121130

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

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

@@ -142,17 +151,22 @@ deriving instance Eq v => Eq (MaybeDefault v)

142151deriving instance Eq v => Show (MaybeDefault v)

143152deriving instance (Eq v, Show v, Read v) => Read (MaybeDefault v)

144153

154+instance Eq v => Semigroup (MaybeDefault v) where

155+ Default <> Default = Default

156+ Default <> KeepCurrent = Default

157+ Default <> SetTo v = SetTo v

158+ KeepCurrent <> Default = Default

159+ KeepCurrent <> KeepCurrent = KeepCurrent

160+ KeepCurrent <> SetTo v = SetTo v

161+ SetTo _v <> Default = Default

162+ SetTo v <> KeepCurrent = SetTo v

163+ SetTo _ <> SetTo v = SetTo v

164+

145165instance Eq v => Monoid ( MaybeDefault v ) where

146166 mempty = KeepCurrent

147− mappend Default Default = Default

148− mappend Default KeepCurrent = Default

149− mappend Default ( SetTo v ) = SetTo v

150− mappend KeepCurrent Default = Default

151− mappend KeepCurrent KeepCurrent = KeepCurrent

152− mappend KeepCurrent ( SetTo v ) = SetTo v

153− mappend ( SetTo _v ) Default = Default

154− mappend ( SetTo v ) KeepCurrent = SetTo v

155− mappend ( SetTo _ ) ( SetTo v ) = SetTo v

167+#if !(MIN_VERSION_base(4,11,0))

168+ mappend = (<>)

169+#endif

156170

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

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

src/Graphics/Vty/Config.hs+22−13

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

12{-# LANGUAGE DeriveDataTypeable #-}

23{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}

34{-# LANGUAGE TypeOperators #-}

@@ -75,7 +76,10 @@ import Control.Exception (catch, IOException, Exception(..), throwIO)

7576import Control.Monad (liftM, guard, void)

7677

7778import qualified Data.ByteString as BS

78−import Data.Monoid

79+import Data.Monoid (Monoid(..))

80+#if !(MIN_VERSION_base(4,11,0))

81+import Data.Semigroup (Semigroup(..))

82+#endif

7983import Data.Typeable (Typeable)

8084

8185import Graphics.Vty.Input.Events

@@ -137,6 +141,20 @@ data Config = Config

137141defaultConfig :: Config

138142defaultConfig = mempty

139143

144+instance Semigroup Config where

145+ c0 <> c1 = Config

146+ -- latter config takes priority for everything but inputMap

147+ { vmin = vmin c1 <|> vmin c0

148+ , vtime = vtime c1 <|> vtime c0

149+ , mouseMode = mouseMode c1

150+ , bracketedPasteMode = bracketedPasteMode c1

151+ , debugLog = debugLog c1 <|> debugLog c0

152+ , inputMap = inputMap c0 <> inputMap c1

153+ , inputFd = inputFd c1 <|> inputFd c0

154+ , outputFd = outputFd c1 <|> outputFd c0

155+ , termName = termName c1 <|> termName c0

156+ }

157+

140158instance Monoid Config where

141159 mempty = Config

142160 { vmin = Nothing

@@ -149,18 +167,9 @@ instance Monoid Config where

149167 , outputFd = Nothing

150168 , termName = Nothing

151169 }

152− mappend c0 c1 = Config

153− -- latter config takes priority for everything but inputMap

154− { vmin = vmin c1 <|> vmin c0

155− , vtime = vtime c1 <|> vtime c0

156− , mouseMode = mouseMode c1

157− , bracketedPasteMode = bracketedPasteMode c1

158− , debugLog = debugLog c1 <|> debugLog c0

159− , inputMap = inputMap c0 <> inputMap c1

160− , inputFd = inputFd c1 <|> inputFd c0

161− , outputFd = outputFd c1 <|> outputFd c0

162− , termName = termName c1 <|> termName c0

163− }

170+#if !(MIN_VERSION_base(4,11,0))

171+ mappend = (<>)

172+#endif

164173

165174-- | Load a configuration from @'getAppUserDataDirectory'/config@ and

166175-- @$VTY_CONFIG_FILE@.

src/Graphics/Vty/DisplayAttributes.hs+12−3

@@ -1,5 +1,6 @@

22{-# LANGUAGE BangPatterns #-}

3+{-# LANGUAGE CPP #-}

45module Graphics.Vty.DisplayAttributes where

@@ -7,6 +8,9 @@ import Graphics.Vty.Attributes

89import Data.Bits ((.&.))

910import Data.ByteString (ByteString)

11+#if !(MIN_VERSION_base(4,11,0))

12+import Data.Semigroup (Semigroup(..))

13+#endif

1014import Data.Text (Text)

1115import Data.Text.Encoding (encodeUtf8)

1216

@@ -47,15 +51,20 @@ data DisplayAttrDiff = DisplayAttrDiff

4751 }

4852 deriving (Show)

4953

50−instance Monoid DisplayAttrDiff where

51− mempty = DisplayAttrDiff [] NoColorChange NoColorChange NoLinkChange

52− mappend d0 d1 =

54+instance Semigroup DisplayAttrDiff where

55+ d0 <> d1 =

5356 let ds = simplifyStyleDiffs (styleDiffs d0) (styleDiffs d1)

5457 fcd = simplifyColorDiffs (foreColorDiff d0) (foreColorDiff d1)

5558 bcd = simplifyColorDiffs (backColorDiff d0) (backColorDiff d1)

5659 ud = simplifyUrlDiffs (urlDiff d0) (urlDiff d1)

5760 in DisplayAttrDiff ds fcd bcd ud

5861

62+instance Monoid DisplayAttrDiff where

63+ mempty = DisplayAttrDiff [] NoColorChange NoColorChange NoLinkChange

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

65+ mappend = (<>)

66+#endif

67+

5968-- | Used in the computation of a final style attribute change.

6069simplifyStyleDiffs :: [StyleStateChange] -> [StyleStateChange] -> [StyleStateChange]

6170simplifyStyleDiffs cs0 cs1 = cs0 `mappend` cs1

src/Graphics/Vty/Image/Internal.hs+12−2

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

12{-# LANGUAGE NamedFieldPuns #-}

23{-# LANGUAGE DeriveGeneric #-}

34{-# OPTIONS_HADDOCK hide #-}

@@ -11,6 +12,9 @@ import GHC.Generics

1112

1213import Control.DeepSeq

1314

15+#if !(MIN_VERSION_base(4,11,0))

16+import Data.Semigroup (Semigroup(..))

17+#endif

1418import qualified Data.Text.Lazy as TL

1519

1620-- | A display text is a Data.Text.Lazy

@@ -232,10 +236,16 @@ imageHeight CropBottom { outputHeight = h } = h

232236imageHeight CropTop { outputHeight = h } = h

233237imageHeight EmptyImage = 0

234238

235−-- | Append in the Monoid instance is equivalent to '<->'.

239+-- | Append in the 'Semigroup' instance is equivalent to '<->'.

240+instance Semigroup Image where

241+ (<>) = vertJoin

242+

243+-- | Append in the 'Monoid' instance is equivalent to '<->'.

236244instance Monoid Image where

237245 mempty = EmptyImage

238− mappend = vertJoin

246+#if !(MIN_VERSION_base(4,11,0))

247+ mappend = (<>)

248+#endif

239249

240250-- | combines two images side by side

241251--

vty.cabal+3

@@ -61,6 +61,9 @@ library

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

6262 vector >= 0.7

6363

64+ if !impl(ghc >= 8.0)

65+ build-depends: semigroups >= 0.16

66+

6467 exposed-modules: Graphics.Vty

6568 Graphics.Vty.Attributes

6669 Graphics.Vty.Config