f8ca450 · vty · git.iko.soy

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

compare with master

unifiedsplit

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

1{-# LANGUAGE BangPatterns #-}

2+{-# LANGUAGE CPP #-}

2{-# OPTIONS_HADDOCK hide #-}

3{-# OPTIONS_HADDOCK hide #-}

3{-# LANGUAGE NoMonomorphismRestriction #-}

4{-# LANGUAGE NoMonomorphismRestriction #-}

4{-# LANGUAGE NamedFieldPuns #-}

5{-# LANGUAGE NamedFieldPuns #-}

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

13import Control.Monad ( liftM )

14import Control.Monad ( liftM )

14import Control.DeepSeq

15import Control.DeepSeq

15

16

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

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

19+#endif

16import Data.Word

20import Data.Word

17import qualified Data.Vector.Unboxed as Vector

21import qualified Data.Vector.Unboxed as Vector

18

22

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

329 , outParamOps :: !ParamOps

333 , outParamOps :: !ParamOps

330 }

334 }

331

335

332−instance Monoid BuildResults where

336+instance Semigroup BuildResults where

333− mempty = BuildResults 0 [] []

334− v0 `mappend` v1

337+ v0 <> v1

335 = BuildResults

338 = BuildResults

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

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

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

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

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

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

339 }

342 }

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 #-}

2+

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

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

2-- output.

4-- output.

3--

5--

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

50import Control.Concurrent.STM

52import Control.Concurrent.STM

51

53

52import Data.IORef

54import Data.IORef

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

53−import Data.Monoid

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

57+#endif

54

58

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

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

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

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

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

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

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE StandaloneDeriving #-}

2{-# LANGUAGE StandaloneDeriving #-}

2{-# LANGUAGE GADTs #-}

3{-# LANGUAGE GADTs #-}

3{-# LANGUAGE RankNTypes #-}

4{-# LANGUAGE RankNTypes #-}

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

60where

61where

61

62

62import Data.Bits

63import Data.Bits

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

65+import Data.Semigroup

66+#endif

63import Data.Text (Text)

67import Data.Text (Text)

64import Data.Word

68import Data.Word

65

69

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

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

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

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

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

113

117

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+

114instance Monoid Attr where

125instance Monoid Attr where

115 mempty = Attr mempty mempty mempty mempty

126 mempty = Attr mempty mempty mempty mempty

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

116− mappend attr0 attr1 =

128+ mappend = (<>)

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

129+#endif

118− ( attrForeColor attr0 `mappend` attrForeColor attr1 )

119− ( attrBackColor attr0 `mappend` attrBackColor attr1 )

120− ( attrURL attr0 `mappend` attrURL attr1 )

121

130

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

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

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

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

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

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

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

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

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

144

153

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+

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

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

146 mempty = KeepCurrent

166 mempty = KeepCurrent

147− mappend Default Default = Default

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

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

168+ mappend = (<>)

154− mappend ( SetTo v ) KeepCurrent = SetTo v

169+#endif

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

156

170

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

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

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

172-- 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 #-}

1{-# LANGUAGE DeriveDataTypeable #-}

2{-# LANGUAGE DeriveDataTypeable #-}

2{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}

3{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}

3{-# LANGUAGE TypeOperators #-}

4{-# LANGUAGE TypeOperators #-}

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

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

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

76

77

77import qualified Data.ByteString as BS

78import 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

79import Data.Typeable (Typeable)

83import Data.Typeable (Typeable)

80

84

81import Graphics.Vty.Input.Events

85import Graphics.Vty.Input.Events

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

137defaultConfig :: Config

141defaultConfig :: Config

138defaultConfig = mempty

142defaultConfig = mempty

139

143

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+

140instance Monoid Config where

158instance Monoid Config where

141 mempty = Config

159 mempty = Config

142 { vmin = Nothing

160 { vmin = Nothing

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

149 , outputFd = Nothing

167 , outputFd = Nothing

150 , termName = Nothing

168 , termName = Nothing

151 }

169 }

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

152− mappend c0 c1 = Config

171+ mappend = (<>)

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

172+#endif

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− }

164

173

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

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

166-- @$VTY_CONFIG_FILE@.

175-- @$VTY_CONFIG_FILE@.

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

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

2{-# LANGUAGE BangPatterns #-}

3+{-# LANGUAGE CPP #-}

3

4

4module Graphics.Vty.DisplayAttributes where

5module Graphics.Vty.DisplayAttributes where

5

6

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

7

8

8import Data.Bits ((.&.))

9import Data.Bits ((.&.))

9import Data.ByteString (ByteString)

10import Data.ByteString (ByteString)

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

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

13+#endif

10import Data.Text (Text)

14import Data.Text (Text)

11import Data.Text.Encoding (encodeUtf8)

15import Data.Text.Encoding (encodeUtf8)

12

16

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

47 }

51 }

48 deriving (Show)

52 deriving (Show)

49

53

50−instance Monoid DisplayAttrDiff where

54+instance Semigroup DisplayAttrDiff where

51− mempty = DisplayAttrDiff [] NoColorChange NoColorChange NoLinkChange

52− mappend d0 d1 =

55+ d0 <> d1 =

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

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

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

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

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

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

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

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

57 in DisplayAttrDiff ds fcd bcd ud

60 in DisplayAttrDiff ds fcd bcd ud

58

61

62+instance Monoid DisplayAttrDiff where

63+ mempty = DisplayAttrDiff [] NoColorChange NoColorChange NoLinkChange

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

65+ mappend = (<>)

66+#endif

67+

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

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

60simplifyStyleDiffs :: [StyleStateChange] -> [StyleStateChange] -> [StyleStateChange]

69simplifyStyleDiffs :: [StyleStateChange] -> [StyleStateChange] -> [StyleStateChange]

61simplifyStyleDiffs cs0 cs1 = cs0 `mappend` cs1

70simplifyStyleDiffs cs0 cs1 = cs0 `mappend` cs1

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

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

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE NamedFieldPuns #-}

2{-# LANGUAGE NamedFieldPuns #-}

2{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE DeriveGeneric #-}

3{-# OPTIONS_HADDOCK hide #-}

4{-# OPTIONS_HADDOCK hide #-}

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

11

12

12import Control.DeepSeq

13import Control.DeepSeq

13

14

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

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

17+#endif

14import qualified Data.Text.Lazy as TL

18import qualified Data.Text.Lazy as TL

15

19

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

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

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

232imageHeight CropTop { outputHeight = h } = h

236imageHeight CropTop { outputHeight = h } = h

233imageHeight EmptyImage = 0

237imageHeight EmptyImage = 0

234

238

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

240+instance Semigroup Image where

241+ (<>) = vertJoin

242+

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

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

236instance Monoid Image where

244instance Monoid Image where

237 mempty = EmptyImage

245 mempty = EmptyImage

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

238− mappend = vertJoin

247+ mappend = (<>)

248+#endif

239

249

240-- | combines two images side by side

250-- | combines two images side by side

241--

251--

vty.cabal+3

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

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

62 vector >= 0.7

63

64+ if !impl(ghc >= 8.0)

65+ build-depends: semigroups >= 0.16

66+

64 exposed-modules: Graphics.Vty

67 exposed-modules: Graphics.Vty

65 Graphics.Vty.Attributes

68 Graphics.Vty.Attributes

66 Graphics.Vty.Config

69 Graphics.Vty.Config