1{-# LANGUAGE RankNTypes #-}
2
3module GHC.Utils.Error where
4
5import GHC.Prelude
6import GHC.Utils.Outputable (SDoc, PprStyle )
7import GHC.Types.SrcLoc (SrcSpan)
8import GHC.Utils.Json
9import {-# SOURCE #-} GHC.Driver.Session ( DynFlags )
10
11type DumpAction = DynFlags -> PprStyle -> DumpOptions -> String
12                  -> DumpFormat -> SDoc -> IO ()
13
14type TraceAction = forall a. DynFlags -> String -> SDoc -> a -> a
15
16data DumpOptions = DumpOptions
17   { dumpForcedToFile :: Bool
18   , dumpSuffix       :: String
19   }
20
21data DumpFormat
22  = FormatHaskell
23  | FormatCore
24  | FormatSTG
25  | FormatByteCode
26  | FormatCMM
27  | FormatASM
28  | FormatC
29  | FormatLLVM
30  | FormatText
31
32data Severity
33  = SevOutput
34  | SevFatal
35  | SevInteractive
36  | SevDump
37  | SevInfo
38  | SevWarning
39  | SevError
40
41
42type MsgDoc = SDoc
43
44mkLocMessage :: Severity -> SrcSpan -> MsgDoc -> MsgDoc
45mkLocMessageAnn :: Maybe String -> Severity -> SrcSpan -> MsgDoc -> MsgDoc
46getCaretDiagnostic :: Severity -> SrcSpan -> IO MsgDoc
47defaultDumpAction :: DumpAction
48defaultTraceAction :: TraceAction
49
50instance ToJson Severity
51