packages feed

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 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:  ![](./example.png)  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:  ![](./example.png)  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