snippet 0.1.0.2 → 0.1.0.3
raw patch · 15 files changed
+785/−339 lines, 15 filesdep +Globdep +aesondep +filepathPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: Glob, aeson, filepath, yaml
API changes (from Hackage documentation)
- Snippet.Line: Line :: Maybe Int -> Text -> Text -> Text -> Line
- Snippet.Line: [focused] :: Line -> Text
- Snippet.Line: [number] :: Line -> Maybe Int
- Snippet.Line: [post] :: Line -> Text
- Snippet.Line: [pre] :: Line -> Text
- Snippet.Line: instance GHC.Classes.Eq Snippet.Line.Line
- Snippet.Line: instance GHC.Show.Show Snippet.Line.Line
- Snippet.Lines: makeLines :: Region -> NonEmpty Text -> NonEmpty Line
- Snippet.Lines: makeLines1 :: Region -> NonEmpty Text -> NonEmpty Line
- Snippet.Lines: makeLinesN :: Region -> NonEmpty Text -> NonEmpty Line
- Snippet.Pretty: AnnGutter :: Ann
+ Snippet: [message] :: Region -> Maybe Text
+ Snippet: [subRegion] :: Region -> Maybe Region
+ Snippet.Line: lineContent :: Line -> Doc Ann
+ Snippet.Line: lineNumber :: Line -> Maybe Int
+ Snippet.Line: linesFromRegion :: Region -> Maybe Int -> NonEmpty Text -> [Line]
+ Snippet.Pretty: AnnDecoration :: Ann
+ Snippet.Pretty: AnnMessage :: Ann
+ Snippet.Pretty: snippetInsetWidth :: Snippet -> Int
+ Snippet.Pretty.Ann: AnnDecoration :: Ann
+ Snippet.Pretty.Ann: AnnFocused :: Int -> Ann
+ Snippet.Pretty.Ann: AnnMessage :: Ann
+ Snippet.Pretty.Ann: annToAnsi :: Ann -> AnsiStyle
+ Snippet.Pretty.Ann: data Ann
+ Snippet.Pretty.Ann: instance GHC.Classes.Eq Snippet.Pretty.Ann.Ann
+ Snippet.Pretty.Ann: instance GHC.Show.Show Snippet.Pretty.Ann.Ann
+ Snippet.Region: [message] :: Region -> Maybe Text
+ Snippet.Region: [subRegion] :: Region -> Maybe Region
+ Snippet.Region: instance GHC.Generics.Generic Snippet.Region.Region
+ Snippet.Region: regionIsOneLine :: Region -> Bool
- Snippet: Region :: Int -> Maybe Int -> Maybe Int -> Maybe Int -> Region
+ Snippet: Region :: Int -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Text -> Maybe Region -> Region
- Snippet: snippetFromContents :: Region -> Text -> Text -> Maybe Snippet
+ Snippet: snippetFromContents :: Region -> Text -> Maybe Int -> NonEmpty Text -> Snippet
- Snippet.Pretty: AnnFocused :: Ann
+ Snippet.Pretty: AnnFocused :: Int -> Ann
- Snippet.Region: Region :: Int -> Maybe Int -> Maybe Int -> Maybe Int -> Region
+ Snippet.Region: Region :: Int -> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Text -> Maybe Region -> Region
- Snippet.Snippet: Snippet :: Text -> Region -> NonEmpty Line -> Snippet
+ Snippet.Snippet: Snippet :: Text -> Region -> [Line] -> Snippet
- Snippet.Snippet: [lines] :: Snippet -> NonEmpty Line
+ Snippet.Snippet: [lines] :: Snippet -> [Line]
Files
- README.lhs +36/−3
- README.md +36/−3
- snippet.cabal +25/−14
- src/Snippet.hs +25/−12
- src/Snippet/Line.hs +222/−6
- src/Snippet/Lines.hs +0/−140
- src/Snippet/Pretty.hs +28/−25
- src/Snippet/Pretty/Ann.hs +27/−0
- src/Snippet/Region.hs +27/−4
- src/Snippet/Snippet.hs +1/−2
- test-cases/nested/readme.yaml +136/−0
- test-cases/simple/multi-line.yaml +36/−0
- test-cases/simple/one-line.yaml +25/−0
- test/Snippet/LinesSpec.hs +0/−130
- test/SnippetSpec.hs +161/−0
README.lhs view
@@ -33,9 +33,29 @@ let region = Region { startLine = 32- , endLine = Just 44 , startColumn = Just 8+ , endLine = Just 64 , endColumn = Nothing+ , message = Nothing+ , subRegion =+ Just+ Region+ { startLine = 34+ , startColumn = Just 5+ , endLine = Just 59+ , endColumn = Nothing+ , message = Just "Denotes a region in the snippet"+ , subRegion =+ Just+ Region+ { startLine = 45+ , startColumn = Just 27+ , endLine = Nothing+ , endColumn = Just 31+ , message = Just "Would default to startLine"+ , subRegion = Nothing+ }+ } } -- Returns Nothing if file is missing/empty or region is invalid@@ -44,12 +64,25 @@ traverse_ (putDoc . reAnnotate annToAnsi . prettySnippet) mSnippet ``` -The above `Region` focuses just the body of the `do` block in this file.-Rendering it with the default `annToAnsi` looks like:+The above `Region` focuses one of the `Just` constructors, within the `region`+binding, within the body of the `do` block. Rendering it with the default+`annToAnsi` looks like:  Supplying an alternative `annToAnsi` function is how you can adjust colors.++## Limitations++Drawing these regions is not an easy problem. Therefore, there are some+limitations to the kind of `Region` values we support:++1. One top-level region per snippet,+1. A region may only have zero or one sub-region,+1. A sub-region must be contained within its parent, and+1. A sub-region cannot share start or end lines or columns with its parent++One notable consequence is that a one-line region cannot contain sub-regions. ## License
README.md view
@@ -33,9 +33,29 @@ let region = Region { startLine = 32- , endLine = Just 44 , startColumn = Just 8+ , endLine = Just 64 , endColumn = Nothing+ , message = Nothing+ , subRegion =+ Just+ Region+ { startLine = 34+ , startColumn = Just 5+ , endLine = Just 59+ , endColumn = Nothing+ , message = Just "Denotes a region in the snippet"+ , subRegion =+ Just+ Region+ { startLine = 45+ , startColumn = Just 27+ , endLine = Nothing+ , endColumn = Just 31+ , message = Just "Would default to startLine"+ , subRegion = Nothing+ }+ } } -- Returns Nothing if file is missing/empty or region is invalid@@ -44,12 +64,25 @@ traverse_ (putDoc . reAnnotate annToAnsi . prettySnippet) mSnippet ``` -The above `Region` focuses just the body of the `do` block in this file.-Rendering it with the default `annToAnsi` looks like:+The above `Region` focuses one of the `Just` constructors, within the `region`+binding, within the body of the `do` block. Rendering it with the default+`annToAnsi` looks like:  Supplying an alternative `annToAnsi` function is how you can adjust colors.++## Limitations++Drawing these regions is not an easy problem. Therefore, there are some+limitations to the kind of `Region` values we support:++1. One top-level region per snippet,+1. A region may only have zero or one sub-region,+1. A sub-region must be contained within its parent, and+1. A sub-region cannot share start or end lines or columns with its parent++One notable consequence is that a one-line region cannot contain sub-regions. ## License
snippet.cabal view
@@ -1,12 +1,12 @@-cabal-version: 1.18-name: snippet-version: 0.1.0.2-license: AGPL-3-license-file: COPYING-maintainer: Patrick Brisbin-homepage: https://codeberg.org/pbrisbin/snippet#readme-bug-reports: https://codeberg.org/pbrisbin/snippet/issues-synopsis: Pretty-print regions within source code files+cabal-version: 1.18+name: snippet+version: 0.1.0.3+license: AGPL-3+license-file: COPYING+maintainer: Patrick Brisbin+homepage: https://codeberg.org/pbrisbin/snippet#readme+bug-reports: https://codeberg.org/pbrisbin/snippet/issues+synopsis: Pretty-print regions within source code files description: Pretty-print @Region@s of source-code, i.e. snippets. .@@ -38,8 +38,13 @@ To see the code that produces this, and an image of the output (e.g. with color), view the [README on Codeberg](https://codeberg.org/pbrisbin/snippet#readme). -category: Data-build-type: Simple+category: Data+build-type: Simple+extra-source-files:+ test-cases/nested/readme.yaml+ test-cases/simple/multi-line.yaml+ test-cases/simple/one-line.yaml+ extra-doc-files: README.md CHANGELOG.md@@ -53,8 +58,8 @@ exposed-modules: Snippet Snippet.Line- Snippet.Lines Snippet.Pretty+ Snippet.Pretty.Ann Snippet.Region Snippet.Snippet @@ -138,7 +143,7 @@ main-is: Spec.hs hs-source-dirs: test other-modules:- Snippet.LinesSpec+ SnippetSpec Paths_snippet default-language: GHC2021@@ -156,10 +161,16 @@ -rtsopts -with-rtsopts=-N build-depends:+ Glob >=0.10.2,+ aeson >=2.0.3.0, base >=4.16.4.0 && <5,+ filepath >=1.4.2.2, hspec >=2.9.7,+ prettyprinter >=1.7.1,+ prettyprinter-ansi-terminal >=1.1.3, snippet,- text >=1.2.5.0+ text >=1.2.5.0,+ yaml >=0.11.11.1 if impl(ghc >=9.8) ghc-options:
src/Snippet.hs view
@@ -15,12 +15,12 @@ import Prelude -import Data.List.NonEmpty (nonEmpty)+import Data.List.NonEmpty (NonEmpty, nonEmpty) import Data.Maybe (fromMaybe) import Data.Text (Text, pack) import Data.Text qualified as T import Data.Text.IO qualified as T-import Snippet.Lines+import Snippet.Line import Snippet.Region import Snippet.Snippet import System.Directory (doesFileExist)@@ -32,19 +32,32 @@ if exists then do contents <- T.readFile path- pure $ snippetFromContents region (pack path) contents++ let -- Show only the lines of the region+ mSourceLines =+ nonEmpty+ $ drop (sl - 1)+ $ take el+ $ T.lines contents++ pure $ snippetFromContents region (pack path) Nothing <$> mSourceLines else pure Nothing+ where+ sl = region.startLine+ el = fromMaybe sl region.endLine snippetFromContents :: Region -> Text -- ^ URI- -> Text- -- ^ Code content- -> Maybe Snippet-snippetFromContents region uri =- fmap mkSnippet . nonEmpty . drop (sl - 1) . take el . T.lines- where- mkSnippet = Snippet uri region . makeLines region- sl = region.startLine- el = fromMaybe sl region.endLine+ -> Maybe Int+ -- ^ Explicit start line, if not the region's+ -> NonEmpty Text+ -- ^ Code lines+ -> Snippet+snippetFromContents region uri mStartLine sourceLines = do+ Snippet+ { uri+ , region+ , lines = linesFromRegion region mStartLine sourceLines+ }
src/Snippet/Line.hs view
@@ -7,17 +7,233 @@ -- Stability : experimental -- Portability : POSIX module Snippet.Line- ( Line (..)+ ( Line+ , lineNumber+ , lineContent+ , linesFromRegion ) where import Prelude +import Control.Applicative ((<|>))+import Control.Monad (guard)+import Data.Foldable (toList)+import Data.List.NonEmpty (NonEmpty)+import Data.Maybe (fromMaybe) import Data.Text (Text)+import Data.Text qualified as T+import Prettyprinter (Doc, alterAnnotations, annotate, pretty, reAnnotate)+import Snippet.Pretty.Ann+import Snippet.Region data Line = Line- { number :: Maybe Int- , pre :: Text- , focused :: Text- , post :: Text+ { number :: LineNumber+ , length :: Int+ -- ^ Length+ --+ -- Stored at construction because 'Color' will lose it+ , content :: LineContent }- deriving stock (Eq, Show)++data LineNumber+ = At Int+ | Under Int++data LineContent+ = Plain Int Text+ | Color (Doc Ann)++lineAt :: Int -> Text -> Line+lineAt n t =+ Line+ { number = At n+ , length = T.length t+ , content = Plain 0 t+ }++linesAt :: Int -> NonEmpty Text -> [Line]+linesAt n = zipWith lineAt [n ..] . toList++-- | Return a line's number (only if it's a real, numbered line)+lineNumber :: Line -> Maybe Int+lineNumber line =+ case line.number of+ At n -> Just n+ _ -> Nothing++-- | Return a line's number, or that of the one it's under+lineNumber' :: Line -> Int+lineNumber' line =+ case line.number of+ At n -> n+ Under n -> n++lineContent :: Line -> Doc Ann+lineContent = alterAnnotations dropPlain . lineContent'+ where+ -- We use zero-focus annotations to mark parts of text that can/should be+ -- re-annotated when nested. But they add extra reset escapes to the output,+ -- so we'll drop them at the end of processing.+ dropPlain = \case+ AnnFocused 0 -> []+ ann -> [ann]++-- | 'lineContent', but without dropping the @'AnnFocused' 0@ annotations+lineContent' :: Line -> Doc Ann+lineContent' line =+ case line.content of+ Plain i t -> plain $ T.replicate i " " <> t+ Color d -> d++-- | Built (focused) lines from a region and source lines+linesFromRegion :: Region -> Maybe Int -> NonEmpty Text -> [Line]+linesFromRegion region mStartLine = insideOut focusRegion region . linesAt sl+ where+ sl = fromMaybe region.startLine mStartLine++focusRegion :: Region -> [Line] -> [Line]+focusRegion region = alterLines $ \line -> do+ let+ sl = region.startLine+ el = fromMaybe sl region.endLine+ sc = fromMaybe 1 region.startColumn+ ec = fromMaybe (line.length + 1) region.endColumn++ oneLine = do+ guard $ el == sl+ n <- lineNumber line+ guard $ n == region.startLine++ -- inside-out and one-line rules mean we'll never see indent here+ Plain 0 content <- pure line.content++ let+ spaces = T.replicate (sc - 1) " "+ marker = T.replicate (ec - sc) "^"++ (pre, marked, post) = markLine sc (Just ec) content++ doc = plain pre <> focus marked <> plain post++ pure+ [ line {content = Color doc}+ , underline n spaces marker $ regionMessage (ec + 2) region+ ]++ startLine = do+ n <- lineNumber line+ guard $ n == sl+ Plain i content <- pure line.content++ let (pre, marked, post) = markLine sc (Just ec) content++ if T.null $ T.strip pre+ then do+ let+ marker = "╭─" <> T.replicate (i + sc - 2) "─"+ doc =+ focus (marker <> " " <> marked <> post)+ <> regionMessage (i + ec + 2) region++ pure [line {content = Color doc}]+ else do+ let+ marker = "╭─" <> T.replicate (i + sc - 1) "─" <> "^"+ doc =+ " "+ <> pretty (T.replicate i " ")+ <> pretty pre+ <> focus (marked <> post)++ pure+ [ line {content = Color doc}+ , underline n "" marker $ regionMessage (i + ec) region+ ]++ inRegion = do+ let n = lineNumber' line+ guard $ n > sl && n < el++ pure [line {content = Color $ inRegionLine line}]++ endLine = do+ n <- lineNumber line+ guard $ n == el+ Plain i _ <- pure line.content++ let marker = "╰─" <> T.replicate (i + ec - 2) "─" <> "^"++ pure+ [ line {content = Color $ inRegionLine line}+ , underline n "" marker mempty+ ]++ shiftLine = do+ -- Don't do this for one-line regions+ guard $ el /= sl+ Plain i c <- pure line.content+ guard $ not $ T.null c+ pure [line {content = Plain (i + 2) c}]++ oneLine <|> startLine <|> inRegion <|> endLine <|> shiftLine <|> Just [line]++inRegionLine :: Line -> Doc Ann+inRegionLine line =+ if line.length == 0+ then focus "│"+ else focus "│ " <> refocus (lineContent' line)++underline :: Int -> Text -> Text -> Doc Ann -> Line+underline n prefix marker post =+ Line+ { number = Under n+ , length = T.length prefix + T.length marker+ , content = Color $ pretty prefix <> focus marker <> post+ }++-- | Run a function on nested 'Region's on sub-regions before parents+insideOut :: (Region -> a -> a) -> Region -> a -> a+insideOut f region a = case region.subRegion of+ Nothing -> f region a+ Just sr -> f region $ insideOut f sr a++alterLines :: (Line -> Maybe [Line]) -> [Line] -> [Line]+alterLines f = concatMap $ \l -> fromMaybe [l] $ f l++plain :: Text -> Doc Ann+plain = annotate (AnnFocused 0) . pretty++focus :: Text -> Doc Ann+focus = annotate (AnnFocused 1) . pretty++markLine :: Int -> Maybe Int -> Text -> (Text, Text, Text)+markLine sc mec t = (pre, marked, post)+ where+ (pre, rest) = T.splitAt (sc - 1) t+ (marked, post) = case mec of+ Nothing -> (rest, "")+ Just ec -> T.splitAt (ec - sc) rest++refocus :: Doc Ann -> Doc Ann+refocus = reAnnotate go+ where+ go = \case+ AnnFocused i -> AnnFocused $ i + 1+ x -> x++regionMessage :: Int -> Region -> Doc Ann+regionMessage sc region = maybe mempty (message sc) region.message++message :: Int -> Text -> Doc Ann+message sc m =+ mconcat+ [ " "+ , annotate AnnDecoration ("•" <> pretty bar <> "┤")+ , annotate AnnMessage $ pretty m+ ]+ where+ bar = T.replicate (max 2 barLen) "─"+ barLen = rightEdge - T.length m - sc - 3++rightEdge :: Int+rightEdge = 72
− src/Snippet/Lines.hs
@@ -1,140 +0,0 @@--- |------ Module : Snippet.Lines--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Snippet.Lines- ( makeLines- , makeLines1- , makeLinesN- ) where--import Prelude--import Data.List.NonEmpty (NonEmpty (..))-import Data.List.NonEmpty qualified as NE-import Data.Maybe (fromMaybe)-import Data.Text (Text)-import Data.Text qualified as T-import Snippet.Line-import Snippet.Region--makeLines :: Region -> NonEmpty Text -> NonEmpty Line-makeLines region input = case NE.length input of- 1 -> makeLines1 region input- _ -> makeLinesN region input---- | Make 'Line's for the one-line case:------ @--- 85 │ , ((annotate AnnIcon "=" \<+\>) . pretty) \<$\> r.fullDescription--- │ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^--- @-makeLines1 :: Region -> NonEmpty Text -> NonEmpty Line-makeLines1 region input = headLine :| [underbarLine]- where- headLine =- Line- { number = Just sl- , pre- , focused- , post- }-- underbarLine =- Line- { number = Nothing- , pre = T.replicate (sc - 1) " "- , focused = T.replicate (ec - sc) "^"- , post = ""- }-- (pre, focused, post) = focusLine sc (Just ec) $ NE.head input-- sl = region.startLine- sc = fromMaybe 1 region.startColumn- ec = fromMaybe (defaultEndColumn input) region.endColumn---- | Make 'Line's for multi-line case------ If on column 1:------ @--- 15 │ ╭ data ArtifactLocation = ArtifactLocation--- 16 │ │ { uri :: Text--- 17 │ │ }--- 18 │ │ deriving stock (Eq)--- │ ╰─────────────────────^--- @------ If not on column 1:------ @--- 15 │ data ArtifactLocation = ArtifactLocation--- │ ╭────^--- 16 │ │ { uri :: Text--- 17 │ │ }--- 18 │ │ deriving stock (Eq)--- │ ╰─────────────────────^--- @-makeLinesN :: Region -> NonEmpty Text -> NonEmpty Line-makeLinesN region input- | sc == 1 =- Line- { number = Just sl- , pre = ""- , focused = "╭ " <> NE.head input- , post = ""- }- :| tailLines- | otherwise =- let (pre, focused, post) = focusLine sc Nothing $ NE.head input- in Line- { number = Just sl- , pre = " " <> pre- , focused- , post- }- :| Line- { number = Nothing- , pre = ""- , focused = "╭" <> T.replicate sc "─" <> "^"- , post = ""- }- : tailLines- where- tailLines = zipWith tailLine [sl + 1 ..] (NE.tail input) <> [underbarLine]-- tailLine n x =- Line- { number = Just n- , pre = ""- , focused = "│ " <> x- , post = ""- }-- underbarLine =- Line- { number = Nothing- , pre = ""- , focused = "╰─" <> T.replicate (ec - 2) "─" <> "^"- , post = ""- }-- sl = region.startLine- sc = fromMaybe 1 region.startColumn- ec = fromMaybe (defaultEndColumn input) region.endColumn--focusLine :: Int -> Maybe Int -> Text -> (Text, Text, Text)-focusLine sc mec t = (pre, marked, post)- where- (pre, rest) = T.splitAt (sc - 1) t- (marked, post) = case mec of- Nothing -> (rest, "")- Just ec -> T.splitAt (ec - sc) rest--defaultEndColumn :: NonEmpty Text -> Int-defaultEndColumn = (+ 1) . T.length . NE.last
src/Snippet/Pretty.hs view
@@ -12,30 +12,19 @@ , prettySnippet , prettySnippetFill , snippetGutterWidth+ , snippetInsetWidth ) where import Prelude -import Data.Foldable (toList)-import Data.List.NonEmpty (NonEmpty) import Data.Maybe (fromMaybe)+import Data.Text qualified as T import Prettyprinter hiding (line)-import Prettyprinter.Render.Terminal (AnsiStyle, Color (..), colorDull) import Snippet.Line+import Snippet.Pretty.Ann import Snippet.Region import Snippet.Snippet -data Ann- = -- | Line numbers and left-hand bar- AnnGutter- | -- | Focused line content- AnnFocused--annToAnsi :: Ann -> AnsiStyle-annToAnsi = \case- AnnGutter -> colorDull Blue- AnnFocused -> colorDull Green- -- | A 'Snippet's gutter fits the digits of its maximum (i.e. end) line number, -- plus 1 character of whitespace. snippetGutterWidth :: Snippet -> Int@@ -44,6 +33,19 @@ sl = snippet.region.startLine el = fromMaybe sl snippet.region.endLine +-- | A 'Snippet's inset matches how far the code is indented to support region+-- marking.+snippetInsetWidth :: Snippet -> Int+snippetInsetWidth = regionInsetWidth . (.region)++regionInsetWidth :: Region -> Int+regionInsetWidth region =+ go region + maybe 0 go region.subRegion+ where+ go r+ | maybe True (== r.startLine) r.endLine = 0+ | otherwise = 2+ prettySnippet :: Snippet -> Doc Ann prettySnippet snippet = prettySnippetFill w snippet where@@ -75,7 +77,8 @@ -- -- -- @--- >>> vsep [prettySnippetFill 2 a, prettySnippetFill 2 b]+-- >>> let w = max `on` snippetGutterWidth a b+-- >>> vsep [prettySnippetFill w a, prettySnippetFill w b] -- ┌─ -- │ -- 1 │ ...@@ -89,23 +92,23 @@ prettySnippetFill w snippet = vsep [ indent w- $ annotate AnnGutter "┌─"+ $ annotate+ AnnDecoration+ (pretty $ "┌" <> T.replicate (snippetInsetWidth snippet) "─") <+> pretty (snippet.uri) <> ":" <> pretty snippet.region.startLine <> ":" <> pretty snippet.region.startColumn- , indent w $ annotate AnnGutter "│"+ , indent w $ annotate AnnDecoration "│" , prettyLines w snippet.lines ] -prettyLines :: Int -> NonEmpty Line -> Doc Ann-prettyLines w = vsep . map (prettyLine w) . toList+prettyLines :: Int -> [Line] -> Doc Ann+prettyLines w = vsep . map (prettyLine w) prettyLine :: Int -> Line -> Doc Ann-prettyLine w line =- -- TODO: this is a fill-right, I want fill-left- annotate AnnGutter (fill w (maybe "" pretty line.number) <> "│")- <+> pretty line.pre- <> annotate AnnFocused (pretty line.focused)- <> pretty line.post+prettyLine w line = annotate AnnDecoration (number <> "│") <+> lineContent line+ where+ -- TODO: I'd prefer right-align+ number = fill w (maybe "" pretty $ lineNumber line)
+ src/Snippet/Pretty/Ann.hs view
@@ -0,0 +1,27 @@+module Snippet.Pretty.Ann+ ( Ann (..)+ , annToAnsi+ ) where++import Prelude++import Prettyprinter.Render.Terminal (AnsiStyle, Color (..), bold, colorDull)++data Ann+ = -- | Line numbers, left-hand bar, etc+ AnnDecoration+ | -- | Focused line content by depth (0 is un-focused)+ AnnFocused Int+ | -- | Message annotating the region+ AnnMessage+ deriving stock (Eq, Show)++annToAnsi :: Ann -> AnsiStyle+annToAnsi = \case+ AnnDecoration -> colorDull Blue+ AnnFocused 0 -> mempty+ AnnFocused n ->+ colorDull+ $ (!! (n - 1))+ $ cycle [Green, Red, Cyan, Yellow, Magenta, Blue]+ AnnMessage -> bold
src/Snippet/Region.hs view
@@ -8,6 +8,7 @@ -- Portability : POSIX module Snippet.Region ( Region (..)+ , regionIsOneLine -- * Single-line helpers , lineRegion@@ -17,17 +18,33 @@ import Prelude +import Data.Text (Text)+import GHC.Generics (Generic)+ data Region = Region { startLine :: Int+ -- ^ The line number of the line containing the first character in the region. , endLine :: Maybe Int- -- ^ Defaults to 'startLine' if missing+ -- ^ The line number of the line containing the last character in the region.+ --+ -- If missing, defaults to 'startLine'. , startColumn :: Maybe Int- -- ^ Defaults to @1@ if missing+ -- ^ The column number of the first character of the region.+ --+ -- ^ If missing, defaults to @1@. , endColumn :: Maybe Int- -- ^ If missing, the entire last line is considered focused+ -- ^ The column number /one past/ the last character in the region.+ --+ -- If missing defaults to the position after the last character of the line,+ -- excluding newline.+ , message :: Maybe Text+ , subRegion :: Maybe Region }- deriving stock (Eq, Show)+ deriving stock (Eq, Generic, Show) +regionIsOneLine :: Region -> Bool+regionIsOneLine region = maybe True (== region.startLine) region.endLine+ lineRegion :: Int -> Region lineRegion startLine = Region@@ -35,6 +52,8 @@ , endLine = Nothing , startColumn = Nothing , endColumn = Nothing+ , message = Nothing+ , subRegion = Nothing } lineRegionFrom :: Int -> Int -> Region@@ -44,6 +63,8 @@ , endLine = Nothing , startColumn = Just sc , endColumn = Nothing+ , message = Nothing+ , subRegion = Nothing } lineRegionFromTo :: Int -> Int -> Int -> Region@@ -53,4 +74,6 @@ , endLine = Nothing , startColumn = Just sc , endColumn = Just ec+ , message = Nothing+ , subRegion = Nothing }
src/Snippet/Snippet.hs view
@@ -10,7 +10,6 @@ ( Snippet (..) ) where -import Data.List.NonEmpty (NonEmpty) import Data.Text (Text) import Snippet.Line import Snippet.Region@@ -19,5 +18,5 @@ { uri :: Text -- ^ Usually a file path, but can be anything , region :: Region- , lines :: NonEmpty Line+ , lines :: [Line] }
+ test-cases/nested/readme.yaml view
@@ -0,0 +1,136 @@+expected:+ ansi: |2-+ {b}┌────{x} test-cases/nested/readme.yaml:32:8+ {b}│{x}+ {b}32 │{x} main = {g}do{x}+ {b} │{x} {g}╭──────────^{x}+ {b}33 │{x} {g}│ {x}{g} let{x}+ {b}34 │{x} {g}│ {x}{r}╭──── region = Region{x} {b}•────────────────┤{x}{B}Denotes a region in the snippet{x}+ {b}35 │{x} {g}│ {x}{r}│ {x}{r} { startLine = 32{x}+ {b}36 │{x} {g}│ {x}{r}│ {x}{r} , startColumn = Just 8{x}+ {b}37 │{x} {g}│ {x}{r}│ {x}{r} , endLine = Just 64{x}+ {b}38 │{x} {g}│ {x}{r}│ {x}{r} , endColumn = Nothing{x}+ {b}39 │{x} {g}│ {x}{r}│ {x}{r} , message = Nothing{x}+ {b}40 │{x} {g}│ {x}{r}│ {x}{r} , subRegion ={x}+ {b}41 │{x} {g}│ {x}{r}│ {x}{r} Just{x}+ {b}42 │{x} {g}│ {x}{r}│ {x}{r} Region{x}+ {b}43 │{x} {g}│ {x}{r}│ {x}{r} { startLine = 34{x}+ {b}44 │{x} {g}│ {x}{r}│ {x}{r} , startColumn = Just 5{x}+ {b}45 │{x} {g}│ {x}{r}│ {x}{r} , endLine = {x}{c}Just{x}{r} 59{x}+ {b} │{x} {g}│ {x}{r}│ {x} {c}^^^^{x} {b}•──────────┤{x}{B}Would default to startLine{x}+ {b}46 │{x} {g}│ {x}{r}│ {x}{r} , endColumn = Nothing{x}+ {b}47 │{x} {g}│ {x}{r}│ {x}{r} , message = Just "Denotes a region in the snippet"{x}+ {b}48 │{x} {g}│ {x}{r}│ {x}{r} , subRegion ={x}+ {b}49 │{x} {g}│ {x}{r}│ {x}{r} Just{x}+ {b}50 │{x} {g}│ {x}{r}│ {x}{r} Region{x}+ {b}51 │{x} {g}│ {x}{r}│ {x}{r} { startLine = 45{x}+ {b}52 │{x} {g}│ {x}{r}│ {x}{r} , startColumn = Just 27{x}+ {b}53 │{x} {g}│ {x}{r}│ {x}{r} , endLine = Nothing{x}+ {b}54 │{x} {g}│ {x}{r}│ {x}{r} , endColumn = Just 31{x}+ {b}55 │{x} {g}│ {x}{r}│ {x}{r} , message = Just "Would default to startLine"{x}+ {b}56 │{x} {g}│ {x}{r}│ {x}{r} , subRegion = Nothing{x}+ {b}57 │{x} {g}│ {x}{r}│ {x}{r} }{x}+ {b}58 │{x} {g}│ {x}{r}│ {x}{r} }{x}+ {b}59 │{x} {g}│ {x}{r}│ {x}{r} }{x}+ {b} │{x} {g}│ {x}{r}╰───────^{x}+ {b}60 │{x} {g}│{x}+ {b}61 │{x} {g}│ {x}{g} -- Returns Nothing if file is missing/empty or region is invalid{x}+ {b}62 │{x} {g}│ {x}{g} mSnippet <- snippetFromFile region "README.md"{x}+ {b}63 │{x} {g}│{x}+ {b}64 │{x} {g}│ {x}{g} traverse_ (putDoc . reAnnotate annToAnsi . prettySnippet) mSnippet{x}+ {b} │{x} {g}╰──────────────────────────────────────────────────────────────────────^{x}+ text: |2-+ ┌──── test-cases/nested/readme.yaml:32:8+ │+ 32 │ main = do+ │ ╭──────────^+ 33 │ │ let+ 34 │ │ ╭──── region = Region •────────────────┤Denotes a region in the snippet+ 35 │ │ │ { startLine = 32+ 36 │ │ │ , startColumn = Just 8+ 37 │ │ │ , endLine = Just 64+ 38 │ │ │ , endColumn = Nothing+ 39 │ │ │ , message = Nothing+ 40 │ │ │ , subRegion =+ 41 │ │ │ Just+ 42 │ │ │ Region+ 43 │ │ │ { startLine = 34+ 44 │ │ │ , startColumn = Just 5+ 45 │ │ │ , endLine = Just 59+ │ │ │ ^^^^ •──────────┤Would default to startLine+ 46 │ │ │ , endColumn = Nothing+ 47 │ │ │ , message = Just "Denotes a region in the snippet"+ 48 │ │ │ , subRegion =+ 49 │ │ │ Just+ 50 │ │ │ Region+ 51 │ │ │ { startLine = 45+ 52 │ │ │ , startColumn = Just 27+ 53 │ │ │ , endLine = Nothing+ 54 │ │ │ , endColumn = Just 31+ 55 │ │ │ , message = Just "Would default to startLine"+ 56 │ │ │ , subRegion = Nothing+ 57 │ │ │ }+ 58 │ │ │ }+ 59 │ │ │ }+ │ │ ╰───────^+ 60 │ │+ 61 │ │ -- Returns Nothing if file is missing/empty or region is invalid+ 62 │ │ mSnippet <- snippetFromFile region "README.md"+ 63 │ │+ 64 │ │ traverse_ (putDoc . reAnnotate annToAnsi . prettySnippet) mSnippet+ │ ╰──────────────────────────────────────────────────────────────────────^+input:+ region:+ endColumn: null+ endLine: 64+ message: null+ startColumn: 8+ startLine: 32+ subRegion:+ endColumn: null+ endLine: 59+ message: Denotes a region in the snippet+ startColumn: 5+ startLine: 34+ subRegion:+ endColumn: 31+ endLine: null+ message: Would default to startLine+ startColumn: 27+ startLine: 45+ subRegion: null+ source: |+ main = do+ let+ region = Region+ { startLine = 32+ , startColumn = Just 8+ , endLine = Just 64+ , endColumn = Nothing+ , message = Nothing+ , subRegion =+ Just+ Region+ { startLine = 34+ , startColumn = Just 5+ , endLine = Just 59+ , endColumn = Nothing+ , message = Just "Denotes a region in the snippet"+ , subRegion =+ Just+ Region+ { startLine = 45+ , startColumn = Just 27+ , endLine = Nothing+ , endColumn = Just 31+ , message = Just "Would default to startLine"+ , subRegion = Nothing+ }+ }+ }++ -- Returns Nothing if file is missing/empty or region is invalid+ mSnippet <- snippetFromFile region "README.md"++ traverse_ (putDoc . reAnnotate annToAnsi . prettySnippet) mSnippet+ sourceStartLine: null
+ test-cases/simple/multi-line.yaml view
@@ -0,0 +1,36 @@+expected:+ ansi: |2-+ {b}┌──{x} test-cases/simple/multi-line.yaml:2:8+ {b}│{x}+ {b}1 │{x} main :: IO ()+ {b}2 │{x} main = {g}do{x}+ {b} │{x} {g}╭────────^{x}+ {b}3 │{x} {g}│ {x}{g} putStrLn "This"{x}+ {b}4 │{x} {g}│ {x}{g} putStrLn "That"{x}+ {b}5 │{x} {g}│ {x}{g} putStrLn "That other things"{x}+ {b} │{x} {g}╰──────────────────────────────^{x}+ text: |2-+ ┌── test-cases/simple/multi-line.yaml:2:8+ │+ 1 │ main :: IO ()+ 2 │ main = do+ │ ╭────────^+ 3 │ │ putStrLn "This"+ 4 │ │ putStrLn "That"+ 5 │ │ putStrLn "That other things"+ │ ╰──────────────────────────────^+input:+ region:+ endColumn: null+ endLine: 5+ message: null+ startColumn: 8+ startLine: 2+ subRegion: null+ source: |+ main :: IO ()+ main = do+ putStrLn "This"+ putStrLn "That"+ putStrLn "That other things"+ sourceStartLine: 1
+ test-cases/simple/one-line.yaml view
@@ -0,0 +1,25 @@+expected:+ ansi: |2-+ {b}┌{x} test-cases/simple/one-line.yaml:1:37+ {b}│{x}+ {b}1 │{x} Here is some source code that has a {g}few{x} lines and I'm trying to target the+ {b} │{x} {g}^^^{x}+ {b}2 │{x} word few in the first line+ text: |2-+ ┌ test-cases/simple/one-line.yaml:1:37+ │+ 1 │ Here is some source code that has a few lines and I'm trying to target the+ │ ^^^+ 2 │ word few in the first line++input:+ region:+ endColumn: 40+ endLine: null+ message: null+ startColumn: 37+ startLine: 1+ subRegion: null+ source: |+ Here is some source code that has a few lines and I'm trying to target the+ word few in the first line
− test/Snippet/LinesSpec.hs
@@ -1,130 +0,0 @@--- |------ Module : Snippet.LinesSpec--- Copyright : (c) 2026 Patrick Brisbin--- License : AGPL-3--- Maintainer : pbrisbin@gmail.com--- Stability : experimental--- Portability : POSIX-module Snippet.LinesSpec- ( spec- ) where--import Prelude--import Control.Monad (guard)-import Data.List.NonEmpty qualified as NE-import Data.Text (Text, unpack)-import Data.Text qualified as T-import Snippet.Line-import Snippet.Lines-import Snippet.Region-import Test.Hspec--spec :: Spec-spec = do- describe "makeLines" $ do- it "handles a single-line case" $ do- let- region =- Region- { startLine = 85- , startColumn = Just 9- , endLine = Just 85- , endColumn = Just 46- }- input =- NE.fromList- [ " [ ((annotate AnnIcon xyz <+>) . pretty) <$> r"- ]-- makeLines region input- `shouldBe` NE.fromList- [ l "85| [ |((annotate AnnIcon xyz <+>) . pretty)| <$> r"- , l " | |^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^"- ]-- it "handles a multi-line case" $ do- let- region =- Region- { startLine = 15- , startColumn = Just 1- , endLine = Just 18- , endColumn = Just 22- }-- input =- NE.fromList- [ "data ArtifactLocation = ArtifactLocation"- , " { uri :: Text"- , " }"- , " deriving stock (Eq)"- ]-- makeLines region input- `shouldBe` NE.fromList- [ l "15||╭ data ArtifactLocation = ArtifactLocation"- , l "16||│ { uri :: Text"- , l "17||│ }"- , l "18||│ deriving stock (Eq)"- , l " ||╰─────────────────────^"- ]-- it "handles a complex multi-line case" $ do- let- region =- Region- { startLine = 15- , startColumn = Just 6- , endLine = Just 18- , endColumn = Just 22- }-- input =- NE.fromList- [ "data ArtifactLocation = ArtifactLocation"- , " { uri :: Text"- , " }"- , " deriving stock (Eq)"- ]-- makeLines region input- `shouldBe` NE.fromList- [ l "15| data |ArtifactLocation = ArtifactLocation"- , l " ||╭──────^"- , l "16||│ { uri :: Text"- , l "17||│ }"- , l "18||│ deriving stock (Eq)"- , l " ||╰─────────────────────^"- ]---- | Micro-format to make expectations visually look like expected-l :: Text -> Line-l t = case T.splitOn "|" t of- [nt, pre, focused, post] ->- Line- { number = do- let n = T.strip nt- guard $ not $ T.null n- pure $ read $ unpack n- , pre- , focused- , post- }- [nt, pre, focused] ->- Line- { number = do- let n = T.strip nt- guard $ not $ T.null n- pure $ read $ unpack n- , pre- , focused- , post = ""- }- x ->- error- $ "Expected line must be 3 or 4 parts delimited by \"|\". Saw "- <> show (length x)- <> "part(s): "- <> show x
+ test/SnippetSpec.hs view
@@ -0,0 +1,161 @@+{-# OPTIONS_GHC -Wno-orphans #-}++module SnippetSpec+ ( spec+ ) where++import Prelude++import Control.Monad (guard)+import Data.Aeson (FromJSON, ToJSON)+import Data.Foldable (traverse_)+import Data.List.NonEmpty (nonEmpty)+import Data.Semigroup (Endo (..))+import Data.Text (Text, pack)+import Data.Text qualified as T+import Data.Yaml qualified as Yaml+import GHC.Generics (Generic)+import Prettyprinter (defaultLayoutOptions, layoutPretty, reAnnotate)+import Prettyprinter.Render.Terminal qualified as ANSI+import Prettyprinter.Render.Text qualified as Text+import Snippet+import Snippet.Pretty (annToAnsi, prettySnippet)+import System.Environment (lookupEnv)+import System.FilePath (dropTrailingPathSeparator, splitPath)+import System.FilePath.Glob (globDir1)+import Test.Hspec++spec :: Spec+spec = do+ gs <- runIO $ loadGoldens "test-cases"+ traverse_ goldenSpec gs++instance FromJSON Region++instance ToJSON Region++data Golden = Golden+ { path :: FilePath+ , fixture :: GoldenFixture+ }++data GoldenFixture = GoldenFixture+ { input :: GoldenInput+ , expected :: Maybe GoldenSnippet+ }+ deriving stock (Generic)+ deriving anyclass (FromJSON, ToJSON)++data GoldenInput = GoldentInput+ { region :: Region+ , source :: Text+ , sourceStartLine :: Maybe Int+ }+ deriving stock (Generic)+ deriving anyclass (FromJSON, ToJSON)++data GoldenSnippet = GoldenSnippet+ { text :: Text+ , ansi :: Text+ }+ deriving stock (Generic)+ deriving anyclass (FromJSON, ToJSON)++loadGoldens :: FilePath -> IO [Golden]+loadGoldens base = do+ yamls <- globDir1 "**/*.yaml" base+ traverse loadGolden yamls++loadGolden :: FilePath -> IO Golden+loadGolden path = do+ fixture <- Yaml.decodeFileThrow path+ pure $ Golden {path, fixture}++goldenSpec :: Golden -> Spec+goldenSpec g = go $ map dropTrailingPathSeparator $ splitPath g.path+ where+ go = \case+ [] -> it g.path $ goldenIt g+ [p] -> it p $ goldenIt g+ (p : ps) -> context p $ go ps++goldenIt :: Golden -> Expectation+goldenIt g = do+ update <- lookupEnvYes "SNIPPET_TEST_GOLDEN_UPDATE"+ actual <- decodeGolden g++ let mExpected = do+ guard $ not update+ g.fixture.expected++ case mExpected of+ Nothing -> encodeGolden g actual+ Just expected -> do+ -- If both are wrong, we'd like to work on the text failure first+ actual.text `shouldBe` expected.text+ actual.ansi `shouldBe` expected.ansi++decodeGolden :: Golden -> IO GoldenSnippet+decodeGolden g = do+ snippet <-+ maybe err (pure . mkSnippet)+ $ nonEmpty+ $ T.lines+ $ g.fixture.input.source++ let simple =+ layoutPretty defaultLayoutOptions+ $ reAnnotate annToAnsi+ $ prettySnippet snippet++ pure+ $ GoldenSnippet+ { text = Text.renderStrict simple+ , ansi = replaceEscapes $ ANSI.renderStrict simple+ }+ where+ mkSnippet =+ snippetFromContents+ g.fixture.input.region+ (pack g.path)+ g.fixture.input.sourceStartLine++ err = do+ expectationFailure "Fixture region was invalid"+ error "unreachable"++encodeGolden :: Golden -> GoldenSnippet -> IO ()+encodeGolden g gs =+ Yaml.encodeFile g.path $ g.fixture {expected = Just gs}++replaceEscapes :: Text -> Text+replaceEscapes = appEndo $ foldMap (uncurry toEndo) escapes+ where+ toEndo :: Text -> Text -> Endo Text+ toEndo a b = Endo $ T.replace a b++ escapes :: [(Text, Text)]+ escapes =+ [ ("\ESC[0;36m", "{c}")+ , ("\ESC[0;34m", "{b}")+ , ("\ESC[0;32m", "{g}")+ , ("\ESC[0;31m", "{r}")+ , ("\ESC[0;1m", "{B}")+ , ("\ESC[0m", "{x}")+ ]++lookupEnvYes :: String -> IO Bool+lookupEnvYes e = maybe False isYes <$> lookupEnv e+ where+ isYes x =+ any+ ((normalize x ==) . normalize)+ [ "1"+ , "y"+ , "yes"+ , "true"+ , "on"+ ]++ normalize :: String -> Text+ normalize = T.toCaseFold . T.strip . pack