mirror of
https://github.com/unisonweb/unison.git
synced 2024-10-05 14:17:33 +03:00
Merge remote-tracking branch 'origin/topic/pretty-errors' into topic/delay
This commit is contained in:
Paul Chiusano
commit
ad1109c439
@ -55,22 +55,22 @@ renderTypeError :: (Var v, Annotated a, Eq a, Show a)
|
||||
=> Env
|
||||
-> TypeError v a
|
||||
-> String
|
||||
-> AT.AnnotatedDocument Color.Color
|
||||
-> AT.AnnotatedDocument Color.Style
|
||||
renderTypeError env e src = case e of
|
||||
Mismatch {..} -> AT.AnnotatedDocument . Seq.fromList $
|
||||
[ (fromString . annotatedToEnglish) mismatchSite
|
||||
, " has a type mismatch (colored in ", AT.Text $ Color.color1 "red", " below):\n\n"
|
||||
, " has a type mismatch (colored in ", AT.Text $ Color.errorSite "red", " below):\n\n"
|
||||
, AT.Blockquote $ AT.markup (fromString src)
|
||||
(Set.fromList $ catMaybes
|
||||
[ (,Color.Color1) <$> rangeForAnnotated mismatchSite
|
||||
, (,Color.Color2) <$> rangeForType overallType1
|
||||
, (,Color.Color3) <$> rangeForType overallType2
|
||||
[ (,Color.ErrorSite) <$> rangeForAnnotated mismatchSite
|
||||
, (,Color.Type1) <$> rangeForType overallType1
|
||||
, (,Color.Type2) <$> rangeForType overallType2
|
||||
])
|
||||
, "\n"
|
||||
, "The two types involved are:\n\n"
|
||||
, AT.Text $ styleInOverallType env overallType1 leaf1 Color.Color2
|
||||
, AT.Text $ styleInOverallType env overallType1 leaf1 Color.Type1
|
||||
, " (", fromString (annotatedToEnglish overallType1), ")\n and\n"
|
||||
, AT.Text $ styleInOverallType env overallType2 leaf2 Color.Color3
|
||||
, AT.Text $ styleInOverallType env overallType2 leaf2 Color.Type2
|
||||
, " (from " , fromString (Char.toLower <$> annotatedToEnglish overallType2)
|
||||
, ")\n\n"
|
||||
]
|
||||
@ -130,11 +130,11 @@ styleInOverallType :: (Var v, Annotated a, Eq a)
|
||||
=> Env
|
||||
-> C.Type v a
|
||||
-> C.Type v a
|
||||
-> Color.Color
|
||||
-> Color.Style
|
||||
-> StyledText
|
||||
styleInOverallType e overallType leafType c =
|
||||
renderType e f overallType
|
||||
where f loc s = if loc == ABT.annotation leafType then Color.color c s else s
|
||||
where f loc s = if loc == ABT.annotation leafType then Color.style c s else s
|
||||
|
||||
posToEnglish :: L.Pos -> String
|
||||
posToEnglish (L.Pos l c) = "Line " ++ show l ++ ", Column " ++ show c
|
||||
@ -239,7 +239,7 @@ prettyTypecheckError :: (Var v, Eq loc, Show loc, Parser.Annotated loc)
|
||||
-> String
|
||||
-> C.Note v loc -> String
|
||||
prettyTypecheckError env input n =
|
||||
show . Color.renderDocInColor $
|
||||
show . Color.renderDocANSI 3 $
|
||||
(renderTypeError env (typeErrorFromNote n) input)
|
||||
-- case cause of
|
||||
-- C.TypeMismatch _ -> case path of
|
||||
|
||||
@ -1,16 +1,20 @@
|
||||
{-# LANGUAGE FlexibleInstances, TypeFamilies #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
||||
module Unison.Util.AnnotatedText where
|
||||
|
||||
import Control.Arrow (second)
|
||||
import Data.Sequence (Seq)
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as Set
|
||||
import Data.Sequence (Seq((:|>)))
|
||||
import Safe (lastMay)
|
||||
import Data.String (IsString(..))
|
||||
import Unison.Lexer (Line)
|
||||
import Unison.Util.Range (Range)
|
||||
import Control.Arrow (second)
|
||||
import Data.Foldable (asum, foldl')
|
||||
import Data.Sequence (Seq)
|
||||
import Data.Sequence (Seq ((:|>)))
|
||||
import Data.Set (Set)
|
||||
import qualified Data.Set as Set
|
||||
import Data.String (IsString (..))
|
||||
import Safe (lastMay)
|
||||
import Unison.Lexer (Line, Pos (..))
|
||||
import Unison.Util.Monoid (intercalateMap)
|
||||
import Unison.Util.Range (Range (..))
|
||||
|
||||
newtype AnnotatedDocument a = AnnotatedDocument (Seq (Section a))
|
||||
|
||||
@ -27,17 +31,75 @@ data AnnotatedExcerpt a = AnnotatedExcerpt
|
||||
, annotations :: Set (Range, a)
|
||||
} deriving (Eq, Ord, Show)
|
||||
|
||||
newtype Rendered a = Rendered (Seq String)
|
||||
|
||||
excerptToDoc :: AnnotatedExcerpt a -> AnnotatedDocument a
|
||||
excerptToDoc = AnnotatedDocument . pure . Blockquote
|
||||
|
||||
trailingNewLine :: AnnotatedText a -> Bool
|
||||
trailingNewLine (AnnotatedText (init :|> (s,_))) =
|
||||
case lastMay s of
|
||||
Just '\n' -> True
|
||||
Just _ -> False
|
||||
_ -> trailingNewLine (AnnotatedText init)
|
||||
Just _ -> False
|
||||
_ -> trailingNewLine (AnnotatedText init)
|
||||
trailingNewLine _ = False
|
||||
|
||||
markup :: Ord a => AnnotatedExcerpt a -> Set (Range, a) -> AnnotatedExcerpt a
|
||||
markup a r = a { annotations = r `Set.union` annotations a }
|
||||
|
||||
splitAndRender :: Ord a
|
||||
=> Int
|
||||
-> (AnnotatedExcerpt a -> Rendered b)
|
||||
-> AnnotatedExcerpt a -> Rendered b
|
||||
splitAndRender n f e = intercalateMap " .\n" f $ snipWithContext n e
|
||||
|
||||
_deoffsetRange :: Line -> Range -> Range
|
||||
_deoffsetRange lineOffset (Range (Pos startLine startCol) (Pos endLine endCol)) =
|
||||
Range (Pos (startLine - lineOffset + 1) startCol)
|
||||
(Pos (endLine - lineOffset + 1) endCol)
|
||||
|
||||
-- | drops lines and replaces with "." if there are more than `n` unannotated
|
||||
-- | lines in a row.
|
||||
snipWithContext :: Ord a => Int -> AnnotatedExcerpt a -> [AnnotatedExcerpt a]
|
||||
snipWithContext margin source =
|
||||
case foldl' whileWithinMargin
|
||||
(Nothing, mempty, mempty)
|
||||
(Set.toList $ annotations source) of
|
||||
(Nothing, _, _) -> []
|
||||
(Just (Range (Pos startLine' _) (Pos endLine' _)), group', rest') ->
|
||||
let dropLineCount = startLine' - lineOffset source
|
||||
takeLineCount = endLine' - startLine' + 1
|
||||
text', text2' :: [String]
|
||||
(text', text2') =
|
||||
splitAt takeLineCount (drop dropLineCount (lines (text source)))
|
||||
in AnnotatedExcerpt startLine' (unlines text') group'
|
||||
: snipWithContext
|
||||
margin (AnnotatedExcerpt (endLine' + 1) (unlines text2') rest')
|
||||
where
|
||||
withinMargin :: Range -> Range -> Bool
|
||||
withinMargin (Range _start1 (Pos end1 _)) (Range (Pos start2 _) _end2) =
|
||||
end1 + margin >= start2
|
||||
|
||||
whileWithinMargin :: Ord a
|
||||
=> (Maybe Range, Set (Range, a), Set (Range, a))
|
||||
-> (Range, a)
|
||||
-> (Maybe Range, Set (Range, a), Set (Range, a))
|
||||
whileWithinMargin (r0, taken, rest) a@(r1,_) =
|
||||
case r0 of
|
||||
Nothing -> -- haven't processed any annotations yet
|
||||
(Just r1, Set.singleton a, mempty)
|
||||
Just r0 ->
|
||||
-- if all annotations so far can be joined without .. separations
|
||||
if null rest
|
||||
-- if this one can be joined to the new region without .. separation
|
||||
then if withinMargin r0 r1
|
||||
-- add it to the first set and grow the compare region
|
||||
then (Just $ r0 <> r1, Set.insert a taken, mempty)
|
||||
-- otherwise add it to the second set
|
||||
else (Just r0, taken, Set.singleton a)
|
||||
-- once we've added to the second set, anything more goes there too
|
||||
else (Just r0, taken, Set.insert a rest)
|
||||
|
||||
instance IsString (AnnotatedDocument a) where
|
||||
fromString = AnnotatedDocument . pure . fromString
|
||||
|
||||
@ -68,3 +130,16 @@ instance Monoid (AnnotatedText a) where
|
||||
|
||||
instance Functor AnnotatedText where
|
||||
fmap f (AnnotatedText chunks) = AnnotatedText (second f <$> chunks)
|
||||
|
||||
instance Show (Rendered a) where
|
||||
show (Rendered chunks) = asum chunks
|
||||
|
||||
instance Semigroup (Rendered a) where
|
||||
(<>) = mappend
|
||||
|
||||
instance Monoid (Rendered a) where
|
||||
mempty = Rendered mempty
|
||||
mappend (Rendered chunks) (Rendered chunks') = Rendered (chunks <> chunks')
|
||||
|
||||
instance IsString (Rendered a) where
|
||||
fromString s = Rendered (pure s)
|
||||
|
||||
@ -1,12 +1,10 @@
|
||||
{-# LANGUAGE EmptyDataDecls #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
module Unison.Util.ColorText where
|
||||
|
||||
import Data.Foldable (asum, foldl', toList)
|
||||
import qualified Data.List as List
|
||||
import Data.Sequence (Seq)
|
||||
import Data.Set (Set)
|
||||
import Data.Foldable (foldl', toList)
|
||||
import qualified Data.Set as Set
|
||||
import Data.String (IsString (..))
|
||||
import Safe (headMay)
|
||||
@ -18,184 +16,106 @@ import System.Console.ANSI (pattern Blue, pattern BoldIntensity,
|
||||
pattern SetUnderlining,
|
||||
pattern SingleUnderline, pattern Vivid,
|
||||
setSGRCode)
|
||||
import Unison.Lexer (Line, Pos (..))
|
||||
import Unison.Util.AnnotatedText
|
||||
import Unison.Lexer (Pos (..))
|
||||
import Unison.Util.AnnotatedText (AnnotatedDocument (..),
|
||||
AnnotatedExcerpt,
|
||||
AnnotatedText (..), Rendered (..),
|
||||
Section (..), annotations,
|
||||
lineOffset, splitAndRender, text,
|
||||
trailingNewLine)
|
||||
import Unison.Util.Range (Range (..), inRange)
|
||||
|
||||
data Color = Color1 | Color2 | Color3 deriving (Eq, Ord, Show)
|
||||
type StyledText = AnnotatedText (Maybe Color)
|
||||
type StyledBlockquote = AnnotatedExcerpt Color
|
||||
data ANSI
|
||||
data ASCII
|
||||
data Style = Type1 | Type2 | ErrorSite deriving (Eq, Ord, Show)
|
||||
type StyledText = AnnotatedText (Maybe Style)
|
||||
type StyledBlockquote = AnnotatedExcerpt Style
|
||||
|
||||
toANSI :: Color -> Rendered
|
||||
toANSI c = Rendered . pure . setSGRCode $ case c of
|
||||
Color1 -> SetColor Foreground Vivid Red : [bold, underline]
|
||||
Color2 -> SetColor Foreground Vivid Blue : [bold, underline]
|
||||
Color3 -> SetColor Foreground Vivid Green : [bold, underline]
|
||||
where bold = SetConsoleIntensity BoldIntensity
|
||||
underline = SetUnderlining SingleUnderline
|
||||
unhighlighted :: StyledText -> StyledText
|
||||
unhighlighted s = const Nothing <$> s
|
||||
|
||||
resetANSI :: Rendered
|
||||
resetANSI = Rendered . pure . setSGRCode $ [Reset]
|
||||
style :: Style -> StyledText -> StyledText
|
||||
style c s = const (Just c) <$> s
|
||||
|
||||
newtype Rendered = Rendered (Seq String)
|
||||
type1 :: StyledText -> StyledText
|
||||
type1 s = const (Just Type1) <$> s
|
||||
|
||||
deoffsetRange :: Line -> Range -> Range
|
||||
deoffsetRange lineOffset (Range (Pos startLine startCol) (Pos endLine endCol)) =
|
||||
Range (Pos (startLine - lineOffset + 1) startCol)
|
||||
(Pos (endLine - lineOffset + 1) endCol)
|
||||
type2 :: StyledText -> StyledText
|
||||
type2 s = const (Just Type2) <$> s
|
||||
|
||||
-- | drops lines and replaces with "." if there are more than `n` unannotated
|
||||
-- | lines in a row.
|
||||
splitAndRenderWithColor :: Int -> StyledBlockquote -> Rendered
|
||||
splitAndRenderWithColor n e =
|
||||
mconcat $ List.intersperse
|
||||
" .\n"
|
||||
(renderExcerptWithColor <$> snipWithContext n e)
|
||||
errorSite :: StyledText -> StyledText
|
||||
errorSite s = const (Just ErrorSite) <$> s
|
||||
|
||||
renderExcerptWithColor :: StyledBlockquote -> Rendered
|
||||
renderExcerptWithColor e =
|
||||
track (Pos line1 1) [] (Set.toList $ annotations e)
|
||||
(Rendered . pure $ renderLineNumber line1) (text e)
|
||||
renderDocANSI :: Int -> AnnotatedDocument Style -> Rendered ANSI
|
||||
renderDocANSI excerptCollapseWidth (AnnotatedDocument chunks) =
|
||||
go $ toList chunks
|
||||
where
|
||||
line1 :: Int
|
||||
line1 = lineOffset e
|
||||
renderLineNumber n = " " ++ replicate (lineNumberWidth - length sn) ' ' ++ sn ++ " | " where sn = show n
|
||||
lineNumberWidth = 4 --length (show maxLineIndex)
|
||||
-- where maxLineIndex = line1 - 1 + length (lines (text e))
|
||||
setupNewLine :: Rendered -> Pos -> Char -> (Rendered, Pos)
|
||||
setupNewLine openColor (Pos line col) c = case c of
|
||||
'\n' -> let r = Rendered . pure $ renderLineNumber (line + 1)
|
||||
in (r <> openColor, Pos (line + 1) 1)
|
||||
_ -> (mempty, Pos line (col + 1))
|
||||
track :: Pos -> [(Color, Pos)] -> [(Range, Color)] -> Rendered -> String -> Rendered
|
||||
track _pos stack _annotations rendered "" =
|
||||
rendered <> if null stack then mempty else resetANSI
|
||||
track pos stack annotations rendered _input@(c:rest) =
|
||||
let -- get whichever annotations may now be open
|
||||
(poppedAnnotations, remainingAnnotations) = span (inRange pos . fst) annotations
|
||||
-- drop any stack entries that will be closed after this char
|
||||
stack0 = dropWhile ((<=pos) . snd) stack
|
||||
-- and add new stack entries
|
||||
stack' = foldl' pushColor stack0 poppedAnnotations
|
||||
where pushColor s (Range _ end, color) = (color, end) : s
|
||||
resetColor = -- stack is newly null, and there are no newly opened annotations
|
||||
if null poppedAnnotations && null stack' && not (null stack)
|
||||
then resetANSI else mempty
|
||||
maybeColor = fst <$> headMay stack'
|
||||
openColor = maybe mempty toANSI maybeColor
|
||||
(lineHeader, pos') = setupNewLine openColor pos c
|
||||
lineHeader' = if null rest then mempty else lineHeader
|
||||
newChar =
|
||||
if c == '\n'
|
||||
then (Rendered . pure) [c] <> resetANSI <> lineHeader'
|
||||
else openColor <> (Rendered . pure) [c]
|
||||
in track pos' stack' remainingAnnotations
|
||||
(rendered <> newChar <> resetColor) rest
|
||||
|
||||
snipWithContext :: Ord a => Int -> AnnotatedExcerpt a -> [AnnotatedExcerpt a]
|
||||
snipWithContext margin source =
|
||||
case foldl' whileWithinMargin
|
||||
(Nothing, mempty, mempty)
|
||||
(Set.toList $ annotations source) of
|
||||
(Nothing, _, _) -> []
|
||||
(Just (Range (Pos startLine' _) (Pos endLine' _)), group', rest') ->
|
||||
let dropLineCount = startLine' - lineOffset source
|
||||
takeLineCount = endLine' - startLine' + 1
|
||||
text', text2' :: [String]
|
||||
(text', text2') =
|
||||
splitAt takeLineCount (drop dropLineCount (lines (text source)))
|
||||
in AnnotatedExcerpt startLine' (unlines text') group'
|
||||
: snipWithContext
|
||||
margin (AnnotatedExcerpt (endLine' + 1) (unlines text2') rest')
|
||||
where
|
||||
withinMargin :: Range -> Range -> Bool
|
||||
withinMargin (Range _start1 (Pos end1 _)) (Range (Pos start2 _) _end2) =
|
||||
end1 + margin >= start2
|
||||
|
||||
whileWithinMargin :: Ord a
|
||||
=> (Maybe Range, Set (Range, a), Set (Range, a))
|
||||
-> (Range, a)
|
||||
-> (Maybe Range, Set (Range, a), Set (Range, a))
|
||||
whileWithinMargin (r0, taken, rest) a@(r1,_) =
|
||||
case r0 of
|
||||
Nothing -> -- haven't processed any annotations yet
|
||||
(Just r1, Set.singleton a, mempty)
|
||||
Just r0 ->
|
||||
if null rest -- if all annotations so far can be joined without .. separations
|
||||
then if withinMargin r0 r1 -- if this one can be joined to the compare region without .. separation
|
||||
then (Just $ r0 <> r1, Set.insert a taken, mempty) -- add it to the first set and grow the compare region
|
||||
else (Just r0, taken, Set.singleton a) -- otherwise add it to the second set
|
||||
else (Just r0, taken, Set.insert a rest) -- once we've added to the second set, anything more goes there too
|
||||
|
||||
renderStyleTextWithColor :: StyledText -> Rendered
|
||||
renderStyleTextWithColor (AnnotatedText chunks) = foldl' go mempty chunks
|
||||
where go :: Rendered -> (String, Maybe Color) -> Rendered
|
||||
go r (text, Nothing) = r <> resetANSI <> fromString text
|
||||
go r (text, Just color) = r <> toANSI color <> fromString text
|
||||
|
||||
renderDocInColor :: AnnotatedDocument Color -> Rendered
|
||||
renderDocInColor (AnnotatedDocument chunks) = go $ toList chunks where
|
||||
go [] = mempty
|
||||
go (Blockquote exc : rest) = splitAndRenderWithColor 3 exc <> go rest
|
||||
go (Blockquote exc : rest) =
|
||||
splitAndRender excerptCollapseWidth renderExcerptWithColor exc <> go rest
|
||||
go (Text t : rest@(Blockquote _ : _)) =
|
||||
renderStyleTextWithColor t
|
||||
<> (if trailingNewLine t then mempty else "\n")
|
||||
<> go rest
|
||||
go (Text t : rest) = renderStyleTextWithColor t <> go rest
|
||||
|
||||
{-
|
||||
toANSI :: Style -> Rendered ANSI
|
||||
toANSI c = Rendered . pure . setSGRCode $ case c of
|
||||
ErrorSite -> SetColor Foreground Vivid Red : [bold, underline]
|
||||
Type1 -> SetColor Foreground Vivid Blue : [bold, underline]
|
||||
Type2 -> SetColor Foreground Vivid Green : [bold, underline]
|
||||
where bold = SetConsoleIntensity BoldIntensity
|
||||
underline = SetUnderlining SingleUnderline
|
||||
|
||||
1 | foo : Int
|
||||
2 | foo = 42
|
||||
❌ 3:80 |
|
||||
> Hello, world!
|
||||
^^^^^
|
||||
> Goodbye, world!
|
||||
^^^^^^^
|
||||
resetANSI :: Rendered ANSI
|
||||
resetANSI = Rendered . pure . setSGRCode $ [Reset]
|
||||
|
||||
Highlight: Line 1, Cols 1-5
|
||||
Highlight: Line 2, Cols 1-7
|
||||
-}
|
||||
renderStyleTextWithColor :: StyledText -> Rendered ANSI
|
||||
renderStyleTextWithColor (AnnotatedText chunks) = foldl' go mempty chunks
|
||||
where go :: Rendered ANSI -> (String, Maybe Style) -> Rendered ANSI
|
||||
go r (text, Nothing) = r <> resetANSI <> fromString text
|
||||
go r (text, Just style) = r <> toANSI style <> fromString text
|
||||
|
||||
unhighlighted :: StyledText -> StyledText
|
||||
unhighlighted s = const Nothing <$> s
|
||||
renderExcerptWithColor :: StyledBlockquote -> Rendered ANSI
|
||||
renderExcerptWithColor e =
|
||||
track (Pos line1 1) [] (Set.toList $ annotations e)
|
||||
(Rendered . pure $ renderLineNumber line1) (text e)
|
||||
where
|
||||
line1 :: Int
|
||||
line1 = lineOffset e
|
||||
|
||||
color :: Color -> StyledText -> StyledText
|
||||
color c s = const (Just c) <$> s
|
||||
renderLineNumber n =
|
||||
" " ++ replicate (lineNumberWidth - length sn) ' ' ++ sn ++ " | "
|
||||
where sn = show n
|
||||
lineNumberWidth = 4
|
||||
|
||||
color1 :: StyledText -> StyledText
|
||||
color1 s = const (Just Color1) <$> s
|
||||
setupNewLine :: Rendered ANSI -> Pos -> Char -> (Rendered ANSI, Pos)
|
||||
setupNewLine openColor (Pos line col) c = case c of
|
||||
'\n' -> let r = Rendered . pure $ renderLineNumber (line + 1)
|
||||
in (r <> openColor, Pos (line + 1) 1)
|
||||
_ -> (mempty, Pos line (col + 1))
|
||||
|
||||
color2 :: StyledText -> StyledText
|
||||
color2 s = const (Just Color2) <$> s
|
||||
|
||||
color3 :: StyledText -> StyledText
|
||||
color3 s = const (Just Color3) <$> s
|
||||
|
||||
-- data AnnotatedText
|
||||
-- = Line { line :: String -- cannot contain newlines
|
||||
-- , overline :: Maybe String
|
||||
-- , underline :: Maybe String
|
||||
-- , colorRegions :: Map (Column) }
|
||||
-- -- , colorline :: String
|
||||
|
||||
-- * Don't print out source that isn't related to the error
|
||||
-- * Color regions that are related to the error
|
||||
-- * Insert lines with carets in place of using colors in some cases
|
||||
|
||||
-- vvvvv
|
||||
-- Foo
|
||||
--
|
||||
|
||||
instance Show Rendered where
|
||||
show (Rendered chunks) = asum chunks
|
||||
|
||||
instance Semigroup Rendered where
|
||||
(<>) = mappend
|
||||
|
||||
instance Monoid Rendered where
|
||||
mempty = Rendered mempty
|
||||
mappend (Rendered chunks) (Rendered chunks') = Rendered (chunks <> chunks')
|
||||
|
||||
instance IsString Rendered where
|
||||
fromString s = Rendered (pure s)
|
||||
track :: Pos -> [(Style, Pos)] -> [(Range, Style)] -> Rendered ANSI -> String -> Rendered ANSI
|
||||
track _pos stack _annotations rendered _input@"" =
|
||||
rendered <> if null stack then mempty else resetANSI
|
||||
track pos stack annotations rendered _input@(c:rest) =
|
||||
let -- get whichever annotations may now be open
|
||||
(poppedAnnotations, remainingAnnotations) = span (inRange pos . fst) annotations
|
||||
-- drop any stack entries that will be closed after this char
|
||||
stack0 = dropWhile ((<=pos) . snd) stack
|
||||
-- and add new stack entries
|
||||
stack' = foldl' pushColor stack0 poppedAnnotations
|
||||
where pushColor s (Range _ end, style) = (style, end) : s
|
||||
resetColor = -- stack is newly null, and there are no newly opened annotations
|
||||
if null poppedAnnotations && null stack' && not (null stack)
|
||||
then resetANSI else mempty
|
||||
maybeColor = fst <$> headMay stack'
|
||||
openColor = maybe mempty toANSI maybeColor
|
||||
(lineHeader, pos') = setupNewLine openColor pos c
|
||||
lineHeader' = if null rest then mempty else lineHeader
|
||||
newChar =
|
||||
if c == '\n'
|
||||
then (Rendered . pure) [c] <> resetANSI <> lineHeader'
|
||||
else openColor <> (Rendered . pure) [c]
|
||||
in track pos' stack' remainingAnnotations
|
||||
(rendered <> newChar <> resetColor) rest
|
||||
|
||||
@ -3,34 +3,35 @@
|
||||
module Unison.Test.ColorText where
|
||||
|
||||
-- import EasyTest
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Set as Set
|
||||
import Text.RawString.QQ
|
||||
import Unison.Lexer (Pos (..))
|
||||
import Unison.Util.AnnotatedText (AnnotatedExcerpt (..), markup)
|
||||
import Unison.Util.ColorText (Color (..), Rendered,
|
||||
renderExcerptWithColor)
|
||||
import Unison.Util.Range (Range (..))
|
||||
import Unison.Lexer (Pos (..))
|
||||
import Unison.Util.AnnotatedText (AnnotatedExcerpt (..), Rendered,
|
||||
excerptToDoc, markup)
|
||||
import Unison.Util.ColorText (ANSI, Style (..), renderDocANSI)
|
||||
import Unison.Util.Range (Range (..))
|
||||
|
||||
ex2 :: AnnotatedExcerpt Color
|
||||
ex2 :: AnnotatedExcerpt Style
|
||||
ex2 = markup ex (Set.fromList
|
||||
[ (Range (Pos 3 1) (Pos 3 5), Color2) -- SCENE
|
||||
, (Range (Pos 5 1) (Pos 5 5), Color1) -- Enter
|
||||
, (Range (Pos 25 1) (Pos 25 6), Color2) -- ALONSO
|
||||
, (Range (Pos 12 1) (Pos 13 44), Color1) -- Good, ... bestir.
|
||||
[ (Range (Pos 3 1) (Pos 3 5), ErrorSite) -- SCENE
|
||||
, (Range (Pos 5 9) (Pos 5 14), Type1) -- Master
|
||||
, (Range (Pos 5 22) (Pos 5 30), Type1) -- Boatswain
|
||||
, (Range (Pos 25 1) (Pos 25 6), ErrorSite) -- ALONSO
|
||||
, (Range (Pos 12 30) (Pos 13 27), Type2) -- fall ... aground.
|
||||
])
|
||||
|
||||
renderEx2 :: Rendered
|
||||
renderEx2 = renderExcerptWithColor ex2
|
||||
renderEx2 :: Rendered ANSI
|
||||
renderEx2 = renderDocANSI 3 . excerptToDoc $ ex2
|
||||
|
||||
ex3 :: AnnotatedExcerpt Color
|
||||
ex3 :: AnnotatedExcerpt Style
|
||||
ex3 = markup "Hello, world!" $ Set.fromList
|
||||
[ (Range (Pos 1 8) (Pos 1 12), Color1)
|
||||
, (Range (Pos 1 1) (Pos 1 5), Color2) ]
|
||||
[ (Range (Pos 1 8) (Pos 1 12), Type1)
|
||||
, (Range (Pos 1 1) (Pos 1 5), Type2) ]
|
||||
|
||||
ex4 :: AnnotatedExcerpt Color
|
||||
ex4 :: AnnotatedExcerpt Style
|
||||
ex4 = markup "Hello,\nworld!" $ Set.fromList
|
||||
[ (Range (Pos 2 1) (Pos 2 5), Color1)
|
||||
, (Range (Pos 1 1) (Pos 1 5), Color2) ]
|
||||
[ (Range (Pos 2 1) (Pos 2 5), Type1)
|
||||
, (Range (Pos 1 1) (Pos 1 5), Type2) ]
|
||||
|
||||
ex :: Ord a => AnnotatedExcerpt a
|
||||
ex = [r|The Tempest | Act 1, Scene 1
|
||||
|
||||
Loading…
Reference in New Issue
Block a user