@@ -43,6 +43,7 @@ import Control.Applicative
43
43
import Control.Exception (evaluate )
44
44
import Control.Monad
45
45
import Data.Traversable
46
+ import GHC.Stack (HasCallStack )
46
47
47
48
import Avail hiding (avail )
48
49
import qualified Avail
@@ -63,16 +64,21 @@ import BasicTypes ( StringLiteral(..), SourceText(..) )
63
64
import qualified Outputable as O
64
65
import HsDecls ( getConArgs )
65
66
67
+ mkExceptionContext :: TypecheckedModule -> String
68
+ mkExceptionContext =
69
+ (" creating Haddock interface for " ++ ) . moduleNameString . ms_mod_name . pm_mod_summary . tm_parsed_module
66
70
67
71
-- | Use a 'TypecheckedModule' to produce an 'Interface'.
68
72
-- To do this, we need access to already processed modules in the topological
69
73
-- sort. That's what's in the 'IfaceMap'.
70
- createInterface :: TypecheckedModule
74
+ createInterface :: HasCallStack
75
+ => TypecheckedModule
71
76
-> [Flag ] -- Boolean flags
72
77
-> IfaceMap -- Locally processed modules
73
78
-> InstIfaceMap -- External, already installed interfaces
74
79
-> ErrMsgGhc Interface
75
- createInterface tm flags modMap instIfaceMap = do
80
+ createInterface tm flags modMap instIfaceMap =
81
+ withExceptionContext (mkExceptionContext tm) $ do
76
82
77
83
let ms = pm_mod_summary . tm_parsed_module $ tm
78
84
mi = moduleInfo tm
@@ -200,7 +206,6 @@ createInterface tm flags modMap instIfaceMap = do
200
206
, ifaceTokenizedSrc = tokenizedSrc
201
207
}
202
208
203
-
204
209
-- | Given all of the @import M as N@ declarations in a package,
205
210
-- create a mapping from the module identity of M, to an alias N
206
211
-- (if there are multiple aliases, we pick the last one.) This
@@ -634,7 +639,8 @@ collectDocs = go Nothing []
634
639
-- We create the export items even if the module is hidden, since they
635
640
-- might be useful when creating the export items for other modules.
636
641
mkExportItems
637
- :: Bool -- is it a signature
642
+ :: HasCallStack
643
+ => Bool -- is it a signature
638
644
-> IfaceMap
639
645
-> Maybe Package -- this package
640
646
-> Module -- this module
@@ -693,7 +699,8 @@ mkExportItems
693
699
availExportItem is_sig modMap thisMod semMod warnings exportedNames
694
700
maps fixMap splices instIfaceMap dflags avail
695
701
696
- availExportItem :: Bool -- is it a signature
702
+ availExportItem :: HasCallStack
703
+ => Bool -- is it a signature
697
704
-> IfaceMap
698
705
-> Module -- this module
699
706
-> Module -- semantic module
@@ -775,7 +782,7 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames
775
782
776
783
_ -> return []
777
784
778
- availExportDecl :: AvailInfo -> LHsDecl GhcRn
785
+ availExportDecl :: HasCallStack => AvailInfo -> LHsDecl GhcRn
779
786
-> (DocForDecl Name , [(Name , DocForDecl Name )])
780
787
-> ErrMsgGhc [ ExportItem GhcRn ]
781
788
availExportDecl avail decl (doc, subs)
@@ -1039,7 +1046,7 @@ fullModuleContents is_sig modMap pkgName thisMod semMod warnings gre exportedNam
1039
1046
-- it might be an individual record selector or a class method. In these
1040
1047
-- cases we have to extract the required declaration (and somehow cobble
1041
1048
-- together a type signature for it...).
1042
- extractDecl :: DeclMap -> Name -> LHsDecl GhcRn -> LHsDecl GhcRn
1049
+ extractDecl :: HasCallStack => DeclMap -> Name -> LHsDecl GhcRn -> LHsDecl GhcRn
1043
1050
extractDecl declMap name decl
1044
1051
| name `elem` getMainDeclBinder (unLoc decl) = decl
1045
1052
| otherwise =
@@ -1116,10 +1123,11 @@ extractDecl declMap name decl
1116
1123
_ -> error " internal: extractDecl"
1117
1124
1118
1125
1119
- extractPatternSyn :: Name -> Name -> [LHsType GhcRn ] -> [LConDecl GhcRn ] -> LSig GhcRn
1126
+ extractPatternSyn :: HasCallStack => Name -> Name -> [LHsType GhcRn ] -> [LConDecl GhcRn ] -> LSig GhcRn
1120
1127
extractPatternSyn nm t tvs cons =
1121
1128
case filter matches cons of
1122
- [] -> error " extractPatternSyn: constructor pattern not found"
1129
+ [] -> O. pprPanic " extractPatternSyn" $
1130
+ O. text " constructor pattern " O. <+> O. ppr nm O. <+> O. text " not found in type" O. <+> O. ppr t
1123
1131
con: _ -> extract <$> con
1124
1132
where
1125
1133
matches :: LConDecl GhcRn -> Bool
0 commit comments