diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # Changelog for safe-coloured-text-gen +## [0.0.0.5] - 2026-04-12 + +### Added + +* `GenValid ChunkStyle` instance + ## [0.0.0.4] - 2026-04-12 ### Added diff --git a/safe-coloured-text-gen.cabal b/safe-coloured-text-gen.cabal --- a/safe-coloured-text-gen.cabal +++ b/safe-coloured-text-gen.cabal @@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.37.0. +-- This file has been generated from package.yaml by hpack version 0.38.3. -- -- see: https://github.com/sol/hpack name: safe-coloured-text-gen -version: 0.0.0.4 +version: 0.0.0.5 description: Generators for types in safe-coloured-text homepage: https://github.com/NorfairKing/safe-coloured-text#readme bug-reports: https://github.com/NorfairKing/safe-coloured-text/issues diff --git a/src/Text/Colour/Gen.hs b/src/Text/Colour/Gen.hs --- a/src/Text/Colour/Gen.hs +++ b/src/Text/Colour/Gen.hs @@ -12,6 +12,10 @@ genValid = genValidStructurallyWithoutExtraChecking shrinkValid = shrinkValidStructurallyWithoutExtraFiltering +instance GenValid ChunkStyle where + genValid = genValidStructurallyWithoutExtraChecking + shrinkValid = shrinkValidStructurallyWithoutExtraFiltering + instance GenValid CSI where genValid = genValidStructurallyWithoutExtraChecking shrinkValid = shrinkValidStructurallyWithoutExtraFiltering diff --git a/test/Text/Colour/Chunk/ParsingRoundtripSpec.hs b/test/Text/Colour/Chunk/ParsingRoundtripSpec.hs --- a/test/Text/Colour/Chunk/ParsingRoundtripSpec.hs +++ b/test/Text/Colour/Chunk/ParsingRoundtripSpec.hs @@ -6,7 +6,6 @@ import Control.Monad import qualified Data.ByteString as SB import Data.List (sort) -import qualified Data.Text as Text import qualified Data.Text.Encoding as TE import Path import Path.IO (listDirRecurRel, resolveDir') @@ -27,6 +26,6 @@ content <- case TE.decodeUtf8' bs of Left err -> expectationFailure $ "Invalid UTF-8: " ++ show err Right t -> pure t - let (_, parsed) = parseAnsiChunks (chunk Text.empty) content + let (_, parsed) = parseAnsiChunks noStyle content reRendered = renderChunksText With24BitColours parsed reRendered `shouldBe` content diff --git a/test/Text/Colour/ChunkSpec.hs b/test/Text/Colour/ChunkSpec.hs --- a/test/Text/Colour/ChunkSpec.hs +++ b/test/Text/Colour/ChunkSpec.hs @@ -39,17 +39,19 @@ intensity <- [minBound .. maxBound] pure $ Colour8 intensity terminalColour let mColour = Nothing : map Just colour - chunkItalic <- Nothing : map Just [minBound .. maxBound] - chunkStrikethrough <- Nothing : map Just [minBound .. maxBound] - chunkSwapForegroundBackground <- Nothing : map Just [minBound .. maxBound] - chunkConcealed <- Nothing : map Just [minBound .. maxBound] - chunkOverlined <- Nothing : map Just [minBound .. maxBound] - chunkConsoleIntensity <- Nothing : map Just [minBound .. maxBound] - chunkUnderlining <- Nothing : map Just [minBound .. maxBound] - chunkBlinking <- Nothing : map Just [minBound .. maxBound] - chunkForeground <- mColour - chunkBackground <- mColour + chunkStyleItalic <- Nothing : map Just [minBound .. maxBound] + chunkStyleStrikethrough <- Nothing : map Just [minBound .. maxBound] + chunkStyleSwapForegroundBackground <- Nothing : map Just [minBound .. maxBound] + chunkStyleConcealed <- Nothing : map Just [minBound .. maxBound] + chunkStyleOverlined <- Nothing : map Just [minBound .. maxBound] + chunkStyleConsoleIntensity <- Nothing : map Just [minBound .. maxBound] + chunkStyleUnderlining <- Nothing : map Just [minBound .. maxBound] + chunkStyleBlinking <- Nothing : map Just [minBound .. maxBound] + chunkStyleForeground <- mColour + chunkStyleBackground <- mColour + let chunkStyleHyperlink = Nothing let chunkText = T.pack string + chunkStyle = ChunkStyle {..} let boolName label b = if b then label else "non-" <> label boolPath label b = if b then label else "no-" <> label consoleIntensityName :: ConsoleIntensity -> String @@ -71,19 +73,19 @@ unwords $ filter (not . null) - [ maybe "" (boolName "italic") chunkItalic, - maybe "" (boolName "strikethrough") chunkStrikethrough, - maybe "" (boolName "reverse") chunkSwapForegroundBackground, - maybe "" (boolName "concealed") chunkConcealed, - maybe "" (boolName "overlined") chunkOverlined, - maybe "" consoleIntensityName chunkConsoleIntensity, - maybe "" underliningName chunkUnderlining, - maybe "" blinkingName chunkBlinking, + [ maybe "" (boolName "italic") chunkStyleItalic, + maybe "" (boolName "strikethrough") chunkStyleStrikethrough, + maybe "" (boolName "reverse") chunkStyleSwapForegroundBackground, + maybe "" (boolName "concealed") chunkStyleConcealed, + maybe "" (boolName "overlined") chunkStyleOverlined, + maybe "" consoleIntensityName chunkStyleConsoleIntensity, + maybe "" underliningName chunkStyleUnderlining, + maybe "" blinkingName chunkStyleBlinking, string, "with", - mColourName chunkForeground, + mColourName chunkStyleForeground, "foreground on", - mColourName chunkBackground, + mColourName chunkStyleBackground, "background" ] @@ -107,17 +109,17 @@ "-" ( filter (not . null) - [ maybe "" (boolPath "it") chunkItalic, - maybe "" (boolPath "st") chunkStrikethrough, - maybe "" (boolPath "rv") chunkSwapForegroundBackground, - maybe "" (boolPath "hd") chunkConcealed, - maybe "" (boolPath "ol") chunkOverlined, - maybe "" consoleIntensityPath chunkConsoleIntensity, - maybe "" underliningPath chunkUnderlining, - maybe "" blinkingPath chunkBlinking, - mColourPath chunkForeground, + [ maybe "" (boolPath "it") chunkStyleItalic, + maybe "" (boolPath "st") chunkStyleStrikethrough, + maybe "" (boolPath "rv") chunkStyleSwapForegroundBackground, + maybe "" (boolPath "hd") chunkStyleConcealed, + maybe "" (boolPath "ol") chunkStyleOverlined, + maybe "" consoleIntensityPath chunkStyleConsoleIntensity, + maybe "" underliningPath chunkStyleUnderlining, + maybe "" blinkingPath chunkStyleBlinking, + mColourPath chunkStyleForeground, "fg", - mColourPath chunkBackground, + mColourPath chunkStyleBackground, "bg" ] ) @@ -132,30 +134,32 @@ let chunks string = justAFew $ do let colour = Colour8Bit <$> [minBound .. maxBound] let mColour = Nothing : map Just colour - let chunkItalic = Nothing - let chunkStrikethrough = Nothing - let chunkSwapForegroundBackground = Nothing - let chunkConcealed = Nothing - let chunkOverlined = Nothing - let chunkConsoleIntensity = Nothing - let chunkUnderlining = Nothing - let chunkBlinking = Nothing - chunkForeground <- mColour - chunkBackground <- mColour + let chunkStyleItalic = Nothing + let chunkStyleStrikethrough = Nothing + let chunkStyleSwapForegroundBackground = Nothing + let chunkStyleConcealed = Nothing + let chunkStyleOverlined = Nothing + let chunkStyleConsoleIntensity = Nothing + let chunkStyleUnderlining = Nothing + let chunkStyleBlinking = Nothing + chunkStyleForeground <- mColour + chunkStyleBackground <- mColour + let chunkStyleHyperlink = Nothing let chunkText = T.pack string + chunkStyle = ChunkStyle {..} let name = unwords - [ mColourName chunkForeground, + [ mColourName chunkStyleForeground, "foreground on", - mColourName chunkBackground, + mColourName chunkStyleBackground, "background" ] path = intercalate "-" - [ mColourPath chunkForeground, + [ mColourPath chunkStyleForeground, "fg", - mColourPath chunkBackground, + mColourPath chunkStyleBackground, "bg" ] <> ".dat" @@ -174,30 +178,32 @@ b <- w pure $ Colour24Bit r g b let mColour = Nothing : map Just colour - let chunkItalic = Nothing - let chunkStrikethrough = Nothing - let chunkSwapForegroundBackground = Nothing - let chunkConcealed = Nothing - let chunkOverlined = Nothing - let chunkConsoleIntensity = Nothing - let chunkUnderlining = Nothing - let chunkBlinking = Nothing - chunkForeground <- mColour - chunkBackground <- mColour + let chunkStyleItalic = Nothing + let chunkStyleStrikethrough = Nothing + let chunkStyleSwapForegroundBackground = Nothing + let chunkStyleConcealed = Nothing + let chunkStyleOverlined = Nothing + let chunkStyleConsoleIntensity = Nothing + let chunkStyleUnderlining = Nothing + let chunkStyleBlinking = Nothing + chunkStyleForeground <- mColour + chunkStyleBackground <- mColour + let chunkStyleHyperlink = Nothing let chunkText = T.pack string + chunkStyle = ChunkStyle {..} let name = unwords - [ mColourName chunkForeground, + [ mColourName chunkStyleForeground, "foreground on", - mColourName chunkBackground, + mColourName chunkStyleBackground, "background" ] path = intercalate "-" - [ mColourPath chunkForeground, + [ mColourPath chunkStyleForeground, "fg", - mColourPath chunkBackground, + mColourPath chunkStyleBackground, "bg" ] <> ".dat"