git.iko.soy/Idris-dev
on master help sign in
Decorate type provider errors with source location
fab7083David Raymond Christiansen
src/Idris/ElabDecls.hs+1−1
compare with master
unifiedsplit
@@ -646,7 +646,7 @@ elabProvider info syn fc n ty tm
646 logLvl 1 $ "Normalised " ++ show n ++ "'s RHS to " ++ show rhs
646 logLvl 1 $ "Normalised " ++ show n ++ "'s RHS to " ++ show rhs
647
647
648 -- Extract the provided term from the type provider
648 -- Extract the provided term from the type provider
649− tm <- getProvided rhs'
649+ tm <- getProvided fc rhs'
650
650
651 -- Finally add a top-level definition of the provided term
651 -- Finally add a top-level definition of the provided term
652 elabClauses info fc [] n [PClause fc n (PRef fc n) [] (delab i tm) []]
652 elabClauses info fc [] n [PClause fc n (PRef fc n) [] (delab i tm) []]
src/Idris/Providers.hs+13−13
@@ -18,17 +18,17 @@ ermod = sNS (sUN "Error") ["Providers"]
18prmod = sNS (sUN "Provide") ["Providers"]
18prmod = sNS (sUN "Provide") ["Providers"]
19
19
20-- | Handle an error, if the type provider returned an error. Otherwise return the provided term.
20-- | Handle an error, if the type provider returned an error. Otherwise return the provided term.
21−getProvided :: TT Name -> Idris (TT Name)
21+getProvided :: FC -> TT Name -> Idris (TT Name)
22−getProvided tm | (P _ pioret _, [tp, result]) <- unApply tm
22+getProvided fc tm | (P _ pioret _, [tp, result]) <- unApply tm
23− , (P _ nm _, [_, err]) <- unApply result
23+ , (P _ nm _, [_, err]) <- unApply result
24− , pioret == ioret && nm == ermod
24+ , pioret == ioret && nm == ermod
25− = case err of
25+ = case err of
26− Constant (Str msg) -> ierror . ProviderError $ msg
26+ Constant (Str msg) -> ierror . At fc . ProviderError $ msg
27− _ -> ifail "Internal error in type provider, non-normalised error"
27+ _ -> ifail "Internal error in type provider, non-normalised error"
28− | (P _ pioret _, [tp, result]) <- unApply tm
28+ | (P _ pioret _, [tp, result]) <- unApply tm
29− , (P _ nm _, [_, res]) <- unApply result
29+ , (P _ nm _, [_, res]) <- unApply result
30− , pioret == ioret && nm == prmod
30+ , pioret == ioret && nm == prmod
31− = return res
31+ = return res
32− | otherwise = ifail $ "Internal type provider error: result was not " ++
32+ | otherwise = ifail $ "Internal type provider error: result was not " ++
33− "IO (Provider a), or perhaps missing normalisation."
33+ "IO (Provider a), or perhaps missing normalisation."
34
34