unisonweb/unison
1
0
Fork 0
mirror of https://github.com/unisonweb/unison.git synced 2024-10-05 06:07:21 +03:00
Code Issues Projects Releases Wiki Activity

Merge branch 'topic/codebase-editor' of https://github.com/unisonweb/unison into topic/codebase-editor

Browse Source
This commit is contained in:
Paul Chiusano 2018-10-28 11:08:09 -04:00
commit 8e952b9e3e
12 changed files with 256 additions and 324 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
parser-typechecker/bootstrap/Bootstrap.hs
View File

@ -11,7 +11,7 @@ import System.Exit (exitFailure)
import qualified Unison.FileParsers as FileParsers
import qualified Unison.Parser as Parser
import qualified Unison.Parsers as Parsers
import Unison.PrintError (printNoteWithSourceAsAnsi, renderType')
import Unison.PrintError (renderNoteAsANSI, renderType')
import Unison.Result (Result (Result))
import qualified Unison.Result as Result
import Unison.Symbol (Symbol)
@ -38,6 +38,6 @@ main = do
traverse_ (flip BS.writeFile bs) outputFile
showNote :: [Result.Note Symbol Parser.Ann] -> String
showNote notes =
intercalateMap "\n\n" (printNoteWithSourceAsAnsi env0 source) notes
intercalateMap "\n\n" (show . renderNoteAsANSI env0 source) notes
putStrLn . showNote . toList $ notes'
maybe exitFailure f r

17
parser-typechecker/src/Unison/Builtin.hs
View File

@ -7,33 +7,42 @@ module Unison.Builtin where
import Control.Arrow ((&&&), second)
import qualified Data.Map as Map
import qualified Text.Megaparsec.Error as MPE
import qualified Unison.ABT as ABT
import Unison.DataDeclaration (DataDeclaration', EffectDeclaration')
import qualified Unison.DataDeclaration as DD
import qualified Unison.FileParser as FileParser
import Unison.Parser (Ann(..))
import qualified Unison.Parser as Parser
import Unison.PrintError (parseErrorToAnsiString)
import Unison.PrintError (prettyParseError)
import qualified Unison.Reference as R
import qualified Unison.Term as Term
import qualified Unison.TermParser as TermParser
import Unison.Type (AnnotatedType)
import qualified Unison.Type as Type
import qualified Unison.TypeParser as TypeParser
import qualified Unison.Util.ColorText as Color
import Unison.Var (Var)
import qualified Unison.Var as Var
import qualified Unison.Lexer as L
type Term v = Term.AnnotatedTerm v Ann
type Type v = AnnotatedType v Ann
type DataDeclaration v = DataDeclaration' v Ann
type EffectDeclaration v = EffectDeclaration' v Ann
showParseError :: Var v
=> String
-> MPE.ParseError (L.Token L.Lexeme) (Parser.Error v)
-> String
showParseError s = show . Color.renderText . prettyParseError s
-- todo: to update these, just inline definition of Parsers.{unsafeParseType, unsafeParseTerm}
-- then merge Parsers back into Parsers (and GC and unused functions)
-- parse a type, hard-coding the builtins defined in this file
t :: Var v => String -> Type v
t s = ABT.amap (const Intrinsic) .
bindTypeBuiltins . either (error . parseErrorToAnsiString s) tweak $
bindTypeBuiltins . either (error . showParseError s) tweak $
Parser.run (Parser.root TypeParser.valueType) s Parser.penv0
-- lowercase vars become forall'd, and we assume the function is pure up
-- until it returns its result.
@ -41,12 +50,12 @@ t s = ABT.amap (const Intrinsic) .
-- parse a term, hard-coding the builtins defined in this file
tm :: Var v => String -> Term v
tm s = bindBuiltins . either (error . parseErrorToAnsiString s) id $
tm s = bindBuiltins . either (error . showParseError s) id $
Parser.run (Parser.root TermParser.term) s Parser.penv0
parseDataDeclAsBuiltin :: Var v => String -> (v, (R.Reference, DataDeclaration v))
parseDataDeclAsBuiltin s =
let (v, dd) = either (error . parseErrorToAnsiString s) id $
let (v, dd) = either (error . showParseError s) id $
Parser.run (Parser.root FileParser.dataDeclaration) s Parser.penv0
in (v, (R.Builtin . Var.qualifiedName $ v,
const Intrinsic <$>

12
parser-typechecker/src/Unison/Codebase/CommandLine.hs
View File

@ -40,9 +40,9 @@ import Unison.FileParsers (parseAndSynthesizeFile)
import Unison.Parser (PEnv)
import qualified Unison.Parser as Parser
import qualified Unison.PrintError as PrintError
import Unison.PrintError (parseErrorToAnsiString,
import Unison.PrintError (prettyParseError,
prettyTypecheckedFile,
printNoteWithSourceAsAnsi)
renderNoteAsANSI)
import Unison.Result (Result (Result))
import qualified Unison.Result as Result
import qualified Unison.Typechecker.Context as C
@ -131,7 +131,7 @@ main dir currentBranchName initialFile startRuntime toA codebase = do
Console.setTitle "Unison \128721"
forM_ notes $ \case
Result.Parsing err -> do
putStrLn $ parseErrorToAnsiString (unpack src) err
print . Color.renderText $ prettyParseError (unpack src) err
clearLastTypechecked
err ->
error $"I was expecting a parsing error here but got:\n" ++ show err
@ -140,7 +140,7 @@ main dir currentBranchName initialFile startRuntime toA codebase = do
Nothing -> do -- typechecking failed
Console.setTitle "Unison \128721"
let showNote notes = intercalateMap
"\n\n" (printNoteWithSourceAsAnsi errorEnv (unpack src)) (filter notInfo notes)
"\n\n" (show . renderNoteAsANSI errorEnv (unpack src)) (filter notInfo notes)
notInfo (Result.TypeInfo _) = False
notInfo _ = True
putStrLn . showNote . toList $ notes
@ -155,7 +155,7 @@ main dir currentBranchName initialFile startRuntime toA codebase = do
(UF.effectDeclarations unisonFile)
components
writeIORef lastTypechecked (Just filePath, uf, errorEnv)
putStrLn . show . Color.renderDocANSI 6 $
putStrLn . show . Color.renderText $
prettyTypecheckedFile uf errorEnv
putStrLn ""
putStrLn "👀 Now evaluating any watch expressions (lines starting with `>`) ..."
@ -218,7 +218,7 @@ main dir currentBranchName initialFile startRuntime toA codebase = do
let hashedTerms = UF.hashTerms typecheckedFile
putStrLn $ "Adding the following definitions:"
putStrLn ""
putStrLn . show $ Color.renderDocANSI 5 (prettyTypecheckedFile typecheckedFile env)
putStrLn . show $ Color.renderText (prettyTypecheckedFile typecheckedFile env)
putStrLn ""
let allTypeDecls = (second (Left . fmap toA) <$> UF.effectDeclarations' typecheckedFile) `Map.union`
(second (Right . fmap toA) <$> UF.dataDeclarations' typecheckedFile)

9
parser-typechecker/src/Unison/Codebase/Watch.hs
View File

@ -23,14 +23,13 @@ import System.FSNotify (Event (Added, Modified), watchTree,
import qualified Unison.FileParsers as FileParsers
import qualified Unison.Parser as Parser
import qualified Unison.Parsers as Parsers
-- import Unison.Util.AnnotatedText (renderTextUnstyled)
import Control.Exception (finally)
import System.Random (randomIO)
import Unison.Codebase (Codebase)
import Unison.Codebase.Runtime (Runtime (..))
import qualified Unison.Codebase.Runtime as RT
import Unison.PrintError (parseErrorToAnsiString,
printNoteWithSourceAsAnsi)
import Unison.PrintError (renderParseErrorAsANSI,
renderNoteAsANSI)
import Unison.Result (Result (Result))
import Unison.Util.Monoid
import Unison.Util.TQueue (TQueue)
@ -112,12 +111,12 @@ watcher initialFile dir runtime codebase = do
case parseResult of
Left parseError -> do
Console.setTitle "Unison \128721"
putStrLn $ parseErrorToAnsiString source parseError
print $ renderParseErrorAsANSI source parseError
Right (env0, parsedUnisonFile) -> do
let (Result notes' r) =
FileParsers.synthesizeUnisonFile parsedUnisonFile
showNote notes =
intercalateMap "\n\n" (printNoteWithSourceAsAnsi env0 source) notes
intercalateMap "\n\n" (show . renderNoteAsANSI env0 source) notes
putStrLn . showNote . toList $ notes'
case r of
Nothing -> do

6
parser-typechecker/src/Unison/Parsers.hs
View File

@ -7,7 +7,7 @@ import qualified Unison.Builtin as Builtin
import qualified Unison.FileParser as FileParser
import Unison.Parser (PEnv, Ann)
import qualified Unison.Parser as Parser
import Unison.PrintError (parseErrorToAnsiString)
import Unison.PrintError (prettyParseError)
import qualified Unison.PrintError as PrintError
import Unison.Symbol (Symbol)
import Unison.Term (AnnotatedTerm)
@ -15,10 +15,12 @@ import qualified Unison.TermParser as TermParser
import Unison.Type (AnnotatedType)
import qualified Unison.TypeParser as TypeParser
import Unison.UnisonFile (UnisonFile)
import qualified Unison.Util.ColorText as Color
import Unison.Var (Var)
unsafeGetRightFrom :: (Var v, Show v) => String -> Either (Parser.Err v) a -> a
unsafeGetRightFrom src = either (error . parseErrorToAnsiString src) id
unsafeGetRightFrom src =
either (error . show . Color.renderText . prettyParseError src) id
parse :: Var v => Parser.P v a -> String -> PEnv v -> Either (Parser.Err v) a
parse p s env = Parser.run (Parser.root p) s env

209
parser-typechecker/src/Unison/PrintError.hs
View File

@ -13,58 +13,48 @@ module Unison.PrintError where
-- import Unison.Parser (showLineCol)
-- import Unison.Util.Monoid (whenM)
import Control.Monad (join)
import Control.Lens ( (%~) )
import Control.Lens.Tuple ( _1
, _2
, _3
)
import qualified Data.Char as Char
import Control.Lens ((%~))
import Control.Lens.Tuple (_1, _2, _3)
import Control.Monad (join)
import qualified Data.Char as Char
import Data.Foldable
import Data.List ( intersperse, sortOn )
import qualified Data.List.NonEmpty as Nel
import Data.Map ( Map )
import qualified Data.Map as Map
import Data.Maybe ( catMaybes
, fromMaybe
)
import Data.Sequence ( Seq(..) )
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import Data.String ( IsString
, fromString
)
import qualified Data.Text as Text
import Data.Text ( Text )
import Data.Void ( Void )
import Data.List (intersperse, sortOn)
import qualified Data.List.NonEmpty as Nel
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (catMaybes, fromMaybe)
import Data.Sequence (Seq (..))
import qualified Data.Set as Set
import Data.String (IsString, fromString)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Void (Void)
import Debug.Trace
import qualified Text.Megaparsec as P
import qualified Unison.ABT as ABT
import Unison.Kind ( Kind )
import qualified Unison.Kind as Kind
import qualified Unison.Lexer as L
import Unison.Parser ( Ann(..)
, Annotated
, ann
)
import qualified Unison.Parser as Parser
import qualified Unison.Reference as R
import Unison.Result ( Note(..) )
import qualified Unison.Settings as Settings
import qualified Unison.Type as Type
import qualified Unison.Term as Term
import qualified Unison.TypeVar as TypeVar
import qualified Unison.Typechecker.Context as C
import qualified Text.Megaparsec as P
import qualified Unison.ABT as ABT
import qualified Unison.DataDeclaration as DD
import Unison.Kind (Kind)
import qualified Unison.Kind as Kind
import qualified Unison.Lexer as L
import Unison.Parser (Ann (..), Annotated, ann)
import qualified Unison.Parser as Parser
import qualified Unison.Reference as R
import Unison.Result (Note (..))
import qualified Unison.Settings as Settings
import qualified Unison.Term as Term
import qualified Unison.Type as Type
import qualified Unison.Typechecker.Context as C
import Unison.Typechecker.TypeError
import qualified Unison.Util.AnnotatedText as AT
import Unison.Util.ColorText ( Color, StyledText )
import qualified Unison.Util.ColorText as Color
import Unison.Util.Monoid ( intercalateMap )
import Unison.Util.Range ( Range(..) )
import Unison.Var ( Var )
import qualified Unison.Var as Var
import qualified Unison.UnisonFile as UF
import qualified Unison.DataDeclaration as DD
import qualified Unison.TypeVar as TypeVar
import qualified Unison.UnisonFile as UF
import Unison.Util.AnnotatedText (AnnotatedText)
import qualified Unison.Util.AnnotatedText as AT
import Unison.Util.ColorText (ANSI, Color, Rendered)
import qualified Unison.Util.ColorText as Color
import Unison.Util.Monoid (intercalateMap)
import Unison.Util.Range (Range (..))
import Unison.Var (Var)
import qualified Unison.Var as Var
data Env = Env { referenceNames :: Map R.Reference String
, constructorNames :: Map (R.Reference, Int) String }
@ -91,12 +81,12 @@ fromOverHere'
=> String
-> [Maybe (Range, a)]
-> [Maybe (Range, a)]
-> AT.AnnotatedDocument a
-> AnnotatedText a
fromOverHere' s spots0 removing =
fromOverHere s (catMaybes spots0) (catMaybes removing)
fromOverHere
:: Ord a => String -> [(Range, a)] -> [(Range, a)] -> AT.AnnotatedDocument a
:: Ord a => String -> [(Range, a)] -> [(Range, a)] -> AnnotatedText a
fromOverHere src spots0 removing =
let spots = toList $ Set.fromList spots0 Set.\\ Set.fromList removing
in case length spots of
@ -110,7 +100,7 @@ showTypeWithProvenance
-> String
-> style
-> Type.AnnotatedType v a
-> AT.AnnotatedDocument style
-> AnnotatedText style
showTypeWithProvenance env src color typ =
style color (renderType' env typ)
<> ".\n"
@ -119,22 +109,22 @@ showTypeWithProvenance env src color typ =
styleAnnotated :: Annotated a => sty -> a -> Maybe (Range, sty)
styleAnnotated sty a = (, sty) <$> rangeForAnnotated a
style :: s -> String -> AT.AnnotatedDocument s
style sty str = AT.pairToDoc' (str, sty)
style :: s -> String -> AnnotatedText s
style sty str = AT.annotate sty str
describeStyle :: Color -> AT.AnnotatedDocument Color
describeStyle :: Color -> AnnotatedText Color
describeStyle ErrorSite = "in " <> style ErrorSite "red"
describeStyle Type1 = "in " <> style Type1 "blue"
describeStyle Type2 = "in " <> style Type2 "green"
describeStyle _ = ""
describeStyle Type1 = "in " <> style Type1 "blue"
describeStyle Type2 = "in " <> style Type2 "green"
describeStyle _ = ""
prettyTypecheckedFile'
:: forall v loc
. (Var v, Annotated loc, Ord loc, Show loc)
=> UF.TypecheckedUnisonFile v loc
-> Env
-> ([(v, AT.AnnotatedDocument Color)], -- types
[(v, AT.AnnotatedDocument Color)]) -- terms
-> ([(v, AnnotatedText Color)], -- types
[(v, AnnotatedText Color)]) -- terms
prettyTypecheckedFile' file env = (sortOn fst types, sortOn fst terms)
where
dot = " "
@ -143,22 +133,22 @@ prettyTypecheckedFile' file env = (sortOn fst types, sortOn fst terms)
types = (renderDecl (dot <> style TypeKeyword "type ") <$> Map.toList (UF.dataDeclarations' file))
<> (renderEffect dot <$> Map.toList (UF.effectDeclarations' file))
renderVar :: Var v => v -> AT.AnnotatedDocument Color
renderVar :: Var v => v -> AnnotatedText Color
renderVar v = style Identifier . fromString . Text.unpack $ Var.name v
renderTerm :: AT.AnnotatedDocument Color -> (v, Term.AnnotatedTerm v loc, Type.AnnotatedType v loc) -> (v, AT.AnnotatedDocument Color)
renderTerm :: AnnotatedText Color -> (v, Term.AnnotatedTerm v loc, Type.AnnotatedType v loc) -> (v, AnnotatedText Color)
renderTerm s (v, _, typ) =
(v, mconcat [s, renderVar v, " : ", renderType' env typ])
renderDecl :: AT.AnnotatedDocument Color -> (v, (r, DD.DataDeclaration' v loc)) -> (v, AT.AnnotatedDocument Color)
renderDecl :: AnnotatedText Color -> (v, (r, DD.DataDeclaration' v loc)) -> (v, AnnotatedText Color)
renderDecl s (v, (_, decl)) = (v, mconcat
[s, renderVar v, intercalateMap " " renderVar $ DD.bound decl])
renderEffect :: AT.AnnotatedDocument Color -> (v, (r, DD.EffectDeclaration' v loc)) -> (v, AT.AnnotatedDocument Color)
renderEffect :: AnnotatedText Color -> (v, (r, DD.EffectDeclaration' v loc)) -> (v, AnnotatedText Color)
renderEffect s (v, (r, decl)) = renderDecl (s <> style AbilityKeyword "ability ") (v, (r, DD.toDataDecl decl))
prettyTypecheckedFile
:: forall v loc
. (Var v, Annotated loc, Ord loc, Show loc)
=> UF.TypecheckedUnisonFile v loc -> Env -> AT.AnnotatedDocument Color
=> UF.TypecheckedUnisonFile v loc -> Env -> AnnotatedText Color
prettyTypecheckedFile file env = let
(types, terms) = prettyTypecheckedFile' file env
sep n = if not (null n) then "\n" else ""
@ -171,7 +161,7 @@ renderTypeInfo
. (Var v, Annotated loc, Ord loc, Show loc)
=> TypeInfo v loc
-> Env
-> AT.AnnotatedDocument sty
-> AnnotatedText sty
renderTypeInfo i env = case i of
TopLevelComponent {..} ->
let defs =
@ -197,7 +187,7 @@ renderTypeError
=> TypeError v loc
-> Env
-> String
-> AT.AnnotatedDocument Color
-> AnnotatedText Color
renderTypeError e env src = case e of
BooleanMismatch {..} -> mconcat
[ preamble
@ -309,8 +299,7 @@ renderTypeError e env src = case e of
, ", but I was expecting "
, style Type1 (renderType' env expectedType)
, ":\n\n"
, showSourceMaybes
src
, showSourceMaybes src
[ (, Type1) <$> rangeForAnnotated expectedType
, (, Type2) <$> rangeForAnnotated foundType
, (, Type2) <$> rangeForAnnotated arg
@ -336,7 +325,7 @@ renderTypeError e env src = case e of
, case solvedVars' of
_ : _ ->
let
go :: (v, C.Type v loc) -> AT.AnnotatedDocument Color
go :: (v, C.Type v loc) -> AnnotatedText Color
go (v, t) = mconcat
[ " "
, renderVar v
@ -551,7 +540,7 @@ renderTypeError e env src = case e of
, pl "this" "one of these"
, ":\n\n"
]
formatSuggestion :: (Text, C.Type v loc) -> AT.AnnotatedDocument Color
formatSuggestion :: (Text, C.Type v loc) -> AnnotatedText Color
formatSuggestion (name, typ) =
" - " <> fromString (Text.unpack name) <> " : " <> renderType' env typ
formatWrongs txt wrongs =
@ -565,10 +554,10 @@ renderTypeError e env src = case e of
'3' -> "rd"
_ -> "th"
debugNoteLoc a = if Settings.debugNoteLoc then a else mempty
debugSummary :: C.ErrorNote v loc -> AT.AnnotatedDocument Color
debugSummary :: C.ErrorNote v loc -> AnnotatedText Color
debugSummary note =
if Settings.debugNoteSummary then summary note else mempty
summary :: C.ErrorNote v loc -> AT.AnnotatedDocument Color
summary :: C.ErrorNote v loc -> AnnotatedText Color
summary note = mconcat
[ "\n"
, " simple cause:\n"
@ -579,9 +568,9 @@ renderTypeError e env src = case e of
[] -> " path: (empty)\n"
l -> " path:\n" <> mconcat (simplePath <$> l)
]
simplePath :: C.PathElement v loc -> AT.AnnotatedDocument Color
simplePath :: C.PathElement v loc -> AnnotatedText Color
simplePath e = " " <> simplePath' e <> "\n"
simplePath' :: C.PathElement v loc -> AT.AnnotatedDocument Color
simplePath' :: C.PathElement v loc -> AnnotatedText Color
simplePath' = \case
C.InSynthesize e -> "InSynthesize e=" <> renderTerm e
C.InSubtype t1 t2 ->
@ -618,7 +607,7 @@ renderTypeError e env src = case e of
C.InMatch loc -> "InMatch firstBody=" <> annotatedToEnglish loc
C.InMatchGuard -> "InMatchGuard"
C.InMatchBody -> "InMatchBody"
simpleCause :: C.Cause v loc -> AT.AnnotatedDocument Color
simpleCause :: C.Cause v loc -> AnnotatedText Color
simpleCause = \case
C.TypeMismatch c ->
mconcat ["TypeMismatch\n", " context:\n", renderContext env c]
@ -685,7 +674,7 @@ renderTypeError e env src = case e of
, "\n"
]
C.DuplicateDefinitions vs ->
let go :: (v, [loc]) -> AT.AnnotatedDocument a
let go :: (v, [loc]) -> AnnotatedText a
go (v, locs) =
"["
<> renderVar v
@ -694,7 +683,7 @@ renderTypeError e env src = case e of
in "DuplicateDefinitions:" <> mconcat (go <$> Nel.toList vs)
renderContext
:: (Var v, Ord loc) => Env -> C.Context v loc -> AT.AnnotatedDocument a
:: (Var v, Ord loc) => Env -> C.Context v loc -> AnnotatedText a
renderContext env ctx@(C.Context es) = " Γ\n "
<> intercalateMap "\n " (showElem ctx . fst) (reverse es)
where
@ -704,7 +693,7 @@ renderContext env ctx@(C.Context es) = " Γ\n "
:: (Var v, Ord loc)
=> C.Context v loc
-> C.Element v loc
-> AT.AnnotatedDocument a
-> AnnotatedText a
showElem _ctx (C.Var v) = case v of
TypeVar.Universal x -> "@" <> renderVar x
TypeVar.Existential _ x -> "'" <> renderVar x
@ -727,7 +716,7 @@ renderTerm e =
-- | renders a type with no special styling
renderType' :: (IsString s, Var v) => Env -> Type.AnnotatedType v loc -> s
renderType' env typ =
let AT.AnnotatedText seq = renderType env (const id) typ
let AT.AnnotatedText' seq = renderType env (const id) typ
in fromString . fold . fmap fst $ seq
-- | `f` may do some styling based on `loc`.
@ -735,9 +724,9 @@ renderType' env typ =
renderType
:: Var v
=> Env
-> (loc -> AT.AnnotatedText (Maybe a) -> AT.AnnotatedText (Maybe a))
-> (loc -> AnnotatedText a -> AnnotatedText a)
-> Type.AnnotatedType v loc
-> AT.AnnotatedText (Maybe a)
-> AnnotatedText a
renderType env f t = renderType0 env f (0 :: Int) (Type.ungeneralizeEffects t)
where
paren :: (IsString a, Semigroup a) => Bool -> a -> a
@ -794,7 +783,7 @@ renderVar' env ctx v = case C.lookupSolved ctx v of
Nothing -> "unsolved"
Just t -> renderType' env $ Type.getPolytype t
renderKind :: Kind -> AT.AnnotatedText (Maybe a)
renderKind :: Kind -> AnnotatedText a
renderKind Kind.Star = "*"
renderKind (Kind.Arrow k1 k2) = renderKind k1 <> " -> " <> renderKind k2
@ -814,7 +803,7 @@ styleInOverallType
-> C.Type v a
-> C.Type v a
-> Color
-> StyledText
-> AnnotatedText Color
styleInOverallType e overallType leafType c = renderType e f overallType
where f loc s = if loc == ABT.annotation leafType then Color.style c s else s
@ -865,17 +854,19 @@ rangeForAnnotated a = case ann a of
showLexerOutput :: Bool
showLexerOutput = False
printNoteWithSourceAsAnsi
:: (Var v, Annotated a, Show a, Ord a) => Env -> String -> Note v a -> String
printNoteWithSourceAsAnsi e s n =
show . Color.renderDocANSI 6 $ printNoteWithSource e s n
renderNoteAsANSI :: (Var v, Annotated a, Show a, Ord a)
=> Env -> String -> Note v a -> Rendered ANSI
renderNoteAsANSI e s n = Color.renderText $ printNoteWithSource e s n
renderParseErrorAsANSI :: Var v => String -> Parser.Err v -> Rendered ANSI
renderParseErrorAsANSI src = Color.renderText . prettyParseError src
printNoteWithSource
:: (Var v, Annotated a, Show a, Ord a)
=> Env
-> String
-> Note v a
-> AT.AnnotatedDocument Color
-> AnnotatedText Color
printNoteWithSource env _s (TypeInfo n) = prettyTypeInfo n env
printNoteWithSource _env s (Parsing e) = prettyParseError s e
printNoteWithSource env s (TypeError e) = prettyTypecheckError e env s
@ -904,7 +895,7 @@ prettyParseError
. Var v
=> String
-> Parser.Err v
-> AT.AnnotatedDocument Color
-> AnnotatedText Color
prettyParseError s = \case
P.TrivialError sp unexpected expected
-> fromString
@ -920,13 +911,10 @@ prettyParseError s = \case
P.FancyError sp fancyErrors ->
mconcat (go' <$> Set.toList fancyErrors) <> dumpSourcePos sp <> lexerOutput
where
dumpSourcePos :: Nel.NonEmpty P.SourcePos -> AT.AnnotatedDocument a
dumpSourcePos :: Nel.NonEmpty P.SourcePos -> AnnotatedText a
dumpSourcePos sp =
AT.AnnotatedDocument
. Seq.fromList
. Nel.toList
$ (fromString . (\s -> " " ++ show s ++ "\n") <$> sp)
go' :: P.ErrorFancy (Parser.Error v) -> AT.AnnotatedDocument Color
(mconcat . toList) (fromString . (\s -> " " ++ show s ++ "\n") <$> sp)
go' :: P.ErrorFancy (Parser.Error v) -> AnnotatedText Color
go' (P.ErrorFail s) =
"The parser failed with this message:\n" <> fromString s
go' (P.ErrorIndentation ordering indent1 indent2) = mconcat
@ -940,7 +928,7 @@ prettyParseError s = \case
, ").\n"
]
go' (P.ErrorCustom e) = go e
go :: Parser.Error v -> AT.AnnotatedDocument Color
go :: Parser.Error v -> AnnotatedText Color
go (Parser.SignatureNeedsAccompanyingBody tok) = mconcat
[ "You provided a type signature, but I didn't find an accompanying\n"
, "binding after it. Could it be a spelling mismatch?\n"
@ -965,7 +953,7 @@ prettyParseError s = \case
go (Parser.UnknownEffectConstructor tok) = unknownConstructor "effect" tok
go (Parser.UnknownDataConstructor tok) = unknownConstructor "data" tok
unknownConstructor
:: String -> L.Token String -> AT.AnnotatedDocument Color
:: String -> L.Token String -> AnnotatedText Color
unknownConstructor ctorType tok = mconcat
[ "I don't know about any "
, fromString ctorType
@ -975,32 +963,33 @@ prettyParseError s = \case
, "Maybe make sure it's correctly spelled and that you've imported it:\n"
, tokenAsErrorSite s tok
]
lexerOutput :: AT.AnnotatedDocument a
lexerOutput :: AnnotatedText a
lexerOutput = if showLexerOutput
then "\nLexer output:\n" <> fromString (L.debugLex' s)
else mempty
annotatedAsErrorSite
:: Annotated a => String -> a -> AT.AnnotatedDocument Color
:: Annotated a => String -> a -> AnnotatedText Color
annotatedAsErrorSite = annotatedAsStyle ErrorSite
annotatedAsStyle
:: (Ord s, Annotated a) => s -> String -> a -> AT.AnnotatedDocument s
:: (Ord s, Annotated a) => s -> String -> a -> AnnotatedText s
annotatedAsStyle style s ann =
showSourceMaybes s [(, style) <$> rangeForAnnotated ann]
tokenAsErrorSite :: String -> L.Token a -> AT.AnnotatedDocument Color
tokenAsErrorSite :: String -> L.Token a -> AnnotatedText Color
tokenAsErrorSite src tok = showSource1 src (rangeForToken tok, ErrorSite)
showSourceMaybes
:: Ord a => String -> [Maybe (Range, a)] -> AT.AnnotatedDocument a
:: Ord a => String -> [Maybe (Range, a)] -> AnnotatedText a
showSourceMaybes src annotations = showSource src $ catMaybes annotations
showSource :: Ord a => String -> [(Range, a)] -> AT.AnnotatedDocument a
showSource :: Ord a => String -> [(Range, a)] -> AnnotatedText a
showSource src annotations =
AT.excerptToDoc $ AT.markup (fromString src) (Map.fromList annotations)
AT.condensedExcerptToText 6 $
AT.markup (fromString src) (Map.fromList annotations)
showSource1 :: Ord a => String -> (Range, a) -> AT.AnnotatedDocument a
showSource1 :: Ord a => String -> (Range, a) -> AnnotatedText a
showSource1 src annotation = showSource src [annotation]
findTerm :: Seq (C.PathElement v loc) -> Maybe loc
@ -1017,17 +1006,13 @@ prettyTypecheckError
=> C.ErrorNote v loc
-> Env
-> String
-> AT.AnnotatedDocument Color
-> AnnotatedText Color
prettyTypecheckError = renderTypeError . typeErrorFromNote
prettyTypeInfo
:: (Var v, Ord loc, Show loc, Parser.Annotated loc)
=> C.InfoNote v loc
-> Env
-> AT.AnnotatedDocument Color
-> AnnotatedText Color
prettyTypeInfo n e =
fromMaybe "" $ flip renderTypeInfo e <$> typeInfoFromNote n
parseErrorToAnsiString :: Var v => String -> Parser.Err v -> String
parseErrorToAnsiString src =
show . Color.renderDocANSI 3 . prettyParseError src

129
parser-typechecker/src/Unison/Util/AnnotatedText.hs
View File

@ -4,96 +4,107 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}
module Unison.Util.AnnotatedText where
import Data.Foldable (asum, foldl')
import Data.Foldable (foldl')
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Sequence (Seq ((:|>)))
import qualified Data.Sequence as Seq
import Data.String (IsString (..))
import Data.Void (Void)
import Safe (lastMay)
import Safe (headMay, lastMay)
import Unison.Lexer (Line, Pos (..))
import Unison.Util.Monoid (intercalateMap)
import Unison.Util.Range (Range (..))
import Unison.Util.Range (Range (..), inRange)
newtype AnnotatedDocument a = AnnotatedDocument (Seq (Section a))
deriving (Functor, Semigroup, Monoid)
type AnnotatedText a = AnnotatedText' (Maybe a)
-- Prose with subsequences that may have an annotation.
-- A textual reference to an annotation style.
-- Quoted text (indented, with source line numbers) with annotated portions.
-- The reason the current API deals with a bunch of different types instead of
-- a single one is because not all of the combinators make sense on all of the
-- types.
-- Question: Should every bit of text be forced to have an annotation?
-- Answer: No. That doesn't make sense for the Excerpt text — especially
-- in the context of multiple rendering options.
data Section a
= Text (AnnotatedText (Maybe a))
-- | NoBreak (AnnotatedText (Maybe a))
| Blockquote (AnnotatedExcerpt a)
deriving (Functor)
newtype AnnotatedText a = AnnotatedText (Seq (String, a))
newtype AnnotatedText' a = AnnotatedText' (Seq (String, a))
deriving (Functor, Foldable, Semigroup, Monoid)
-- Quoted text (indented, with source line numbers) with annotated portions.
data AnnotatedExcerpt a = AnnotatedExcerpt
{ lineOffset :: Line
, text :: String
, annotations :: Map Range a
} deriving (Functor)
newtype Rendered a = Rendered { rawRender :: Seq String }
deriving (Semigroup, Monoid)
annotate :: a -> String -> AnnotatedText a
annotate a str = AnnotatedText' . Seq.singleton $ (str, Just a)
sectionToDoc :: Section a -> AnnotatedDocument a
sectionToDoc = AnnotatedDocument . pure
annotate' :: a -> String -> AnnotatedText' a
annotate' a str = AnnotatedText' . Seq.singleton $ (str, a)
pairToDoc :: (String, Maybe a) -> AnnotatedDocument a
pairToDoc (str, a) = textToDoc . AnnotatedText . Seq.singleton $ (str, a)
deannotate :: AnnotatedText a -> AnnotatedText b
deannotate t = const Nothing <$> t
pairToDoc' :: (String, a) -> AnnotatedDocument a
pairToDoc' (str, a) = pairToDoc (str, Just a)
reannotate :: a -> AnnotatedText a -> AnnotatedText a
reannotate a t = fmap (const a) <$> t
textToDoc :: AnnotatedText (Maybe a) -> AnnotatedDocument a
textToDoc = AnnotatedDocument . pure . Text
excerptToDoc :: AnnotatedExcerpt a -> AnnotatedDocument a
excerptToDoc = AnnotatedDocument . pure . Blockquote
reannotate' :: a -> AnnotatedText' a -> AnnotatedText' a
reannotate' a t = const a <$> t
trailingNewLine :: AnnotatedText a -> Bool
trailingNewLine (AnnotatedText (init :|> (s,_))) =
trailingNewLine (AnnotatedText' (init :|> (s,_))) =
case lastMay s of
Just '\n' -> True
Just _ -> False
_ -> trailingNewLine (AnnotatedText init)
_ -> trailingNewLine (AnnotatedText' init)
trailingNewLine _ = False
markup :: AnnotatedExcerpt a -> Map Range a -> AnnotatedExcerpt a
markup a r = a { annotations = r `Map.union` annotations a }
renderTextUnstyled :: AnnotatedText a -> Rendered Void
renderTextUnstyled (AnnotatedText chunks) = foldl' go mempty chunks
where go r (text, _) = r <> fromString text
-- renderTextUnstyled :: AnnotatedText' a -> Rendered Void
-- renderTextUnstyled (AnnotatedText' chunks) = foldl' go mempty chunks
-- where go r (text, _) = r <> fromString text
textLength :: AnnotatedText a -> Int
textLength = length . show . renderTextUnstyled
textLength :: AnnotatedText' a -> Int
textLength (AnnotatedText' chunks) = foldl' go 0 chunks
where go len (text, _a) = len + length text
textEmpty :: AnnotatedText a -> Bool
textEmpty :: AnnotatedText' a -> Bool
textEmpty = (==0) . textLength
splitAndRender :: Int
-> (AnnotatedExcerpt a -> Rendered b)
-> AnnotatedExcerpt a -> Rendered b
splitAndRender n f e = intercalateMap " .\n" f $ snipWithContext n e
condensedExcerptToText :: Int -> AnnotatedExcerpt a -> AnnotatedText a
condensedExcerptToText margin e =
intercalateMap " .\n" excerptToText $ snipWithContext margin e
excerptToText :: forall a. AnnotatedExcerpt a -> AnnotatedText a
excerptToText e =
track (Pos line1 1) [] (Map.toList $ annotations e) (renderLineNumber line1) (text e)
where
line1 :: Int
line1 = lineOffset e
renderLineNumber :: Int -> AnnotatedText a
renderLineNumber n = fromString $ " " ++ spaces ++ sn ++ " | "
where sn = show n
spaces = replicate (lineNumberWidth - length sn) ' '
lineNumberWidth = 4
-- step through the source characters and annotations
track _ _ _ rendered "" = rendered
track _ _ _ rendered "\n" = rendered <> "\n"
track pos@(Pos line col) stack annotations rendered _input@(c:rest) =
let
(poppedAnnotations, remainingAnnotations) = span (inRange pos . fst) annotations
-- drop any stack entries that will be closed after this char
-- and add new stack entries
stack' = foldl' pushColor stack0 poppedAnnotations
where pushColor s (Range _ end, style) = (style, end) : s
stack0 = dropWhile ((<=pos) . snd) stack
maybeColor = fst <$> headMay stack'
-- on new line, advance pos' vertically and set up line header
-- additions :: AnnotatedText (Maybe a)
pos' :: Pos
(additions, pos') =
if c == '\n'
then ("\n" <> renderLineNumber (line + 1), Pos (line + 1) 1)
else (annotate' maybeColor [c], Pos line (col + 1))
in track pos' stack' remainingAnnotations (rendered <> additions) rest
-- | drops lines and replaces with "." if there are more than `n` unannotated
-- | lines in a row.
snipWithContext :: Int -> AnnotatedExcerpt a -> [AnnotatedExcerpt a]
snipWithContext margin source =
case foldl' whileWithinMargin
@ -133,20 +144,8 @@ snipWithContext margin source =
-- once we've added to the second set, anything more goes there too
else (Just r0, taken, Map.insert r1 a1 rest)
instance IsString (AnnotatedDocument a) where
fromString = AnnotatedDocument . pure . fromString
instance IsString (Section a) where
fromString = Text . fromString
instance IsString (AnnotatedText (Maybe a)) where
fromString s = AnnotatedText . pure $ (s, Nothing)
instance IsString (AnnotatedText a) where
fromString s = AnnotatedText' . pure $ (s, Nothing)
instance IsString (AnnotatedExcerpt a) where
fromString s = AnnotatedExcerpt 1 s mempty
instance Show (Rendered a) where
show (Rendered chunks) = asum chunks
instance IsString (Rendered a) where
fromString s = Rendered (pure s)

167
parser-typechecker/src/Unison/Util/ColorText.hs
View File

@ -1,30 +1,23 @@
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
module Unison.Util.ColorText
(ANSI, StyledText, Color (..), style,
renderDocANSI, renderText)
module Unison.Util.ColorText (ANSI, Color (..), ColorText, Rendered, style, renderText)
where
import Data.Foldable (foldl', toList)
import qualified Data.Map as Map
import Data.String (IsString (..))
import Safe (headMay)
import qualified System.Console.ANSI as ANSI
import Unison.Lexer (Pos (..))
import Unison.Util.AnnotatedText (AnnotatedDocument (..),
AnnotatedExcerpt,
AnnotatedText (..), Rendered (..),
Section (..), annotations,
lineOffset, splitAndRender, text,
trailingNewLine)
import Unison.Util.Range (Range (..), inRange)
import Data.Foldable (asum, foldl')
import Data.Sequence (Seq)
import Data.String (IsString (..))
import qualified System.Console.ANSI as ANSI
import Unison.Util.AnnotatedText (AnnotatedText,
pattern AnnotatedText', reannotate)
type ColorText = AnnotatedText Color
data ANSI
type StyledText = AnnotatedText (Maybe Color)
type StyledBlockquote = AnnotatedExcerpt Color
data Color
= Black | Red | Green | Yellow | Blue | Purple | Cyan | White
@ -32,101 +25,47 @@ data Color
| Bold
deriving (Eq, Ord, Bounded, Enum, Show, Read)
_unhighlighted :: StyledText -> StyledText
_unhighlighted s = const Nothing <$> s
style :: Color -> ColorText -> ColorText
style = reannotate
style :: a -> AnnotatedText (Maybe a) -> AnnotatedText (Maybe a)
style c s = const (Just c) <$> s
renderText :: ColorText -> Rendered ANSI
renderText (AnnotatedText' chunks) =
(snd $ foldl' go (Nothing, mempty) chunks) <> resetANSI
where go :: (Maybe Color, Rendered ANSI) -> (String, Maybe Color) -> (Maybe Color, Rendered ANSI)
go (prev, r) (text, new) =
if prev == new then (prev, r <> fromString text)
else (new, case new of
Nothing -> r <> resetANSI <> fromString text
Just style -> r <> resetANSI <> toANSI style <> fromString text)
toANSI :: Color -> Rendered ANSI
toANSI c = Rendered . pure . ANSI.setSGRCode $ case c of
Black -> [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Black]
Red -> [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Red]
Green -> [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Green]
Yellow -> [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Yellow]
Blue -> [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Blue]
Purple -> [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Magenta]
Cyan -> [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Cyan]
White -> [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.White]
HiBlack -> [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Black]
HiRed -> [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Red]
HiGreen -> [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Green]
HiYellow -> [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Yellow]
HiBlue -> [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Blue]
HiPurple -> [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Magenta]
HiCyan -> [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Cyan]
HiWhite -> [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.White]
Bold -> [ANSI.SetConsoleIntensity ANSI.BoldIntensity]
resetANSI :: Rendered ANSI
resetANSI = Rendered . pure . ANSI.setSGRCode $ [ANSI.Reset]
toANSI :: Color -> Rendered ANSI
toANSI c = Rendered . pure . ANSI.setSGRCode $ case c of
Black -> [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Black]
Red -> [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Red]
Green -> [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Green]
Yellow -> [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Yellow]
Blue -> [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Blue]
Purple -> [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Magenta]
Cyan -> [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Cyan]
White -> [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.White]
HiBlack -> [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Black]
HiRed -> [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Red]
HiGreen -> [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Green]
HiYellow -> [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Yellow]
HiBlue -> [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Blue]
HiPurple -> [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Magenta]
HiCyan -> [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Cyan]
HiWhite -> [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.White]
Bold -> [ANSI.SetConsoleIntensity ANSI.BoldIntensity]
newtype Rendered a = Rendered { _rawRender :: Seq String }
deriving (Semigroup, Monoid)
resetANSI :: Rendered ANSI
resetANSI = Rendered . pure . ANSI.setSGRCode $ [ANSI.Reset]
instance Show (Rendered a) where
show (Rendered chunks) = asum chunks
renderText :: StyledText -> Rendered ANSI
renderText (AnnotatedText chunks) =
foldl' (go Nothing) mempty chunks <> resetANSI
where go :: Maybe Color -> Rendered ANSI -> (String, Maybe Color) -> Rendered ANSI
go prev r (text, new) =
if prev == new then r <> fromString text
else case new of
Nothing -> r <> resetANSI <> fromString text
Just style -> r <> resetANSI <> toANSI style <> fromString text
renderDocANSI :: Int -> AnnotatedDocument Color -> Rendered ANSI
renderDocANSI excerptCollapseWidth (AnnotatedDocument chunks) =
go $ toList chunks
where
go [] = mempty
go (Blockquote exc : rest) =
splitAndRender excerptCollapseWidth renderExcerpt exc <> go rest
-- go (Describe style : rest) = go (Text (describe style) : rest)
go (Text t : rest@(Blockquote _ : _)) =
renderText t
<> (if trailingNewLine t then mempty else "\n")
<> go rest
go (Text t : rest) = renderText t <> go rest
renderExcerpt :: StyledBlockquote -> Rendered ANSI
renderExcerpt e =
track (Pos line1 1) [] (Map.toList $ annotations e)
(Rendered . pure $ renderLineNumber line1) (text e)
where
line1 :: Int
line1 = lineOffset e
renderLineNumber n =
" " ++ replicate (lineNumberWidth - length sn) ' ' ++ sn ++ " | "
where sn = show n
lineNumberWidth = 4
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))
track :: Pos -> [(Color, Pos)] -> [(Range, Color)] -> 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 <> resetColor <> newChar ) rest
instance IsString (Rendered ANSI) where
fromString s = Rendered (pure s)

6
parser-typechecker/src/Unison/Util/Menu.hs
View File

@ -15,12 +15,12 @@ import Data.Strings (strPadLeft)
import Safe (atMay)
import qualified Text.Read as Read
import Unison.Util.AnnotatedText (textEmpty)
import Unison.Util.ColorText (StyledText, renderText)
import Unison.Util.ColorText (ColorText, renderText)
import Unison.Util.Monoid (intercalateMap)
-- utility - command line menus
type Caption = StyledText
type Stylized = StyledText
type Caption = ColorText
type Stylized = ColorText
type Keyword = String
type Console = IO String

13
parser-typechecker/tests/Unison/Test/ColorText.hs
View File

@ -7,9 +7,9 @@ import qualified Data.Map as Map
import EasyTest
import Text.RawString.QQ
import Unison.Lexer (Pos (..))
import Unison.Util.AnnotatedText (AnnotatedExcerpt (..), Rendered,
excerptToDoc, markup, textToDoc)
import Unison.Util.ColorText (ANSI, Color (..), renderDocANSI)
import Unison.Util.AnnotatedText (AnnotatedExcerpt (..),
condensedExcerptToText, markup)
import Unison.Util.ColorText (ANSI, Color (..), Rendered, renderText)
import qualified Unison.Util.ColorText as ColorText
import Unison.Util.Range (Range (..))
@ -20,12 +20,11 @@ test = scope "colortext" . tests $ [
]
ex4e :: Rendered ANSI
ex4e = renderDocANSI 1 . excerptToDoc $ markup "abc" m
ex4e = renderText . condensedExcerptToText 1 $ markup "abc" m
where m = Map.singleton (Range (Pos 1 2) (Pos 1 3)) Red
ex4t :: Rendered ANSI
ex4t = renderDocANSI 1 . textToDoc $
" 1 | " <> "a" <> ColorText.style Red "b" <> "c" <> "\n"
ex4t = renderText $ " 1 | " <> "a" <> ColorText.style Red "b" <> "c" <> "\n"
ex2 :: AnnotatedExcerpt Color
@ -38,7 +37,7 @@ ex2 = markup ex (Map.fromList
])
renderEx2 :: Rendered ANSI
renderEx2 = renderDocANSI 3 . excerptToDoc $ ex2
renderEx2 = renderText . condensedExcerptToText 3 $ ex2
ex3 :: AnnotatedExcerpt Color
ex3 = markup "Hello, world!" $ Map.fromList

6
parser-typechecker/tests/Unison/Test/TermParser.hs
View File

@ -12,7 +12,7 @@ import qualified Text.Megaparsec as P
import Text.RawString.QQ
import Unison.Parser
import qualified Unison.Parsers as Ps
import Unison.PrintError (parseErrorToAnsiString)
import Unison.PrintError (renderParseErrorAsANSI)
import qualified Unison.Reference as R
import Unison.Symbol (Symbol)
import qualified Unison.TermParser as TP
@ -189,6 +189,6 @@ parseWith :: P Symbol a -> String -> Test ()
parseWith p s = scope (join . take 1 $ lines s) $
case Ps.parse @ Symbol p s builtins of
Left e -> do
note $ parseErrorToAnsiString s e
crash $ parseErrorToAnsiString s e
note . show $ renderParseErrorAsANSI s e
crash . show $ renderParseErrorAsANSI s e
Right _ -> ok

2
parser-typechecker/tests/Unison/Test/Typechecker.hs
View File

@ -67,7 +67,7 @@ go files how = do
showNotes :: Foldable f => String -> PrintError.Env -> f Note -> String
showNotes source env notes =
intercalateMap "\n\n" (PrintError.printNoteWithSourceAsAnsi env source) notes
intercalateMap "\n\n" (show . PrintError.renderNoteAsANSI env source) notes
decodeResult
:: String -> SynthResult -> Either String (Term Symbol, Type Symbol)