safe-coloured-text 0.2.0.2 → 0.6.0.0
raw patch · 5 files changed
Files
- CHANGELOG.md +50/−0
- safe-coloured-text.cabal +3/−2
- src/Text/Colour.hs +25/−20
- src/Text/Colour/Chunk.hs +122/−66
- src/Text/Colour/Code.hs +8/−0
CHANGELOG.md view
@@ -1,5 +1,55 @@ # Changelog for safe-coloured-text +## [0.6.0.0] - 2026-05-13++### Added++* `chunkStyleHyperlink :: !(Maybe Text)` field in `ChunkStyle` for OSC 8 hyperlink URLs+* `renderOsc8Open` and `renderOsc8Close` for emitting OSC 8 terminal hyperlink sequences+* `renderChunkBuilder` now emits OSC 8 sequences when `chunkStyleHyperlink` is set++## [0.5.0.0] - 2026-04-12++### Changed++* Separated styling from text: `Chunk` now has `chunkText` and `chunkStyle` fields+* New `ChunkStyle` type holds all styling attributes (italic, bold, colours, etc.)+* Styling field names now use `chunkStyle` prefix (e.g. `chunkStyleItalic`)+* Added `noStyle` constructor and `plainStyle`, `styleSGR` functions+* Renamed `chunkSGR` to `styleSGR`++## [0.4.0.0] - 2026-04-12++### Added++* Strikethrough support (`chunkStrikethrough`, `strikethrough`, SGR 9/29)+* Reverse video support (`chunkSwapForegroundBackground`, `swapForegroundBackground`, SGR 7/27)+* Concealed/hidden text support (`chunkConcealed`, `concealed`, SGR 8/28)+* Overline support (`chunkOverlined`, `overlined`, SGR 53/55)++### Fixed++* `chunkBlinking` is now rendered in `chunkSGR` (was stored but never emitted)++## [0.3.0.2] - 2024-06-23++### Added++* `unwordsChunks`+* `chunkWidth`++## [0.3.0.1] - 2024-03-26++### Added++* `unlinesChunks`++## [0.3.0.0] - 2024-03-26++### Removed++* Removed deprecated functions+ ## [0.2.0.2] - 2024-03-26 ### Changed
safe-coloured-text.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2.+-- This file has been generated from package.yaml by hpack version 0.38.3. -- -- see: https://github.com/sol/hpack name: safe-coloured-text-version: 0.2.0.2+version: 0.6.0.0 synopsis: Safely output coloured text category: User Interfaces homepage: https://github.com/NorfairKing/safe-coloured-text#readme@@ -17,6 +17,7 @@ license-file: LICENSE build-type: Simple extra-source-files:+ LICENSE CHANGELOG.md source-repository head
src/Text/Colour.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -- | Safe Coloured Text -- -- This module is responsible for defining, building, and rendering coloured text.@@ -7,6 +9,8 @@ ( -- * Building chunks chunk, Chunk (..),+ ChunkStyle (..),+ noStyle, -- ** Styling @@ -24,6 +28,10 @@ bold, faint, italic,+ strikethrough,+ swapForegroundBackground,+ concealed,+ overlined, underline, doubleUnderline, noUnderline,@@ -66,6 +74,10 @@ -- * Rendering + -- ** Composing chunks+ unlinesChunks,+ unwordsChunks,+ -- ** Rendering chunks to strict bytestring in UTF8 renderChunksUtf8BS, renderChunkUtf8BS,@@ -86,14 +98,6 @@ renderChunksBuilder, renderChunkBuilder, - -- ** Decrecated rendering chunks to strict bytestring in UTF8- renderChunksBS,- renderChunkBS,-- -- ** Deprecated rendering chunks to lazy bytestring builders in UTF8- renderChunks,- renderChunk,- -- * IO TerminalCapabilities (..), @@ -102,12 +106,11 @@ putChunksLocaleWith, hPutChunksUtf8With, hPutChunksLocaleWith,- putChunksWith,- hPutChunksWith, ) where import qualified Data.ByteString.Builder as SBB+import Data.List (intercalate) import qualified Data.Text.IO as TIO import System.IO import Text.Colour.Capabilities@@ -119,12 +122,7 @@ -- | Print a list of chunks to stdout with given 'TerminalCapabilities' in an encoding according to the system's locale. putChunksLocaleWith :: TerminalCapabilities -> [Chunk] -> IO ()-putChunksLocaleWith tc = hPutChunksWith tc stdout---- | Deprecated synonym of 'putChunksUtf8With'-putChunksWith :: TerminalCapabilities -> [Chunk] -> IO ()-putChunksWith = putChunksUtf8With-{-# DEPRECATED putChunksWith "Use putChunksLocaleWith, or putChunksUtf8With if you must." #-}+putChunksLocaleWith tc = hPutChunksLocaleWith tc stdout -- | Print a list of chunks to the given 'Handle' with given 'TerminalCapabilities'. hPutChunksUtf8With :: TerminalCapabilities -> Handle -> [Chunk] -> IO ()@@ -134,7 +132,14 @@ hPutChunksLocaleWith :: TerminalCapabilities -> Handle -> [Chunk] -> IO () hPutChunksLocaleWith tc h cs = TIO.hPutStr h $ renderChunksText tc cs --- | Deprecated synonym of 'hPutChunksUtf8With'-hPutChunksWith :: TerminalCapabilities -> Handle -> [Chunk] -> IO ()-hPutChunksWith = hPutChunksUtf8With-{-# DEPRECATED hPutChunksWith "Use hPutChunksLocaleWith, or hPutChunksUtf8With if you must." #-}+-- | Render lines of chunks.+--+-- This puts newlines ("\n") at the end of every list of chunks.+unlinesChunks :: [[Chunk]] -> [Chunk]+unlinesChunks = concatMap (<> [chunk "\n"])++-- | Render lines of chunks.+--+-- This puts newlines (" ") inbetween the list of chunks.+unwordsChunks :: [[Chunk]] -> [Chunk]+unwordsChunks = intercalate [" "]
src/Text/Colour/Chunk.hs view
@@ -10,6 +10,7 @@ import Data.Maybe import Data.String import Data.Text (Text)+import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Builder as LTB@@ -23,12 +24,7 @@ data Chunk = Chunk { chunkText :: !Text,- chunkItalic :: !(Maybe Bool),- chunkConsoleIntensity :: !(Maybe ConsoleIntensity),- chunkUnderlining :: !(Maybe Underlining),- chunkBlinking :: !(Maybe Blinking),- chunkForeground :: !(Maybe Colour),- chunkBackground :: !(Maybe Colour)+ chunkStyle :: !ChunkStyle } deriving (Show, Eq, Generic) @@ -37,18 +33,53 @@ instance IsString Chunk where fromString = chunk . fromString -plainChunk :: TerminalCapabilities -> Chunk -> Bool-plainChunk tc Chunk {..} =- let Chunk _ _ _ _ _ _ _ = undefined+data ChunkStyle = ChunkStyle+ { chunkStyleItalic :: !(Maybe Bool),+ chunkStyleStrikethrough :: !(Maybe Bool),+ chunkStyleSwapForegroundBackground :: !(Maybe Bool),+ chunkStyleConcealed :: !(Maybe Bool),+ chunkStyleOverlined :: !(Maybe Bool),+ chunkStyleConsoleIntensity :: !(Maybe ConsoleIntensity),+ chunkStyleUnderlining :: !(Maybe Underlining),+ chunkStyleBlinking :: !(Maybe Blinking),+ chunkStyleForeground :: !(Maybe Colour),+ chunkStyleBackground :: !(Maybe Colour),+ -- | OSC 8 hyperlink URL, if any.+ -- Rendered as @ESC]8;;\<url\>ESC\\@ before the text and @ESC]8;;ESC\\@ after.+ chunkStyleHyperlink :: !(Maybe Text)+ }+ deriving (Show, Eq, Generic)++instance Validity ChunkStyle++-- TODO This is not correct because text-width is correct but it's a+-- good place to put this so we can fix it later and it'll get fixed+-- everywhere.+chunkWidth :: Chunk -> Int+chunkWidth = T.length . chunkText++plainStyle :: TerminalCapabilities -> ChunkStyle -> Bool+plainStyle tc ChunkStyle {..} =+ let ChunkStyle _ _ _ _ _ _ _ _ _ _ _ = undefined in and- [ isNothing chunkItalic,- isNothing chunkConsoleIntensity,- isNothing chunkUnderlining,- isNothing chunkBlinking,- maybe True (plainColour tc) chunkForeground,- maybe True (plainColour tc) chunkBackground+ [ isNothing chunkStyleItalic,+ isNothing chunkStyleStrikethrough,+ isNothing chunkStyleSwapForegroundBackground,+ isNothing chunkStyleConcealed,+ isNothing chunkStyleOverlined,+ isNothing chunkStyleConsoleIntensity,+ isNothing chunkStyleUnderlining,+ isNothing chunkStyleBlinking,+ maybe True (plainColour tc) chunkStyleForeground,+ maybe True (plainColour tc) chunkStyleBackground,+ isNothing chunkStyleHyperlink ] +plainChunk :: TerminalCapabilities -> Chunk -> Bool+plainChunk tc Chunk {..} =+ let Chunk _ _ = undefined+ in plainStyle tc chunkStyle+ plainColour :: TerminalCapabilities -> Colour -> Bool plainColour tc = \case Colour8 {} -> tc < With8Colours@@ -56,53 +87,33 @@ Colour24Bit {} -> tc < With24BitColours -- | Render chunks directly to a UTF8-encoded 'Bytestring'.-renderChunksUtf8BS :: Foldable f => TerminalCapabilities -> f Chunk -> ByteString+renderChunksUtf8BS :: (Foldable f) => TerminalCapabilities -> f Chunk -> ByteString renderChunksUtf8BS tc = TE.encodeUtf8 . renderChunksText tc --- | Deprecated synonym for 'renderChunksUtf8BS'-renderChunksBS :: Foldable f => TerminalCapabilities -> f Chunk -> ByteString-renderChunksBS = renderChunksUtf8BS-{-# DEPRECATED renderChunksBS "Use renderChunksText, or renderChunksUtf8BS if you must." #-}- -- | Render chunks to a UTF8-encoded 'ByteString' 'Bytestring.Builder'.-renderChunksUtf8BSBuilder :: Foldable f => TerminalCapabilities -> f Chunk -> ByteString.Builder+renderChunksUtf8BSBuilder :: (Foldable f) => TerminalCapabilities -> f Chunk -> ByteString.Builder renderChunksUtf8BSBuilder tc = foldMap (renderChunkUtf8BSBuilder tc) --- | Deprecated synonym for 'renderChunksUtf8BSBuilder'-renderChunks :: Foldable f => TerminalCapabilities -> f Chunk -> ByteString.Builder-renderChunks = renderChunksUtf8BSBuilder-{-# DEPRECATED renderChunks "Use renderChunksBuilder, or renderChunksUtf8BSBuilder if you must." #-}- -- | Render chunks directly to strict 'Text'.-renderChunksText :: Foldable f => TerminalCapabilities -> f Chunk -> Text+renderChunksText :: (Foldable f) => TerminalCapabilities -> f Chunk -> Text renderChunksText tc = LT.toStrict . renderChunksLazyText tc -- | Render chunks directly to lazy 'LT.Text'.-renderChunksLazyText :: Foldable f => TerminalCapabilities -> f Chunk -> LT.Text+renderChunksLazyText :: (Foldable f) => TerminalCapabilities -> f Chunk -> LT.Text renderChunksLazyText tc = LTB.toLazyText . renderChunksBuilder tc -- | Render chunks to a lazy 'LT.Text' 'Text.Builder'-renderChunksBuilder :: Foldable f => TerminalCapabilities -> f Chunk -> Text.Builder+renderChunksBuilder :: (Foldable f) => TerminalCapabilities -> f Chunk -> Text.Builder renderChunksBuilder tc = foldMap (renderChunkBuilder tc) -- | Render a chunk directly to a UTF8-encoded 'Bytestring'. renderChunkUtf8BS :: TerminalCapabilities -> Chunk -> ByteString renderChunkUtf8BS tc = TE.encodeUtf8 . renderChunkText tc --- | Deprecated synonym for 'renderChunkUtf8BS'-renderChunkBS :: TerminalCapabilities -> Chunk -> ByteString-renderChunkBS = renderChunkUtf8BS-{-# DEPRECATED renderChunkBS "Use renderChunkText, or renderChunkUtf8BS if you must." #-}- -- | Render a chunk directly to a UTF8-encoded 'Bytestring' 'ByteString.Builder'. renderChunkUtf8BSBuilder :: TerminalCapabilities -> Chunk -> ByteString.Builder renderChunkUtf8BSBuilder tc = LTE.encodeUtf8Builder . renderChunkLazyText tc --- | Deprecated synonym for 'renderChunkUtf8BSBuilder'-renderChunk :: TerminalCapabilities -> Chunk -> ByteString.Builder-renderChunk = renderChunkUtf8BSBuilder-{-# DEPRECATED renderChunk "Use renderChunkBuilder, or renderChunkUtf8BSBuilder if you must." #-}- -- | Render a chunk directly to strict 'Text'. renderChunkText :: TerminalCapabilities -> Chunk -> Text renderChunkText tc = LT.toStrict . renderChunkLazyText tc@@ -118,19 +129,40 @@ then LTB.fromText chunkText else mconcat- [ renderCSI (SGR (chunkSGR tc c)),+ [ maybe mempty renderOsc8Open (chunkStyleHyperlink chunkStyle),+ renderCSI (SGR (styleSGR tc chunkStyle)), LTB.fromText chunkText,- renderCSI (SGR [Reset])+ renderCSI (SGR [Reset]),+ maybe mempty (const renderOsc8Close) (chunkStyleHyperlink chunkStyle) ] -chunkSGR :: TerminalCapabilities -> Chunk -> [SGR]-chunkSGR tc Chunk {..} =+-- | Render an OSC 8 hyperlink open sequence: @ESC]8;;<url>ESC\@.+-- An empty URL renders the close sequence.+renderOsc8Open :: Text -> Text.Builder+renderOsc8Open url =+ mconcat+ [ LTB.fromText (T.pack "\ESC]8;;"),+ LTB.fromText url,+ LTB.fromText (T.pack "\ESC\\")+ ]++-- | Render an OSC 8 hyperlink close sequence: @ESC]8;;ESC\@.+renderOsc8Close :: Text.Builder+renderOsc8Close = LTB.fromText (T.pack "\ESC]8;;\ESC\\")++styleSGR :: TerminalCapabilities -> ChunkStyle -> [SGR]+styleSGR tc ChunkStyle {..} = catMaybes- [ SetItalic <$> chunkItalic,- SetUnderlining <$> chunkUnderlining,- SetConsoleIntensity <$> chunkConsoleIntensity,- chunkForeground >>= colourSGR tc Foreground,- chunkBackground >>= colourSGR tc Background+ [ SetItalic <$> chunkStyleItalic,+ SetStrikethrough <$> chunkStyleStrikethrough,+ SetSwapForegroundBackground <$> chunkStyleSwapForegroundBackground,+ SetConcealed <$> chunkStyleConcealed,+ SetOverlined <$> chunkStyleOverlined,+ SetUnderlining <$> chunkStyleUnderlining,+ SetBlinking <$> chunkStyleBlinking,+ SetConsoleIntensity <$> chunkStyleConsoleIntensity,+ chunkStyleForeground >>= colourSGR tc Foreground,+ chunkStyleBackground >>= colourSGR tc Background ] -- | Turn a text into a plain chunk, without any styling@@ -138,46 +170,70 @@ chunk t = Chunk { chunkText = t,- chunkItalic = Nothing,- chunkConsoleIntensity = Nothing,- chunkUnderlining = Nothing,- chunkBlinking = Nothing,- chunkForeground = Nothing,- chunkBackground = Nothing+ chunkStyle = noStyle } +-- | The empty style, without any styling+noStyle :: ChunkStyle+noStyle =+ ChunkStyle+ { chunkStyleItalic = Nothing,+ chunkStyleStrikethrough = Nothing,+ chunkStyleSwapForegroundBackground = Nothing,+ chunkStyleConcealed = Nothing,+ chunkStyleOverlined = Nothing,+ chunkStyleConsoleIntensity = Nothing,+ chunkStyleUnderlining = Nothing,+ chunkStyleBlinking = Nothing,+ chunkStyleForeground = Nothing,+ chunkStyleBackground = Nothing,+ chunkStyleHyperlink = Nothing+ }+ fore :: Colour -> Chunk -> Chunk-fore col chu = chu {chunkForeground = Just col}+fore col chu = chu {chunkStyle = (chunkStyle chu) {chunkStyleForeground = Just col}} back :: Colour -> Chunk -> Chunk-back col chu = chu {chunkBackground = Just col}+back col chu = chu {chunkStyle = (chunkStyle chu) {chunkStyleBackground = Just col}} bold :: Chunk -> Chunk-bold chu = chu {chunkConsoleIntensity = Just BoldIntensity}+bold chu = chu {chunkStyle = (chunkStyle chu) {chunkStyleConsoleIntensity = Just BoldIntensity}} faint :: Chunk -> Chunk-faint chu = chu {chunkConsoleIntensity = Just FaintIntensity}+faint chu = chu {chunkStyle = (chunkStyle chu) {chunkStyleConsoleIntensity = Just FaintIntensity}} italic :: Chunk -> Chunk-italic chu = chu {chunkItalic = Just True}+italic chu = chu {chunkStyle = (chunkStyle chu) {chunkStyleItalic = Just True}} +strikethrough :: Chunk -> Chunk+strikethrough chu = chu {chunkStyle = (chunkStyle chu) {chunkStyleStrikethrough = Just True}}++swapForegroundBackground :: Chunk -> Chunk+swapForegroundBackground chu = chu {chunkStyle = (chunkStyle chu) {chunkStyleSwapForegroundBackground = Just True}}++concealed :: Chunk -> Chunk+concealed chu = chu {chunkStyle = (chunkStyle chu) {chunkStyleConcealed = Just True}}++overlined :: Chunk -> Chunk+overlined chu = chu {chunkStyle = (chunkStyle chu) {chunkStyleOverlined = Just True}}+ underline :: Chunk -> Chunk-underline chu = chu {chunkUnderlining = Just SingleUnderline}+underline chu = chu {chunkStyle = (chunkStyle chu) {chunkStyleUnderlining = Just SingleUnderline}} doubleUnderline :: Chunk -> Chunk-doubleUnderline chu = chu {chunkUnderlining = Just DoubleUnderline}+doubleUnderline chu = chu {chunkStyle = (chunkStyle chu) {chunkStyleUnderlining = Just DoubleUnderline}} noUnderline :: Chunk -> Chunk-noUnderline chu = chu {chunkUnderlining = Just NoUnderline}+noUnderline chu = chu {chunkStyle = (chunkStyle chu) {chunkStyleUnderlining = Just NoUnderline}} slowBlinking :: Chunk -> Chunk-slowBlinking chu = chu {chunkBlinking = Just SlowBlinking}+slowBlinking chu = chu {chunkStyle = (chunkStyle chu) {chunkStyleBlinking = Just SlowBlinking}} rapidBlinking :: Chunk -> Chunk-rapidBlinking chu = chu {chunkBlinking = Just RapidBlinking}+rapidBlinking chu = chu {chunkStyle = (chunkStyle chu) {chunkStyleBlinking = Just RapidBlinking}} noBlinking :: Chunk -> Chunk-noBlinking chu = chu {chunkBlinking = Just NoBlinking}+noBlinking chu = chu {chunkStyle = (chunkStyle chu) {chunkStyleBlinking = Just NoBlinking}} -- TODO consider allowing an 8-colour alternative to a given 256-colour data Colour
src/Text/Colour/Code.hs view
@@ -71,6 +71,10 @@ data SGR = Reset | SetItalic !Bool+ | SetStrikethrough !Bool+ | SetSwapForegroundBackground !Bool+ | SetConcealed !Bool+ | SetOverlined !Bool | SetUnderlining !Underlining | SetBlinking !Blinking | SetConsoleIntensity !ConsoleIntensity@@ -95,6 +99,10 @@ sgrToCSIParams = \case Reset -> [] -- [0] would be fine too SetItalic b -> [if b then 3 else 23]+ SetStrikethrough b -> [if b then 9 else 29]+ SetSwapForegroundBackground b -> [if b then 7 else 27]+ SetConcealed b -> [if b then 8 else 28]+ SetOverlined b -> [if b then 53 else 55] SetUnderlining u -> [ case u of SingleUnderline -> 4