mirror of
https://github.com/unisonweb/unison.git
synced 2024-10-05 06:07:21 +03:00
if/and/or-related type errors should be working now
code looking a bit less ugly too.
This commit is contained in:
parent
b56b8b1dc3
commit
59f24188f6
@ -10,6 +10,7 @@
|
||||
module Unison.PrintError where
|
||||
|
||||
-- import Unison.Parser (showLineCol)
|
||||
import Control.Applicative ((<|>))
|
||||
import qualified Data.Char as Char
|
||||
import Data.Foldable
|
||||
import qualified Data.List.NonEmpty as Nel
|
||||
@ -501,28 +502,32 @@ typeErrorFromNote n@(C.Note (C.TypeMismatch ctx) path) =
|
||||
(Just (foundLeaf, expectedLeaf),
|
||||
Just (foundType, expectedType),
|
||||
Just mismatchSite) ->
|
||||
let mismatchLoc = ABT.annotation mismatchSite in
|
||||
if Ex.matchAny Ex.inAndApp n then
|
||||
BooleanMismatch AndMismatch (ABT.annotation mismatchSite) foundType n
|
||||
-- else if Ex.matchAny Ex.inOrApp n then
|
||||
-- BooleanMismatch OrMismatch (ABT.annotation mismatchSite) foundType n
|
||||
-- else if Ex.matchAny Ex.inIfCond n then
|
||||
-- BooleanMismatch CondMismatch (ABT.annotation mismatchSite) foundType n
|
||||
else
|
||||
case Ex.run Ex.inOrApp $ n of
|
||||
Just _ ->
|
||||
BooleanMismatch OrMismatch (ABT.annotation mismatchSite) foundType n
|
||||
_ ->
|
||||
case Ex.run Ex.inIfBody $ n of
|
||||
Just expectedLoc ->
|
||||
ExistentialMismatch IfBody expectedType expectedLoc
|
||||
foundType mismatchLoc
|
||||
n
|
||||
Nothing ->
|
||||
Mismatch (sub foundType) (sub expectedType)
|
||||
(sub foundLeaf) (sub expectedLeaf)
|
||||
(ABT.annotation mismatchSite)
|
||||
n
|
||||
let mismatchLoc = ABT.annotation mismatchSite
|
||||
booleanMismatch :: Monad m => m a -> BooleanMismatch -> m (TypeError v loc)
|
||||
booleanMismatch x y = x >>
|
||||
(pure $ BooleanMismatch y (ABT.annotation mismatchSite) foundType n)
|
||||
existentialMismatch :: Monad m
|
||||
=> m loc -> ExistentialMismatch -> m (TypeError v loc)
|
||||
existentialMismatch x y = x >>= \expectedLoc -> pure $
|
||||
ExistentialMismatch y expectedType expectedLoc foundType mismatchLoc n
|
||||
and,or,cond :: Ex.NoteExtractor v loc (TypeError v loc)
|
||||
and = booleanMismatch Ex.inAndApp AndMismatch
|
||||
or = booleanMismatch Ex.inOrApp OrMismatch
|
||||
cond = booleanMismatch Ex.inIfCond CondMismatch
|
||||
-- guard = tricky boolean mismatch
|
||||
ifBody = existentialMismatch Ex.inIfBody IfBody
|
||||
-- vectorBody = existentialMismatch Ex.inIfBody VectorBody
|
||||
-- caseBody = existentialMismatch Ex.inIfBody CaseBody
|
||||
all :: Ex.NoteExtractor v loc (TypeError v loc)
|
||||
all = and <|> or <|> cond <|> ifBody
|
||||
|
||||
in case Ex.run all n of
|
||||
Just err -> err
|
||||
Nothing ->
|
||||
Mismatch (sub foundType) (sub expectedType)
|
||||
(sub foundLeaf) (sub expectedLeaf)
|
||||
(ABT.annotation mismatchSite)
|
||||
n
|
||||
_ -> Other n
|
||||
typeErrorFromNote n@(C.Note (C.AbilityCheckFailure amb req _) _) =
|
||||
let go :: C.Term v loc -> TypeError v loc
|
||||
|
@ -33,18 +33,6 @@ adjacent (PathExtractor a) (PathExtractor b) =
|
||||
|
||||
type PathPredicate v loc = C.PathElement v loc -> Bool
|
||||
|
||||
inAndApp :: PathPredicate v loc
|
||||
inAndApp C.InAndApp = True
|
||||
inAndApp _ = False
|
||||
|
||||
inOrApp' :: PathPredicate v loc
|
||||
inOrApp' C.InOrApp = True
|
||||
inOrApp' _ = False
|
||||
|
||||
inIfCond :: PathPredicate v loc
|
||||
inIfCond C.InIfCond = True
|
||||
inIfCond _ = False
|
||||
|
||||
exactly1AppBefore :: PathExtractor v loc a -> NoteExtractor v loc a
|
||||
exactly1AppBefore p = do
|
||||
(prefix, a) <- elementsUntil p
|
||||
@ -60,11 +48,21 @@ elementsUntil p = NoteExtractor $ go [] . toList . C.path where
|
||||
Just a -> Just (reverse acc, a)
|
||||
Nothing -> go (h:acc) t
|
||||
|
||||
inAndApp :: NoteExtractor v loc ()
|
||||
inAndApp = exactly1AppBefore . PathExtractor $ \case
|
||||
C.InAndApp -> Just ()
|
||||
_ -> Nothing
|
||||
|
||||
inOrApp :: NoteExtractor v loc ()
|
||||
inOrApp = exactly1AppBefore . PathExtractor $ \case
|
||||
C.InOrApp -> Just ()
|
||||
_ -> Nothing
|
||||
|
||||
inIfCond :: NoteExtractor v loc ()
|
||||
inIfCond = exactly1AppBefore . PathExtractor $ \case
|
||||
C.InIfCond -> Just ()
|
||||
_ -> Nothing
|
||||
|
||||
inIfBody :: NoteExtractor v loc loc
|
||||
inIfBody = exactly1AppBefore . PathExtractor $ \case
|
||||
C.InIfBody loc -> Just loc
|
||||
|
Loading…
Reference in New Issue
Block a user