@@ -21,6 +21,8 @@ import Wingman.Metaprogramming.Parser.Documentation
21
21
import Wingman.Metaprogramming.ProofState (proofState , layout )
22
22
import Wingman.Tactics
23
23
import Wingman.Types
24
+ import Development.IDE.GHC.Compat (RealSrcLoc , srcLocLine , srcLocCol , srcLocFile )
25
+ import FastString (unpackFS )
24
26
25
27
26
28
nullary :: T. Text -> TacticsM () -> Parser (TacticsM () )
@@ -421,17 +423,30 @@ wrapError :: String -> String
421
423
wrapError err = " ```\n " <> err <> " \n ```\n "
422
424
423
425
426
+ fixErrorOffset :: RealSrcLoc -> P. ParseErrorBundle a b -> P. ParseErrorBundle a b
427
+ fixErrorOffset rsl (P. ParseErrorBundle ne (P. PosState a n (P. SourcePos _ line col) pos s))
428
+ = P. ParseErrorBundle ne
429
+ $ P. PosState a n
430
+ (P. SourcePos
431
+ (unpackFS $ srcLocFile rsl)
432
+ ((<>) line $ P. mkPos $ srcLocLine rsl - 1 )
433
+ ((<>) col $ P. mkPos $ srcLocCol rsl - 1 + length @ [] " [wingman|" )
434
+ )
435
+ pos
436
+ s
437
+
424
438
------------------------------------------------------------------------------
425
439
-- | Attempt to run a metaprogram tactic, returning the proof state, or the
426
440
-- errors.
427
441
attempt_it
428
- :: Context
442
+ :: RealSrcLoc
443
+ -> Context
429
444
-> Judgement
430
445
-> String
431
446
-> IO (Either String String )
432
- attempt_it ctx jdg program =
447
+ attempt_it rsl ctx jdg program =
433
448
case P. runParser tacticProgram " <splice>" (T. pack program) of
434
- Left peb -> pure $ Left $ wrapError $ P. errorBundlePretty peb
449
+ Left peb -> pure $ Left $ wrapError $ P. errorBundlePretty $ fixErrorOffset rsl peb
435
450
Right tt -> do
436
451
res <- runTactic
437
452
ctx
0 commit comments