safe-coloured-text-parsing-gen (empty) → 0.0.0.0
raw patch · 6 files changed
+301/−0 lines, 6 filesdep +basedep +genvaliditydep +genvalidity-sydtest
Dependencies added: base, genvalidity, genvalidity-sydtest, genvalidity-text, safe-coloured-text, safe-coloured-text-gen, safe-coloured-text-parsing, safe-coloured-text-parsing-gen, sydtest, text
Files
- CHANGELOG.md +9/−0
- LICENSE +21/−0
- safe-coloured-text-parsing-gen.cabal +62/−0
- src/Text/Colour/Chunk/Parsing/Gen.hs +15/−0
- test/Spec.hs +1/−0
- test/Text/Colour/Chunk/ParsingSpec.hs +193/−0
+ CHANGELOG.md view
@@ -0,0 +1,9 @@+# Changelog for safe-coloured-text-parsing-gen++## [0.0.0.0] - 2026-04-12++### Added++* Initial release+* `GenValid` instance for `AnsiToken`+* Property and unit tests for ANSI parsing
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2021 Tom Sydney Kerckhove++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ safe-coloured-text-parsing-gen.cabal view
@@ -0,0 +1,62 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.38.3.+--+-- see: https://github.com/sol/hpack++name: safe-coloured-text-parsing-gen+version: 0.0.0.0+synopsis: Generators for safe-coloured-text-parsing+category: User Interfaces+homepage: https://github.com/NorfairKing/safe-coloured-text#readme+bug-reports: https://github.com/NorfairKing/safe-coloured-text/issues+author: Tom Sydney Kerckhove+maintainer: syd@cs-syd.eu+copyright: Copyright (c) 2026 Tom Sydney Kerckhove+license: MIT+license-file: LICENSE+build-type: Simple+extra-source-files:+ LICENSE+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/NorfairKing/safe-coloured-text++library+ exposed-modules:+ Text.Colour.Chunk.Parsing.Gen+ other-modules:+ Paths_safe_coloured_text_parsing_gen+ hs-source-dirs:+ src+ build-depends:+ base >=4.7 && <5+ , genvalidity+ , safe-coloured-text-gen+ , safe-coloured-text-parsing+ default-language: Haskell2010++test-suite safe-coloured-text-parsing-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Text.Colour.Chunk.ParsingSpec+ Paths_safe_coloured_text_parsing_gen+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-tool-depends:+ sydtest-discover:sydtest-discover+ build-depends:+ base >=4.7 && <5+ , genvalidity-sydtest+ , genvalidity-text+ , safe-coloured-text+ , safe-coloured-text-gen+ , safe-coloured-text-parsing+ , safe-coloured-text-parsing-gen+ , sydtest+ , text+ default-language: Haskell2010
+ src/Text/Colour/Chunk/Parsing/Gen.hs view
@@ -0,0 +1,15 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Text.Colour.Chunk.Parsing.Gen where++import Data.GenValidity+import Text.Colour.Chunk.Parsing+import Text.Colour.Gen ()++instance GenValid OscCommand where+ genValid = genValidStructurallyWithoutExtraChecking+ shrinkValid = shrinkValidStructurallyWithoutExtraFiltering++instance GenValid AnsiToken where+ genValid = genValidStructurallyWithoutExtraChecking+ shrinkValid = shrinkValidStructurallyWithoutExtraFiltering
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF sydtest-discover #-}
+ test/Text/Colour/Chunk/ParsingSpec.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Text.Colour.Chunk.ParsingSpec (spec) where++import Data.GenValidity.Text ()+import qualified Data.Text as Text+import qualified Data.Text.Lazy as Lazy+import Test.Syd+import Test.Syd.Validity+import Text.Colour.Capabilities+import Text.Colour.Chunk+import Text.Colour.Chunk.Parsing+import Text.Colour.Chunk.Parsing.Gen ()+import Text.Colour.Code+import Text.Colour.Gen ()++spec :: Spec+spec = do+ genValidSpec @OscCommand+ genValidSpec @AnsiToken++ describe "parseAnsiTokens" $ do+ it "tokenizes plain text" $+ parseAnsiTokens "hello" `shouldBe` [PlainText "hello"]++ it "tokenizes an SGR sequence" $+ parseAnsiTokens "\ESC[31m" `shouldBe` [SgrSequence [31]]++ it "tokenizes mixed content" $+ parseAnsiTokens "hello\ESC[31mworld\ESC[0m!"+ `shouldBe` [PlainText "hello", SgrSequence [31], PlainText "world", SgrSequence [0], PlainText "!"]++ it "tokenizes non-SGR CSI as OtherCsiSequence" $+ parseAnsiTokens "\ESC[2J" `shouldBe` [OtherCsiSequence]++ it "treats CSI with intermediate bytes as non-SGR" $+ parseAnsiTokens "\ESC[ 1m" `shouldBe` [OtherCsiSequence]++ it "tokenizes combined parameters" $+ parseAnsiTokens "\ESC[1;31m" `shouldBe` [SgrSequence [1, 31]]++ it "tokenizes 256-colour parameters" $+ parseAnsiTokens "\ESC[38;5;196m" `shouldBe` [SgrSequence [38, 5, 196]]++ it "tokenizes bare ESC as plain text" $+ parseAnsiTokens "before\ESCafter"+ `shouldBe` [PlainText "before", PlainText "\ESC", PlainText "after"]++ it "keeps incomplete ESC[ together as single token" $+ parseAnsiTokens "hello\ESC[" `shouldBe` [PlainText "hello", PlainText "\ESC["]++ it "drops parameter values that overflow Word8" $+ parseAnsiTokens "\ESC[256m" `shouldBe` [SgrSequence []]++ it "tokenizes empty input" $+ parseAnsiTokens "" `shouldBe` []++ it "tokenizes an OSC 8 hyperlink open with ST terminator" $+ parseAnsiTokens "\ESC]8;;https://example.com\ESC\\"+ `shouldBe` [OscSequence (OscHyperlink "" "https://example.com")]++ it "tokenizes an OSC 8 hyperlink close with ST terminator" $+ parseAnsiTokens "\ESC]8;;\ESC\\"+ `shouldBe` [OscSequence (OscHyperlink "" "")]++ it "tokenizes an OSC 0 window title with BEL terminator" $+ parseAnsiTokens "\ESC]0;My Title\BEL"+ `shouldBe` [OscSequence (OscOther 0 "My Title")]++ it "tokenizes an OSC 8 hyperlink around text" $+ parseAnsiTokens "\ESC]8;;https://errors.haskell.org/messages/GHC-63394\ESC\\GHC-63394\ESC]8;;\ESC\\"+ `shouldBe` [ OscSequence (OscHyperlink "" "https://errors.haskell.org/messages/GHC-63394"),+ PlainText "GHC-63394",+ OscSequence (OscHyperlink "" "")+ ]++ describe "parseAnsiTokensLazy" $ do+ it "produces the same tokens as strict parsing" $+ forAllValid $ \text ->+ parseAnsiTokensLazy (Lazy.fromStrict text) `shouldBe` parseAnsiTokens text++ it "works with multi-chunk lazy text" $+ let lazyText = Lazy.fromChunks ["hello\ESC[31m", "world\ESC[0m!"]+ tokens = parseAnsiTokensLazy lazyText+ in tokens+ `shouldBe` [PlainText "hello", SgrSequence [31], PlainText "world", SgrSequence [0], PlainText "!"]++ describe "parseAnsiChunks" $ do+ it "returns plain text unchanged" $+ parseAnsiChunks noStyle "hello world"+ `shouldBe` (noStyle, [chunk "hello world"])++ it "parses a simple red foreground" $+ parseAnsiChunks noStyle "\ESC[31mhello\ESC[0m world"+ `shouldBe` ( noStyle,+ [ fore (Colour8 Dull Red) (chunk "hello"),+ chunk " world"+ ]+ )++ it "parses bold" $+ parseAnsiChunks noStyle "\ESC[1mbold\ESC[0m"+ `shouldBe` (noStyle, [bold (chunk "bold")])++ it "parses combined bold and colour" $+ parseAnsiChunks noStyle "\ESC[1;31mred bold\ESC[0m"+ `shouldBe` (noStyle, [fore (Colour8 Dull Red) (bold (chunk "red bold"))])++ it "parses bright colours" $+ parseAnsiChunks noStyle "\ESC[91mbright red\ESC[0m"+ `shouldBe` (noStyle, [fore (Colour8 Bright Red) (chunk "bright red")])++ it "parses 256-colour foreground" $+ parseAnsiChunks noStyle "\ESC[38;5;196mcolour\ESC[0m"+ `shouldBe` (noStyle, [fore (Colour8Bit 196) (chunk "colour")])++ it "parses 24-bit RGB foreground" $+ parseAnsiChunks noStyle "\ESC[38;2;255;128;0mcolour\ESC[0m"+ `shouldBe` (noStyle, [fore (Colour24Bit 255 128 0) (chunk "colour")])++ it "parses background colour" $+ parseAnsiChunks noStyle "\ESC[42mgreen bg\ESC[0m"+ `shouldBe` (noStyle, [back (Colour8 Dull Green) (chunk "green bg")])++ it "strips non-SGR CSI sequences" $+ parseAnsiChunks noStyle "before\ESC[2Jafter"+ `shouldBe` (noStyle, [chunk "before", chunk "after"])++ it "renders OSC 8 hyperlinks, keeping surrounding text" $+ parseAnsiChunks noStyle "warning: \ESC]8;;https://errors.haskell.org/messages/GHC-63394\ESC\\GHC-63394\ESC]8;;\ESC\\ [-Wx-partial]"+ `shouldBe` ( noStyle,+ [ chunk "warning: ",+ (chunk "GHC-63394") {chunkStyle = noStyle {chunkStyleHyperlink = Just "https://errors.haskell.org/messages/GHC-63394"}},+ chunk " [-Wx-partial]"+ ]+ )++ it "handles empty input" $+ parseAnsiChunks noStyle ""+ `shouldBe` (noStyle, [])++ it "handles text with no visible content between escapes" $+ parseAnsiChunks noStyle "\ESC[31m\ESC[0m"+ `shouldBe` (noStyle, [])++ it "threads state across calls" $+ let (style1, chunks1) = parseAnsiChunks noStyle "\ESC[31mhello"+ result2 = parseAnsiChunks style1 "world\ESC[0m"+ in do+ chunks1 `shouldBe` [fore (Colour8 Dull Red) (chunk "hello")]+ style1 `shouldBe` noStyle {chunkStyleForeground = Just (Colour8 Dull Red)}+ result2 `shouldBe` (noStyle, [fore (Colour8 Dull Red) (chunk "world")])++ it "handles incomplete sequence at end of text" $+ parseAnsiChunks noStyle "hello\ESC["+ `shouldBe` (noStyle, [chunk "hello", chunk "\ESC["])++ it "never crashes on arbitrary input" $+ forAllValid $ \text ->+ let (_, chunks) = parseAnsiChunks noStyle text+ in seq (length chunks) (pure () :: IO ())++ it "produces segment texts that concatenate to the input minus ANSI codes" $+ forAllValid $ \text ->+ let (_, chunks) = parseAnsiChunks noStyle text+ combined = Text.concat $ map chunkText chunks+ in combined `shouldBe` stripAnsi text++ describe "parseAnsiChunksLazy" $ do+ it "produces the same chunks as strict parsing" $+ forAllValid $ \text ->+ let (styleS, chunksS) = parseAnsiChunks noStyle text+ (styleL, chunksL) = parseAnsiChunksLazy noStyle (Lazy.fromStrict text)+ in do+ chunksL `shouldBe` chunksS+ styleL `shouldBe` styleS++ describe "roundtrip" $ do+ it "recovers chunk style from rendered output for non-empty chunks" $+ forAllValid $ \c ->+ let c' = c {chunkText = if Text.null (chunkText c) then "x" else chunkText c}+ rendered = renderChunkText With24BitColours c'+ (_, parsed) = parseAnsiChunks noStyle rendered+ in parsed `shouldBe` [c']++-- | Strip all ANSI escape sequences from text, keeping only plain text.+stripAnsi :: Text.Text -> Text.Text+stripAnsi =+ Text.concat+ . map (\case PlainText t -> t; _ -> "")+ . parseAnsiTokens