adding an extra parameter to error printing so that References and constructor/effect calls can be rendered with names

parser-typechecker/src/Unison/PrintError.hs

@@ -1,28 +1,37 @@
 module Unison.PrintError where
 
+import           Unison.Parser (Ann(..))
+import           Unison.Result (Note(..))
+import           Unison.Var (Var, qualifiedName)
+import Data.Map (Map)
 import qualified Data.List.NonEmpty as Nel
+import qualified Data.Map as Map
 import qualified Data.Text as Text
 import qualified Text.Megaparsec as P
 import qualified Unison.ABT as ABT
-import qualified Unison.Typechecker.Context as Context
 import qualified Unison.Lexer as L
-import           Unison.Result (Note(..))
 import qualified Unison.Parser as Parser
-import           Unison.Parser (Ann(..))
-import           Unison.Var (Var, qualifiedName)
+import qualified Unison.Typechecker.Context as Context
+import qualified Unison.Reference as R
+
+data Env = Env { referenceNames :: Map R.Reference String
+               , constructorNames :: Map (R.Reference, Int) String }
+
+env0 :: Env
+env0 = Env Map.empty Map.empty
 
 showLexerOutput :: Bool
 showLexerOutput = True
 
-printNoteWithSource :: Var v => String -> Note v Ann -> String
-printNoteWithSource s (Parsing e) = prettyParseError s e
-printNoteWithSource s (Typechecking e) = prettyTypecheckError s e
-printNoteWithSource s (InvalidPath path term) =
+printNoteWithSource :: Var v => Env -> String -> Note v Ann -> String
+printNoteWithSource _env s (Parsing e) = prettyParseError s e
+printNoteWithSource env s (Typechecking e) = prettyTypecheckError env s e
+printNoteWithSource env s (InvalidPath path term) =
   "Invalid Path: " ++ show path ++ "\n" ++
     case ABT.annotation term of
       Intrinsic -> "  in Intrinsic " ++ show term
       Ann start end -> printPosRange s start end
-printNoteWithSource s (UnknownSymbol v ann) =
+printNoteWithSource env s (UnknownSymbol v ann) =
   "Unknown symbol `" ++ (Text.unpack $ qualifiedName v) ++
     case ann of
       Intrinsic -> "` (Intrinsic)"
@@ -30,7 +39,7 @@ printNoteWithSource s (UnknownSymbol v ann) =
         -- todo: multi-line ranges
         -- todo: ranges
         "`:\n\n" ++ printArrowsAtPos s startLine startCol
-printNoteWithSource _s (UnknownReference r) =
+printNoteWithSource env _s (UnknownReference r) =
   "Unknown reference: " ++ show r
 
 printPosRange :: String -> L.Pos -> L.Pos -> String
@@ -39,7 +48,6 @@ printPosRange s (L.Pos startLine startCol) _end =
   -- todo: ranges
   printArrowsAtPos s startLine startCol
 
-
 printArrowsAtPos :: String -> Int -> Int -> String
 printArrowsAtPos s line column =
   let lineCaret s i = s ++ if i == line
@@ -59,5 +67,9 @@ prettyParseError s e =
      then "\nLexer output:\n" ++ L.debugLex' s
      else ""
 
-prettyTypecheckError :: (Var v, Show loc) => String -> Context.Note v loc -> String
-prettyTypecheckError _s note = show note -- todo
+prettyTypecheckError :: (Var v, Show loc)
+                     => Env
+                     -> String
+                     -> Context.Note v loc -> String
+prettyTypecheckError _env _input note =
+  show note -- todo

parser-typechecker/tests/Unison/Test/Typechecker.hs

@@ -9,7 +9,7 @@ import           Data.List (intercalate)
 import           EasyTest
 import           Text.RawString.QQ
 import           Unison.FileParsers (parseAndSynthesizeAsFile)
-import           Unison.PrintError (printNoteWithSource)
+import qualified Unison.PrintError as PE
 import qualified Unison.Result as Result
 import           Unison.Symbol
 import           Unison.Test.Common
@@ -403,12 +403,12 @@ test = scope "typechecker" . tests $
             |y = handle state 5 in ex ()
             |
             |() |]
-  , broken [r|--map/traverse
-             |effect Noop where
-             |  noop : ∀ a . a -> {Noop} a
-             |
-             |effect Noop2 where
-             |  noop2 : ∀ a . a -> a -> {Noop2} a
+  , checks [r|--map/traverse
+             |--effect Noop where
+             |--  noop : ∀ a . a -> {Noop} a
+             |--
+             |--effect Noop2 where
+             |--  noop2 : ∀ a . a -> a -> {Noop2} a
              |
              |type List a = Nil | Cons a (List a)
              |
@@ -460,4 +460,4 @@ test = scope "typechecker" . tests $
         stripMargin =
           unlines . map (drop1If (== '|'). dropWhile isSpace) . lines
 
-printError s = intercalate "\n------\n" . map (printNoteWithSource s)
+printError s = intercalate "\n------\n" . map (PE.printNoteWithSource PE.env0 s)