{-# LANGUAGE RecordWildCards #-}

module Unison.PrintError
  ( Env,
    defaultWidth,
    prettyParseError,
    prettyResolutionFailures,
    prettyVar,
    printNoteWithSource,
    renderCompilerBug,
    renderNoteAsANSI,
    renderParseErrorAsANSI,
    renderParseErrors,
  )
where

import Control.Lens.Tuple (_1, _2, _3)
import Data.Foldable qualified as Foldable
import Data.Function (on)
import Data.List (find, intersperse, sortBy)
import Data.List.Extra (nubOrd)
import Data.List.NonEmpty qualified as Nel
import Data.Map qualified as Map
import Data.Ord (comparing)
import Data.Proxy
import Data.Sequence (Seq (..))
import Data.Set qualified as Set
import Data.Set.NonEmpty (NESet)
import Data.Set.NonEmpty qualified as NES
import Data.Text qualified as Text
import Text.Megaparsec qualified as P
import Unison.ABT qualified as ABT
import Unison.Builtin.Decls (unitRef, pattern TupleType')
import Unison.ConstructorReference (ConstructorReference, GConstructorReference (..))
import Unison.HashQualified qualified as HQ
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.Kind (Kind)
import Unison.Kind qualified as Kind
import Unison.KindInference.Error.Pretty (prettyKindError)
import Unison.Name (Name)
import Unison.Name qualified as Name
import Unison.NameSegment.Internal (NameSegment (NameSegment))
import Unison.Names qualified as Names
import Unison.Names.ResolutionResult qualified as Names
import Unison.Parser.Ann (Ann (..))
import Unison.Pattern (Pattern)
import Unison.Prelude
import Unison.PrettyPrintEnv qualified as PPE
import Unison.PrettyPrintEnv.Names qualified as PPE
import Unison.Reference qualified as R
import Unison.Referent (Referent, pattern Ref)
import Unison.Result (Note (..))
import Unison.Result qualified as Result
import Unison.Settings qualified as Settings
import Unison.Symbol (Symbol)
import Unison.Syntax.HashQualified qualified as HQ (toText)
import Unison.Syntax.Lexer.Unison qualified as L
import Unison.Syntax.Name qualified as Name (toText)
import Unison.Syntax.NamePrinter (prettyHashQualified0)
import Unison.Syntax.Parser (Annotated, ann)
import Unison.Syntax.Parser qualified as Parser
import Unison.Syntax.Precedence qualified as Precedence
import Unison.Syntax.TermPrinter qualified as TermPrinter
import Unison.Term qualified as Term
import Unison.Type (Type)
import Unison.Type qualified as Type
import Unison.Typechecker.Context qualified as C
import Unison.Typechecker.TypeError
import Unison.Typechecker.TypeVar qualified as TypeVar
import Unison.UnisonFile.Error qualified as UF
import Unison.Util.AnnotatedText (AnnotatedText)
import Unison.Util.AnnotatedText qualified as AT
import Unison.Util.ColorText (Color)
import Unison.Util.ColorText qualified as Color
import Unison.Util.Monoid (intercalateMap)
import Unison.Util.Pretty (ColorText, Pretty)
import Unison.Util.Pretty qualified as Pr
import Unison.Util.Range (Range (..), startingLine)
import Unison.Util.Text (ordinal)
import Unison.Var (Var)
import Unison.Var qualified as Var

type Env = PPE.PrettyPrintEnv

pattern Code :: Color
pattern $mCode :: forall {r}. Color -> ((# #) -> r) -> ((# #) -> r) -> r
$bCode :: Color
Code = Color.Blue

pattern Type1 :: Color
pattern $mType1 :: forall {r}. Color -> ((# #) -> r) -> ((# #) -> r) -> r
$bType1 :: Color
Type1 = Color.HiBlue

pattern Type2 :: Color
pattern $mType2 :: forall {r}. Color -> ((# #) -> r) -> ((# #) -> r) -> r
$bType2 :: Color
Type2 = Color.Green

pattern ErrorSite :: Color
pattern $mErrorSite :: forall {r}. Color -> ((# #) -> r) -> ((# #) -> r) -> r
$bErrorSite :: Color
ErrorSite = Color.HiRed

pattern Identifier :: Color
pattern $mIdentifier :: forall {r}. Color -> ((# #) -> r) -> ((# #) -> r) -> r
$bIdentifier :: Color
Identifier = Color.Bold

defaultWidth :: Pr.Width
defaultWidth :: Width
defaultWidth = Width
60

-- Various links used in error messages, collected here for a quick overview
structuralVsUniqueDocsLink :: (IsString a) => Pretty a
structuralVsUniqueDocsLink :: forall a. IsString a => Pretty a
structuralVsUniqueDocsLink = Pretty a
"https://www.unison-lang.org/learn/language-reference/unique-types/"

fromOverHere' ::
  (Ord a) =>
  String ->
  [Maybe (Range, a)] ->
  [Maybe (Range, a)] ->
  Pretty (AnnotatedText a)
fromOverHere' :: forall a.
Ord a =>
[Char]
-> [Maybe (Range, a)]
-> [Maybe (Range, a)]
-> Pretty (AnnotatedText a)
fromOverHere' [Char]
s [Maybe (Range, a)]
spots0 [Maybe (Range, a)]
removing =
  [Char] -> [(Range, a)] -> [(Range, a)] -> Pretty (AnnotatedText a)
forall a.
Ord a =>
[Char] -> [(Range, a)] -> [(Range, a)] -> Pretty (AnnotatedText a)
fromOverHere [Char]
s ([Maybe (Range, a)] -> [(Range, a)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Range, a)]
spots0) ([Maybe (Range, a)] -> [(Range, a)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Range, a)]
removing)

fromOverHere ::
  (Ord a) => String -> [(Range, a)] -> [(Range, a)] -> Pretty (AnnotatedText a)
fromOverHere :: forall a.
Ord a =>
[Char] -> [(Range, a)] -> [(Range, a)] -> Pretty (AnnotatedText a)
fromOverHere [Char]
src [(Range, a)]
spots0 [(Range, a)]
removing =
  let spots :: [(Range, a)]
spots = Set (Range, a) -> [(Range, a)]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set (Range, a) -> [(Range, a)]) -> Set (Range, a) -> [(Range, a)]
forall a b. (a -> b) -> a -> b
$ [(Range, a)] -> Set (Range, a)
forall a. Ord a => [a] -> Set a
Set.fromList [(Range, a)]
spots0 Set (Range, a) -> Set (Range, a) -> Set (Range, a)
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ [(Range, a)] -> Set (Range, a)
forall a. Ord a => [a] -> Set a
Set.fromList [(Range, a)]
removing
   in case [(Range, a)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Range, a)]
spots of
        Int
0 -> Pretty (AnnotatedText a)
forall a. Monoid a => a
mempty
        Int
1 -> Pretty (AnnotatedText a)
"\n  from right here:\n\n" Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> [Char] -> [(Range, a)] -> Pretty (AnnotatedText a)
forall a.
Ord a =>
[Char] -> [(Range, a)] -> Pretty (AnnotatedText a)
showSource [Char]
src [(Range, a)]
spots
        Int
_ -> Pretty (AnnotatedText a)
"\n  from these spots, respectively:\n\n" Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> [Char] -> [(Range, a)] -> Pretty (AnnotatedText a)
forall a.
Ord a =>
[Char] -> [(Range, a)] -> Pretty (AnnotatedText a)
showSource [Char]
src [(Range, a)]
spots

styleAnnotated :: (Annotated a) => sty -> a -> Maybe (Range, sty)
styleAnnotated :: forall a sty. Annotated a => sty -> a -> Maybe (Range, sty)
styleAnnotated sty
sty a
a = (,sty
sty) (Range -> (Range, sty)) -> Maybe Range -> Maybe (Range, sty)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated a
a

style :: s -> String -> Pretty (AnnotatedText s)
style :: forall s. s -> [Char] -> Pretty (AnnotatedText s)
style s
sty [Char]
str = AnnotatedText s -> Pretty (AnnotatedText s)
forall s. (IsString s, ListLike s Char) => s -> Pretty s
Pr.lit (AnnotatedText s -> Pretty (AnnotatedText s))
-> (AnnotatedText s -> AnnotatedText s)
-> AnnotatedText s
-> Pretty (AnnotatedText s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> AnnotatedText s -> AnnotatedText s
forall a. a -> AnnotatedText a -> AnnotatedText a
AT.annotate s
sty (AnnotatedText s -> Pretty (AnnotatedText s))
-> AnnotatedText s -> Pretty (AnnotatedText s)
forall a b. (a -> b) -> a -> b
$ [Char] -> AnnotatedText s
forall a. IsString a => [Char] -> a
fromString [Char]
str

-- | Applies the color highlighting for `Code`, but also quotes the code, to separate it from the containing context.
quoteCode :: String -> Pretty ColorText
quoteCode :: [Char] -> Pretty ColorText
quoteCode = Pretty ColorText -> Pretty ColorText
forall s. IsString s => Pretty s -> Pretty s
Pr.backticked (Pretty ColorText -> Pretty ColorText)
-> ([Char] -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Code

stylePretty :: Color -> Pretty ColorText -> Pretty ColorText
stylePretty :: Color -> Pretty ColorText -> Pretty ColorText
stylePretty = (ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText
forall s2 s. ListLike s2 Char => (s -> s2) -> Pretty s -> Pretty s2
Pr.map ((ColorText -> ColorText) -> Pretty ColorText -> Pretty ColorText)
-> (Color -> ColorText -> ColorText)
-> Color
-> Pretty ColorText
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> ColorText -> ColorText
forall a. a -> AnnotatedText a -> AnnotatedText a
AT.annotate

describeStyle :: Color -> Pretty ColorText
describeStyle :: Color -> Pretty ColorText
describeStyle Color
ErrorSite = Pretty ColorText
"in " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite [Char]
"red"
describeStyle Color
Type1 = Pretty ColorText
"in " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type1 [Char]
"blue"
describeStyle Color
Type2 = Pretty ColorText
"in " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type2 [Char]
"green"
describeStyle Color
_ = Pretty ColorText
""

-- Render an informational typechecking note
renderTypeInfo ::
  forall v loc sty.
  (Var v, Annotated loc, Ord loc, Show loc) =>
  TypeInfo v loc ->
  Env ->
  Pretty (AnnotatedText sty)
renderTypeInfo :: forall v loc sty.
(Var v, Annotated loc, Ord loc, Show loc) =>
TypeInfo v loc -> Env -> Pretty (AnnotatedText sty)
renderTypeInfo TypeInfo v loc
i Env
env = case TypeInfo v loc
i of
  TopLevelComponent {[(v, Type v loc, RedundantTypeAnnotation)]
definitions :: [(v, Type v loc, RedundantTypeAnnotation)]
$sel:definitions:TopLevelComponent :: forall v loc.
TypeInfo v loc -> [(v, Type v loc, RedundantTypeAnnotation)]
..} -> case [(v, Type v loc, RedundantTypeAnnotation)]
definitions of
    [(v, Type v loc, RedundantTypeAnnotation)
def] ->
      Pretty (AnnotatedText sty) -> Pretty (AnnotatedText sty)
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap Pretty (AnnotatedText sty)
"🌟 I found and typechecked a definition:"
        Pretty (AnnotatedText sty)
-> Pretty (AnnotatedText sty) -> Pretty (AnnotatedText sty)
forall a. Semigroup a => a -> a -> a
<> Pretty (AnnotatedText sty)
forall a. IsString a => Pretty a
Pr.newline
        Pretty (AnnotatedText sty)
-> Pretty (AnnotatedText sty) -> Pretty (AnnotatedText sty)
forall a. Semigroup a => a -> a -> a
<> [Pretty (AnnotatedText sty)] -> Pretty (AnnotatedText sty)
forall a. Monoid a => [a] -> a
mconcat
          ((v, Type v loc, RedundantTypeAnnotation)
-> [Pretty (AnnotatedText sty)]
forall s.
IsString s =>
(v, Type v loc, RedundantTypeAnnotation) -> [s]
renderOne (v, Type v loc, RedundantTypeAnnotation)
def)
    [] -> Pretty (AnnotatedText sty)
forall a. Monoid a => a
mempty
    [(v, Type v loc, RedundantTypeAnnotation)]
_ ->
      Pretty (AnnotatedText sty) -> Pretty (AnnotatedText sty)
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap Pretty (AnnotatedText sty)
"🎁 These mutually dependent definitions typechecked:"
        Pretty (AnnotatedText sty)
-> Pretty (AnnotatedText sty) -> Pretty (AnnotatedText sty)
forall a. Semigroup a => a -> a -> a
<> Pretty (AnnotatedText sty)
forall a. IsString a => Pretty a
Pr.newline
        Pretty (AnnotatedText sty)
-> Pretty (AnnotatedText sty) -> Pretty (AnnotatedText sty)
forall a. Semigroup a => a -> a -> a
<> Pretty (AnnotatedText sty)
-> ((v, Type v loc, RedundantTypeAnnotation)
    -> Pretty (AnnotatedText sty))
-> [(v, Type v loc, RedundantTypeAnnotation)]
-> Pretty (AnnotatedText sty)
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap Pretty (AnnotatedText sty)
forall a. IsString a => Pretty a
Pr.newline ((Pretty (AnnotatedText sty) -> Pretty (AnnotatedText sty))
-> [Pretty (AnnotatedText sty)] -> Pretty (AnnotatedText sty)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Pretty (AnnotatedText sty)
"\t" Pretty (AnnotatedText sty)
-> Pretty (AnnotatedText sty) -> Pretty (AnnotatedText sty)
forall a. Semigroup a => a -> a -> a
<>) ([Pretty (AnnotatedText sty)] -> Pretty (AnnotatedText sty))
-> ((v, Type v loc, RedundantTypeAnnotation)
    -> [Pretty (AnnotatedText sty)])
-> (v, Type v loc, RedundantTypeAnnotation)
-> Pretty (AnnotatedText sty)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v, Type v loc, RedundantTypeAnnotation)
-> [Pretty (AnnotatedText sty)]
forall s.
IsString s =>
(v, Type v loc, RedundantTypeAnnotation) -> [s]
renderOne) [(v, Type v loc, RedundantTypeAnnotation)]
definitions
  where
    renderOne :: (IsString s) => (v, Type v loc, RedundantTypeAnnotation) -> [s]
    renderOne :: forall s.
IsString s =>
(v, Type v loc, RedundantTypeAnnotation) -> [s]
renderOne (v
v, Type v loc
typ, RedundantTypeAnnotation
_) =
      [[Char] -> s
forall a. IsString a => [Char] -> a
fromString ([Char] -> s) -> (Text -> [Char]) -> Text -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack (Text -> s) -> Text -> s
forall a b. (a -> b) -> a -> b
$ v -> Text
forall v. Var v => v -> Text
Var.name v
v, s
" : ", Env -> Type v loc -> s
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
typ]

-- Render a type error
renderTypeError ::
  forall v loc.
  (Var v, Annotated loc, Ord loc, Show loc) =>
  TypeError v loc ->
  Env ->
  String ->
  Pretty ColorText
renderTypeError :: forall v loc.
(Var v, Annotated loc, Ord loc, Show loc) =>
TypeError v loc -> Env -> [Char] -> Pretty ColorText
renderTypeError TypeError v loc
e Env
env [Char]
src = case TypeError v loc
e of
  BooleanMismatch {Type v loc
Term v loc
ErrorNote v loc
BooleanMismatch
getBooleanMismatch :: BooleanMismatch
mismatchSite :: Term v loc
foundType :: Type v loc
note :: ErrorNote v loc
$sel:foundType:Mismatch :: forall v loc. TypeError v loc -> Type v loc
$sel:mismatchSite:Mismatch :: forall v loc. TypeError v loc -> Term v loc
$sel:note:Mismatch :: forall v loc. TypeError v loc -> ErrorNote v loc
$sel:getBooleanMismatch:Mismatch :: forall v loc. TypeError v loc -> BooleanMismatch
..} ->
    [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
      [ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
          [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
            [ Pretty ColorText
preamble,
              Pretty ColorText
" ",
              Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type1 [Char]
"Boolean",
              Pretty ColorText
", but this one is ",
              Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type2 (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
foundType),
              Pretty ColorText
":"
            ],
        Pretty ColorText
forall a. IsString a => Pretty a
Pr.lineSkip,
        [Char] -> [Maybe (Range, Color)] -> Pretty ColorText
forall a.
Ord a =>
[Char] -> [Maybe (Range, a)] -> Pretty (AnnotatedText a)
showSourceMaybes [Char]
src [Maybe (Range, Color)
siteS],
        [Char]
-> [Maybe (Range, Color)]
-> [Maybe (Range, Color)]
-> Pretty ColorText
forall a.
Ord a =>
[Char]
-> [Maybe (Range, a)]
-> [Maybe (Range, a)]
-> Pretty (AnnotatedText a)
fromOverHere' [Char]
src [Maybe (Range, Color)
typeS] [Maybe (Range, Color)
siteS],
        Pretty ColorText -> Pretty ColorText
forall {p}. Monoid p => p -> p
debugNoteLoc (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
          [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
            [ Pretty ColorText
"loc debug:",
              Pretty ColorText
"\n  mismatchSite: ",
              Term v loc -> Pretty ColorText
forall a s. (Annotated a, IsString s, Semigroup s) => a -> s
annotatedToEnglish Term v loc
mismatchSite,
              Pretty ColorText
"\n     foundType: ",
              Type v loc -> Pretty ColorText
forall a s. (Annotated a, IsString s, Semigroup s) => a -> s
annotatedToEnglish Type v loc
foundType,
              Pretty ColorText
"\n"
            ],
        ErrorNote v loc -> Pretty ColorText
debugSummary ErrorNote v loc
note
      ]
    where
      siteS :: Maybe (Range, Color)
siteS = Color -> Term v loc -> Maybe (Range, Color)
forall a sty. Annotated a => sty -> a -> Maybe (Range, sty)
styleAnnotated Color
Type2 Term v loc
mismatchSite
      typeS :: Maybe (Range, Color)
typeS = Color -> Type v loc -> Maybe (Range, Color)
forall a sty. Annotated a => sty -> a -> Maybe (Range, sty)
styleAnnotated Color
Type2 Type v loc
foundType
      preamble :: Pretty ColorText
preamble = case BooleanMismatch
getBooleanMismatch of
        BooleanMismatch
CondMismatch ->
          Pretty ColorText
"The condition for an "
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite [Char]
"if"
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"-expression has to be"
        BooleanMismatch
AndMismatch ->
          Pretty ColorText
"The arguments to " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite [Char]
"&&" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" have to be"
        BooleanMismatch
OrMismatch ->
          Pretty ColorText
"The arguments to " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite [Char]
"||" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" have to be"
        BooleanMismatch
GuardMismatch ->
          Pretty ColorText
"The guard expression for a "
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite [Char]
"match"
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"/"
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite [Char]
"with"
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" has to be"
  ExistentialMismatch {loc
Type v loc
Term v loc
ErrorNote v loc
ExistentialMismatch
$sel:foundType:Mismatch :: forall v loc. TypeError v loc -> Type v loc
$sel:mismatchSite:Mismatch :: forall v loc. TypeError v loc -> Term v loc
$sel:note:Mismatch :: forall v loc. TypeError v loc -> ErrorNote v loc
getExistentialMismatch :: ExistentialMismatch
expectedType :: Type v loc
expectedLoc :: loc
foundType :: Type v loc
mismatchSite :: Term v loc
note :: ErrorNote v loc
$sel:expectedType:Mismatch :: forall v loc. TypeError v loc -> Type v loc
$sel:getExistentialMismatch:Mismatch :: forall v loc. TypeError v loc -> ExistentialMismatch
$sel:expectedLoc:Mismatch :: forall v loc. TypeError v loc -> loc
..} ->
    [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
      [ [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
          [ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap Pretty ColorText
preamble,
            Pretty ColorText
"",
            Pretty ColorText
"Here, one   is:  " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type1 (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
expectedType),
            Pretty ColorText
"and another is:  " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type2 (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
foundType),
            Pretty ColorText
""
          ],
        Pretty ColorText
forall a. IsString a => Pretty a
Pr.lineSkip,
        [Char] -> [Maybe (Range, Color)] -> Pretty ColorText
forall a.
Ord a =>
[Char] -> [Maybe (Range, a)] -> Pretty (AnnotatedText a)
showSourceMaybes [Char]
src [Maybe (Range, Color)
mismatchSiteS, Maybe (Range, Color)
expectedLocS],
        [Char]
-> [Maybe (Range, Color)]
-> [Maybe (Range, Color)]
-> Pretty ColorText
forall a.
Ord a =>
[Char]
-> [Maybe (Range, a)]
-> [Maybe (Range, a)]
-> Pretty (AnnotatedText a)
fromOverHere'
          [Char]
src
          [Maybe (Range, Color)
expectedTypeS, Maybe (Range, Color)
mismatchedTypeS]
          [Maybe (Range, Color)
mismatchSiteS, Maybe (Range, Color)
expectedLocS],
        Term v loc -> Type v loc -> Pretty ColorText
forall v loc. Term v loc -> Type v loc -> Pretty ColorText
intLiteralSyntaxTip Term v loc
mismatchSite Type v loc
expectedType,
        Pretty ColorText -> Pretty ColorText
forall {p}. Monoid p => p -> p
debugNoteLoc (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
          [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
            [ Pretty ColorText
"\nloc debug:",
              Pretty ColorText
"\n  mismatchSite: ",
              Term v loc -> Pretty ColorText
forall a s. (Annotated a, IsString s, Semigroup s) => a -> s
annotatedToEnglish Term v loc
mismatchSite,
              Pretty ColorText
"\n     foundType: ",
              Type v loc -> Pretty ColorText
forall a s. (Annotated a, IsString s, Semigroup s) => a -> s
annotatedToEnglish Type v loc
foundType,
              Pretty ColorText
"\n  expectedType: ",
              Type v loc -> Pretty ColorText
forall a s. (Annotated a, IsString s, Semigroup s) => a -> s
annotatedToEnglish Type v loc
expectedType,
              Pretty ColorText
"\n   expectedLoc: ",
              loc -> Pretty ColorText
forall a s. (Annotated a, IsString s, Semigroup s) => a -> s
annotatedToEnglish loc
expectedLoc,
              Pretty ColorText
"\n"
            ],
        ErrorNote v loc -> Pretty ColorText
debugSummary ErrorNote v loc
note
      ]
    where
      mismatchedTypeS :: Maybe (Range, Color)
mismatchedTypeS = Color -> Type v loc -> Maybe (Range, Color)
forall a sty. Annotated a => sty -> a -> Maybe (Range, sty)
styleAnnotated Color
Type2 Type v loc
foundType
      mismatchSiteS :: Maybe (Range, Color)
mismatchSiteS = Color -> Term v loc -> Maybe (Range, Color)
forall a sty. Annotated a => sty -> a -> Maybe (Range, sty)
styleAnnotated Color
Type2 Term v loc
mismatchSite
      expectedTypeS :: Maybe (Range, Color)
expectedTypeS = Color -> Type v loc -> Maybe (Range, Color)
forall a sty. Annotated a => sty -> a -> Maybe (Range, sty)
styleAnnotated Color
Type1 Type v loc
expectedType
      expectedLocS :: Maybe (Range, Color)
expectedLocS = Color -> loc -> Maybe (Range, Color)
forall a sty. Annotated a => sty -> a -> Maybe (Range, sty)
styleAnnotated Color
Type1 loc
expectedLoc
      preamble :: Pretty ColorText
preamble = case ExistentialMismatch
getExistentialMismatch of
        ExistentialMismatch
IfBody ->
          [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
            [ Pretty ColorText
"The ",
              Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite [Char]
"else",
              Pretty ColorText
" clause of an ",
              Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite [Char]
"if",
              Pretty ColorText
" expression needs to have the same type as the ",
              Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite [Char]
"then",
              Pretty ColorText
" clause."
            ]
        ExistentialMismatch
ListBody -> Pretty ColorText
"All the elements of a list need to have the same type."
        ExistentialMismatch
CaseBody ->
          [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
            [ Pretty ColorText
"Each case of a ",
              Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite [Char]
"match",
              Pretty ColorText
"/",
              Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite [Char]
"with",
              Pretty ColorText
" expression ",
              Pretty ColorText
"need to have the same type."
            ]
  NotFunctionApplication {Type v loc
Term v loc
ErrorNote v loc
$sel:note:Mismatch :: forall v loc. TypeError v loc -> ErrorNote v loc
f :: Term v loc
ft :: Type v loc
note :: ErrorNote v loc
$sel:f:Mismatch :: forall v loc. TypeError v loc -> Term v loc
$sel:ft:Mismatch :: forall v loc. TypeError v loc -> Type v loc
..} ->
    [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
      [ Pretty ColorText
"This looks like a function call, but with a ",
        Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type1 (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
ft),
        Pretty ColorText
" where the function should be.  Are you missing an operator?\n\n",
        Color -> [Char] -> Term v loc -> Pretty ColorText
forall style a.
(Ord style, Annotated a) =>
style -> [Char] -> a -> Pretty (AnnotatedText style)
annotatedAsStyle Color
Type1 [Char]
src Term v loc
f,
        ErrorNote v loc -> Pretty ColorText
debugSummary ErrorNote v loc
note
      ]
  FunctionApplication {Int
[(v, Type v loc)]
Maybe (Type v loc, Type v loc)
Type v loc
Term v loc
ErrorNote v loc
$sel:foundType:Mismatch :: forall v loc. TypeError v loc -> Type v loc
$sel:note:Mismatch :: forall v loc. TypeError v loc -> ErrorNote v loc
$sel:expectedType:Mismatch :: forall v loc. TypeError v loc -> Type v loc
$sel:f:Mismatch :: forall v loc. TypeError v loc -> Term v loc
$sel:ft:Mismatch :: forall v loc. TypeError v loc -> Type v loc
f :: Term v loc
ft :: Type v loc
arg :: Term v loc
argNum :: Int
foundType :: Type v loc
expectedType :: Type v loc
leafs :: Maybe (Type v loc, Type v loc)
solvedVars :: [(v, Type v loc)]
note :: ErrorNote v loc
$sel:arg:Mismatch :: forall v loc. TypeError v loc -> Term v loc
$sel:argNum:Mismatch :: forall v loc. TypeError v loc -> Int
$sel:leafs:Mismatch :: forall v loc. TypeError v loc -> Maybe (Type v loc, Type v loc)
$sel:solvedVars:Mismatch :: forall v loc. TypeError v loc -> [(v, Type v loc)]
..} ->
    let fte :: Type v loc
fte = RedundantTypeAnnotation -> Type v loc -> Type v loc
forall v a.
Var v =>
RedundantTypeAnnotation -> Type v a -> Type v a
Type.removePureEffects RedundantTypeAnnotation
False Type v loc
ft
        fteFreeVars :: Set v
fteFreeVars = (TypeVar v loc -> v) -> Set (TypeVar v loc) -> Set v
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map TypeVar v loc -> v
forall b v. TypeVar b v -> v
TypeVar.underlying (Set (TypeVar v loc) -> Set v) -> Set (TypeVar v loc) -> Set v
forall a b. (a -> b) -> a -> b
$ Type v loc -> Set (TypeVar v loc)
forall (f :: * -> *) v a. Term f v a -> Set v
ABT.freeVars Type v loc
fte
        showVar :: (v, Type v loc) -> RedundantTypeAnnotation
showVar (v
v, Type v loc
_t) = v -> Set v -> RedundantTypeAnnotation
forall a. Ord a => a -> Set a -> RedundantTypeAnnotation
Set.member v
v Set v
fteFreeVars
        solvedVars' :: [(v, Type v loc)]
solvedVars' = ((v, Type v loc) -> RedundantTypeAnnotation)
-> [(v, Type v loc)] -> [(v, Type v loc)]
forall a. (a -> RedundantTypeAnnotation) -> [a] -> [a]
filter (v, Type v loc) -> RedundantTypeAnnotation
showVar [(v, Type v loc)]
solvedVars
     in [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
          [ [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
              [ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                  Pretty ColorText
"The "
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Int -> Pretty ColorText
forall s. IsString s => Int -> s
ordinal Int
argNum
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" argument to "
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. IsString s => Pretty s -> Pretty s
Pr.backticked (Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite (Env -> Term v loc -> [Char]
forall s v loc0 loc1.
(IsString s, Var v) =>
Env -> Term' (TypeVar loc0 v) v loc1 -> s
renderTerm Env
env Term v loc
f)),
                Pretty ColorText
"",
                Pretty ColorText
"          has type:  " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type2 (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
foundType),
                Pretty ColorText
"    but I expected:  " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type1 (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
expectedType),
                Pretty ColorText
"",
                [Char] -> [Maybe (Range, Color)] -> Pretty ColorText
forall a.
Ord a =>
[Char] -> [Maybe (Range, a)] -> Pretty (AnnotatedText a)
showSourceMaybes
                  [Char]
src
                  [ (,Color
Type1) (Range -> (Range, Color)) -> Maybe Range -> Maybe (Range, Color)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type v loc -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated Type v loc
expectedType,
                    (,Color
Type2) (Range -> (Range, Color)) -> Maybe Range -> Maybe (Range, Color)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type v loc -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated Type v loc
foundType,
                    (,Color
Type2) (Range -> (Range, Color)) -> Maybe Range -> Maybe (Range, Color)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v loc -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated Term v loc
arg,
                    (,Color
ErrorSite) (Range -> (Range, Color)) -> Maybe Range -> Maybe (Range, Color)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v loc -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated Term v loc
f
                  ]
              ],
            Term v loc -> Type v loc -> Pretty ColorText
forall v loc. Term v loc -> Type v loc -> Pretty ColorText
intLiteralSyntaxTip Term v loc
arg Type v loc
expectedType,
            -- todo: factor this out and use in ExistentialMismatch and any other
            --       "recursive subtypes" situations
            case Maybe (Type v loc, Type v loc)
leafs of
              Maybe (Type v loc, Type v loc)
Nothing -> Pretty ColorText
forall a. Monoid a => a
mempty
              Just (Type v loc
foundLeaf, Type v loc
expectedLeaf) ->
                [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
                  [ Pretty ColorText
"",
                    Pretty ColorText
"The mismatch is because these types differ:\n",
                    Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
Pr.indentN Width
2 (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type2 (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
foundLeaf),
                    Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
Pr.indentN Width
2 (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type1 (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
expectedLeaf),
                    Pretty ColorText
""
                  ]
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [Char] -> [Maybe (Range, Color)] -> Pretty ColorText
forall a.
Ord a =>
[Char] -> [Maybe (Range, a)] -> Pretty (AnnotatedText a)
showSourceMaybes
                    [Char]
src
                    [ (,Color
Type1) (Range -> (Range, Color)) -> Maybe Range -> Maybe (Range, Color)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type v loc -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated Type v loc
expectedLeaf,
                      (,Color
Type2) (Range -> (Range, Color)) -> Maybe Range -> Maybe (Range, Color)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type v loc -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated Type v loc
foundLeaf
                    ],
            case [(v, Type v loc)]
solvedVars' of
              (v, Type v loc)
_ : [(v, Type v loc)]
_ ->
                let go :: (v, C.Type v loc) -> Pretty ColorText
                    go :: (v, Type v loc) -> Pretty ColorText
go (v
v, Type v loc
t) =
                      [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
                        [ Pretty ColorText
" ",
                          v -> Pretty ColorText
forall a v. (IsString a, Var v) => v -> a
renderVar v
v,
                          Pretty ColorText
" = ",
                          Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
t),
                          Pretty ColorText
", from here:\n\n",
                          [Char] -> [Maybe (Range, Color)] -> Pretty ColorText
forall a.
Ord a =>
[Char] -> [Maybe (Range, a)] -> Pretty (AnnotatedText a)
showSourceMaybes
                            [Char]
src
                            [(,Color
ErrorSite) (Range -> (Range, Color)) -> Maybe Range -> Maybe (Range, Color)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type v loc -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated Type v loc
t],
                          Pretty ColorText
"\n"
                        ]
                 in [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
                      [ Pretty ColorText
"\n",
                        Pretty ColorText
"because the ",
                        Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite (Env -> Term v loc -> [Char]
forall s v loc0 loc1.
(IsString s, Var v) =>
Env -> Term' (TypeVar loc0 v) v loc1 -> s
renderTerm Env
env Term v loc
f),
                        Pretty ColorText
" function has type",
                        Pretty ColorText
"\n\n",
                        Pretty ColorText
"  ",
                        Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
fte,
                        Pretty ColorText
"\n\n",
                        Pretty ColorText
"where:",
                        Pretty ColorText
"\n\n",
                        [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat ((v, Type v loc) -> Pretty ColorText
go ((v, Type v loc) -> Pretty ColorText)
-> [(v, Type v loc)] -> [Pretty ColorText]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(v, Type v loc)]
solvedVars')
                      ]
              [] -> Pretty ColorText
forall a. Monoid a => a
mempty,
            Pretty ColorText -> Pretty ColorText
forall {p}. Monoid p => p -> p
debugNoteLoc
              (Pretty ColorText -> Pretty ColorText)
-> ([Pretty ColorText] -> Pretty ColorText)
-> [Pretty ColorText]
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
              ([Pretty ColorText] -> Pretty ColorText)
-> [Pretty ColorText] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ [ Pretty ColorText
"\nloc debug:",
                  Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite [Char]
"\n             f: ",
                  Term v loc -> Pretty ColorText
forall a s. (Annotated a, IsString s, Semigroup s) => a -> s
annotatedToEnglish Term v loc
f,
                  Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type2 [Char]
"\n     foundType: ",
                  Type v loc -> Pretty ColorText
forall a s. (Annotated a, IsString s, Semigroup s) => a -> s
annotatedToEnglish Type v loc
foundType,
                  Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type1 [Char]
"\n  expectedType: ",
                  Type v loc -> Pretty ColorText
forall a s. (Annotated a, IsString s, Semigroup s) => a -> s
annotatedToEnglish Type v loc
expectedType
                  -- , "\n   expectedLoc: ", annotatedToEnglish expectedLoc
                ],
            ErrorNote v loc -> Pretty ColorText
debugSummary ErrorNote v loc
note
          ]
  Mismatch {Type v loc
Term v loc
ErrorNote v loc
$sel:foundType:Mismatch :: forall v loc. TypeError v loc -> Type v loc
$sel:mismatchSite:Mismatch :: forall v loc. TypeError v loc -> Term v loc
$sel:note:Mismatch :: forall v loc. TypeError v loc -> ErrorNote v loc
$sel:expectedType:Mismatch :: forall v loc. TypeError v loc -> Type v loc
foundType :: Type v loc
expectedType :: Type v loc
foundLeaf :: Type v loc
expectedLeaf :: Type v loc
mismatchSite :: Term v loc
note :: ErrorNote v loc
$sel:foundLeaf:Mismatch :: forall v loc. TypeError v loc -> Type v loc
$sel:expectedLeaf:Mismatch :: forall v loc. TypeError v loc -> Type v loc
..} ->
    [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
      [ [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
          [ Pretty ColorText
"I found a value  of type:  " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type1 (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
foundLeaf),
            Pretty ColorText
"where I expected to find:  " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type2 (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
expectedLeaf)
          ],
        Pretty ColorText
"\n\n",
        [Char] -> [Maybe (Range, Color)] -> Pretty ColorText
forall a.
Ord a =>
[Char] -> [Maybe (Range, a)] -> Pretty (AnnotatedText a)
showSourceMaybes
          [Char]
src
          [ -- these are overwriting the colored ranges for some reason?
            --   (,Color.ForceShow) <$> rangeForAnnotated mismatchSite
            -- , (,Color.ForceShow) <$> rangeForType foundType
            -- , (,Color.ForceShow) <$> rangeForType expectedType
            -- ,
            (,Color
Type1) (Range -> (Range, Color))
-> (Range -> Range) -> Range -> (Range, Color)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Range
startingLine (Range -> (Range, Color)) -> Maybe Range -> Maybe (Range, Color)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Term v loc -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated Term v loc
mismatchSite),
            (,Color
Type2) (Range -> (Range, Color)) -> Maybe Range -> Maybe (Range, Color)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type v loc -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated Type v loc
expectedLeaf
          ],
        [Char]
-> [Maybe (Range, Color)]
-> [Maybe (Range, Color)]
-> Pretty ColorText
forall a.
Ord a =>
[Char]
-> [Maybe (Range, a)]
-> [Maybe (Range, a)]
-> Pretty (AnnotatedText a)
fromOverHere'
          [Char]
src
          [Color -> Type v loc -> Maybe (Range, Color)
forall a sty. Annotated a => sty -> a -> Maybe (Range, sty)
styleAnnotated Color
Type1 Type v loc
foundLeaf]
          [Color -> Type v loc -> Maybe (Range, Color)
forall a sty. Annotated a => sty -> a -> Maybe (Range, sty)
styleAnnotated Color
Type2 Type v loc
expectedLeaf],
        Pretty ColorText
unitHint,
        Term v loc -> Type v loc -> Pretty ColorText
forall v loc. Term v loc -> Type v loc -> Pretty ColorText
intLiteralSyntaxTip Term v loc
mismatchSite Type v loc
expectedType,
        Pretty ColorText -> Pretty ColorText
forall {p}. Monoid p => p -> p
debugNoteLoc
          (Pretty ColorText -> Pretty ColorText)
-> ([Pretty ColorText] -> Pretty ColorText)
-> [Pretty ColorText]
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
          ([Pretty ColorText] -> Pretty ColorText)
-> [Pretty ColorText] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ [ Pretty ColorText
"\nloc debug:",
              Pretty ColorText
"\n  mismatchSite: ",
              Term v loc -> Pretty ColorText
forall a s. (Annotated a, IsString s, Semigroup s) => a -> s
annotatedToEnglish Term v loc
mismatchSite,
              Pretty ColorText
"\n     foundType: ",
              Type v loc -> Pretty ColorText
forall a s. (Annotated a, IsString s, Semigroup s) => a -> s
annotatedToEnglish Type v loc
foundType,
              Pretty ColorText
"\n     foundLeaf: ",
              Type v loc -> Pretty ColorText
forall a s. (Annotated a, IsString s, Semigroup s) => a -> s
annotatedToEnglish Type v loc
foundLeaf,
              Pretty ColorText
"\n  expectedType: ",
              Type v loc -> Pretty ColorText
forall a s. (Annotated a, IsString s, Semigroup s) => a -> s
annotatedToEnglish Type v loc
expectedType,
              Pretty ColorText
"\n  expectedLeaf: ",
              Type v loc -> Pretty ColorText
forall a s. (Annotated a, IsString s, Semigroup s) => a -> s
annotatedToEnglish Type v loc
expectedLeaf,
              Pretty ColorText
"\n"
            ],
        ErrorNote v loc -> Pretty ColorText
debugSummary ErrorNote v loc
note
      ]
    where
      unitHintMsg :: Pretty ColorText
unitHintMsg =
        Pretty ColorText
"\nHint: Actions within a block must have type "
          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type2 (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
expectedLeaf)
          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
".\n"
          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"      Use "
          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type1 [Char]
"_ = <expr>"
          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" to ignore a result."
      unitHint :: Pretty ColorText
unitHint = if RedundantTypeAnnotation
giveUnitHint then Pretty ColorText
unitHintMsg else Pretty ColorText
""
      giveUnitHint :: RedundantTypeAnnotation
giveUnitHint = case Type v loc
expectedType of
        Type.Ref' TypeReference
u | TypeReference
u TypeReference -> TypeReference -> RedundantTypeAnnotation
forall a. Eq a => a -> a -> RedundantTypeAnnotation
== TypeReference
unitRef -> case Term v loc
mismatchSite of
          Term.Let1Named' v
v Term v loc
_ Term v loc
_ -> v -> RedundantTypeAnnotation
forall v. Var v => v -> RedundantTypeAnnotation
Var.isAction v
v
          Term v loc
_ -> RedundantTypeAnnotation
False
        Type v loc
_ -> RedundantTypeAnnotation
False
  AbilityCheckFailure {loc
[Type v loc]
ErrorNote v loc
$sel:note:Mismatch :: forall v loc. TypeError v loc -> ErrorNote v loc
ambient :: [Type v loc]
requested :: [Type v loc]
abilityCheckFailureSite :: loc
note :: ErrorNote v loc
$sel:ambient:Mismatch :: forall v loc. TypeError v loc -> [Type v loc]
$sel:requested:Mismatch :: forall v loc. TypeError v loc -> [Type v loc]
$sel:abilityCheckFailureSite:Mismatch :: forall v loc. TypeError v loc -> loc
..}
    | [tv :: Type v loc
tv@(Type.Var' TypeVar v loc
ev)] <- [Type v loc]
ambient,
      TypeVar v loc
ev TypeVar v loc -> Set (TypeVar v loc) -> RedundantTypeAnnotation
forall a. Ord a => a -> Set a -> RedundantTypeAnnotation
`Set.member` (Type v loc -> Set (TypeVar v loc))
-> [Type v loc] -> Set (TypeVar v loc)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Type v loc -> Set (TypeVar v loc)
forall v a. Type v a -> Set v
Type.freeVars [Type v loc]
requested ->
        [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
          [ Pretty ColorText
"I tried to infer a cyclic ability.",
            Pretty ColorText
"\n\n",
            Pretty ColorText
"The expression ",
            Color -> Pretty ColorText
describeStyle Color
ErrorSite,
            Pretty ColorText
" was inferred to require the ",
            case [Type v loc] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type v loc]
requested of
              Int
1 -> Pretty ColorText
"ability: "
              Int
_ -> Pretty ColorText
"abilities: ",
            Pretty ColorText
"\n\n    {",
            (Type v loc -> Pretty ColorText)
-> [Type v loc] -> Pretty ColorText
forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
commas (Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env) [Type v loc]
requested,
            Pretty ColorText
"}",
            Pretty ColorText
"\n\n",
            Pretty ColorText
"where `",
            Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
tv,
            Pretty ColorText
"` is its overall abilities.",
            Pretty ColorText
"\n\n",
            Pretty ColorText
"I need a type signature to help figure this out.",
            Pretty ColorText
"\n\n",
            [Char] -> loc -> Pretty ColorText
forall a. Annotated a => [Char] -> a -> Pretty ColorText
annotatedAsErrorSite [Char]
src loc
abilityCheckFailureSite,
            ErrorNote v loc -> Pretty ColorText
debugSummary ErrorNote v loc
note
          ]
  AbilityCheckFailure {loc
[Type v loc]
ErrorNote v loc
$sel:note:Mismatch :: forall v loc. TypeError v loc -> ErrorNote v loc
$sel:ambient:Mismatch :: forall v loc. TypeError v loc -> [Type v loc]
$sel:requested:Mismatch :: forall v loc. TypeError v loc -> [Type v loc]
$sel:abilityCheckFailureSite:Mismatch :: forall v loc. TypeError v loc -> loc
ambient :: [Type v loc]
requested :: [Type v loc]
abilityCheckFailureSite :: loc
note :: ErrorNote v loc
..}
    | C.InSubtype {} :<| Seq (PathElement v loc)
_ <- ErrorNote v loc -> Seq (PathElement v loc)
forall v loc. ErrorNote v loc -> Seq (PathElement v loc)
C.path ErrorNote v loc
note ->
        [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
          [ Pretty ColorText
"The expression ",
            Color -> Pretty ColorText
describeStyle Color
ErrorSite,
            Pretty ColorText
"\n\n",
            Pretty ColorText
"              needs the abilities: {",
            (Type v loc -> Pretty ColorText)
-> [Type v loc] -> Pretty ColorText
forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
commas (Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env) [Type v loc]
requested,
            Pretty ColorText
"}\n",
            Pretty ColorText
"  but was assumed to only require: {",
            (Type v loc -> Pretty ColorText)
-> [Type v loc] -> Pretty ColorText
forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
commas (Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env) [Type v loc]
ambient,
            Pretty ColorText
"}",
            Pretty ColorText
"\n\n",
            Pretty ColorText
"This is likely a result of using an un-annotated ",
            Pretty ColorText
"function as an argument with concrete abilities. ",
            Pretty ColorText
"Try adding an annotation to the function definition whose ",
            Pretty ColorText
"body is red.",
            Pretty ColorText
"\n\n",
            [Char] -> loc -> Pretty ColorText
forall a. Annotated a => [Char] -> a -> Pretty ColorText
annotatedAsErrorSite [Char]
src loc
abilityCheckFailureSite,
            ErrorNote v loc -> Pretty ColorText
debugSummary ErrorNote v loc
note
          ]
  AbilityCheckFailure {loc
[Type v loc]
ErrorNote v loc
$sel:note:Mismatch :: forall v loc. TypeError v loc -> ErrorNote v loc
$sel:ambient:Mismatch :: forall v loc. TypeError v loc -> [Type v loc]
$sel:requested:Mismatch :: forall v loc. TypeError v loc -> [Type v loc]
$sel:abilityCheckFailureSite:Mismatch :: forall v loc. TypeError v loc -> loc
ambient :: [Type v loc]
requested :: [Type v loc]
abilityCheckFailureSite :: loc
note :: ErrorNote v loc
..} ->
    [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
      [ Pretty ColorText
"The expression ",
        Color -> Pretty ColorText
describeStyle Color
ErrorSite,
        Pretty ColorText
" ",
        case [Type v loc] -> [Type v loc]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [Type v loc]
requested of
          [] -> [Char] -> Pretty ColorText
forall a. HasCallStack => [Char] -> a
error [Char]
"unpossible"
          [Type v loc
e] -> Pretty ColorText
"needs the {" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
e Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"} ability,"
          [Type v loc]
requested ->
            Pretty ColorText
" needs these abilities: {"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> (Type v loc -> Pretty ColorText)
-> [Type v loc] -> Pretty ColorText
forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
commas (Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env) [Type v loc]
requested
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"},",
        Pretty ColorText
" but ",
        case [Type v loc] -> [Type v loc]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [Type v loc]
ambient of
          [] -> Pretty ColorText
"this location does not have access to any abilities."
          [Type v loc
e] ->
            Pretty ColorText
"this location only has access to the {"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
e
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"} ability,"
          [Type v loc]
ambient ->
            Pretty ColorText
"this location only has access to these abilities: "
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"{"
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> (Type v loc -> Pretty ColorText)
-> [Type v loc] -> Pretty ColorText
forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
commas (Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env) [Type v loc]
ambient
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"}",
        Pretty ColorText
"\n\n",
        [Char] -> loc -> Pretty ColorText
forall a. Annotated a => [Char] -> a -> Pretty ColorText
annotatedAsErrorSite [Char]
src loc
abilityCheckFailureSite,
        ErrorNote v loc -> Pretty ColorText
debugSummary ErrorNote v loc
note
      ]
  AbilityEqFailure {loc
[Type v loc]
Type v loc
ErrorNote v loc
$sel:note:Mismatch :: forall v loc. TypeError v loc -> ErrorNote v loc
$sel:abilityCheckFailureSite:Mismatch :: forall v loc. TypeError v loc -> loc
lhs :: [Type v loc]
rhs :: [Type v loc]
tlhs :: Type v loc
trhs :: Type v loc
abilityCheckFailureSite :: loc
note :: ErrorNote v loc
$sel:lhs:Mismatch :: forall v loc. TypeError v loc -> [Type v loc]
$sel:rhs:Mismatch :: forall v loc. TypeError v loc -> [Type v loc]
$sel:tlhs:Mismatch :: forall v loc. TypeError v loc -> Type v loc
$sel:trhs:Mismatch :: forall v loc. TypeError v loc -> Type v loc
..} ->
    [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
      [ Pretty ColorText
"I found an ability mismatch when checking the expression ",
        Color -> Pretty ColorText
describeStyle Color
ErrorSite,
        Pretty ColorText
"\n\n",
        [Char] -> [Maybe (Range, Color)] -> Pretty ColorText
forall a.
Ord a =>
[Char] -> [Maybe (Range, a)] -> Pretty (AnnotatedText a)
showSourceMaybes
          [Char]
src
          [ (,Color
Type1) (Range -> (Range, Color)) -> Maybe Range -> Maybe (Range, Color)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type v loc -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated Type v loc
tlhs,
            (,Color
Type2) (Range -> (Range, Color)) -> Maybe Range -> Maybe (Range, Color)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type v loc -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated Type v loc
trhs,
            (,Color
ErrorSite) (Range -> (Range, Color)) -> Maybe Range -> Maybe (Range, Color)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> loc -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated loc
abilityCheckFailureSite
          ],
        Pretty ColorText
"\n\n",
        Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
          [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
            [ Pretty ColorText
"When trying to match ",
              Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type1 ([Char] -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
tlhs,
              Pretty ColorText
" with ",
              Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type2 ([Char] -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
trhs,
              case ([Type v loc]
lhs, [Type v loc]
rhs) of
                ([], [Type v loc]
_) ->
                  [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
                    [ Pretty ColorText
"the right hand side contained extra abilities: ",
                      Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type2 ([Char] -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ [Char]
"{" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (Type v loc -> [Char]) -> [Type v loc] -> [Char]
forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
commas (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env) [Type v loc]
rhs [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"}"
                    ]
                ([Type v loc]
_, []) ->
                  [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
                    [ Pretty ColorText
"the left hand side contained extra abilities: ",
                      Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type1 ([Char] -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ [Char]
"{" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (Type v loc -> [Char]) -> [Type v loc] -> [Char]
forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
commas (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env) [Type v loc]
lhs [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"}"
                    ]
                ([Type v loc], [Type v loc])
_ ->
                  [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
                    [ Pretty ColorText
" I could not make ",
                      Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type1 ([Char] -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ [Char]
"{" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (Type v loc -> [Char]) -> [Type v loc] -> [Char]
forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
commas (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env) [Type v loc]
lhs [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"}",
                      Pretty ColorText
" on the left compatible with ",
                      Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type2 ([Char] -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ [Char]
"{" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (Type v loc -> [Char]) -> [Type v loc] -> [Char]
forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
commas (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env) [Type v loc]
rhs [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"}",
                      Pretty ColorText
" on the right."
                    ]
            ],
        Pretty ColorText
"\n\n",
        ErrorNote v loc -> Pretty ColorText
debugSummary ErrorNote v loc
note
      ]
  AbilityEqFailureFromAp {[Type v loc]
Type v loc
Term v loc
ErrorNote v loc
$sel:mismatchSite:Mismatch :: forall v loc. TypeError v loc -> Term v loc
$sel:note:Mismatch :: forall v loc. TypeError v loc -> ErrorNote v loc
$sel:lhs:Mismatch :: forall v loc. TypeError v loc -> [Type v loc]
$sel:rhs:Mismatch :: forall v loc. TypeError v loc -> [Type v loc]
$sel:tlhs:Mismatch :: forall v loc. TypeError v loc -> Type v loc
$sel:trhs:Mismatch :: forall v loc. TypeError v loc -> Type v loc
lhs :: [Type v loc]
rhs :: [Type v loc]
tlhs :: Type v loc
trhs :: Type v loc
expectedSite :: Term v loc
mismatchSite :: Term v loc
note :: ErrorNote v loc
$sel:expectedSite:Mismatch :: forall v loc. TypeError v loc -> Term v loc
..} ->
    [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
      [ Pretty ColorText
"I found an ability mismatch when checking the application",
        Pretty ColorText
"\n\n",
        [Char] -> [Maybe (Range, Color)] -> Pretty ColorText
forall a.
Ord a =>
[Char] -> [Maybe (Range, a)] -> Pretty (AnnotatedText a)
showSourceMaybes
          [Char]
src
          [ (,Color
Type1) (Range -> (Range, Color)) -> Maybe Range -> Maybe (Range, Color)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v loc -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated Term v loc
expectedSite,
            (,Color
Type2) (Range -> (Range, Color)) -> Maybe Range -> Maybe (Range, Color)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term v loc -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated Term v loc
mismatchSite
          ],
        Pretty ColorText
"\n\n",
        Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
          [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
            [ Pretty ColorText
"When trying to match ",
              Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type1 ([Char] -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
tlhs,
              Pretty ColorText
" with ",
              Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type2 ([Char] -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
trhs,
              case ([Type v loc]
lhs, [Type v loc]
rhs) of
                ([], [Type v loc]
_) ->
                  [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
                    [ Pretty ColorText
"the right hand side contained extra abilities: ",
                      Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type2 ([Char] -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ [Char]
"{" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (Type v loc -> [Char]) -> [Type v loc] -> [Char]
forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
commas (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env) [Type v loc]
rhs [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"}"
                    ]
                ([Type v loc]
_, []) ->
                  [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
                    [ Pretty ColorText
"the left hand side contained extra abilities: ",
                      Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type1 ([Char] -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ [Char]
"{" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (Type v loc -> [Char]) -> [Type v loc] -> [Char]
forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
commas (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env) [Type v loc]
lhs [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"}"
                    ]
                ([Type v loc], [Type v loc])
_ ->
                  [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
                    [ Pretty ColorText
" I could not make ",
                      Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type1 ([Char] -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ [Char]
"{" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (Type v loc -> [Char]) -> [Type v loc] -> [Char]
forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
commas (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env) [Type v loc]
lhs [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"}",
                      Pretty ColorText
" on the left compatible with ",
                      Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type2 ([Char] -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ [Char]
"{" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (Type v loc -> [Char]) -> [Type v loc] -> [Char]
forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
commas (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env) [Type v loc]
rhs [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"}",
                      Pretty ColorText
" on the right."
                    ]
            ],
        Pretty ColorText
"\n\n",
        ErrorNote v loc -> Pretty ColorText
debugSummary ErrorNote v loc
note
      ]
  UnguardedLetRecCycle [v]
vs [loc]
locs ErrorNote v loc
_ ->
    [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
      [ Pretty ColorText
"These definitions depend on each other cyclically but aren't guarded ",
        Pretty ColorText
"by a lambda: " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
-> (v -> Pretty ColorText) -> [v] -> Pretty ColorText
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap Pretty ColorText
", " v -> Pretty ColorText
forall a v. (IsString a, Var v) => v -> a
renderVar [v]
vs,
        Pretty ColorText
"\n",
        [Char] -> [Maybe (Range, Color)] -> Pretty ColorText
forall a.
Ord a =>
[Char] -> [Maybe (Range, a)] -> Pretty (AnnotatedText a)
showSourceMaybes [Char]
src [(,Color
ErrorSite) (Range -> (Range, Color)) -> Maybe Range -> Maybe (Range, Color)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> loc -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated loc
loc | loc
loc <- [loc]
locs]
      ]
  UnknownType {v
loc
ErrorNote v loc
$sel:note:Mismatch :: forall v loc. TypeError v loc -> ErrorNote v loc
unknownTypeV :: v
typeSite :: loc
note :: ErrorNote v loc
$sel:unknownTypeV:Mismatch :: forall v loc. TypeError v loc -> v
$sel:typeSite:Mismatch :: forall v loc. TypeError v loc -> loc
..} ->
    [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
      [ if loc -> Ann
forall a. Annotated a => a -> Ann
ann loc
typeSite Ann -> Ann -> RedundantTypeAnnotation
forall a. Eq a => a -> a -> RedundantTypeAnnotation
== Ann
Intrinsic
          then Pretty ColorText
"I don't know about the builtin type " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite (v -> [Char]
forall a v. (IsString a, Var v) => v -> a
renderVar v
unknownTypeV) Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
". "
          else
            if loc -> Ann
forall a. Annotated a => a -> Ann
ann loc
typeSite Ann -> Ann -> RedundantTypeAnnotation
forall a. Eq a => a -> a -> RedundantTypeAnnotation
== Ann
External
              then Pretty ColorText
"I don't know about the type " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite (v -> [Char]
forall a v. (IsString a, Var v) => v -> a
renderVar v
unknownTypeV) Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
". "
              else
                Pretty ColorText
"I don't know about the type "
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite (v -> [Char]
forall a v. (IsString a, Var v) => v -> a
renderVar v
unknownTypeV)
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
":\n"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [Char] -> loc -> Pretty ColorText
forall a. Annotated a => [Char] -> a -> Pretty ColorText
annotatedAsErrorSite [Char]
src loc
typeSite,
        Pretty ColorText
"Make sure it's imported and spelled correctly."
      ]
  UncoveredPatterns loc
loc NonEmpty (Pattern ())
tms ->
    [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
      [ Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
Pr.hang
          Pretty ColorText
"Pattern match doesn't cover all possible cases:"
          ([Char] -> loc -> Pretty ColorText
forall a. Annotated a => [Char] -> a -> Pretty ColorText
annotatedAsErrorSite [Char]
src loc
loc),
        Pretty ColorText
"\n\n"
      ]
      Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
Pr.hang
        Pretty ColorText
"Patterns not matched:\n"
        ( [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, ListLike s Char, IsString s) =>
f (Pretty s) -> Pretty s
Pr.bulleted
            ((Pattern () -> Pretty ColorText)
-> [Pattern ()] -> [Pretty ColorText]
forall a b. (a -> b) -> [a] -> [b]
map (\Pattern ()
x -> ColorText -> Pretty ColorText
forall s. (IsString s, ListLike s Char) => s -> Pretty s
Pr.lit (Env -> Pattern () -> ColorText
forall ann. Env -> Pattern ann -> ColorText
renderPattern Env
env Pattern ()
x)) (NonEmpty (Pattern ()) -> [Pattern ()]
forall a. NonEmpty a -> [a]
Nel.toList NonEmpty (Pattern ())
tms))
        )
  RedundantPattern loc
loc ->
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
Pr.hang
      Pretty ColorText
"This case would be ignored because it's already covered by the preceding case(s):"
      ([Char] -> loc -> Pretty ColorText
forall a. Annotated a => [Char] -> a -> Pretty ColorText
annotatedAsErrorSite [Char]
src loc
loc)
  KindInferenceFailure KindError v loc
ke ->
    let prettyTyp :: Type v loc -> Pretty ColorText
prettyTyp Type v loc
t = Pretty ColorText -> Pretty ColorText
Pr.bold (Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
t)
        showSource :: [(loc, Color)] -> Pretty ColorText
showSource = [Char] -> [Maybe (Range, Color)] -> Pretty ColorText
forall a.
Ord a =>
[Char] -> [Maybe (Range, a)] -> Pretty (AnnotatedText a)
showSourceMaybes [Char]
src ([Maybe (Range, Color)] -> Pretty ColorText)
-> ([(loc, Color)] -> [Maybe (Range, Color)])
-> [(loc, Color)]
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((loc, Color) -> Maybe (Range, Color))
-> [(loc, Color)] -> [Maybe (Range, Color)]
forall a b. (a -> b) -> [a] -> [b]
map (\(loc
loc, Color
color) -> (,Color
color) (Range -> (Range, Color)) -> Maybe Range -> Maybe (Range, Color)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> loc -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated loc
loc)
     in (Type v loc -> Pretty ColorText)
-> ([(loc, Color)] -> Pretty ColorText)
-> Color
-> Color
-> Env
-> KindError v loc
-> Pretty ColorText
forall v loc.
Var v =>
(Type v loc -> Pretty ColorText)
-> ([(loc, Color)] -> Pretty ColorText)
-> Color
-> Color
-> Env
-> KindError v loc
-> Pretty ColorText
prettyKindError Type v loc -> Pretty ColorText
prettyTyp [(loc, Color)] -> Pretty ColorText
showSource Color
Type1 Color
Type2 Env
env KindError v loc
ke
  UnknownTerm {v
loc
[Suggestion v loc]
Type v loc
ErrorNote v loc
$sel:note:Mismatch :: forall v loc. TypeError v loc -> ErrorNote v loc
$sel:expectedType:Mismatch :: forall v loc. TypeError v loc -> Type v loc
unknownTermV :: v
termSite :: loc
suggestions :: [Suggestion v loc]
expectedType :: Type v loc
note :: ErrorNote v loc
$sel:unknownTermV:Mismatch :: forall v loc. TypeError v loc -> v
$sel:termSite:Mismatch :: forall v loc. TypeError v loc -> loc
$sel:suggestions:Mismatch :: forall v loc. TypeError v loc -> [Suggestion v loc]
..}
    | v -> Type
forall v. Var v => v -> Type
Var.typeOf v
unknownTermV Type -> Type -> RedundantTypeAnnotation
forall a. Eq a => a -> a -> RedundantTypeAnnotation
== Type
Var.MissingResult ->
        [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
          [ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap Pretty ColorText
"The last element of a block must be an expression, but this is a definition:",
            Pretty ColorText
"",
            [Char] -> loc -> Pretty ColorText
forall a. Annotated a => [Char] -> a -> Pretty ColorText
annotatedAsErrorSite [Char]
src loc
termSite,
            Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Pretty ColorText
"Try adding an expression at the end of the block." Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
msg
          ]
    where
      msg :: Pretty ColorText
msg = case Type v loc
expectedType of
        Type.Var' (TypeVar.Existential {}) -> Pretty ColorText
forall a. Monoid a => a
mempty
        Type v loc
_ -> Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Pretty ColorText
"It should be of type " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
Pr.group (Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type1 (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
expectedType) Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
".")
  UnknownTerm {v
loc
[Suggestion v loc]
Type v loc
ErrorNote v loc
$sel:note:Mismatch :: forall v loc. TypeError v loc -> ErrorNote v loc
$sel:expectedType:Mismatch :: forall v loc. TypeError v loc -> Type v loc
$sel:unknownTermV:Mismatch :: forall v loc. TypeError v loc -> v
$sel:termSite:Mismatch :: forall v loc. TypeError v loc -> loc
$sel:suggestions:Mismatch :: forall v loc. TypeError v loc -> [Suggestion v loc]
unknownTermV :: v
termSite :: loc
suggestions :: [Suggestion v loc]
expectedType :: Type v loc
note :: ErrorNote v loc
..} ->
    let ([Suggestion v loc]
correct, [Suggestion v loc]
wrongTypes, [Suggestion v loc]
wrongNames) =
          (Suggestion v loc
 -> (([Suggestion v loc], [Suggestion v loc], [Suggestion v loc])
     -> ([Suggestion v loc], [Suggestion v loc], [Suggestion v loc]))
 -> ([Suggestion v loc], [Suggestion v loc], [Suggestion v loc])
 -> ([Suggestion v loc], [Suggestion v loc], [Suggestion v loc]))
-> (([Suggestion v loc], [Suggestion v loc], [Suggestion v loc])
    -> ([Suggestion v loc], [Suggestion v loc], [Suggestion v loc]))
-> [Suggestion v loc]
-> ([Suggestion v loc], [Suggestion v loc], [Suggestion v loc])
-> ([Suggestion v loc], [Suggestion v loc], [Suggestion v loc])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
            Suggestion v loc
-> (([Suggestion v loc], [Suggestion v loc], [Suggestion v loc])
    -> ([Suggestion v loc], [Suggestion v loc], [Suggestion v loc]))
-> ([Suggestion v loc], [Suggestion v loc], [Suggestion v loc])
-> ([Suggestion v loc], [Suggestion v loc], [Suggestion v loc])
forall {b} {c} {v} {loc} {a}.
(Field1 b c [Suggestion v loc] [Suggestion v loc],
 Field2 b c [Suggestion v loc] [Suggestion v loc],
 Field3 b c [Suggestion v loc] [Suggestion v loc]) =>
Suggestion v loc -> (a -> b) -> a -> c
sep
            ([Suggestion v loc], [Suggestion v loc], [Suggestion v loc])
-> ([Suggestion v loc], [Suggestion v loc], [Suggestion v loc])
forall a. a -> a
id
            ((Suggestion v loc -> Suggestion v loc -> Ordering)
-> [Suggestion v loc] -> [Suggestion v loc]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((NonEmpty NameSegment -> Int)
-> NonEmpty NameSegment -> NonEmpty NameSegment -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing NonEmpty NameSegment -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (NonEmpty NameSegment -> NonEmpty NameSegment -> Ordering)
-> (NonEmpty NameSegment -> NonEmpty NameSegment -> Ordering)
-> NonEmpty NameSegment
-> NonEmpty NameSegment
-> Ordering
forall a. Semigroup a => a -> a -> a
<> NonEmpty NameSegment -> NonEmpty NameSegment -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (NonEmpty NameSegment -> NonEmpty NameSegment -> Ordering)
-> (Suggestion v loc -> NonEmpty NameSegment)
-> Suggestion v loc
-> Suggestion v loc
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Name -> NonEmpty NameSegment
Name.segments (Name -> NonEmpty NameSegment)
-> (Suggestion v loc -> Name)
-> Suggestion v loc
-> NonEmpty NameSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Suggestion v loc -> Name
forall v loc. Suggestion v loc -> Name
C.suggestionName)) [Suggestion v loc]
suggestions)
            ([], [], [])
        sep :: Suggestion v loc -> (a -> b) -> a -> c
sep s :: Suggestion v loc
s@(C.Suggestion Name
_ Type v loc
_ Replacement v
_ SuggestionMatch
match) a -> b
r =
          case SuggestionMatch
match of
            SuggestionMatch
C.Exact -> (([Suggestion v loc] -> Identity [Suggestion v loc])
-> b -> Identity c
forall s t a b. Field1 s t a b => Lens s t a b
Lens b c [Suggestion v loc] [Suggestion v loc]
_1 (([Suggestion v loc] -> Identity [Suggestion v loc])
 -> b -> Identity c)
-> ([Suggestion v loc] -> [Suggestion v loc]) -> b -> c
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Suggestion v loc
s Suggestion v loc -> [Suggestion v loc] -> [Suggestion v loc]
forall a. a -> [a] -> [a]
:)) (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
r
            SuggestionMatch
C.WrongType -> (([Suggestion v loc] -> Identity [Suggestion v loc])
-> b -> Identity c
forall s t a b. Field2 s t a b => Lens s t a b
Lens b c [Suggestion v loc] [Suggestion v loc]
_2 (([Suggestion v loc] -> Identity [Suggestion v loc])
 -> b -> Identity c)
-> ([Suggestion v loc] -> [Suggestion v loc]) -> b -> c
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Suggestion v loc
s Suggestion v loc -> [Suggestion v loc] -> [Suggestion v loc]
forall a. a -> [a] -> [a]
:)) (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
r
            SuggestionMatch
C.WrongName -> (([Suggestion v loc] -> Identity [Suggestion v loc])
-> b -> Identity c
forall s t a b. Field3 s t a b => Lens s t a b
Lens b c [Suggestion v loc] [Suggestion v loc]
_3 (([Suggestion v loc] -> Identity [Suggestion v loc])
 -> b -> Identity c)
-> ([Suggestion v loc] -> [Suggestion v loc]) -> b -> c
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Suggestion v loc
s Suggestion v loc -> [Suggestion v loc] -> [Suggestion v loc]
forall a. a -> [a] -> [a]
:)) (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
r
        undefinedSymbolHelp :: Pretty ColorText
undefinedSymbolHelp =
          [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
            [ ( case Type v loc
expectedType of
                  Type.Var' (TypeVar.Existential {}) ->
                    Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap Pretty ColorText
"I also don't know what type it should be."
                  Type v loc
_ ->
                    [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
                      [ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap Pretty ColorText
"I think its type should be:",
                        Pretty ColorText
"\n\n",
                        Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
Pr.indentN Width
4 (Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type1 (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
expectedType))
                      ]
              ),
              Pretty ColorText
"\n\n",
              Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
Pr.hang
                Pretty ColorText
"Some common causes of this error include:"
                ( [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, ListLike s Char, IsString s) =>
f (Pretty s) -> Pretty s
Pr.bulleted
                    [ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap Pretty ColorText
"Your current namespace is too deep to contain the definition in its subtree",
                      Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap Pretty ColorText
"The definition is part of a library which hasn't been added to this project",
                      Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap Pretty ColorText
"You have a typo in the name"
                    ]
                )
            ]
     in [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
          [ Pretty ColorText
"I couldn't figure out what ",
            Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite (v -> [Char]
forall v. Var v => v -> [Char]
Var.nameStr v
unknownTermV),
            Pretty ColorText
" refers to here:\n\n",
            [Char] -> loc -> Pretty ColorText
forall a. Annotated a => [Char] -> a -> Pretty ColorText
annotatedAsErrorSite [Char]
src loc
termSite,
            Pretty ColorText
"\n",
            case [Suggestion v loc]
correct of
              [] -> case [Suggestion v loc]
wrongTypes of
                [] -> case [Suggestion v loc]
wrongNames of
                  [] -> Pretty ColorText
undefinedSymbolHelp
                  [Suggestion v loc]
wrongs -> ((Text -> Text -> Text) -> Pretty ColorText)
-> [Suggestion v loc] -> Pretty ColorText
formatWrongs (Text -> Text -> Text) -> Pretty ColorText
forall {s} {t} {t}.
(Item s ~ Char, ListLike s Char, IsString s, IsString t,
 IsString t) =>
(t -> t -> Text) -> Pretty s
wrongNameText [Suggestion v loc]
wrongs
                [Suggestion v loc]
wrongs ->
                  let helpMeOut :: Pretty ColorText
helpMeOut =
                        Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap
                          ( [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
                              [ Pretty ColorText
"Help me out by",
                                Pretty ColorText -> Pretty ColorText
Pr.bold Pretty ColorText
"using a more specific name here",
                                Pretty ColorText
"or",
                                Pretty ColorText -> Pretty ColorText
Pr.bold Pretty ColorText
"adding a type annotation."
                              ]
                          )
                   in Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap
                        ( Pretty ColorText
"The name "
                            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Identifier (v -> [Char]
forall v. Var v => v -> [Char]
Var.nameStr v
unknownTermV)
                            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" is ambiguous. I tried to resolve it by type but"
                        )
                        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" "
                        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> case Type v loc
expectedType of
                          Type.Var' (TypeVar.Existential {}) -> Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText
"its type could be anything." Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
helpMeOut) Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"\n"
                          Type v loc
_ ->
                            [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
                              [ ( Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                                    [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
                                      [ Pretty ColorText
"no term with that name would pass typechecking.",
                                        Pretty ColorText
"I think its type should be:"
                                      ]
                                ),
                                Pretty ColorText
"\n\n",
                                Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
Pr.indentN Width
4 (Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type1 (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
expectedType)),
                                Pretty ColorText
"\n\n",
                                Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap
                                  ( [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
                                      [ Pretty ColorText
"If that's not what you expected, you may have a type error somewhere else in your code.",
                                        Pretty ColorText
helpMeOut
                                      ]
                                  )
                              ]
                        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"\n\n"
                        Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> ((Text -> Text -> Text) -> Pretty ColorText)
-> [Suggestion v loc] -> Pretty ColorText
formatWrongs (Text -> Text -> Text) -> Pretty ColorText
forall {s} {t} {t}.
(Item s ~ Char, ListLike s Char, IsString s, IsString t,
 IsString t) =>
(t -> t -> Text) -> Pretty s
wrongTypeText [Suggestion v loc]
wrongs
              [Suggestion v loc]
suggs ->
                [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
                  [ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap
                      ( [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
                          [ [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
                              [ Pretty ColorText
"The name ",
                                Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Identifier (v -> [Char]
forall v. Var v => v -> [Char]
Var.nameStr v
unknownTermV),
                                Pretty ColorText
" is ambiguous. "
                              ],
                            case Type v loc
expectedType of
                              Type.Var' (TypeVar.Existential {}) -> Pretty ColorText
"I couldn't narrow it down by type, as any type would work here."
                              Type v loc
_ ->
                                Pretty ColorText
"Its type should be:\n\n"
                                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
Pr.indentN Width
4 (Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type1 (Env -> Type v loc -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
expectedType))
                          ]
                      ),
                    Pretty ColorText
"\n\n",
                    Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap Pretty ColorText
"I found some terms in scope that have matching names and types. Maybe you meant one of these:",
                    Pretty ColorText
"\n\n",
                    Pretty ColorText
-> (Suggestion v loc -> Pretty ColorText)
-> [Suggestion v loc]
-> Pretty ColorText
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap Pretty ColorText
"\n" (Env -> Suggestion v loc -> Pretty ColorText
forall s v loc.
(IsString s, Semigroup s, Var v) =>
Env -> Suggestion v loc -> s
renderSuggestion Env
env) [Suggestion v loc]
suggs
                  ]
          ]
  DuplicateDefinitions {NonEmpty (v, [loc])
ErrorNote v loc
$sel:note:Mismatch :: forall v loc. TypeError v loc -> ErrorNote v loc
defns :: NonEmpty (v, [loc])
note :: ErrorNote v loc
$sel:defns:Mismatch :: forall v loc. TypeError v loc -> NonEmpty (v, [loc])
..} ->
    [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
      [ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
          [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
            [ Pretty ColorText
"I found",
              Int -> Pretty ColorText
forall a s. (Show a, IsString s) => a -> Pretty s
Pr.shown (NonEmpty (v, [loc]) -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (v, [loc])
defns),
              Pretty ColorText
names,
              Pretty ColorText
"with multiple definitions:"
            ],
        Pretty ColorText
forall a. IsString a => Pretty a
Pr.lineSkip,
        NonEmpty (Pretty ColorText) -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.spaced ((\(v
v, [loc]
_locs) -> v -> Pretty ColorText
forall a v. (IsString a, Var v) => v -> a
renderVar v
v) ((v, [loc]) -> Pretty ColorText)
-> NonEmpty (v, [loc]) -> NonEmpty (Pretty ColorText)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (v, [loc])
defns),
        ErrorNote v loc -> Pretty ColorText
debugSummary ErrorNote v loc
note
      ]
    where
      names :: Pretty ColorText
names =
        case NonEmpty (v, [loc])
defns of
          (v, [loc])
_ Nel.:| [] -> Pretty ColorText
"name"
          NonEmpty (v, [loc])
_ -> Pretty ColorText
"names"
  Other (ErrorNote v loc -> Cause v loc
forall v loc. ErrorNote v loc -> Cause v loc
C.cause -> C.HandlerOfUnexpectedType loc
loc Type v loc
typ) ->
    [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
      [ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap Pretty ColorText
"The handler used here",
        Pretty ColorText
"",
        [Char] -> loc -> Pretty ColorText
forall a. Annotated a => [Char] -> a -> Pretty ColorText
annotatedAsErrorSite [Char]
src loc
loc,
        Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
          Pretty ColorText
"has type "
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> Pretty ColorText -> Pretty ColorText
stylePretty Color
ErrorSite (Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
Pr.group (Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
typ))
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"but I'm expecting a function of the form"
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
Pr.group (Pretty ColorText -> Pretty ColorText
Pr.blue (Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
exHandler) Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
".")
      ]
    where
      exHandler :: C.Type v loc
      exHandler :: Type v loc
exHandler =
        (() -> loc) -> Term F (TypeVar v loc) () -> Type v loc
forall a b.
(a -> b) -> Term F (TypeVar v loc) a -> Term F (TypeVar v loc) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (loc -> () -> loc
forall a b. a -> b -> a
const loc
loc) (Term F (TypeVar v loc) () -> Type v loc)
-> Term F (TypeVar v loc) () -> Type v loc
forall a b. (a -> b) -> a -> b
$
          ()
-> Term F (TypeVar v loc) ()
-> Term F (TypeVar v loc) ()
-> Term F (TypeVar v loc) ()
forall v a. Ord v => a -> Type v a -> Type v a -> Type v a
Type.arrow
            ()
            ( Term F (TypeVar v loc) ()
-> [Term F (TypeVar v loc) ()] -> Term F (TypeVar v loc) ()
forall a v.
(Semigroup a, Ord v) =>
Type v a -> [Type v a] -> Type v a
Type.apps'
                (() -> TypeReference -> Term F (TypeVar v loc) ()
forall v a. Ord v => a -> TypeReference -> Type v a
Type.ref () TypeReference
Type.effectRef)
                [() -> TypeVar v loc -> Term F (TypeVar v loc) ()
forall v a. Ord v => a -> v -> Type v a
Type.var () (Text -> TypeVar v loc
forall v. Var v => Text -> v
Var.named Text
"e"), () -> TypeVar v loc -> Term F (TypeVar v loc) ()
forall v a. Ord v => a -> v -> Type v a
Type.var () (Text -> TypeVar v loc
forall v. Var v => Text -> v
Var.named Text
"a")]
            )
            (() -> TypeVar v loc -> Term F (TypeVar v loc) ()
forall v a. Ord v => a -> v -> Type v a
Type.var () (Text -> TypeVar v loc
forall v. Var v => Text -> v
Var.named Text
"o"))
  Other (ErrorNote v loc -> Cause v loc
forall v loc. ErrorNote v loc -> Cause v loc
C.cause -> C.PatternArityMismatch loc
loc Type v loc
typ Int
num) ->
    [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
      [ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap Pretty ColorText
"This pattern has the wrong number of arguments",
        Pretty ColorText
"",
        [Char] -> loc -> Pretty ColorText
forall a. Annotated a => [Char] -> a -> Pretty ColorText
annotatedAsErrorSite [Char]
src loc
loc,
        Pretty ColorText
"The constructor has type ",
        Pretty ColorText
"",
        Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
Pr.indentN Width
2 (Color -> Pretty ColorText -> Pretty ColorText
stylePretty Color
Type1 (Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
Pr.group (Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
typ))),
        Pretty ColorText
"",
        Pretty ColorText
"but you supplied " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> (Int -> Pretty ColorText
forall a s. (Show a, IsString s) => a -> Pretty s
Pr.shown Int
num) Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" arguments."
      ]
  Other ErrorNote v loc
note ->
    [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
      [ Pretty ColorText
"Sorry, you hit an error we didn't make a nice message for yet.\n\n",
        Pretty ColorText
"Here is a summary of the Note:\n",
        ErrorNote v loc -> Pretty ColorText
summary ErrorNote v loc
note
      ]
  where
    wrongTypeText :: (t -> t -> Text) -> Pretty s
wrongTypeText t -> t -> Text
pl =
      Text -> Pretty s
forall s. (ListLike s Char, IsString s) => Text -> Pretty s
Pr.paragraphyText
        ( [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"I found ",
              t -> t -> Text
pl t
"a term" t
"some terms",
              Text
" in scope with ",
              t -> t -> Text
pl t
"a " t
"",
              Text
"matching name",
              t -> t -> Text
pl t
"" t
"s",
              Text
" but ",
              t -> t -> Text
pl t
"a " t
"",
              Text
"different type",
              t -> t -> Text
pl t
"" t
"s",
              Text
". ",
              Text
"If ",
              t -> t -> Text
pl t
"this" t
"one of these",
              Text
" is what you meant, try using its full name:"
            ]
        )
        Pretty s -> Pretty s -> Pretty s
forall a. Semigroup a => a -> a -> a
<> Pretty s
"\n\n"
    wrongNameText :: (t -> t -> Text) -> Pretty s
wrongNameText t -> t -> Text
pl =
      Text -> Pretty s
forall s. (ListLike s Char, IsString s) => Text -> Pretty s
Pr.paragraphyText
        ( [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"I found ",
              t -> t -> Text
pl t
"a term" t
"some terms",
              Text
" in scope with ",
              t -> t -> Text
pl t
"a " t
"",
              Text
"matching type",
              t -> t -> Text
pl t
"" t
"s",
              Text
" but ",
              t -> t -> Text
pl t
"a " t
"",
              Text
"different name",
              t -> t -> Text
pl t
"" t
"s",
              Text
". ",
              Text
"Maybe you meant ",
              t -> t -> Text
pl t
"this" t
"one of these",
              Text
":\n\n"
            ]
        )
    formatWrongs :: ((Text -> Text -> Text) -> Pretty ColorText)
-> [Suggestion v loc] -> Pretty ColorText
formatWrongs (Text -> Text -> Text) -> Pretty ColorText
txt [Suggestion v loc]
wrongs =
      let sz :: Int
sz = [Suggestion v loc] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Suggestion v loc]
wrongs
          pl :: Text -> Text -> Text
pl Text
a Text
b = if Int
sz Int -> Int -> RedundantTypeAnnotation
forall a. Eq a => a -> a -> RedundantTypeAnnotation
== Int
1 then Text
a else Text
b
       in [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat [(Text -> Text -> Text) -> Pretty ColorText
txt Text -> Text -> Text
pl, Pretty ColorText
-> (Suggestion v loc -> Pretty ColorText)
-> [Suggestion v loc]
-> Pretty ColorText
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap Pretty ColorText
"\n" (Env -> Suggestion v loc -> Pretty ColorText
forall s v loc.
(IsString s, Semigroup s, Var v) =>
Env -> Suggestion v loc -> s
renderSuggestion Env
env) [Suggestion v loc]
wrongs]
    debugNoteLoc :: p -> p
debugNoteLoc p
a = if RedundantTypeAnnotation
Settings.debugNoteLoc then p
a else p
forall a. Monoid a => a
mempty
    debugSummary :: C.ErrorNote v loc -> Pretty ColorText
    debugSummary :: ErrorNote v loc -> Pretty ColorText
debugSummary ErrorNote v loc
note =
      if RedundantTypeAnnotation
Settings.debugNoteSummary then ErrorNote v loc -> Pretty ColorText
summary ErrorNote v loc
note else Pretty ColorText
forall a. Monoid a => a
mempty
    summary :: C.ErrorNote v loc -> Pretty ColorText
    summary :: ErrorNote v loc -> Pretty ColorText
summary ErrorNote v loc
note =
      [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
        [ Pretty ColorText
"\n",
          Pretty ColorText
"  simple cause:\n",
          Pretty ColorText
"    ",
          Cause v loc -> Pretty ColorText
simpleCause (ErrorNote v loc -> Cause v loc
forall v loc. ErrorNote v loc -> Cause v loc
C.cause ErrorNote v loc
note),
          Pretty ColorText
"\n"
          -- This can be very slow to print in large file. This was taking several minutes to print out the path in a file when the error occurred deep in the file after many other let bindings - stew
          --    , case toList (C.path note) of
          --      [] -> "  path: (empty)\n"
          --      l  -> "  path:\n" <> mconcat (simplePath <$> l)
        ]
    --   simplePath :: C.PathElement v loc -> Pretty ColorText
    --   simplePath e = "    " <> simplePath' e <> "\n"
    --   simplePath' :: C.PathElement v loc -> Pretty ColorText
    --   simplePath' = \case
    --     C.InSynthesize e -> "InSynthesize e=" <> renderTerm env e
    --     C.InEquate t1 t2 ->
    --       "InEquate t1=" <> renderType' env t1 <>
    --       ", t2=" <> renderType' env t2
    --     C.InSubtype t1 t2 ->
    --       "InSubtype t1=" <> renderType' env t1 <> ", t2=" <> renderType' env t2
    --     C.InCheck e t ->
    --       "InCheck e=" <> renderTerm env e <> "," <> " t=" <> renderType' env t
    --     C.InInstantiateL v t ->
    --       "InInstantiateL v=" <> renderVar v <> ", t=" <> renderType' env t
    --     C.InInstantiateR t v ->
    --       "InInstantiateR t=" <> renderType' env t <> " v=" <> renderVar v
    --     C.InSynthesizeApp t e n ->
    --       "InSynthesizeApp t="
    --         <> renderType' env t
    --         <> ", e="
    --         <> renderTerm env e
    --         <> ", n="
    --         <> fromString (show n)
    --     C.InFunctionCall vs f ft es ->
    --       "InFunctionCall vs=["
    --         <> commas renderVar vs
    --         <> "]"
    --         <> ", f="
    --         <> renderTerm env f
    --         <> ", ft="
    --         <> renderType' env ft
    --         <> ", es=["
    --         <> commas (renderTerm env) es
    --         <> "]"
    --     C.InIfCond        -> "InIfCond"
    --     C.InIfBody loc    -> "InIfBody thenBody=" <> annotatedToEnglish loc
    --     C.InAndApp        -> "InAndApp"
    --     C.InOrApp         -> "InOrApp"
    --     C.InVectorApp loc -> "InVectorApp firstTerm=" <> annotatedToEnglish loc
    --     C.InMatch     loc -> "InMatch firstBody=" <> annotatedToEnglish loc
    --     C.InMatchGuard    -> "InMatchGuard"
    --     C.InMatchBody     -> "InMatchBody"
    simpleCause :: C.Cause v loc -> Pretty ColorText
    simpleCause :: Cause v loc -> Pretty ColorText
simpleCause = \case
      C.UncoveredPatterns loc
loc NonEmpty (Pattern ())
tms ->
        [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
          [ Pretty ColorText
"Incomplete pattern matches:\n",
            [Char] -> loc -> Pretty ColorText
forall a. Annotated a => [Char] -> a -> Pretty ColorText
annotatedAsErrorSite [Char]
src loc
loc,
            Pretty ColorText
"\n\n",
            Pretty ColorText
"Uncovered cases:\n"
          ]
          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
Pretty s -> f (Pretty s) -> Pretty s
Pr.sep Pretty ColorText
"\n" ((Pattern () -> Pretty ColorText)
-> [Pattern ()] -> [Pretty ColorText]
forall a b. (a -> b) -> [a] -> [b]
map (\Pattern ()
x -> ColorText -> Pretty ColorText
forall s. (IsString s, ListLike s Char) => s -> Pretty s
Pr.lit (Env -> Pattern () -> ColorText
forall ann. Env -> Pattern ann -> ColorText
renderPattern Env
env Pattern ()
x)) (NonEmpty (Pattern ()) -> [Pattern ()]
forall a. NonEmpty a -> [a]
Nel.toList NonEmpty (Pattern ())
tms))
      C.RedundantPattern loc
loc ->
        [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
          [ Pretty ColorText
"Redundant pattern match: ",
            Pretty ColorText
"\n",
            [Char] -> loc -> Pretty ColorText
forall a. Annotated a => [Char] -> a -> Pretty ColorText
annotatedAsErrorSite [Char]
src loc
loc
          ]
      C.InaccessiblePattern loc
loc ->
        [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
          [ Pretty ColorText
"Inaccessible pattern match: ",
            Pretty ColorText
"\n",
            [Char] -> loc -> Pretty ColorText
forall a. Annotated a => [Char] -> a -> Pretty ColorText
annotatedAsErrorSite [Char]
src loc
loc
          ]
      C.TypeMismatch Context v loc
c ->
        [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat [Pretty ColorText
"TypeMismatch\n", Pretty ColorText
"  context:\n", Env -> Context v loc -> Pretty ColorText
forall v loc a.
(Var v, Ord loc) =>
Env -> Context v loc -> Pretty (AnnotatedText a)
renderContext Env
env Context v loc
c]
      C.HandlerOfUnexpectedType loc
loc Type v loc
typ ->
        [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat [Pretty ColorText
"HandlerOfUnexpectedType\n", loc -> Pretty ColorText
forall a s. (Show a, IsString s) => a -> Pretty s
Pr.shown loc
loc, Pretty ColorText
"type:\n", Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
typ]
      C.IllFormedType Context v loc
c ->
        [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat [Pretty ColorText
"IllFormedType\n", Pretty ColorText
"  context:\n", Env -> Context v loc -> Pretty ColorText
forall v loc a.
(Var v, Ord loc) =>
Env -> Context v loc -> Pretty (AnnotatedText a)
renderContext Env
env Context v loc
c]
      C.UnguardedLetRecCycle [v]
vs [(v, Term v loc)]
_ts ->
        Pretty ColorText
"Unguarded cycle of definitions: "
          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> (v -> Pretty ColorText) -> [v] -> Pretty ColorText
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap v -> Pretty ColorText
forall a v. (IsString a, Var v) => v -> a
renderVar [v]
vs
      C.UnknownSymbol loc
loc v
v ->
        [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
          [ Pretty ColorText
"UnknownSymbol: ",
            loc -> Pretty ColorText
forall a s. (Annotated a, IsString s, Semigroup s) => a -> s
annotatedToEnglish loc
loc,
            Pretty ColorText
" " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> v -> Pretty ColorText
forall a v. (IsString a, Var v) => v -> a
renderVar v
v,
            Pretty ColorText
"\n\n",
            [Char] -> loc -> Pretty ColorText
forall a. Annotated a => [Char] -> a -> Pretty ColorText
annotatedAsErrorSite [Char]
src loc
loc
          ]
      C.UnknownTerm loc
loc v
v [Suggestion v loc]
suggestions Type v loc
typ ->
        [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
          [ Pretty ColorText
"UnknownTerm: ",
            loc -> Pretty ColorText
forall a s. (Annotated a, IsString s, Semigroup s) => a -> s
annotatedToEnglish loc
loc,
            Pretty ColorText
" ",
            v -> Pretty ColorText
forall a v. (IsString a, Var v) => v -> a
renderVar v
v,
            Pretty ColorText
"\n\n",
            [Char] -> loc -> Pretty ColorText
forall a. Annotated a => [Char] -> a -> Pretty ColorText
annotatedAsErrorSite [Char]
src loc
loc,
            Pretty ColorText
"Suggestions: ",
            [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat (Env -> Suggestion v loc -> Pretty ColorText
forall s v loc.
(IsString s, Semigroup s, Var v) =>
Env -> Suggestion v loc -> s
renderSuggestion Env
env (Suggestion v loc -> Pretty ColorText)
-> [Suggestion v loc] -> [Pretty ColorText]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Suggestion v loc]
suggestions),
            Pretty ColorText
"\n\n",
            Pretty ColorText
"Type: ",
            Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
typ
          ]
      C.AbilityCheckFailure [Type v loc]
ambient [Type v loc]
requested Context v loc
c ->
        [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
          [ Pretty ColorText
"AbilityCheckFailure: ",
            Pretty ColorText
"ambient={",
            (Type v loc -> Pretty ColorText)
-> [Type v loc] -> Pretty ColorText
forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
commas (Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env) [Type v loc]
ambient,
            Pretty ColorText
"} requested={",
            (Type v loc -> Pretty ColorText)
-> [Type v loc] -> Pretty ColorText
forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
commas (Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env) [Type v loc]
requested,
            Pretty ColorText
"}\n",
            Env -> Context v loc -> Pretty ColorText
forall v loc a.
(Var v, Ord loc) =>
Env -> Context v loc -> Pretty (AnnotatedText a)
renderContext Env
env Context v loc
c
          ]
      C.AbilityEqFailure [Type v loc]
left [Type v loc]
right Context v loc
c ->
        [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
          [ Pretty ColorText
"AbilityEqFailure: ",
            Pretty ColorText
"lhs={",
            (Type v loc -> Pretty ColorText)
-> [Type v loc] -> Pretty ColorText
forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
commas (Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env) [Type v loc]
left,
            Pretty ColorText
"} rhs={",
            (Type v loc -> Pretty ColorText)
-> [Type v loc] -> Pretty ColorText
forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
commas (Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env) [Type v loc]
right,
            Pretty ColorText
"}\n",
            Env -> Context v loc -> Pretty ColorText
forall v loc a.
(Var v, Ord loc) =>
Env -> Context v loc -> Pretty (AnnotatedText a)
renderContext Env
env Context v loc
c
          ]
      C.EffectConstructorWrongArgCount Int
e Int
a ConstructorReference
r ->
        [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
          [ Pretty ColorText
"EffectConstructorWrongArgCount:",
            Pretty ColorText
"  expected=",
            ([Char] -> Pretty ColorText
forall a. IsString a => [Char] -> a
fromString ([Char] -> Pretty ColorText)
-> (Int -> [Char]) -> Int -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show) Int
e,
            Pretty ColorText
", actual=",
            ([Char] -> Pretty ColorText
forall a. IsString a => [Char] -> a
fromString ([Char] -> Pretty ColorText)
-> (Int -> [Char]) -> Int -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show) Int
a,
            Pretty ColorText
", reference=",
            Env -> ConstructorReference -> Pretty ColorText
forall s. IsString s => Env -> ConstructorReference -> s
showConstructor Env
env ConstructorReference
r
          ]
      C.MalformedEffectBind Type v loc
ctorType Type v loc
ctorResult [Type v loc]
es ->
        [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
          [ Pretty ColorText
"MalformedEffectBind: ",
            Pretty ColorText
"  ctorType=",
            Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
ctorType,
            Pretty ColorText
"  ctorResult=",
            Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
ctorResult,
            Pretty ColorText
"  effects=",
            [Char] -> Pretty ColorText
forall a. IsString a => [Char] -> a
fromString ([Type v loc] -> [Char]
forall a. Show a => a -> [Char]
show [Type v loc]
es)
          ]
      C.PatternArityMismatch loc
loc Type v loc
typ Int
args ->
        [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
          [ Pretty ColorText
"PatternArityMismatch:\n",
            Pretty ColorText
"  loc=",
            loc -> Pretty ColorText
forall a s. (Annotated a, IsString s, Semigroup s) => a -> s
annotatedToEnglish loc
loc,
            Pretty ColorText
"\n",
            Pretty ColorText
"  typ=",
            Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
typ,
            Pretty ColorText
"\n",
            Pretty ColorText
"  args=",
            [Char] -> Pretty ColorText
forall a. IsString a => [Char] -> a
fromString (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
args),
            Pretty ColorText
"\n"
          ]
      C.KindInferenceFailure KindError v loc
_ -> Pretty ColorText
"kind inference failure"
      C.DuplicateDefinitions NonEmpty (v, [loc])
vs ->
        let go :: (v, [loc]) -> Pretty (AnnotatedText a)
            go :: forall a. (v, [loc]) -> Pretty (AnnotatedText a)
go (v
v, [loc]
locs) =
              Pretty (AnnotatedText a)
"["
                Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> v -> Pretty (AnnotatedText a)
forall a v. (IsString a, Var v) => v -> a
renderVar v
v
                Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> [Pretty (AnnotatedText a)] -> Pretty (AnnotatedText a)
forall a. Monoid a => [a] -> a
mconcat (Pretty (AnnotatedText a)
-> [Pretty (AnnotatedText a)] -> [Pretty (AnnotatedText a)]
forall a. a -> [a] -> [a]
intersperse Pretty (AnnotatedText a)
" : " ([Pretty (AnnotatedText a)] -> [Pretty (AnnotatedText a)])
-> [Pretty (AnnotatedText a)] -> [Pretty (AnnotatedText a)]
forall a b. (a -> b) -> a -> b
$ loc -> Pretty (AnnotatedText a)
forall a s. (Annotated a, IsString s, Semigroup s) => a -> s
annotatedToEnglish (loc -> Pretty (AnnotatedText a))
-> [loc] -> [Pretty (AnnotatedText a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [loc]
locs)
                Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Pretty (AnnotatedText a)
"]"
         in Pretty ColorText
"DuplicateDefinitions:" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat ((v, [loc]) -> Pretty ColorText
forall a. (v, [loc]) -> Pretty (AnnotatedText a)
go ((v, [loc]) -> Pretty ColorText)
-> [(v, [loc])] -> [Pretty ColorText]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (v, [loc]) -> [(v, [loc])]
forall a. NonEmpty a -> [a]
Nel.toList NonEmpty (v, [loc])
vs)
      C.ConcatPatternWithoutConstantLength loc
loc Type v loc
typ ->
        [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
          [ Pretty ColorText
"ConcatPatternWithoutConstantLength:\n",
            Pretty ColorText
"  loc=",
            loc -> Pretty ColorText
forall a s. (Annotated a, IsString s, Semigroup s) => a -> s
annotatedToEnglish loc
loc,
            Pretty ColorText
"\n",
            Pretty ColorText
"  typ=",
            Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
typ,
            Pretty ColorText
"\n"
          ]
      C.DataEffectMismatch Unknown
actual TypeReference
rf DataDeclaration v loc
_ ->
        [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
          [ Pretty ColorText
"DataEffectMismatch:\n",
            case Unknown
actual of
              Unknown
C.Data -> Pretty ColorText
"  data type used as effect"
              Unknown
C.Effect -> Pretty ColorText
"  ability used as data type",
            Pretty ColorText
"\n",
            Pretty ColorText
"  reference=",
            Env -> TypeReference -> Pretty ColorText
forall s. IsString s => Env -> TypeReference -> s
showTypeRef Env
env TypeReference
rf
          ]

renderCompilerBug ::
  (Var v, Annotated loc, Ord loc, Show loc) =>
  Env ->
  String ->
  C.CompilerBug v loc ->
  Pretty ColorText
renderCompilerBug :: forall v loc.
(Var v, Annotated loc, Ord loc, Show loc) =>
Env -> [Char] -> CompilerBug v loc -> Pretty ColorText
renderCompilerBug Env
env [Char]
_src CompilerBug v loc
bug = [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat ([Pretty ColorText] -> Pretty ColorText)
-> [Pretty ColorText] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ case CompilerBug v loc
bug of
  C.UnknownDecl Unknown
sort TypeReference
rf Map TypeReference (DataDeclaration v loc)
_decls ->
    [ Pretty ColorText
"UnknownDecl:\n",
      case Unknown
sort of
        Unknown
C.Data -> Pretty ColorText
"  data type"
        Unknown
C.Effect -> Pretty ColorText
"  ability",
      Pretty ColorText
"\n",
      Pretty ColorText
"  reference = ",
      Env -> TypeReference -> Pretty ColorText
forall s. IsString s => Env -> TypeReference -> s
showTypeRef Env
env TypeReference
rf
    ]
  C.UnknownConstructor Unknown
sort (ConstructorReference TypeReference
rf ConstructorId
i) DataDeclaration v loc
_decl ->
    [ Pretty ColorText
"UnknownConstructor:\n",
      case Unknown
sort of
        Unknown
C.Data -> Pretty ColorText
"  data type\n"
        Unknown
C.Effect -> Pretty ColorText
"  ability\n",
      Pretty ColorText
"  reference = ",
      Env -> TypeReference -> Pretty ColorText
forall s. IsString s => Env -> TypeReference -> s
showTypeRef Env
env TypeReference
rf,
      Pretty ColorText
"\n",
      Pretty ColorText
"  constructor index = ",
      [Char] -> Pretty ColorText
forall a. IsString a => [Char] -> a
fromString (ConstructorId -> [Char]
forall a. Show a => a -> [Char]
show ConstructorId
i)
    ]
  C.UndeclaredTermVariable v
v Context v loc
ctx ->
    [ Pretty ColorText
"UndeclaredTermVariable:\n  ",
      [Char] -> Pretty ColorText
forall a. IsString a => [Char] -> a
fromString ([Char] -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Env -> Context v loc -> v -> [Char]
forall v a.
(Var v, Annotated a) =>
Env -> Context v a -> v -> [Char]
renderVar' Env
env Context v loc
ctx v
v
    ]
  C.RetractFailure Element v loc
elem Context v loc
ctx ->
    [ Pretty ColorText
"RetractFailure:\n",
      [Char] -> Pretty ColorText
forall a. IsString a => [Char] -> a
fromString ([Char] -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Element v loc -> [Char]
forall a. Show a => a -> [Char]
show Element v loc
elem,
      [Char] -> Pretty ColorText
forall a. IsString a => [Char] -> a
fromString ([Char] -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Context v loc -> [Char]
forall a. Show a => a -> [Char]
show Context v loc
ctx
    ]
  C.EmptyLetRec Term v loc
tm ->
    [ Pretty ColorText
"EmptyLetRec:\n",
      Env -> Term v loc -> Pretty ColorText
forall s v loc0 loc1.
(IsString s, Var v) =>
Env -> Term' (TypeVar loc0 v) v loc1 -> s
renderTerm Env
env Term v loc
tm
    ]
  CompilerBug v loc
C.PatternMatchFailure -> [Pretty ColorText
"PatternMatchFailure"]
  C.EffectConstructorHadMultipleEffects Type v loc
es ->
    [ Pretty ColorText
"EffectConstructorHadMultipleEffects:\n  ",
      Env -> Type v loc -> Pretty ColorText
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
es
    ]
  C.FreeVarsInTypeAnnotation Set (TypeVar v loc)
vs ->
    [ Pretty ColorText
"FreeVarsInTypeAnnotation:\n  ",
      Pretty ColorText
-> (TypeVar v loc -> Pretty ColorText)
-> [TypeVar v loc]
-> Pretty ColorText
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap Pretty ColorText
", " TypeVar v loc -> Pretty ColorText
forall a v. (IsString a, Var v) => v -> a
renderVar (Set (TypeVar v loc) -> [TypeVar v loc]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set (TypeVar v loc)
vs)
    ]
  C.UnannotatedReference TypeReference
rf ->
    [ Pretty ColorText
"UnannotatedReference:\n",
      Env -> TypeReference -> Pretty ColorText
forall s. IsString s => Env -> TypeReference -> s
showTypeRef Env
env TypeReference
rf -- term/type shouldn't matter, since unknown
    ]
  C.MalformedPattern Pattern loc
p ->
    [ Pretty ColorText
"MalformedPattern:\n",
      [Char] -> Pretty ColorText
forall a. IsString a => [Char] -> a
fromString ([Char] -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Pattern loc -> [Char]
forall a. Show a => a -> [Char]
show Pattern loc
p
    ]
  C.UnknownTermReference TypeReference
rf ->
    [ Pretty ColorText
"UnknownTermReference:\n",
      Env -> Referent -> Pretty ColorText
forall s. IsString s => Env -> Referent -> s
showTermRef Env
env (TypeReference -> Referent
Ref TypeReference
rf)
    ]
  C.UnknownExistentialVariable v
v Context v loc
ctx ->
    [ Pretty ColorText
"UnknownExistentialVariable:\n",
      [Char] -> Pretty ColorText
forall a. IsString a => [Char] -> a
fromString ([Char] -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Env -> Context v loc -> v -> [Char]
forall v a.
(Var v, Annotated a) =>
Env -> Context v a -> v -> [Char]
renderVar' Env
env Context v loc
ctx v
v
    ]
  C.IllegalContextExtension Context v loc
ctx Element v loc
el [Char]
str ->
    [ Pretty ColorText
"IllegalContextExtension:\n",
      Pretty ColorText
"  context:\n    ",
      [Char] -> Pretty ColorText
forall a. IsString a => [Char] -> a
fromString ([Char] -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Context v loc -> [Char]
forall a. Show a => a -> [Char]
show Context v loc
ctx,
      Pretty ColorText
"  element:\n    ",
      [Char] -> Pretty ColorText
forall a. IsString a => [Char] -> a
fromString ([Char] -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Element v loc -> [Char]
forall a. Show a => a -> [Char]
show Element v loc
el,
      [Char] -> Pretty ColorText
forall a. IsString a => [Char] -> a
fromString [Char]
str
    ]
  C.OtherBug [Char]
str -> [Pretty ColorText
"OtherBug:\n", [Char] -> Pretty ColorText
forall a. IsString a => [Char] -> a
fromString [Char]
str]

renderContext ::
  (Var v, Ord loc) => Env -> C.Context v loc -> Pretty (AnnotatedText a)
renderContext :: forall v loc a.
(Var v, Ord loc) =>
Env -> Context v loc -> Pretty (AnnotatedText a)
renderContext Env
env ctx :: Context v loc
ctx@(C.Context [(Element v loc, Info v loc)]
es) =
  Pretty (AnnotatedText a)
"  Γ\n    "
    Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Pretty (AnnotatedText a)
-> ((Element v loc, Info v loc) -> Pretty (AnnotatedText a))
-> [(Element v loc, Info v loc)]
-> Pretty (AnnotatedText a)
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap Pretty (AnnotatedText a)
"\n    " (Context v loc -> Element v loc -> Pretty (AnnotatedText a)
forall v loc a.
(Var v, Ord loc) =>
Context v loc -> Element v loc -> Pretty (AnnotatedText a)
showElem Context v loc
ctx (Element v loc -> Pretty (AnnotatedText a))
-> ((Element v loc, Info v loc) -> Element v loc)
-> (Element v loc, Info v loc)
-> Pretty (AnnotatedText a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element v loc, Info v loc) -> Element v loc
forall a b. (a, b) -> a
fst) ([(Element v loc, Info v loc)] -> [(Element v loc, Info v loc)]
forall a. [a] -> [a]
reverse [(Element v loc, Info v loc)]
es)
  where
    shortName :: (Var v, IsString loc) => v -> loc
    shortName :: forall v loc. (Var v, IsString loc) => v -> loc
shortName = [Char] -> loc
forall a. IsString a => [Char] -> a
fromString ([Char] -> loc) -> (v -> [Char]) -> v -> loc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack (Text -> [Char]) -> (v -> Text) -> v -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Text
forall v. Var v => v -> Text
Var.name
    showElem ::
      (Var v, Ord loc) =>
      C.Context v loc ->
      C.Element v loc ->
      Pretty (AnnotatedText a)
    showElem :: forall v loc a.
(Var v, Ord loc) =>
Context v loc -> Element v loc -> Pretty (AnnotatedText a)
showElem Context v loc
_ctx (C.Var TypeVar v loc
v) = case TypeVar v loc
v of
      TypeVar.Universal v
x -> Pretty (AnnotatedText a)
"@" Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> v -> Pretty (AnnotatedText a)
forall a v. (IsString a, Var v) => v -> a
renderVar v
x
      TypeVar v loc
e -> TypeVar v loc -> Pretty (AnnotatedText a)
forall a s. (Show a, IsString s) => a -> Pretty s
Pr.shown TypeVar v loc
e
    showElem Context v loc
ctx (C.Solved Blank loc
_ v
v (Type.Monotype Type (TypeVar v loc) loc
t)) =
      Pretty (AnnotatedText a)
"'" Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> v -> Pretty (AnnotatedText a)
forall v loc. (Var v, IsString loc) => v -> loc
shortName v
v Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Pretty (AnnotatedText a)
" = " Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Env -> Type (TypeVar v loc) loc -> Pretty (AnnotatedText a)
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env (Context v loc
-> Type (TypeVar v loc) loc -> Type (TypeVar v loc) loc
forall v loc.
(Var v, Ord loc) =>
Context v loc -> Type v loc -> Type v loc
C.apply Context v loc
ctx Type (TypeVar v loc) loc
t)
    showElem Context v loc
ctx (C.Ann v
v Type (TypeVar v loc) loc
t) =
      v -> Pretty (AnnotatedText a)
forall v loc. (Var v, IsString loc) => v -> loc
shortName v
v Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Pretty (AnnotatedText a)
" : " Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Env -> Type (TypeVar v loc) loc -> Pretty (AnnotatedText a)
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env (Context v loc
-> Type (TypeVar v loc) loc -> Type (TypeVar v loc) loc
forall v loc.
(Var v, Ord loc) =>
Context v loc -> Type v loc -> Type v loc
C.apply Context v loc
ctx Type (TypeVar v loc) loc
t)
    showElem Context v loc
_ (C.Marker v
v) = Pretty (AnnotatedText a)
"|" Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> v -> Pretty (AnnotatedText a)
forall v loc. (Var v, IsString loc) => v -> loc
shortName v
v Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Pretty (AnnotatedText a)
"|"

renderTerm :: (IsString s, Var v) => Env -> Term.Term' (TypeVar.TypeVar loc0 v) v loc1 -> s
renderTerm :: forall s v loc0 loc1.
(IsString s, Var v) =>
Env -> Term' (TypeVar loc0 v) v loc1 -> s
renderTerm Env
env Term' (TypeVar loc0 v) v loc1
e =
  [Char] -> s
forall a. IsString a => [Char] -> a
fromString (ColorText -> [Char]
Color.toPlain (ColorText -> [Char]) -> ColorText -> [Char]
forall a b. (a -> b) -> a -> b
$ Maybe Width -> Env -> Term v loc1 -> ColorText
forall v a. Var v => Maybe Width -> Env -> Term v a -> ColorText
TermPrinter.pretty' (Width -> Maybe Width
forall a. a -> Maybe a
Just Width
80) Env
env (Term' (TypeVar loc0 v) v loc1 -> Term v loc1
forall v b a. Ord v => Term' (TypeVar b v) v a -> Term v a
TypeVar.lowerTerm Term' (TypeVar loc0 v) v loc1
e))

renderPattern :: Env -> Pattern ann -> ColorText
renderPattern :: forall ann. Env -> Pattern ann -> ColorText
renderPattern Env
env Pattern ann
e = Pretty ColorText -> ColorText
forall s. (Monoid s, IsString s) => Pretty s -> s
Pr.renderUnbroken (Pretty ColorText -> ColorText)
-> ((Pretty (SyntaxText' TypeReference), [Symbol])
    -> Pretty ColorText)
-> (Pretty (SyntaxText' TypeReference), [Symbol])
-> ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty (SyntaxText' TypeReference) -> Pretty ColorText
forall r. Pretty (SyntaxText' r) -> Pretty ColorText
Pr.syntaxToColor (Pretty (SyntaxText' TypeReference) -> Pretty ColorText)
-> ((Pretty (SyntaxText' TypeReference), [Symbol])
    -> Pretty (SyntaxText' TypeReference))
-> (Pretty (SyntaxText' TypeReference), [Symbol])
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pretty (SyntaxText' TypeReference), [Symbol])
-> Pretty (SyntaxText' TypeReference)
forall a b. (a, b) -> a
fst ((Pretty (SyntaxText' TypeReference), [Symbol]) -> ColorText)
-> (Pretty (SyntaxText' TypeReference), [Symbol]) -> ColorText
forall a b. (a -> b) -> a -> b
$ Env
-> AmbientContext
-> Precedence
-> [Symbol]
-> Pattern ann
-> (Pretty (SyntaxText' TypeReference), [Symbol])
forall v loc.
Var v =>
Env
-> AmbientContext
-> Precedence
-> [v]
-> Pattern loc
-> (Pretty (SyntaxText' TypeReference), [v])
TermPrinter.prettyPattern Env
env AmbientContext
TermPrinter.emptyAc Precedence
Precedence.Annotation ([] :: [Symbol]) Pattern ann
e

-- | renders a type with no special styling
renderType' :: (IsString s, Var v) => Env -> Type v loc -> s
renderType' :: forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env Type v loc
typ =
  [Char] -> s
forall a. IsString a => [Char] -> a
fromString ([Char] -> s)
-> (Pretty ColorText -> [Char]) -> Pretty ColorText -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Pretty ColorText -> [Char]
Pr.toPlain Width
defaultWidth (Pretty ColorText -> s) -> Pretty ColorText -> s
forall a b. (a -> b) -> a -> b
$ Env
-> (loc -> Pretty ColorText -> Pretty ColorText)
-> Type v loc
-> Pretty ColorText
forall v loc a.
Var v =>
Env
-> (loc -> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a))
-> Type v loc
-> Pretty (AnnotatedText a)
renderType Env
env ((Pretty ColorText -> Pretty ColorText)
-> loc -> Pretty ColorText -> Pretty ColorText
forall a b. a -> b -> a
const Pretty ColorText -> Pretty ColorText
forall a. a -> a
id) Type v loc
typ

-- | `f` may do some styling based on `loc`.
-- | You can pass `(const id)` if no styling is needed, or call `renderType'`.
renderType ::
  (Var v) =>
  Env ->
  (loc -> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)) ->
  Type v loc ->
  Pretty (AnnotatedText a)
renderType :: forall v loc a.
Var v =>
Env
-> (loc -> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a))
-> Type v loc
-> Pretty (AnnotatedText a)
renderType Env
env loc -> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
f Term F v loc
t = Env
-> (loc -> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a))
-> Int
-> Term F v loc
-> Pretty (AnnotatedText a)
renderType0 Env
env loc -> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
f (Int
0 :: Int) (Term F v loc -> Term F v loc
forall {v} {a}. Var v => Type v a -> Type v a
cleanup Term F v loc
t)
  where
    cleanup :: Type v a -> Type v a
cleanup Type v a
t = Type v a -> Type v a
forall v a. Ord v => Type v a -> Type v a
Type.removeEmptyEffects (RedundantTypeAnnotation -> Type v a -> Type v a
forall v a.
Var v =>
RedundantTypeAnnotation -> Type v a -> Type v a
Type.removePureEffects RedundantTypeAnnotation
False Type v a
t)
    wrap :: (IsString a, Semigroup a) => a -> a -> Bool -> a -> a
    wrap :: forall a.
(IsString a, Semigroup a) =>
a -> a -> RedundantTypeAnnotation -> a -> a
wrap a
start a
end RedundantTypeAnnotation
test a
s = if RedundantTypeAnnotation
test then a
start a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
s a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
end else a
s
    paren :: RedundantTypeAnnotation
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
paren = Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a)
-> RedundantTypeAnnotation
-> Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a)
forall a.
(IsString a, Semigroup a) =>
a -> a -> RedundantTypeAnnotation -> a -> a
wrap Pretty (AnnotatedText a)
"(" Pretty (AnnotatedText a)
")"
    curly :: RedundantTypeAnnotation
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
curly = Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a)
-> RedundantTypeAnnotation
-> Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a)
forall a.
(IsString a, Semigroup a) =>
a -> a -> RedundantTypeAnnotation -> a -> a
wrap Pretty (AnnotatedText a)
"{" Pretty (AnnotatedText a)
"}"
    renderType0 :: Env
-> (loc -> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a))
-> Int
-> Term F v loc
-> Pretty (AnnotatedText a)
renderType0 Env
env loc -> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
f Int
p Term F v loc
t = loc -> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
f (Term F v loc -> loc
forall (f :: * -> *) v a. Term f v a -> a
ABT.annotation Term F v loc
t) (Pretty (AnnotatedText a) -> Pretty (AnnotatedText a))
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a b. (a -> b) -> a -> b
$ case Term F v loc
t of
      Type.Ref' TypeReference
r -> Env -> TypeReference -> Pretty (AnnotatedText a)
forall s. IsString s => Env -> TypeReference -> s
showTypeRef Env
env TypeReference
r
      Type.Arrow' Term F v loc
i (Type.Effect1' Term F v loc
e Term F v loc
o) ->
        RedundantTypeAnnotation
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
paren (Int
p Int -> Int -> RedundantTypeAnnotation
forall a. Ord a => a -> a -> RedundantTypeAnnotation
>= Int
2) (Pretty (AnnotatedText a) -> Pretty (AnnotatedText a))
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a b. (a -> b) -> a -> b
$ Int -> Term F v loc -> Pretty (AnnotatedText a)
go Int
2 Term F v loc
i Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Pretty (AnnotatedText a)
" ->{" Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Int -> Term F v loc -> Pretty (AnnotatedText a)
go Int
1 Term F v loc
e Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Pretty (AnnotatedText a)
"} " Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Int -> Term F v loc -> Pretty (AnnotatedText a)
go Int
1 Term F v loc
o
      Type.Arrow' Term F v loc
i Term F v loc
o -> RedundantTypeAnnotation
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
paren (Int
p Int -> Int -> RedundantTypeAnnotation
forall a. Ord a => a -> a -> RedundantTypeAnnotation
>= Int
2) (Pretty (AnnotatedText a) -> Pretty (AnnotatedText a))
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a b. (a -> b) -> a -> b
$ Int -> Term F v loc -> Pretty (AnnotatedText a)
go Int
2 Term F v loc
i Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Pretty (AnnotatedText a)
" -> " Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Int -> Term F v loc -> Pretty (AnnotatedText a)
go Int
1 Term F v loc
o
      Type.Ann' Term F v loc
t Kind
k -> RedundantTypeAnnotation
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
paren RedundantTypeAnnotation
True (Pretty (AnnotatedText a) -> Pretty (AnnotatedText a))
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a b. (a -> b) -> a -> b
$ Int -> Term F v loc -> Pretty (AnnotatedText a)
go Int
1 Term F v loc
t Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Pretty (AnnotatedText a)
" : " Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Kind -> Pretty (AnnotatedText a)
forall a. Kind -> Pretty (AnnotatedText a)
renderKind Kind
k
      TupleType' [Term F v loc]
ts -> RedundantTypeAnnotation
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
paren RedundantTypeAnnotation
True (Pretty (AnnotatedText a) -> Pretty (AnnotatedText a))
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a b. (a -> b) -> a -> b
$ (Term F v loc -> Pretty (AnnotatedText a))
-> [Term F v loc] -> Pretty (AnnotatedText a)
forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
commas (Int -> Term F v loc -> Pretty (AnnotatedText a)
go Int
0) [Term F v loc]
ts
      Type.Apps' (Type.Ref' (R.Builtin Text
"Sequence")) [Term F v loc
arg] ->
        Pretty (AnnotatedText a)
"[" Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Int -> Term F v loc -> Pretty (AnnotatedText a)
go Int
0 Term F v loc
arg Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Pretty (AnnotatedText a)
"]"
      Type.Apps' Term F v loc
f' [Term F v loc]
args -> RedundantTypeAnnotation
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
paren (Int
p Int -> Int -> RedundantTypeAnnotation
forall a. Ord a => a -> a -> RedundantTypeAnnotation
>= Int
3) (Pretty (AnnotatedText a) -> Pretty (AnnotatedText a))
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a b. (a -> b) -> a -> b
$ (Term F v loc -> Pretty (AnnotatedText a))
-> [Term F v loc] -> Pretty (AnnotatedText a)
forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
spaces (Int -> Term F v loc -> Pretty (AnnotatedText a)
go Int
3) (Term F v loc
f' Term F v loc -> [Term F v loc] -> [Term F v loc]
forall a. a -> [a] -> [a]
: [Term F v loc]
args)
      Type.Effects' [Term F v loc]
es -> RedundantTypeAnnotation
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
curly (Int
p Int -> Int -> RedundantTypeAnnotation
forall a. Ord a => a -> a -> RedundantTypeAnnotation
>= Int
3) (Pretty (AnnotatedText a) -> Pretty (AnnotatedText a))
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a b. (a -> b) -> a -> b
$ (Term F v loc -> Pretty (AnnotatedText a))
-> [Term F v loc] -> Pretty (AnnotatedText a)
forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
commas (Int -> Term F v loc -> Pretty (AnnotatedText a)
go Int
0) [Term F v loc]
es
      Type.Effect' [Term F v loc]
es Term F v loc
t -> case [Term F v loc]
es of
        [] -> Int -> Term F v loc -> Pretty (AnnotatedText a)
go Int
p Term F v loc
t
        [Term F v loc]
_ -> Pretty (AnnotatedText a)
"{" Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> (Term F v loc -> Pretty (AnnotatedText a))
-> [Term F v loc] -> Pretty (AnnotatedText a)
forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
commas (Int -> Term F v loc -> Pretty (AnnotatedText a)
go Int
0) [Term F v loc]
es Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Pretty (AnnotatedText a)
"} " Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Int -> Term F v loc -> Pretty (AnnotatedText a)
go Int
3 Term F v loc
t
      Type.Effect1' Term F v loc
e Term F v loc
t -> RedundantTypeAnnotation
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
paren (Int
p Int -> Int -> RedundantTypeAnnotation
forall a. Ord a => a -> a -> RedundantTypeAnnotation
>= Int
3) (Pretty (AnnotatedText a) -> Pretty (AnnotatedText a))
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a b. (a -> b) -> a -> b
$ Pretty (AnnotatedText a)
"{" Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Int -> Term F v loc -> Pretty (AnnotatedText a)
go Int
0 Term F v loc
e Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Pretty (AnnotatedText a)
"}" Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Int -> Term F v loc -> Pretty (AnnotatedText a)
go Int
3 Term F v loc
t
      Type.ForallsNamed' [v]
vs Term F v loc
body ->
        RedundantTypeAnnotation
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
paren (Int
p Int -> Int -> RedundantTypeAnnotation
forall a. Ord a => a -> a -> RedundantTypeAnnotation
>= Int
1) (Pretty (AnnotatedText a) -> Pretty (AnnotatedText a))
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a b. (a -> b) -> a -> b
$
          if RedundantTypeAnnotation -> RedundantTypeAnnotation
not RedundantTypeAnnotation
Settings.debugRevealForalls
            then Int -> Term F v loc -> Pretty (AnnotatedText a)
go Int
0 Term F v loc
body
            else Pretty (AnnotatedText a)
"forall " Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> (v -> Pretty (AnnotatedText a)) -> [v] -> Pretty (AnnotatedText a)
forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
spaces v -> Pretty (AnnotatedText a)
forall a v. (IsString a, Var v) => v -> a
renderVar [v]
vs Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Pretty (AnnotatedText a)
" . " Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Int -> Term F v loc -> Pretty (AnnotatedText a)
go Int
1 Term F v loc
body
      Type.Var' v
v -> v -> Pretty (AnnotatedText a)
forall a v. (IsString a, Var v) => v -> a
renderVar v
v
      Term F v loc
_ -> [Char] -> Pretty (AnnotatedText a)
forall a. HasCallStack => [Char] -> a
error ([Char] -> Pretty (AnnotatedText a))
-> [Char] -> Pretty (AnnotatedText a)
forall a b. (a -> b) -> a -> b
$ [Char]
"pattern match failure in PrintError.renderType " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Term F v loc -> [Char]
forall a. Show a => a -> [Char]
show Term F v loc
t
      where
        go :: Int -> Term F v loc -> Pretty (AnnotatedText a)
go = Env
-> (loc -> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a))
-> Int
-> Term F v loc
-> Pretty (AnnotatedText a)
renderType0 Env
env loc -> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
f

renderSuggestion :: (IsString s, Semigroup s, Var v) => Env -> C.Suggestion v loc -> s
renderSuggestion :: forall s v loc.
(IsString s, Semigroup s, Var v) =>
Env -> Suggestion v loc -> s
renderSuggestion Env
env Suggestion v loc
sug =
  Env -> Term' (TypeVar Any v) v () -> s
forall s v loc0 loc1.
(IsString s, Var v) =>
Env -> Term' (TypeVar loc0 v) v loc1 -> s
renderTerm Env
env Term' (TypeVar Any v) v ()
term
    s -> s -> s
forall a. Semigroup a => a -> a -> a
<> s
" : "
    s -> s -> s
forall a. Semigroup a => a -> a -> a
<> Env -> Type (TypeVar v loc) loc -> s
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env (Suggestion v loc -> Type (TypeVar v loc) loc
forall v loc. Suggestion v loc -> Type v loc
C.suggestionType Suggestion v loc
sug)
  where
    term :: Term' (TypeVar Any v) v ()
term =
      case Suggestion v loc -> Replacement v
forall v loc. Suggestion v loc -> Replacement v
C.suggestionReplacement Suggestion v loc
sug of
        C.ReplacementRef Referent
ref -> () -> Referent -> Term' (TypeVar Any v) v ()
forall v a vt at ap. Ord v => a -> Referent -> Term2 vt at ap v a
Term.fromReferent () Referent
ref
        C.ReplacementVar v
v -> () -> v -> Term' (TypeVar Any v) v ()
forall a v vt at ap. a -> v -> Term2 vt at ap v a
Term.var () v
v

spaces :: (IsString a, Monoid a) => (b -> a) -> [b] -> a
spaces :: forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
spaces = a -> (b -> a) -> [b] -> a
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap a
" "

commas :: (IsString a, Monoid a) => (b -> a) -> [b] -> a
commas :: forall a b. (IsString a, Monoid a) => (b -> a) -> [b] -> a
commas = a -> (b -> a) -> [b] -> a
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap a
", "

renderVar :: (IsString a, Var v) => v -> a
renderVar :: forall a v. (IsString a, Var v) => v -> a
renderVar = [Char] -> a
forall a. IsString a => [Char] -> a
fromString ([Char] -> a) -> (v -> [Char]) -> v -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack (Text -> [Char]) -> (v -> Text) -> v -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Text
forall v. Var v => v -> Text
Var.name

renderVar' :: (Var v, Annotated a) => Env -> C.Context v a -> v -> String
renderVar' :: forall v a.
(Var v, Annotated a) =>
Env -> Context v a -> v -> [Char]
renderVar' Env
env Context v a
ctx v
v = case Context v a -> v -> Maybe (Monotype v a)
forall v loc. Ord v => Context v loc -> v -> Maybe (Monotype v loc)
C.lookupSolved Context v a
ctx v
v of
  Maybe (Monotype v a)
Nothing -> [Char]
"unsolved"
  Just Monotype v a
t -> Env -> Type (TypeVar v a) a -> [Char]
forall s v loc. (IsString s, Var v) => Env -> Type v loc -> s
renderType' Env
env (Type (TypeVar v a) a -> [Char]) -> Type (TypeVar v a) a -> [Char]
forall a b. (a -> b) -> a -> b
$ Monotype v a -> Type (TypeVar v a) a
forall v a. Monotype v a -> Type v a
Type.getPolytype Monotype v a
t

prettyVar :: (Var v) => v -> Pretty ColorText
prettyVar :: forall v. Var v => v -> Pretty ColorText
prettyVar = Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
Pr.text (Text -> Pretty ColorText) -> (v -> Text) -> v -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Text
forall v. Var v => v -> Text
Var.name

renderKind :: Kind -> Pretty (AnnotatedText a)
renderKind :: forall a. Kind -> Pretty (AnnotatedText a)
renderKind Kind
Kind.Star = Pretty (AnnotatedText a)
"*"
renderKind (Kind.Arrow Kind
k1 Kind
k2) = Kind -> Pretty (AnnotatedText a)
forall a. Kind -> Pretty (AnnotatedText a)
renderKind Kind
k1 Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Pretty (AnnotatedText a)
" -> " Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> Kind -> Pretty (AnnotatedText a)
forall a. Kind -> Pretty (AnnotatedText a)
renderKind Kind
k2

showTermRef :: (IsString s) => Env -> Referent -> s
showTermRef :: forall s. IsString s => Env -> Referent -> s
showTermRef Env
env Referent
r = [Char] -> s
forall a. IsString a => [Char] -> a
fromString ([Char] -> s)
-> (HashQualified Name -> [Char]) -> HashQualified Name -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack (Text -> [Char])
-> (HashQualified Name -> Text) -> HashQualified Name -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Text
HQ.toText (HashQualified Name -> s) -> HashQualified Name -> s
forall a b. (a -> b) -> a -> b
$ Env -> Referent -> HashQualified Name
PPE.termName Env
env Referent
r

showTypeRef :: (IsString s) => Env -> R.Reference -> s
showTypeRef :: forall s. IsString s => Env -> TypeReference -> s
showTypeRef Env
env TypeReference
r = [Char] -> s
forall a. IsString a => [Char] -> a
fromString ([Char] -> s)
-> (HashQualified Name -> [Char]) -> HashQualified Name -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack (Text -> [Char])
-> (HashQualified Name -> Text) -> HashQualified Name -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Text
HQ.toText (HashQualified Name -> s) -> HashQualified Name -> s
forall a b. (a -> b) -> a -> b
$ Env -> TypeReference -> HashQualified Name
PPE.typeName Env
env TypeReference
r

-- todo: do something different/better if cid not found
showConstructor :: (IsString s) => Env -> ConstructorReference -> s
showConstructor :: forall s. IsString s => Env -> ConstructorReference -> s
showConstructor Env
env ConstructorReference
r =
  [Char] -> s
forall a. IsString a => [Char] -> a
fromString ([Char] -> s)
-> (HashQualified Name -> [Char]) -> HashQualified Name -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack (Text -> [Char])
-> (HashQualified Name -> Text) -> HashQualified Name -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Text
HQ.toText (HashQualified Name -> s) -> HashQualified Name -> s
forall a b. (a -> b) -> a -> b
$
    Env -> ConstructorReference -> HashQualified Name
PPE.patternName Env
env ConstructorReference
r

_posToEnglish :: (IsString s) => L.Pos -> s
_posToEnglish :: forall s. IsString s => Pos -> s
_posToEnglish (L.Pos Int
l Int
c) =
  [Char] -> s
forall a. IsString a => [Char] -> a
fromString ([Char] -> s) -> [Char] -> s
forall a b. (a -> b) -> a -> b
$ [Char]
"Line " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
l [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", Column " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
c

rangeForToken :: L.Token a -> Range
rangeForToken :: forall a. Token a -> Range
rangeForToken Token a
t = Pos -> Pos -> Range
Range (Token a -> Pos
forall a. Token a -> Pos
L.start Token a
t) (Token a -> Pos
forall a. Token a -> Pos
L.end Token a
t)

rangeToEnglish :: (IsString s) => Range -> s
rangeToEnglish :: forall s. IsString s => Range -> s
rangeToEnglish (Range (L.Pos Int
l Int
c) (L.Pos Int
l' Int
c')) =
  [Char] -> s
forall a. IsString a => [Char] -> a
fromString ([Char] -> s) -> [Char] -> s
forall a b. (a -> b) -> a -> b
$
    let showColumn :: RedundantTypeAnnotation
showColumn = RedundantTypeAnnotation
True
     in if RedundantTypeAnnotation
showColumn
          then
            if Int
l Int -> Int -> RedundantTypeAnnotation
forall a. Eq a => a -> a -> RedundantTypeAnnotation
== Int
l'
              then
                if Int
c Int -> Int -> RedundantTypeAnnotation
forall a. Eq a => a -> a -> RedundantTypeAnnotation
== Int
c'
                  then [Char]
"line " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
l [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", column " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
c
                  else [Char]
"line " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
l [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", columns " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
c [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"-" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
c'
              else
                [Char]
"line "
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
l
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", column "
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
c
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" through "
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"line "
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
l'
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", column "
                  [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
c'
          else
            if Int
l Int -> Int -> RedundantTypeAnnotation
forall a. Eq a => a -> a -> RedundantTypeAnnotation
== Int
l'
              then [Char]
"line " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
l
              else [Char]
"lines " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
l [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"—" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
l'

annotatedToEnglish :: (Annotated a, IsString s, Semigroup s) => a -> s
annotatedToEnglish :: forall a s. (Annotated a, IsString s, Semigroup s) => a -> s
annotatedToEnglish a
a = case a -> Ann
forall a. Annotated a => a -> Ann
ann a
a of
  Ann
Intrinsic -> s
"<intrinsic>"
  Ann
External -> s
"<external>"
  GeneratedFrom Ann
a -> s
"generated from: " s -> s -> s
forall a. Semigroup a => a -> a -> a
<> Ann -> s
forall a s. (Annotated a, IsString s, Semigroup s) => a -> s
annotatedToEnglish Ann
a
  Ann Pos
start Pos
end -> Range -> s
forall s. IsString s => Range -> s
rangeToEnglish (Range -> s) -> Range -> s
forall a b. (a -> b) -> a -> b
$ Pos -> Pos -> Range
Range Pos
start Pos
end

rangeForAnnotated :: (Annotated a) => a -> Maybe Range
rangeForAnnotated :: forall a. Annotated a => a -> Maybe Range
rangeForAnnotated a
a = case a -> Ann
forall a. Annotated a => a -> Ann
ann a
a of
  Ann
Intrinsic -> Maybe Range
forall a. Maybe a
Nothing
  Ann
External -> Maybe Range
forall a. Maybe a
Nothing
  GeneratedFrom Ann
a -> Ann -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated Ann
a
  Ann Pos
start Pos
end -> Range -> Maybe Range
forall a. a -> Maybe a
Just (Range -> Maybe Range) -> Range -> Maybe Range
forall a b. (a -> b) -> a -> b
$ Pos -> Pos -> Range
Range Pos
start Pos
end

showLexerOutput :: Bool
showLexerOutput :: RedundantTypeAnnotation
showLexerOutput = RedundantTypeAnnotation
False

renderNoteAsANSI ::
  (Var v, Annotated a, Show a, Ord a) =>
  Pr.Width ->
  Env ->
  String ->
  Note v a ->
  String
renderNoteAsANSI :: forall v a.
(Var v, Annotated a, Show a, Ord a) =>
Width -> Env -> [Char] -> Note v a -> [Char]
renderNoteAsANSI Width
w Env
e [Char]
s Note v a
n = Width -> Pretty ColorText -> [Char]
Pr.toANSI Width
w (Pretty ColorText -> [Char]) -> Pretty ColorText -> [Char]
forall a b. (a -> b) -> a -> b
$ Env -> [Char] -> Note v a -> Pretty ColorText
forall v a.
(Var v, Annotated a, Show a, Ord a) =>
Env -> [Char] -> Note v a -> Pretty ColorText
printNoteWithSource Env
e [Char]
s Note v a
n

renderParseErrorAsANSI :: (Var v) => Pr.Width -> String -> Parser.Err v -> String
renderParseErrorAsANSI :: forall v. Var v => Width -> [Char] -> Err v -> [Char]
renderParseErrorAsANSI Width
w [Char]
src = Width -> Pretty ColorText -> [Char]
Pr.toANSI Width
w (Pretty ColorText -> [Char])
-> (Err v -> Pretty ColorText) -> Err v -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Err v -> Pretty ColorText
forall v. Var v => [Char] -> Err v -> Pretty ColorText
prettyParseError [Char]
src

printNoteWithSource ::
  (Var v, Annotated a, Show a, Ord a) =>
  Env ->
  String ->
  Note v a ->
  Pretty ColorText
printNoteWithSource :: forall v a.
(Var v, Annotated a, Show a, Ord a) =>
Env -> [Char] -> Note v a -> Pretty ColorText
printNoteWithSource Env
env [Char]
_s (TypeInfo InfoNote v a
n) = InfoNote v a -> Env -> Pretty ColorText
forall v loc.
(Var v, Ord loc, Show loc, Annotated loc) =>
InfoNote v loc -> Env -> Pretty ColorText
prettyTypeInfo InfoNote v a
n Env
env
printNoteWithSource Env
_env [Char]
s (Parsing Err v
e) = [Char] -> Err v -> Pretty ColorText
forall v. Var v => [Char] -> Err v -> Pretty ColorText
prettyParseError [Char]
s Err v
e
printNoteWithSource Env
env [Char]
s (TypeError ErrorNote v a
e) = ErrorNote v a -> Env -> [Char] -> Pretty ColorText
forall v loc.
(Var v, Ord loc, Show loc, Annotated loc) =>
ErrorNote v loc -> Env -> [Char] -> Pretty ColorText
prettyTypecheckError ErrorNote v a
e Env
env [Char]
s
printNoteWithSource Env
_env [Char]
_s (NameResolutionFailures [ResolutionFailure a]
_es) = Pretty ColorText
forall a. HasCallStack => a
undefined
printNoteWithSource Env
_env [Char]
s (UnknownSymbol v
v a
a) =
  [Char] -> Pretty ColorText
forall a. IsString a => [Char] -> a
fromString ([Char]
"Unknown symbol `" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
Text.unpack (v -> Text
forall v. Var v => v -> Text
Var.name v
v) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"`\n\n")
    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [Char] -> a -> Pretty ColorText
forall a. Annotated a => [Char] -> a -> Pretty ColorText
annotatedAsErrorSite [Char]
s a
a
printNoteWithSource Env
env [Char]
s (CompilerBug (Result.TypecheckerBug CompilerBug v a
c)) =
  Env -> [Char] -> CompilerBug v a -> Pretty ColorText
forall v loc.
(Var v, Annotated loc, Ord loc, Show loc) =>
Env -> [Char] -> CompilerBug v loc -> Pretty ColorText
renderCompilerBug Env
env [Char]
s CompilerBug v a
c
printNoteWithSource Env
_env [Char]
_s (CompilerBug CompilerBug v a
c) =
  [Char] -> Pretty ColorText
forall a. IsString a => [Char] -> a
fromString ([Char] -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ [Char]
"Compiler bug: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> CompilerBug v a -> [Char]
forall a. Show a => a -> [Char]
show CompilerBug v a
c

_printPosRange :: String -> L.Pos -> L.Pos -> String
_printPosRange :: [Char] -> Pos -> Pos -> [Char]
_printPosRange [Char]
s (L.Pos Int
startLine Int
startCol) Pos
_end =
  -- todo: multi-line ranges
  -- todo: ranges
  [Char] -> Int -> Int -> [Char]
_printArrowsAtPos [Char]
s Int
startLine Int
startCol

_printArrowsAtPos :: String -> Int -> Int -> String
_printArrowsAtPos :: [Char] -> Int -> Int -> [Char]
_printArrowsAtPos [Char]
s Int
line Int
column =
  let lineCaret :: [Char] -> Int -> [Char]
lineCaret [Char]
s Int
i = [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ if Int
i Int -> Int -> RedundantTypeAnnotation
forall a. Eq a => a -> a -> RedundantTypeAnnotation
== Int
line then [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
columnCaret else [Char]
""
      columnCaret :: [Char]
columnCaret = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
column Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Char
'-' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"^"
      source :: [Char]
source = [[Char]] -> [Char]
unlines (([Char] -> Int -> [Char]) -> ([Char], Int) -> [Char]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Char] -> Int -> [Char]
lineCaret (([Char], Int) -> [Char]) -> [([Char], Int)] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [[Char]]
lines [Char]
s [[Char]] -> [Int] -> [([Char], Int)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Int
1 ..])
   in [Char]
source

-- Wow, epic view pattern for picking out a lexer error
pattern LexerError :: [L.Token L.Lexeme] -> L.Err -> Maybe (P.ErrorItem (L.Token L.Lexeme))
pattern $mLexerError :: forall {r}.
Maybe (ErrorItem (Token Lexeme))
-> ([Token Lexeme] -> Err -> r) -> ((# #) -> r) -> r
LexerError ts e <- Just (P.Tokens (firstLexerError -> Just (ts, e)))

firstLexerError :: (Foldable t) => t (L.Token L.Lexeme) -> Maybe ([L.Token L.Lexeme], L.Err)
firstLexerError :: forall (t :: * -> *).
Foldable t =>
t (Token Lexeme) -> Maybe ([Token Lexeme], Err)
firstLexerError t (Token Lexeme)
ts =
  (([Token Lexeme], Err) -> RedundantTypeAnnotation)
-> [([Token Lexeme], Err)] -> Maybe ([Token Lexeme], Err)
forall (t :: * -> *) a.
Foldable t =>
(a -> RedundantTypeAnnotation) -> t a -> Maybe a
find (RedundantTypeAnnotation
-> ([Token Lexeme], Err) -> RedundantTypeAnnotation
forall a b. a -> b -> a
const RedundantTypeAnnotation
True) [(t (Token Lexeme) -> [Token Lexeme]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t (Token Lexeme)
ts, Err
e) | (Token Lexeme -> Lexeme
forall a. Token a -> a
L.payload -> L.Err Err
e) <- t (Token Lexeme) -> [Token Lexeme]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t (Token Lexeme)
ts]

prettyParseError ::
  forall v.
  (Var v) =>
  String ->
  Parser.Err v ->
  Pretty ColorText
prettyParseError :: forall v. Var v => [Char] -> Err v -> Pretty ColorText
prettyParseError [Char]
s Err v
e =
  [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat ((Pretty ColorText, [Range]) -> Pretty ColorText
forall a b. (a, b) -> a
fst ((Pretty ColorText, [Range]) -> Pretty ColorText)
-> [(Pretty ColorText, [Range])] -> [Pretty ColorText]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Err v -> [(Pretty ColorText, [Range])]
forall v. Var v => [Char] -> Err v -> [(Pretty ColorText, [Range])]
renderParseErrors [Char]
s Err v
e) Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall a. Pretty (AnnotatedText a)
lexerOutput
  where
    lexerOutput :: Pretty (AnnotatedText a)
    lexerOutput :: forall a. Pretty (AnnotatedText a)
lexerOutput =
      if RedundantTypeAnnotation
showLexerOutput
        then Pretty (AnnotatedText a)
"\nLexer output:\n" Pretty (AnnotatedText a)
-> Pretty (AnnotatedText a) -> Pretty (AnnotatedText a)
forall a. Semigroup a => a -> a -> a
<> [Char] -> Pretty (AnnotatedText a)
forall a. IsString a => [Char] -> a
fromString ([Char] -> [Char]
L.debugPreParse' [Char]
s)
        else Pretty (AnnotatedText a)
forall a. Monoid a => a
mempty

renderParseErrors ::
  forall v.
  (Var v) =>
  String ->
  Parser.Err v ->
  [(Pretty ColorText, [Range])]
renderParseErrors :: forall v. Var v => [Char] -> Err v -> [(Pretty ColorText, [Range])]
renderParseErrors [Char]
s = \case
  P.TrivialError Int
_ (LexerError [Token Lexeme]
ts Err
e) Set (ErrorItem (Token Input))
_ -> [(Err -> Pretty ColorText
go Err
e, [Range]
ranges)]
    where
      ranges :: [Range]
ranges = Token Lexeme -> Range
forall a. Token a -> Range
rangeForToken (Token Lexeme -> Range) -> [Token Lexeme] -> [Range]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token Lexeme]
ts
      excerpt :: Pretty ColorText
excerpt = [Char] -> [(Range, Color)] -> Pretty ColorText
forall a.
Ord a =>
[Char] -> [(Range, a)] -> Pretty (AnnotatedText a)
showSource [Char]
s ((\Range
r -> (Range
r, Color
ErrorSite)) (Range -> (Range, Color)) -> [Range] -> [(Range, Color)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Range]
ranges)
      go :: Err -> Pretty ColorText
go = \case
        L.UnexpectedDelimiter [Char]
s ->
          Pretty ColorText
"I found a "
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite ([Char] -> [Char]
forall a. IsString a => [Char] -> a
fromString [Char]
s)
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" here, but I didn't see a list or tuple that it might be a separator for.\n\n"
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
excerpt
        L.CloseWithoutMatchingOpen [Char]
open [Char]
close ->
          Pretty ColorText
"I found a closing "
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite ([Char] -> [Char]
forall a. IsString a => [Char] -> a
fromString [Char]
close)
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" here without a matching "
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite ([Char] -> [Char]
forall a. IsString a => [Char] -> a
fromString [Char]
open)
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
".\n\n"
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
excerpt
        L.ReservedWordyId [Char]
id ->
          [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
            [ Pretty ColorText
"The identifier " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [Char] -> Pretty ColorText
quoteCode [Char]
id Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" used here is a reserved keyword: ",
              Pretty ColorText
"",
              Pretty ColorText
excerpt,
              Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                Pretty ColorText
"You can avoid this problem either by renaming the identifier or wrapping it in backticks (like "
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Code ([Char]
"`" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
id [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"`")
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
")."
            ]
        L.InvalidSymbolyId [Char]
id ->
          [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
            [ Pretty ColorText
"The infix identifier " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [Char] -> Pretty ColorText
quoteCode [Char]
id Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" isn’t valid syntax: ",
              Pretty ColorText
"",
              Pretty ColorText
excerpt,
              Pretty ColorText
"Here are a few valid examples: "
                Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [Char] -> Pretty ColorText
quoteCode [Char]
"++"
                Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
", "
                Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [Char] -> Pretty ColorText
quoteCode [Char]
"Float./"
                Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
", and "
                Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [Char] -> Pretty ColorText
quoteCode [Char]
"List.map"
            ]
        L.ReservedSymbolyId [Char]
id ->
          [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
            [ Pretty ColorText
"The identifier " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [Char] -> Pretty ColorText
quoteCode [Char]
id Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" is reserved by Unison and can't be used as an operator: ",
              Pretty ColorText
"",
              Pretty ColorText
excerpt
            ]
        L.InvalidBytesLiteral [Char]
bs ->
          [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
            [ Pretty ColorText
"This bytes literal isn't valid syntax: " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite ([Char] -> [Char]
forall a. IsString a => [Char] -> a
fromString [Char]
bs),
              Pretty ColorText
"",
              Pretty ColorText
excerpt,
              Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                Pretty ColorText
"I was expecting an even number of hexidecimal characters"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"(one of"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
Pr.group (Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Code [Char]
"0123456789abcdefABCDEF" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
")")
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"after the"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
Pr.group (Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite [Char]
"0xs" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
".")
            ]
        Err
L.InvalidHexLiteral ->
          [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
            [ Pretty ColorText
"This number isn't valid syntax: ",
              Pretty ColorText
"",
              Pretty ColorText
excerpt,
              Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                Pretty ColorText
"I was expecting only hexidecimal characters"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"(one of"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
Pr.group (Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Code [Char]
"0123456789abcdefABCDEF" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
")")
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"after the"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
Pr.group (Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite [Char]
"0x" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
".")
            ]
        Err
L.InvalidOctalLiteral ->
          [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
            [ Pretty ColorText
"This number isn't valid syntax: ",
              Pretty ColorText
"",
              Pretty ColorText
excerpt,
              Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                Pretty ColorText
"I was expecting only octal characters"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"(one of"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
Pr.group (Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Code [Char]
"01234567" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
")")
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"after the"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
Pr.group (Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite [Char]
"0o" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
".")
            ]
        Err
L.InvalidBinaryLiteral ->
          [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
            [ Pretty ColorText
"This number isn't valid syntax: ",
              Pretty ColorText
"",
              Pretty ColorText
excerpt,
              Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                Pretty ColorText
"I was expecting only binary characters"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"(one of"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
Pr.group (Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Code [Char]
"01" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
")")
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"after the"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
Pr.group (Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite [Char]
"0b" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
".")
            ]
        L.InvalidShortHash [Char]
h ->
          [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
            [ Pretty ColorText
"Invalid hash: " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite ([Char] -> [Char]
forall a. IsString a => [Char] -> a
fromString [Char]
h),
              Pretty ColorText
"",
              Pretty ColorText
excerpt
            ]
        L.Both Err
e1 Err
e2 -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines [Err -> Pretty ColorText
go Err
e1, Pretty ColorText
"", Err -> Pretty ColorText
go Err
e2]
        Err
L.UnknownLexeme -> [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines [Pretty ColorText
"I couldn't parse this.", Pretty ColorText
"", Pretty ColorText
excerpt]
        L.MissingFractional [Char]
n ->
          [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
            [ Pretty ColorText
"This number isn't valid syntax: ",
              Pretty ColorText
"",
              Pretty ColorText
excerpt,
              Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                Pretty ColorText
"I was expecting some digits after the "
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [Char] -> Pretty ColorText
quoteCode [Char]
"."
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
", for example: "
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [Char] -> Pretty ColorText
quoteCode ([Char]
n [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"0")
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"or"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
Pr.group ([Char] -> Pretty ColorText
quoteCode ([Char]
n [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"1e37") Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
".")
            ]
        L.MissingExponent [Char]
n ->
          [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
            [ Pretty ColorText
"This number isn't valid syntax: ",
              Pretty ColorText
"",
              Pretty ColorText
excerpt,
              Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                Pretty ColorText
"I was expecting some digits for the exponent,"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"for example: "
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
Pr.group ([Char] -> Pretty ColorText
quoteCode ([Char]
n [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"37") Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
".")
            ]
        L.TextLiteralMissingClosingQuote [Char]
_txt ->
          [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
            [ Pretty ColorText
"This text is missing a closing quote:",
              Pretty ColorText
"",
              Pretty ColorText
excerpt
            ]
        L.InvalidEscapeCharacter Char
c ->
          [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
            [ Pretty ColorText
"This isn't a valid escape character: " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite [Char
c],
              Pretty ColorText
"",
              Pretty ColorText
excerpt,
              Pretty ColorText
"",
              Pretty ColorText
"I only know about the following escape characters:",
              Pretty ColorText
"",
              let s :: Char -> Pretty ColorText
s Char
ch = [Char] -> Pretty ColorText
quoteCode ([Char] -> [Char]
forall a. IsString a => [Char] -> a
fromString ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"\\" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char
ch])
               in Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
Pr.indentN Width
2 (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Pretty ColorText
-> (Char -> Pretty ColorText) -> [Char] -> Pretty ColorText
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap Pretty ColorText
"," Char -> Pretty ColorText
s ((Char, Char) -> Char
forall a b. (a, b) -> a
fst ((Char, Char) -> Char) -> [(Char, Char)] -> [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Char, Char)]
L.escapeChars)
            ]
        Err
L.LayoutError ->
          [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
            [ Pretty ColorText
"I found an indentation error somewhere in here:",
              Pretty ColorText
"",
              Pretty ColorText
excerpt
            ]
        L.UnexpectedTokens [Char]
msg ->
          [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
            [ Pretty ColorText
"I got confused here:",
              Pretty ColorText
"",
              Pretty ColorText
excerpt,
              Pretty ColorText
"",
              Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite [Char]
msg
            ]
  P.TrivialError Int
_errOffset Maybe (ErrorItem (Token Input))
unexpected Set (ErrorItem (Token Input))
expected ->
    let unexpectedTokens :: Maybe (Nel.NonEmpty (L.Token L.Lexeme))
        unexpectedTokenStrs :: Set String
        (Maybe (NonEmpty (Token Lexeme))
unexpectedTokens, Set [Char]
unexpectedTokenStrs) = case Maybe (ErrorItem (Token Input))
unexpected of
          Just (P.Tokens NonEmpty (Token Input)
ts) ->
            NonEmpty (Token Lexeme) -> [Token Lexeme]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList NonEmpty (Token Input)
NonEmpty (Token Lexeme)
ts
              [Token Lexeme] -> ([Token Lexeme] -> [[Char]]) -> [[Char]]
forall a b. a -> (a -> b) -> b
& (Token Lexeme -> [Char]) -> [Token Lexeme] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Lexeme -> [Char]
L.displayLexeme (Lexeme -> [Char])
-> (Token Lexeme -> Lexeme) -> Token Lexeme -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token Lexeme -> Lexeme
forall a. Token a -> a
L.payload)
              [[Char]] -> ([[Char]] -> Set [Char]) -> Set [Char]
forall a b. a -> (a -> b) -> b
& [[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList
              Set [Char]
-> (Set [Char] -> (Maybe (NonEmpty (Token Lexeme)), Set [Char]))
-> (Maybe (NonEmpty (Token Lexeme)), Set [Char])
forall a b. a -> (a -> b) -> b
& (NonEmpty (Token Lexeme) -> Maybe (NonEmpty (Token Lexeme))
forall a. a -> Maybe a
Just NonEmpty (Token Input)
NonEmpty (Token Lexeme)
ts,)
          Just (P.Label NonEmpty Char
ts) -> (Maybe (NonEmpty (Token Lexeme))
forall a. Monoid a => a
mempty, [Char] -> Set [Char]
forall a. a -> Set a
Set.singleton ([Char] -> Set [Char]) -> [Char] -> Set [Char]
forall a b. (a -> b) -> a -> b
$ NonEmpty Char -> [Char]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList NonEmpty Char
ts)
          Just (ErrorItem (Token Input)
P.EndOfInput) -> (Maybe (NonEmpty (Token Lexeme))
forall a. Monoid a => a
mempty, [Char] -> Set [Char]
forall a. a -> Set a
Set.singleton [Char]
"end of input")
          Maybe (ErrorItem (Token Input))
Nothing -> (Maybe (NonEmpty (Token Lexeme))
forall a. Monoid a => a
mempty, Set [Char]
forall a. Monoid a => a
mempty)
        expectedTokenStrs :: Set String
        expectedTokenStrs :: Set [Char]
expectedTokenStrs =
          Set (ErrorItem (Token Input))
Set (ErrorItem (Token Lexeme))
expected Set (ErrorItem (Token Lexeme))
-> (Set (ErrorItem (Token Lexeme)) -> Set [Char]) -> Set [Char]
forall a b. a -> (a -> b) -> b
& (ErrorItem (Token Lexeme) -> Set [Char])
-> Set (ErrorItem (Token Lexeme)) -> Set [Char]
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \case
            (P.Tokens NonEmpty (Token Lexeme)
ts) ->
              NonEmpty (Token Lexeme) -> [Token Lexeme]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList NonEmpty (Token Lexeme)
ts
                [Token Lexeme] -> ([Token Lexeme] -> [[Char]]) -> [[Char]]
forall a b. a -> (a -> b) -> b
& (Token Lexeme -> [Char]) -> [Token Lexeme] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Lexeme -> [Char]
L.displayLexeme (Lexeme -> [Char])
-> (Token Lexeme -> Lexeme) -> Token Lexeme -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token Lexeme -> Lexeme
forall a. Token a -> a
L.payload)
                [[Char]] -> ([[Char]] -> Set [Char]) -> Set [Char]
forall a b. a -> (a -> b) -> b
& [[Char]] -> Set [Char]
forall a. Ord a => [a] -> Set a
Set.fromList
            (P.Label NonEmpty Char
ts) -> [Char] -> Set [Char]
forall a. a -> Set a
Set.singleton ([Char] -> Set [Char]) -> [Char] -> Set [Char]
forall a b. (a -> b) -> a -> b
$ NonEmpty Char -> [Char]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList NonEmpty Char
ts
            (ErrorItem (Token Lexeme)
P.EndOfInput) -> [Char] -> Set [Char]
forall a. a -> Set a
Set.singleton [Char]
"end of input"
        ranges :: [Range]
ranges = case Maybe (NonEmpty (Token Lexeme))
unexpectedTokens of
          Maybe (NonEmpty (Token Lexeme))
Nothing -> []
          Just NonEmpty (Token Lexeme)
ts -> Token Lexeme -> Range
forall a. Token a -> Range
rangeForToken (Token Lexeme -> Range) -> [Token Lexeme] -> [Range]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Token Lexeme) -> [Token Lexeme]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList NonEmpty (Token Lexeme)
ts
        excerpt :: Pretty ColorText
excerpt = [Char] -> [(Range, Color)] -> Pretty ColorText
forall a.
Ord a =>
[Char] -> [(Range, a)] -> Pretty (AnnotatedText a)
showSource [Char]
s ((\Range
r -> (Range
r, Color
ErrorSite)) (Range -> (Range, Color)) -> [Range] -> [(Range, Color)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Range]
ranges)
        msg :: [Char]
msg = Set [Char] -> Set [Char] -> [Char]
L.formatTrivialError Set [Char]
unexpectedTokenStrs Set [Char]
expectedTokenStrs
     in [ ( [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
              [ Pretty ColorText
"I got confused here:",
                Pretty ColorText
"",
                Pretty ColorText
excerpt,
                Pretty ColorText
"",
                Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite [Char]
msg
              ],
            [Range]
ranges
          )
        ]
  P.FancyError Int
_sp Set (ErrorFancy (Error v))
fancyErrors ->
    (ErrorFancy (Error v) -> (Pretty ColorText, [Range])
go' (ErrorFancy (Error v) -> (Pretty ColorText, [Range]))
-> [ErrorFancy (Error v)] -> [(Pretty ColorText, [Range])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (ErrorFancy (Error v)) -> [ErrorFancy (Error v)]
forall a. Set a -> [a]
Set.toList Set (ErrorFancy (Error v))
fancyErrors)
  where
    go' :: P.ErrorFancy (Parser.Error v) -> (Pretty ColorText, [Range])
    go' :: ErrorFancy (Error v) -> (Pretty ColorText, [Range])
go' (P.ErrorFail [Char]
s) =
      (Pretty ColorText
"The parser failed with this message:\n" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [Char] -> Pretty ColorText
forall a. IsString a => [Char] -> a
fromString [Char]
s, [])
    go' (P.ErrorIndentation Ordering
ordering Pos
indent1 Pos
indent2) =
      let ranges :: [a]
ranges = [] -- TODO: determine the source location from the offset position, which is the token offset maybe?
       in ( [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
              [ Pretty ColorText
"The parser was confused by the indentation.\n",
                Pretty ColorText
"It was expecting the reference level (",
                [Char] -> Pretty ColorText
forall a. IsString a => [Char] -> a
fromString (Pos -> [Char]
forall a. Show a => a -> [Char]
show Pos
indent1),
                Pretty ColorText
")\nto be ",
                [Char] -> Pretty ColorText
forall a. IsString a => [Char] -> a
fromString (Ordering -> [Char]
forall a. Show a => a -> [Char]
show Ordering
ordering),
                Pretty ColorText
" than/to the actual level (",
                [Char] -> Pretty ColorText
forall a. IsString a => [Char] -> a
fromString (Pos -> [Char]
forall a. Show a => a -> [Char]
show Pos
indent2),
                Pretty ColorText
").\n"
              ],
            [Range]
forall a. [a]
ranges
          )
    go' (P.ErrorCustom Error v
e) = Error v -> (Pretty ColorText, [Range])
go Error v
e
    errorVar :: v -> Pretty ColorText
errorVar v
v = Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite ([Char] -> Pretty ColorText)
-> (Text -> [Char]) -> Text -> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. IsString a => [Char] -> a
fromString ([Char] -> [Char]) -> (Text -> [Char]) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack (Text -> Pretty ColorText) -> Text -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ v -> Text
forall v. Var v => v -> Text
Var.name v
v
    go :: Parser.Error v -> (Pretty ColorText, [Range])
    -- UseInvalidPrefixSuffix (Either (L.Token Name) (L.Token Name)) (Maybe [L.Token Name])
    go :: Error v -> (Pretty ColorText, [Range])
go (Parser.PatternArityMismatch Int
expected Int
actual Ann
loc) = (Pretty ColorText
msg, [Range]
ranges)
      where
        ranges :: [Range]
ranges = Maybe Range -> [Range]
forall a. Maybe a -> [a]
maybeToList (Maybe Range -> [Range]) -> Maybe Range -> [Range]
forall a b. (a -> b) -> a -> b
$ Ann -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated Ann
loc
        msg :: Pretty ColorText
msg =
          Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
Pr.indentN Width
2 (Pretty ColorText -> Pretty ColorText)
-> (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
Pr.callout Pretty ColorText
"😶" (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
            [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
              [ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                  Pretty ColorText
"Not all the branches of this pattern matching have"
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"the same number of arguments. I was assuming they'd all have "
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
Pr.hiBlue (Int -> Pretty ColorText
forall a s. (Show a, IsString s) => a -> Pretty s
Pr.shown Int
expected)
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"arguments (based on the previous patterns)"
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"but this one has "
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
Pr.hiRed (Int -> Pretty ColorText
forall a s. (Show a, IsString s) => a -> Pretty s
Pr.shown Int
actual)
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"arguments:",
                [Char] -> Ann -> Pretty ColorText
forall a. Annotated a => [Char] -> a -> Pretty ColorText
annotatedAsErrorSite [Char]
s Ann
loc
              ]
    go (Parser.FloatPattern Ann
loc) = (Pretty ColorText
msg, [Range]
ranges)
      where
        ranges :: [Range]
ranges = Maybe Range -> [Range]
forall a. Maybe a -> [a]
maybeToList (Maybe Range -> [Range]) -> Maybe Range -> [Range]
forall a b. (a -> b) -> a -> b
$ Ann -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated Ann
loc
        msg :: Pretty ColorText
msg =
          Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
Pr.indentN Width
2 (Pretty ColorText -> Pretty ColorText)
-> (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
Pr.callout Pretty ColorText
"😶" (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
            [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
              [ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                  Pretty ColorText
"Floating point pattern matching is disallowed. Instead,"
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"it is recommended to test that a value is within"
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"an acceptable error bound of the expected value.",
                [Char] -> Ann -> Pretty ColorText
forall a. Annotated a => [Char] -> a -> Pretty ColorText
annotatedAsErrorSite [Char]
s Ann
loc
              ]
    go (Parser.UseEmpty Token [Char]
tok) = (Pretty ColorText
msg, [Range]
ranges)
      where
        ranges :: [Range]
ranges = [Token [Char] -> Range
forall a. Token a -> Range
rangeForToken Token [Char]
tok]
        msg :: Pretty ColorText
msg =
          Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
Pr.indentN Width
2 (Pretty ColorText -> Pretty ColorText)
-> (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
Pr.callout Pretty ColorText
"😶" (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
            [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
              [ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Pretty ColorText
"I was expecting something after the " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
Pr.hiRed Pretty ColorText
"use" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"keyword",
                Pretty ColorText
"",
                [Char] -> Token [Char] -> Pretty ColorText
forall a. [Char] -> Token a -> Pretty ColorText
tokenAsErrorSite [Char]
s Token [Char]
tok,
                Pretty ColorText
useExamples
              ]
    go (Parser.UseInvalidPrefixSuffix Either (Token Name) (Token Name)
prefix Maybe [Token Name]
suffix) = (Pretty ColorText
msg', [Range]
ranges)
      where
        msg' :: Pretty ColorText
        msg' :: Pretty ColorText
msg' = Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
Pr.indentN Width
2 (Pretty ColorText -> Pretty ColorText)
-> ([Pretty ColorText] -> Pretty ColorText)
-> [Pretty ColorText]
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.blockedCallout (Pretty ColorText -> Pretty ColorText)
-> ([Pretty ColorText] -> Pretty ColorText)
-> [Pretty ColorText]
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines ([Pretty ColorText] -> Pretty ColorText)
-> [Pretty ColorText] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ [Pretty ColorText]
msg
        ([Pretty ColorText]
msg, [Range]
ranges) = case (Either (Token Name) (Token Name)
prefix, Maybe [Token Name]
suffix) of
          (Left Token Name
tok, Just [Token Name]
_) ->
            ( [ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap Pretty ColorText
"The first argument of a `use` statement can't be an operator name:",
                Pretty ColorText
"",
                [Char] -> Token Name -> Pretty ColorText
forall a. [Char] -> Token a -> Pretty ColorText
tokenAsErrorSite [Char]
s Token Name
tok,
                Pretty ColorText
useExamples
              ],
              [Token Name -> Range
forall a. Token a -> Range
rangeForToken Token Name
tok]
            )
          (Either (Token Name) (Token Name)
tok0, Maybe [Token Name]
Nothing) ->
            let tok :: Token Name
tok = (Token Name -> Token Name)
-> (Token Name -> Token Name)
-> Either (Token Name) (Token Name)
-> Token Name
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Token Name -> Token Name
forall a. a -> a
id Token Name -> Token Name
forall a. a -> a
id Either (Token Name) (Token Name)
tok0
                ranges :: [Range]
ranges = [Token Name -> Range
forall a. Token a -> Range
rangeForToken Token Name
tok]
                txts :: [Pretty ColorText]
txts =
                  [ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Pretty ColorText
"I was expecting something after " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
Pr.hiRed Pretty ColorText
"here:",
                    Pretty ColorText
"",
                    [Char] -> Token Name -> Pretty ColorText
forall a. [Char] -> Token a -> Pretty ColorText
tokenAsErrorSite [Char]
s Token Name
tok,
                    case Name -> Maybe Name
Name.parent (Token Name -> Name
forall a. Token a -> a
L.payload Token Name
tok) of
                      Maybe Name
Nothing -> Pretty ColorText
useExamples
                      Just Name
parent ->
                        Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                          Pretty ColorText
"You can write"
                            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
Pr.group
                              ( Pretty ColorText -> Pretty ColorText
Pr.blue (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                                  Pretty ColorText
"use "
                                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
Pr.text (Name -> Text
Name.toText (Name -> Name
Name.makeRelative Name
parent))
                                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" "
                                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
Pr.text (Name -> Text
Name.toText (Name -> Name
Name.unqualified (Token Name -> Name
forall a. Token a -> a
L.payload Token Name
tok)))
                              )
                            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"to introduce "
                            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. IsString s => Pretty s -> Pretty s
Pr.backticked (Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
Pr.text (Name -> Text
Name.toText (Name -> Name
Name.unqualified (Token Name -> Name
forall a. Token a -> a
L.payload Token Name
tok))))
                            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"as a local alias for "
                            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. IsString s => Pretty s -> Pretty s
Pr.backticked (Text -> Pretty ColorText
forall s. IsString s => Text -> Pretty s
Pr.text (Name -> Text
Name.toText (Token Name -> Name
forall a. Token a -> a
L.payload Token Name
tok)))
                  ]
             in ([Pretty ColorText]
txts, [Range]
ranges)
          (Right Token Name
tok, Maybe [Token Name]
_) ->
            ( [ -- this is unpossible but rather than bomb, nice msg
                Pretty ColorText
"You found a Unison bug 🐞  here:",
                Pretty ColorText
"",
                [Char] -> Token Name -> Pretty ColorText
forall a. [Char] -> Token a -> Pretty ColorText
tokenAsErrorSite [Char]
s Token Name
tok,
                Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                  Pretty ColorText
"This looks like a valid `use` statement,"
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"but the parser didn't recognize it. This is a Unison bug."
              ],
              [Token Name -> Range
forall a. Token a -> Range
rangeForToken Token Name
tok]
            )
    go (Parser.DisallowedAbsoluteName Token Name
t) = (Pretty ColorText
msg, [Range]
ranges)
      where
        ranges :: [Range]
ranges = [Token Name -> Range
forall a. Token a -> Range
rangeForToken Token Name
t]
        msg :: Pretty ColorText
        msg :: Pretty ColorText
msg =
          Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
Pr.indentN Width
2 (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
            Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.fatalCallout (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
              [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
                [ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                    Pretty ColorText
"I don't currently support creating definitions that start with"
                      Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
Pr.group (Pretty ColorText -> Pretty ColorText
Pr.blue Pretty ColorText
"'.'" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
":"),
                  Pretty ColorText
"",
                  [Char] -> Token Name -> Pretty ColorText
forall a. [Char] -> Token a -> Pretty ColorText
tokenAsErrorSite [Char]
s Token Name
t,
                  Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Pretty ColorText
"Use " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
Pr.blue Pretty ColorText
"help messages.disallowedAbsolute" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"to learn more.",
                  Pretty ColorText
""
                ]
    go (Parser.DuplicateTypeNames [(v, [Ann])]
ts) = (Pretty ColorText
-> ((v, [Ann]) -> Pretty ColorText)
-> [(v, [Ann])]
-> Pretty ColorText
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap Pretty ColorText
"\n\n" (v, [Ann]) -> Pretty ColorText
showDup [(v, [Ann])]
ts, [Range]
ranges)
      where
        ranges :: [Range]
ranges = [(v, [Ann])]
ts [(v, [Ann])] -> ((v, [Ann]) -> [Ann]) -> [Ann]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (v, [Ann]) -> [Ann]
forall a b. (a, b) -> b
snd [Ann] -> (Ann -> [Range]) -> [Range]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Range -> [Range]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Maybe Range -> [Range]) -> (Ann -> Maybe Range) -> Ann -> [Range]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated
        showDup :: (v, [Ann]) -> Pretty ColorText
showDup (v
v, [Ann]
locs) =
          Pretty ColorText
"I found multiple types with the name "
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> v -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
errorVar v
v
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
":\n\n"
            Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> [Ann] -> Pretty ColorText
forall a. Annotated a => Color -> [Char] -> [a] -> Pretty ColorText
annotatedsStartingLineAsStyle Color
ErrorSite [Char]
s [Ann]
locs
    go (Parser.DuplicateTermNames [(v, [Ann])]
ts) =
      (Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.fatalCallout (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ Pretty ColorText
-> ((v, [Ann]) -> Pretty ColorText)
-> [(v, [Ann])]
-> Pretty ColorText
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap Pretty ColorText
"\n\n" (v, [Ann]) -> Pretty ColorText
showDup [(v, [Ann])]
ts, [Range]
ranges)
      where
        ranges :: [Range]
ranges = [(v, [Ann])]
ts [(v, [Ann])] -> ((v, [Ann]) -> [Ann]) -> [Ann]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (v, [Ann]) -> [Ann]
forall a b. (a, b) -> b
snd [Ann] -> (Ann -> [Range]) -> [Range]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Range -> [Range]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Maybe Range -> [Range]) -> (Ann -> Maybe Range) -> Ann -> [Range]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated
        showDup :: (v, [Ann]) -> Pretty ColorText
showDup (v
v, [Ann]
locs) =
          [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
            [ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                Pretty ColorText
"I found multiple bindings with the name " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText -> Pretty ColorText
forall s. Pretty s -> Pretty s
Pr.group (v -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
errorVar v
v Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
":"),
              Color -> [Char] -> [Ann] -> Pretty ColorText
forall a. Annotated a => Color -> [Char] -> [a] -> Pretty ColorText
annotatedsStartingLineAsStyle Color
ErrorSite [Char]
s [Ann]
locs
            ]
    go (Parser.TypeDeclarationErrors [Error v Ann]
es) =
      let unknownTypes :: [(v, Ann)]
unknownTypes = [(v
v, Ann
a) | UF.UnknownType v
v Ann
a <- [Error v Ann]
es]
          dupDataAndAbilities :: [(v, Ann, Ann)]
dupDataAndAbilities = [(v
v, Ann
a, Ann
a2) | UF.DupDataAndAbility v
v Ann
a Ann
a2 <- [Error v Ann]
es]
          allAnns :: [Ann]
allAnns = ((v, Ann) -> Ann
forall a b. (a, b) -> b
snd ((v, Ann) -> Ann) -> [(v, Ann)] -> [Ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(v, Ann)]
unknownTypes) [Ann] -> [Ann] -> [Ann]
forall a. Semigroup a => a -> a -> a
<> (((v, Ann, Ann) -> [Ann]) -> [(v, Ann, Ann)] -> [Ann]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(v
_, Ann
a1, Ann
a2) -> [Ann
a1, Ann
a2]) [(v, Ann, Ann)]
dupDataAndAbilities)
          allRanges :: [Range]
allRanges = [Ann]
allAnns [Ann] -> (Ann -> [Range]) -> [Range]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Range -> [Range]
forall a. Maybe a -> [a]
maybeToList (Maybe Range -> [Range]) -> (Ann -> Maybe Range) -> Ann -> [Range]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ann -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated
          unknownTypesMsg :: Pretty ColorText
unknownTypesMsg =
            [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
              [ Pretty ColorText
"I don't know about the type(s) ",
                Pretty ColorText
-> (v -> Pretty ColorText) -> [v] -> Pretty ColorText
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap Pretty ColorText
", " v -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
errorVar ([v] -> [v]
forall a. Ord a => [a] -> [a]
nubOrd ([v] -> [v]) -> [v] -> [v]
forall a b. (a -> b) -> a -> b
$ (v, Ann) -> v
forall a b. (a, b) -> a
fst ((v, Ann) -> v) -> [(v, Ann)] -> [v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(v, Ann)]
unknownTypes),
                Pretty ColorText
":\n\n",
                Color -> [Char] -> [Ann] -> Pretty ColorText
forall a. Annotated a => Color -> [Char] -> [a] -> Pretty ColorText
annotatedsAsStyle Color
ErrorSite [Char]
s ((v, Ann) -> Ann
forall a b. (a, b) -> b
snd ((v, Ann) -> Ann) -> [(v, Ann)] -> [Ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(v, Ann)]
unknownTypes)
              ]
          dupDataAndAbilitiesMsg :: Pretty ColorText
dupDataAndAbilitiesMsg = Pretty ColorText
-> ((v, Ann, Ann) -> Pretty ColorText)
-> [(v, Ann, Ann)]
-> Pretty ColorText
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap Pretty ColorText
"\n\n" (v, Ann, Ann) -> Pretty ColorText
dupMsg [(v, Ann, Ann)]
dupDataAndAbilities
          dupMsg :: (v, Ann, Ann) -> Pretty ColorText
dupMsg (v
v, Ann
a, Ann
a2) =
            [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
              [ Pretty ColorText
"I found two types called " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> v -> Pretty ColorText
forall v. Var v => v -> Pretty ColorText
errorVar v
v Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
":",
                Pretty ColorText
"\n\n",
                Color -> [Char] -> [Ann] -> Pretty ColorText
forall a. Annotated a => Color -> [Char] -> [a] -> Pretty ColorText
annotatedsStartingLineAsStyle Color
ErrorSite [Char]
s [Ann
a, Ann
a2]
              ]
          msgs :: Pretty ColorText
msgs =
            if [(v, Ann)] -> RedundantTypeAnnotation
forall a. [a] -> RedundantTypeAnnotation
forall (t :: * -> *) a.
Foldable t =>
t a -> RedundantTypeAnnotation
null [(v, Ann)]
unknownTypes
              then Pretty ColorText
dupDataAndAbilitiesMsg
              else
                if [(v, Ann, Ann)] -> RedundantTypeAnnotation
forall a. [a] -> RedundantTypeAnnotation
forall (t :: * -> *) a.
Foldable t =>
t a -> RedundantTypeAnnotation
null [(v, Ann, Ann)]
dupDataAndAbilities
                  then Pretty ColorText
unknownTypesMsg
                  else Pretty ColorText
unknownTypesMsg Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"\n\n" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
dupDataAndAbilitiesMsg
       in (Pretty ColorText
msgs, [Range]
allRanges)
    go (Parser.DidntExpectExpression Token Lexeme
_tok (Just t :: Token Lexeme
t@(Token Lexeme -> Lexeme
forall a. Token a -> a
L.payload -> L.SymbolyId (HQ'.NameOnly Name
name))))
      | Name
name Name -> Name -> RedundantTypeAnnotation
forall a. Eq a => a -> a -> RedundantTypeAnnotation
== NameSegment -> Name
Name.fromSegment (Text -> NameSegment
NameSegment Text
"::") =
          let msg :: Pretty ColorText
msg =
                [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
                  [ Pretty ColorText
"This looks like the start of an expression here but I was expecting a binding.",
                    Pretty ColorText
"\nDid you mean to use a single " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [Char] -> Pretty ColorText
quoteCode [Char]
":",
                    Pretty ColorText
" here for a type signature?",
                    Pretty ColorText
"\n\n",
                    [Char] -> Token Lexeme -> Pretty ColorText
forall a. [Char] -> Token a -> Pretty ColorText
tokenAsErrorSite [Char]
s Token Lexeme
t
                  ]
           in (Pretty ColorText
msg, [Token Lexeme -> Range
forall a. Token a -> Range
rangeForToken Token Lexeme
t])
    go (Parser.DidntExpectExpression Token Lexeme
tok Maybe (Token Lexeme)
_nextTok) =
      let msg :: Pretty ColorText
msg =
            [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
              [ Pretty ColorText
"This looks like the start of an expression here \n\n",
                [Char] -> Token Lexeme -> Pretty ColorText
forall a. [Char] -> Token a -> Pretty ColorText
tokenAsErrorSite [Char]
s Token Lexeme
tok,
                Pretty ColorText
"\nbut at the file top-level, I expect one of the following:",
                Pretty ColorText
"\n",
                Pretty ColorText
"\n  - A binding, like " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
t Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Code [Char]
" = 42" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" OR",
                Pretty ColorText
"\n                    " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
t Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Code [Char]
" : Nat",
                Pretty ColorText
"\n                    " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
t Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Code [Char]
" = 42",
                Pretty ColorText
"\n  - A watch expression, like "
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Code [Char]
"> "
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
t
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style
                    Color
Code
                    [Char]
" + 1",
                Pretty ColorText
"\n  - An `ability` declaration, like "
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Code [Char]
"unique ability Foo where ...",
                Pretty ColorText
"\n  - A `type` declaration, like "
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Code [Char]
"structural type Optional a = None | Some a",
                Pretty ColorText
"\n"
              ]
       in (Pretty ColorText
msg, [Token Lexeme -> Range
forall a. Token a -> Range
rangeForToken Token Lexeme
tok])
      where
        t :: Pretty ColorText
t = Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Code ([Char] -> [Char]
forall a. IsString a => [Char] -> a
fromString (Proxy [Token Lexeme] -> NonEmpty (Token [Token Lexeme]) -> [Char]
forall s. VisualStream s => Proxy s -> NonEmpty (Token s) -> [Char]
P.showTokens (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @[L.Token L.Lexeme]) (Token Lexeme -> NonEmpty (Token Lexeme)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Token Lexeme
tok)))
    go (Parser.ExpectedBlockOpen [Char]
blockName tok :: Token Lexeme
tok@(Token Lexeme -> Lexeme
forall a. Token a -> a
L.payload -> Lexeme
L.Close)) =
      let msg :: Pretty ColorText
msg =
            [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
              [ Pretty ColorText
"I was expecting an indented block following the "
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"`"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [Char] -> Pretty ColorText
forall a. IsString a => [Char] -> a
fromString [Char]
blockName
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"` keyword\n",
                Pretty ColorText
"but instead found an outdent:\n\n",
                [Char] -> Token Lexeme -> Pretty ColorText
forall a. [Char] -> Token a -> Pretty ColorText
tokenAsErrorSite [Char]
s Token Lexeme
tok -- todo: @aryairani why is this displaying weirdly?
              ]
       in (Pretty ColorText
msg, [Token Lexeme -> Range
forall a. Token a -> Range
rangeForToken Token Lexeme
tok])
    go (Parser.ExpectedBlockOpen [Char]
blockName Token Lexeme
tok) =
      let msg :: Pretty ColorText
msg =
            [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
              [ Pretty ColorText
"I was expecting an indented block following the "
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"`"
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> [Char] -> Pretty ColorText
forall a. IsString a => [Char] -> a
fromString [Char]
blockName
                  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"` keyword\n",
                Pretty ColorText
"but instead found this token:\n",
                [Char] -> Token Lexeme -> Pretty ColorText
forall a. [Char] -> Token a -> Pretty ColorText
tokenAsErrorSite [Char]
s Token Lexeme
tok
              ]
       in (Pretty ColorText
msg, [Token Lexeme -> Range
forall a. Token a -> Range
rangeForToken Token Lexeme
tok])
    go (Parser.SignatureNeedsAccompanyingBody Token v
tok) =
      let msg :: Pretty ColorText
msg =
            [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
              [ Pretty ColorText
"You provided a type signature, but I didn't find an accompanying\n",
                Pretty ColorText
"binding after it.  Could it be a spelling mismatch?\n",
                [Char] -> Token v -> Pretty ColorText
forall a. [Char] -> Token a -> Pretty ColorText
tokenAsErrorSite [Char]
s Token v
tok
              ]
       in (Pretty ColorText
msg, [Token v -> Range
forall a. Token a -> Range
rangeForToken Token v
tok])
    go (Parser.EmptyBlock Token [Char]
tok) =
      let msg :: Pretty ColorText
msg =
            [Pretty ColorText] -> Pretty ColorText
forall a. Monoid a => [a] -> a
mconcat
              [ Pretty ColorText
"I expected a block after this (",
                Color -> Pretty ColorText
describeStyle Color
ErrorSite,
                Pretty ColorText
"), ",
                Pretty ColorText
"but there wasn't one.  Maybe check your indentation:\n",
                [Char] -> Token [Char] -> Pretty ColorText
forall a. [Char] -> Token a -> Pretty ColorText
tokenAsErrorSite [Char]
s Token [Char]
tok
              ]
       in (Pretty ColorText
msg, [Token [Char] -> Range
forall a. Token a -> Range
rangeForToken Token [Char]
tok])
    go (Parser.EmptyWatch Ann
tok) =
      let msg :: Pretty ColorText
msg =
            [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
              [ Pretty ColorText
"I expected a non-empty watch expression and not just \">\"",
                Pretty ColorText
"",
                [Char] -> Ann -> Pretty ColorText
forall a. Annotated a => [Char] -> a -> Pretty ColorText
annotatedAsErrorSite [Char]
s Ann
tok
              ]
       in (Pretty ColorText
msg, Maybe Range -> [Range]
forall a. Maybe a -> [a]
maybeToList (Maybe Range -> [Range]) -> Maybe Range -> [Range]
forall a b. (a -> b) -> a -> b
$ Ann -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated Ann
tok)
    go (Parser.UnknownId Token (HashQualified Name)
tok Set Referent
referents Set TypeReference
references) =
      let msg :: Pretty ColorText
msg =
            [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
              [ if RedundantTypeAnnotation
missing
                  then Pretty ColorText
"I couldn't resolve the reference " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite (Text -> [Char]
Text.unpack (HashQualified Name -> Text
HQ.toText (Token (HashQualified Name) -> HashQualified Name
forall a. Token a -> a
L.payload Token (HashQualified Name)
tok))) Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"."
                  else Pretty ColorText
"The reference " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite (Text -> [Char]
Text.unpack (HashQualified Name -> Text
HQ.toText (Token (HashQualified Name) -> HashQualified Name
forall a. Token a -> a
L.payload Token (HashQualified Name)
tok))) Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" was ambiguous.",
                Pretty ColorText
"",
                [Char] -> Token Text -> Pretty ColorText
forall a. [Char] -> Token a -> Pretty ColorText
tokenAsErrorSite [Char]
s (Token Text -> Pretty ColorText) -> Token Text -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Text
HQ.toText (HashQualified Name -> Text)
-> Token (HashQualified Name) -> Token Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token (HashQualified Name)
tok,
                if RedundantTypeAnnotation
missing
                  then Pretty ColorText
"Make sure it's spelled correctly."
                  else Pretty ColorText
"Try hash-qualifying the term you meant to reference."
              ]
       in (Pretty ColorText
msg, [Token (HashQualified Name) -> Range
forall a. Token a -> Range
rangeForToken Token (HashQualified Name)
tok])
      where
        missing :: RedundantTypeAnnotation
missing = Set Referent -> RedundantTypeAnnotation
forall a. Set a -> RedundantTypeAnnotation
Set.null Set Referent
referents RedundantTypeAnnotation
-> RedundantTypeAnnotation -> RedundantTypeAnnotation
&& Set TypeReference -> RedundantTypeAnnotation
forall a. Set a -> RedundantTypeAnnotation
Set.null Set TypeReference
references
    go (Parser.UnknownTerm Token (HashQualified Name)
tok Set Referent
referents) =
      let msg :: Pretty ColorText
msg =
            [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
              [ if Set Referent -> RedundantTypeAnnotation
forall a. Set a -> RedundantTypeAnnotation
Set.null Set Referent
referents
                  then Pretty ColorText
"I couldn't find a term for " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite (Text -> [Char]
Text.unpack (HashQualified Name -> Text
HQ.toText (Token (HashQualified Name) -> HashQualified Name
forall a. Token a -> a
L.payload Token (HashQualified Name)
tok))) Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"."
                  else Pretty ColorText
"The term reference " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite (Text -> [Char]
Text.unpack (HashQualified Name -> Text
HQ.toText (Token (HashQualified Name) -> HashQualified Name
forall a. Token a -> a
L.payload Token (HashQualified Name)
tok))) Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" was ambiguous.",
                Pretty ColorText
"",
                [Char] -> Token Text -> Pretty ColorText
forall a. [Char] -> Token a -> Pretty ColorText
tokenAsErrorSite [Char]
s (Token Text -> Pretty ColorText) -> Token Text -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Text
HQ.toText (HashQualified Name -> Text)
-> Token (HashQualified Name) -> Token Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token (HashQualified Name)
tok,
                if RedundantTypeAnnotation
missing
                  then Pretty ColorText
"Make sure it's spelled correctly."
                  else Pretty ColorText
"Try hash-qualifying the term you meant to reference."
              ]
       in (Pretty ColorText
msg, [Token (HashQualified Name) -> Range
forall a. Token a -> Range
rangeForToken Token (HashQualified Name)
tok])
      where
        missing :: RedundantTypeAnnotation
missing = Set Referent -> RedundantTypeAnnotation
forall a. Set a -> RedundantTypeAnnotation
Set.null Set Referent
referents
    go (Parser.UnknownType Token (HashQualified Name)
tok Set TypeReference
referents) =
      let msg :: Pretty ColorText
msg =
            [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
              [ if Set TypeReference -> RedundantTypeAnnotation
forall a. Set a -> RedundantTypeAnnotation
Set.null Set TypeReference
referents
                  then Pretty ColorText
"I couldn't find a type for " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite (Text -> [Char]
Text.unpack (HashQualified Name -> Text
HQ.toText (Token (HashQualified Name) -> HashQualified Name
forall a. Token a -> a
L.payload Token (HashQualified Name)
tok))) Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"."
                  else Pretty ColorText
"The type reference " Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite (Text -> [Char]
Text.unpack (HashQualified Name -> Text
HQ.toText (Token (HashQualified Name) -> HashQualified Name
forall a. Token a -> a
L.payload Token (HashQualified Name)
tok))) Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" was ambiguous.",
                Pretty ColorText
"",
                [Char] -> Token Text -> Pretty ColorText
forall a. [Char] -> Token a -> Pretty ColorText
tokenAsErrorSite [Char]
s (Token Text -> Pretty ColorText) -> Token Text -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Text
HQ.toText (HashQualified Name -> Text)
-> Token (HashQualified Name) -> Token Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token (HashQualified Name)
tok,
                if RedundantTypeAnnotation
missing
                  then Pretty ColorText
"Make sure it's spelled correctly."
                  else Pretty ColorText
"Try hash-qualifying the type you meant to reference."
              ]
       in (Pretty ColorText
msg, [Token (HashQualified Name) -> Range
forall a. Token a -> Range
rangeForToken Token (HashQualified Name)
tok])
      where
        missing :: RedundantTypeAnnotation
missing = Set TypeReference -> RedundantTypeAnnotation
forall a. Set a -> RedundantTypeAnnotation
Set.null Set TypeReference
referents
    go (Parser.ResolutionFailures [ResolutionFailure Ann]
failures) =
      -- TODO: We should likely output separate error messages, one for each resolution
      -- failure. This would involve adding a separate codepath for LSP error messages.
      let ranges :: [Range]
ranges = [Maybe Range] -> [Range]
forall a. [Maybe a] -> [a]
catMaybes (Ann -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated (Ann -> Maybe Range)
-> (ResolutionFailure Ann -> Ann)
-> ResolutionFailure Ann
-> Maybe Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolutionFailure Ann -> Ann
forall a. ResolutionFailure a -> a
Names.getAnnotation (ResolutionFailure Ann -> Maybe Range)
-> [ResolutionFailure Ann] -> [Maybe Range]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResolutionFailure Ann]
failures)
       in (Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
Pr.border Width
2 (Pretty ColorText -> Pretty ColorText)
-> ([ResolutionFailure Ann] -> Pretty ColorText)
-> [ResolutionFailure Ann]
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [ResolutionFailure Ann] -> Pretty ColorText
forall a.
(Annotated a, Ord a) =>
[Char] -> [ResolutionFailure a] -> Pretty ColorText
prettyResolutionFailures [Char]
s ([ResolutionFailure Ann] -> Pretty ColorText)
-> [ResolutionFailure Ann] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ [ResolutionFailure Ann]
failures, [Range]
ranges)
    go (Parser.MissingTypeModifier Token [Char]
keyword Token v
name) =
      let msg :: Pretty ColorText
msg =
            [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
              [ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                  Pretty ColorText
"I expected to see `structural` or `unique` at the start of this line:",
                Pretty ColorText
"",
                [Char] -> [Token ()] -> Pretty ColorText
forall a. [Char] -> [Token a] -> Pretty ColorText
tokensAsErrorSite [Char]
s [Token [Char] -> Token ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Token [Char]
keyword, Token v -> Token ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Token v
name],
                Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
                  Pretty ColorText
"Learn more about when to use `structural` vs `unique` in the Unison Docs: "
                    Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
forall a. IsString a => Pretty a
structuralVsUniqueDocsLink
              ]
       in (Pretty ColorText
msg, Token () -> Range
forall a. Token a -> Range
rangeForToken (Token () -> Range) -> [Token ()] -> [Range]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token [Char] -> Token ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Token [Char]
keyword, Token v -> Token ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Token v
name])
    go (Parser.TypeNotAllowed Token (HashQualified Name)
tok) =
      let msg :: Pretty ColorText
msg =
            [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
              [ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap Pretty ColorText
"I expected to see a term here, but instead it’s a type:",
                Pretty ColorText
"",
                [Char] -> Token Text -> Pretty ColorText
forall a. [Char] -> Token a -> Pretty ColorText
tokenAsErrorSite [Char]
s (Token Text -> Pretty ColorText) -> Token Text -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ HashQualified Name -> Text
HQ.toText (HashQualified Name -> Text)
-> Token (HashQualified Name) -> Token Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Token (HashQualified Name)
tok
              ]
       in (Pretty ColorText
msg, [Token (HashQualified Name) -> Range
forall a. Token a -> Range
rangeForToken Token (HashQualified Name)
tok])

annotatedAsErrorSite ::
  (Annotated a) => String -> a -> Pretty ColorText
annotatedAsErrorSite :: forall a. Annotated a => [Char] -> a -> Pretty ColorText
annotatedAsErrorSite = Color -> [Char] -> a -> Pretty ColorText
forall style a.
(Ord style, Annotated a) =>
style -> [Char] -> a -> Pretty (AnnotatedText style)
annotatedAsStyle Color
ErrorSite

annotatedAsStyle ::
  (Ord style, Annotated a) =>
  style ->
  String ->
  a ->
  Pretty (AnnotatedText style)
annotatedAsStyle :: forall style a.
(Ord style, Annotated a) =>
style -> [Char] -> a -> Pretty (AnnotatedText style)
annotatedAsStyle style
style [Char]
s a
ann =
  [Char] -> [Maybe (Range, style)] -> Pretty (AnnotatedText style)
forall a.
Ord a =>
[Char] -> [Maybe (Range, a)] -> Pretty (AnnotatedText a)
showSourceMaybes [Char]
s [(,style
style) (Range -> (Range, style)) -> Maybe Range -> Maybe (Range, style)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated a
ann]

annotatedsAsErrorSite :: (Annotated a) => String -> [a] -> Pretty ColorText
annotatedsAsErrorSite :: forall a. Annotated a => [Char] -> [a] -> Pretty ColorText
annotatedsAsErrorSite = Color -> [Char] -> [a] -> Pretty ColorText
forall a. Annotated a => Color -> [Char] -> [a] -> Pretty ColorText
annotatedsAsStyle Color
ErrorSite

annotatedsAsStyle :: (Annotated a) => Color -> String -> [a] -> Pretty ColorText
annotatedsAsStyle :: forall a. Annotated a => Color -> [Char] -> [a] -> Pretty ColorText
annotatedsAsStyle Color
style [Char]
src [a]
as =
  [Char] -> [Maybe (Range, Color)] -> Pretty ColorText
forall a.
Ord a =>
[Char] -> [Maybe (Range, a)] -> Pretty (AnnotatedText a)
showSourceMaybes [Char]
src [(,Color
style) (Range -> (Range, Color)) -> Maybe Range -> Maybe (Range, Color)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated a
a | a
a <- [a]
as]

annotatedsStartingLineAsStyle ::
  (Annotated a) => Color -> String -> [a] -> Pretty ColorText
annotatedsStartingLineAsStyle :: forall a. Annotated a => Color -> [Char] -> [a] -> Pretty ColorText
annotatedsStartingLineAsStyle Color
style [Char]
src [a]
as =
  [Char] -> [Maybe (Range, Color)] -> Pretty ColorText
forall a.
Ord a =>
[Char] -> [Maybe (Range, a)] -> Pretty (AnnotatedText a)
showSourceMaybes
    [Char]
src
    [(,Color
style) (Range -> (Range, Color)) -> Maybe Range -> Maybe (Range, Color)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Range -> Range
startingLine (Range -> Range) -> Maybe Range -> Maybe Range
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Maybe Range
forall a. Annotated a => a -> Maybe Range
rangeForAnnotated a
a) | a
a <- [a]
as]

tokenAsErrorSite :: String -> L.Token a -> Pretty ColorText
tokenAsErrorSite :: forall a. [Char] -> Token a -> Pretty ColorText
tokenAsErrorSite [Char]
src Token a
tok = [Char] -> (Range, Color) -> Pretty ColorText
forall a. Ord a => [Char] -> (Range, a) -> Pretty (AnnotatedText a)
showSource1 [Char]
src (Token a -> Range
forall a. Token a -> Range
rangeForToken Token a
tok, Color
ErrorSite)

tokensAsErrorSite :: String -> [L.Token a] -> Pretty ColorText
tokensAsErrorSite :: forall a. [Char] -> [Token a] -> Pretty ColorText
tokensAsErrorSite [Char]
src [Token a]
ts =
  [Char] -> [(Range, Color)] -> Pretty ColorText
forall a.
Ord a =>
[Char] -> [(Range, a)] -> Pretty (AnnotatedText a)
showSource [Char]
src [(Token a -> Range
forall a. Token a -> Range
rangeForToken Token a
t, Color
ErrorSite) | Token a
t <- [Token a]
ts]

showSourceMaybes ::
  (Ord a) => String -> [Maybe (Range, a)] -> Pretty (AnnotatedText a)
showSourceMaybes :: forall a.
Ord a =>
[Char] -> [Maybe (Range, a)] -> Pretty (AnnotatedText a)
showSourceMaybes [Char]
src [Maybe (Range, a)]
annotations = [Char] -> [(Range, a)] -> Pretty (AnnotatedText a)
forall a.
Ord a =>
[Char] -> [(Range, a)] -> Pretty (AnnotatedText a)
showSource [Char]
src ([(Range, a)] -> Pretty (AnnotatedText a))
-> [(Range, a)] -> Pretty (AnnotatedText a)
forall a b. (a -> b) -> a -> b
$ [Maybe (Range, a)] -> [(Range, a)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Range, a)]
annotations

showSource :: (Ord a) => String -> [(Range, a)] -> Pretty (AnnotatedText a)
showSource :: forall a.
Ord a =>
[Char] -> [(Range, a)] -> Pretty (AnnotatedText a)
showSource [Char]
src [(Range, a)]
annotations =
  AnnotatedText a -> Pretty (AnnotatedText a)
forall s. (IsString s, ListLike s Char) => s -> Pretty s
Pr.lit (AnnotatedText a -> Pretty (AnnotatedText a))
-> (AnnotatedExcerpt a -> AnnotatedText a)
-> AnnotatedExcerpt a
-> Pretty (AnnotatedText a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> AnnotatedExcerpt a -> AnnotatedText a
forall a. Int -> AnnotatedExcerpt a -> AnnotatedText a
AT.condensedExcerptToText Int
6 (AnnotatedExcerpt a -> Pretty (AnnotatedText a))
-> AnnotatedExcerpt a -> Pretty (AnnotatedText a)
forall a b. (a -> b) -> a -> b
$
    AnnotatedExcerpt a -> Map Range a -> AnnotatedExcerpt a
forall a. AnnotatedExcerpt a -> Map Range a -> AnnotatedExcerpt a
AT.markup
      ([Char] -> AnnotatedExcerpt a
forall a. IsString a => [Char] -> a
fromString [Char]
src)
      ([(Range, a)] -> Map Range a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Range, a)]
annotations)

showSource1 :: (Ord a) => String -> (Range, a) -> Pretty (AnnotatedText a)
showSource1 :: forall a. Ord a => [Char] -> (Range, a) -> Pretty (AnnotatedText a)
showSource1 [Char]
src (Range, a)
annotation = [Char] -> [(Range, a)] -> Pretty (AnnotatedText a)
forall a.
Ord a =>
[Char] -> [(Range, a)] -> Pretty (AnnotatedText a)
showSource [Char]
src [(Range, a)
annotation]

prettyTypecheckError ::
  (Var v, Ord loc, Show loc, Parser.Annotated loc) =>
  C.ErrorNote v loc ->
  Env ->
  String ->
  Pretty ColorText
prettyTypecheckError :: forall v loc.
(Var v, Ord loc, Show loc, Annotated loc) =>
ErrorNote v loc -> Env -> [Char] -> Pretty ColorText
prettyTypecheckError ErrorNote v loc
note Env
env [Char]
src =
  TypeError v loc -> Env -> [Char] -> Pretty ColorText
forall v loc.
(Var v, Annotated loc, Ord loc, Show loc) =>
TypeError v loc -> Env -> [Char] -> Pretty ColorText
renderTypeError (ErrorNote v loc -> TypeError v loc
forall loc v.
(Ord loc, Show loc, Var v) =>
ErrorNote v loc -> TypeError v loc
typeErrorFromNote ErrorNote v loc
note) Env
env [Char]
src

prettyTypeInfo ::
  (Var v, Ord loc, Show loc, Parser.Annotated loc) =>
  C.InfoNote v loc ->
  Env ->
  Pretty ColorText
prettyTypeInfo :: forall v loc.
(Var v, Ord loc, Show loc, Annotated loc) =>
InfoNote v loc -> Env -> Pretty ColorText
prettyTypeInfo InfoNote v loc
n Env
e =
  Pretty ColorText
-> (TypeInfo v loc -> Pretty ColorText)
-> Maybe (TypeInfo v loc)
-> Pretty ColorText
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Pretty ColorText
"" (TypeInfo v loc -> Env -> Pretty ColorText
forall v loc sty.
(Var v, Annotated loc, Ord loc, Show loc) =>
TypeInfo v loc -> Env -> Pretty (AnnotatedText sty)
`renderTypeInfo` Env
e) (InfoNote v loc -> Maybe (TypeInfo v loc)
forall loc v.
(Ord loc, Show loc, Var v) =>
InfoNote v loc -> Maybe (TypeInfo v loc)
typeInfoFromNote InfoNote v loc
n)

intLiteralSyntaxTip ::
  C.Term v loc -> C.Type v loc -> Pretty ColorText
intLiteralSyntaxTip :: forall v loc. Term v loc -> Type v loc -> Pretty ColorText
intLiteralSyntaxTip Term v loc
term Type v loc
expectedType = case (Term v loc
term, Type v loc
expectedType) of
  (Term.Nat' ConstructorId
n, Type.Ref' TypeReference
r)
    | TypeReference
r TypeReference -> TypeReference -> RedundantTypeAnnotation
forall a. Eq a => a -> a -> RedundantTypeAnnotation
== TypeReference
Type.intRef ->
        Pretty ColorText
"\nTip: Use the syntax "
          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type2 ([Char]
"+" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> ConstructorId -> [Char]
forall a. Show a => a -> [Char]
show ConstructorId
n)
          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
" to produce an "
          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
Type2 [Char]
"Int"
          Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"."
  (Term v loc, Type v loc)
_ -> Pretty ColorText
""

-- | Pretty prints resolution failure annotations, including a table of disambiguation
-- suggestions.
prettyResolutionFailures ::
  forall a.
  (Annotated a, Ord a) =>
  -- | src
  String ->
  [Names.ResolutionFailure a] ->
  Pretty ColorText
prettyResolutionFailures :: forall a.
(Annotated a, Ord a) =>
[Char] -> [ResolutionFailure a] -> Pretty ColorText
prettyResolutionFailures [Char]
s [ResolutionFailure a]
allFailures =
  Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Pretty s -> Pretty s -> Pretty s
Pr.callout Pretty ColorText
"❓" (Pretty ColorText -> Pretty ColorText)
-> Pretty ColorText -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
    [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.linesNonEmpty
      [ Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap
          (Pretty ColorText
"I couldn't resolve any of" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Color -> [Char] -> Pretty ColorText
forall s. s -> [Char] -> Pretty (AnnotatedText s)
style Color
ErrorSite [Char]
"these" Pretty ColorText -> Pretty ColorText -> Pretty ColorText
forall a. Semigroup a => a -> a -> a
<> Pretty ColorText
"symbols:"),
        Pretty ColorText
"",
        [Char] -> [a] -> Pretty ColorText
forall a. Annotated a => [Char] -> [a] -> Pretty ColorText
annotatedsAsErrorSite [Char]
s (ResolutionFailure a -> a
forall a. ResolutionFailure a -> a
Names.getAnnotation (ResolutionFailure a -> a) -> [ResolutionFailure a] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ResolutionFailure a]
allFailures),
        Pretty ColorText
"",
        [ResolutionFailure a] -> Pretty ColorText
ambiguitiesToTable [ResolutionFailure a]
allFailures
      ]
  where
    -- Collapses identical failures which may have multiple annotations into a single failure.
    -- uniqueFailures
    ambiguitiesToTable :: [Names.ResolutionFailure a] -> Pretty ColorText
    ambiguitiesToTable :: [ResolutionFailure a] -> Pretty ColorText
ambiguitiesToTable [ResolutionFailure a]
failures =
      let pairs :: ([(HQ.HashQualified Name, Maybe (NESet String))])
          pairs :: [(HashQualified Name, Maybe (NESet [Char]))]
pairs = [(HashQualified Name, Maybe (NESet [Char]))]
-> [(HashQualified Name, Maybe (NESet [Char]))]
forall a. Ord a => [a] -> [a]
nubOrd ([(HashQualified Name, Maybe (NESet [Char]))]
 -> [(HashQualified Name, Maybe (NESet [Char]))])
-> ([ResolutionFailure a]
    -> [(HashQualified Name, Maybe (NESet [Char]))])
-> [ResolutionFailure a]
-> [(HashQualified Name, Maybe (NESet [Char]))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ResolutionFailure a -> (HashQualified Name, Maybe (NESet [Char])))
-> [ResolutionFailure a]
-> [(HashQualified Name, Maybe (NESet [Char]))]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResolutionFailure a -> (HashQualified Name, Maybe (NESet [Char]))
forall annotation.
ResolutionFailure annotation
-> (HashQualified Name, Maybe (NESet [Char]))
toAmbiguityPair ([ResolutionFailure a]
 -> [(HashQualified Name, Maybe (NESet [Char]))])
-> [ResolutionFailure a]
-> [(HashQualified Name, Maybe (NESet [Char]))]
forall a b. (a -> b) -> a -> b
$ [ResolutionFailure a]
failures
          spacerRow :: (Pretty ColorText, Pretty ColorText)
spacerRow = (Pretty ColorText
"", Pretty ColorText
"")
       in Pretty ColorText
-> Pretty ColorText
-> [(Pretty ColorText, Pretty ColorText)]
-> Pretty ColorText
Pr.column2Header Pretty ColorText
"Symbol" Pretty ColorText
"Suggestions" ([(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText)
-> [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$ (Pretty ColorText, Pretty ColorText)
spacerRow (Pretty ColorText, Pretty ColorText)
-> [(Pretty ColorText, Pretty ColorText)]
-> [(Pretty ColorText, Pretty ColorText)]
forall a. a -> [a] -> [a]
: ([(Pretty ColorText, Pretty ColorText)]
-> ((HashQualified Name, Maybe (NESet [Char]))
    -> [(Pretty ColorText, Pretty ColorText)])
-> [(HashQualified Name, Maybe (NESet [Char]))]
-> [(Pretty ColorText, Pretty ColorText)]
forall (t :: * -> *) a b.
(Foldable t, Monoid a) =>
a -> (b -> a) -> t b -> a
intercalateMap [(Pretty ColorText, Pretty ColorText)
spacerRow] (HashQualified Name, Maybe (NESet [Char]))
-> [(Pretty ColorText, Pretty ColorText)]
prettyRow [(HashQualified Name, Maybe (NESet [Char]))]
pairs)

    toAmbiguityPair :: Names.ResolutionFailure annotation -> (HQ.HashQualified Name, Maybe (NESet String))
    toAmbiguityPair :: forall annotation.
ResolutionFailure annotation
-> (HashQualified Name, Maybe (NESet [Char]))
toAmbiguityPair = \case
      (Names.TermResolutionFailure HashQualified Name
name annotation
_ (Names.Ambiguous Names
names Set Referent
refs Set Name
localNames)) -> do
        let ppe :: Env
ppe = Names -> Env
ppeFromNames Names
names
         in ( HashQualified Name
name,
              NESet [Char] -> Maybe (NESet [Char])
forall a. a -> Maybe a
Just (NESet [Char] -> Maybe (NESet [Char]))
-> NESet [Char] -> Maybe (NESet [Char])
forall a b. (a -> b) -> a -> b
$
                Set [Char] -> NESet [Char]
forall a. Set a -> NESet a
NES.unsafeFromSet
                  ((Referent -> [Char]) -> Set Referent -> Set [Char]
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (Env -> Referent -> [Char]
forall s. IsString s => Env -> Referent -> s
showTermRef Env
ppe) Set Referent
refs Set [Char] -> Set [Char] -> Set [Char]
forall a. Semigroup a => a -> a -> a
<> (Name -> [Char]) -> Set Name -> Set [Char]
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (Text -> [Char]
Text.unpack (Text -> [Char]) -> (Name -> Text) -> Name -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
Name.toText) Set Name
localNames)
            )
      (Names.TypeResolutionFailure HashQualified Name
name annotation
_ (Names.Ambiguous Names
names Set TypeReference
refs Set Name
localNames)) -> do
        let ppe :: Env
ppe = Names -> Env
ppeFromNames Names
names
         in ( HashQualified Name
name,
              NESet [Char] -> Maybe (NESet [Char])
forall a. a -> Maybe a
Just (NESet [Char] -> Maybe (NESet [Char]))
-> NESet [Char] -> Maybe (NESet [Char])
forall a b. (a -> b) -> a -> b
$
                Set [Char] -> NESet [Char]
forall a. Set a -> NESet a
NES.unsafeFromSet ((TypeReference -> [Char]) -> Set TypeReference -> Set [Char]
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (Env -> TypeReference -> [Char]
forall s. IsString s => Env -> TypeReference -> s
showTypeRef Env
ppe) Set TypeReference
refs Set [Char] -> Set [Char] -> Set [Char]
forall a. Semigroup a => a -> a -> a
<> (Name -> [Char]) -> Set Name -> Set [Char]
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (Text -> [Char]
Text.unpack (Text -> [Char]) -> (Name -> Text) -> Name -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
Name.toText) Set Name
localNames)
            )
      (Names.TermResolutionFailure HashQualified Name
name annotation
_ ResolutionError Referent
Names.NotFound) -> (HashQualified Name
name, Maybe (NESet [Char])
forall a. Maybe a
Nothing)
      (Names.TypeResolutionFailure HashQualified Name
name annotation
_ ResolutionError TypeReference
Names.NotFound) -> (HashQualified Name
name, Maybe (NESet [Char])
forall a. Maybe a
Nothing)

    ppeFromNames :: Names.Names -> PPE.PrettyPrintEnv
    ppeFromNames :: Names -> Env
ppeFromNames Names
names =
      Namer -> Suffixifier -> Env
PPE.makePPE (Int -> Names -> Namer
PPE.hqNamer Int
PPE.todoHashLength Names
names) Suffixifier
PPE.dontSuffixify

    prettyRow :: (HQ.HashQualified Name, Maybe (NESet String)) -> [(Pretty ColorText, Pretty ColorText)]
    prettyRow :: (HashQualified Name, Maybe (NESet [Char]))
-> [(Pretty ColorText, Pretty ColorText)]
prettyRow (HashQualified Name
name, Maybe (NESet [Char])
mSet) = case Maybe (NESet [Char])
mSet of
      Maybe (NESet [Char])
Nothing -> [(HashQualified Name -> Pretty ColorText
forall s. IsString s => HashQualified Name -> Pretty s
prettyHashQualified0 HashQualified Name
name, Pretty ColorText -> Pretty ColorText
Pr.hiBlack Pretty ColorText
"No matches")]
      Just NESet [Char]
suggestions -> [Pretty ColorText]
-> [Pretty ColorText] -> [(Pretty ColorText, Pretty ColorText)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([HashQualified Name -> Pretty ColorText
forall s. IsString s => HashQualified Name -> Pretty s
prettyHashQualified0 HashQualified Name
name] [Pretty ColorText] -> [Pretty ColorText] -> [Pretty ColorText]
forall a. [a] -> [a] -> [a]
++ Pretty ColorText -> [Pretty ColorText]
forall a. a -> [a]
repeat Pretty ColorText
"") ([Char] -> Pretty ColorText
forall s. IsString s => [Char] -> Pretty s
Pr.string ([Char] -> Pretty ColorText) -> [[Char]] -> [Pretty ColorText]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NESet [Char] -> [[Char]]
forall a. NESet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NESet [Char]
suggestions)

useExamples :: Pretty ColorText
useExamples :: Pretty ColorText
useExamples =
  [Pretty ColorText] -> Pretty ColorText
forall (f :: * -> *) s.
(Foldable f, IsString s) =>
f (Pretty s) -> Pretty s
Pr.lines
    [ Pretty ColorText
"Here's a few examples of valid `use` statements:",
      Pretty ColorText
"",
      Width -> Pretty ColorText -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
Width -> Pretty s -> Pretty s
Pr.indentN Width
2 (Pretty ColorText -> Pretty ColorText)
-> ([(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText)
-> [(Pretty ColorText, Pretty ColorText)]
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall s.
(ListLike s Char, IsString s) =>
[(Pretty s, Pretty s)] -> Pretty s
Pr.column2 ([(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText)
-> [(Pretty ColorText, Pretty ColorText)] -> Pretty ColorText
forall a b. (a -> b) -> a -> b
$
        [ (Pretty ColorText -> Pretty ColorText
Pr.blue Pretty ColorText
"use math sqrt", Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap Pretty ColorText
"Introduces `sqrt` as a local alias for `math.sqrt`"),
          (Pretty ColorText -> Pretty ColorText
Pr.blue Pretty ColorText
"use List :+", Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap Pretty ColorText
"Introduces `:+` as a local alias for `List.:+`."),
          (Pretty ColorText -> Pretty ColorText
Pr.blue Pretty ColorText
"use .foo bar.baz", Pretty ColorText -> Pretty ColorText
forall s. (ListLike s Char, IsString s) => Pretty s -> Pretty s
Pr.wrap Pretty ColorText
"Introduces `bar.baz` as a local alias for the absolute name `.foo.bar.baz`")
        ]
    ]