1{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable, StandaloneDeriving, TypeFamilies, RecordWildCards #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE PartialTypeSignatures #-}
4{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
5{-# LANGUAGE FlexibleInstances #-}
6{-# OPTIONS_GHC -fno-warn-orphans #-}
7
8-----------------------------------------------------------------------------
9-- |
10-- Module      :  Haddock.Types
11-- Copyright   :  (c) Simon Marlow      2003-2006,
12--                    David Waern       2006-2009,
13--                    Mateusz Kowalczyk 2013
14-- License     :  BSD-like
15--
16-- Maintainer  :  haddock@projects.haskellorg
17-- Stability   :  experimental
18-- Portability :  portable
19--
20-- Types that are commonly used through-out Haddock. Some of the most
21-- important types are defined here, like 'Interface' and 'DocName'.
22-----------------------------------------------------------------------------
23module Haddock.Types (
24  module Haddock.Types
25  , HsDocString, LHsDocString
26  , Fixity(..)
27  , module Documentation.Haddock.Types
28 ) where
29
30import Control.Exception
31import Control.Arrow hiding ((<+>))
32import Control.DeepSeq
33import Control.Monad (ap)
34import Control.Monad.IO.Class (MonadIO(..))
35import Data.Typeable (Typeable)
36import Data.Map (Map)
37import Data.Data (Data)
38import Data.Void (Void)
39import Documentation.Haddock.Types
40import BasicTypes (Fixity(..), PromotionFlag(..))
41
42import Exception (ExceptionMonad(..), ghandle)
43import GHC
44import DynFlags (Language)
45import qualified GHC.LanguageExtensions as LangExt
46import OccName
47import Outputable hiding ((<>))
48
49-----------------------------------------------------------------------------
50-- * Convenient synonyms
51-----------------------------------------------------------------------------
52
53
54type IfaceMap      = Map Module Interface
55type InstIfaceMap  = Map Module InstalledInterface  -- TODO: rename
56type DocMap a      = Map Name (MDoc a)
57type ArgMap a      = Map Name (Map Int (MDoc a))
58type SubMap        = Map Name [Name]
59type DeclMap       = Map Name [LHsDecl GhcRn]
60type InstMap       = Map SrcSpan Name
61type FixMap        = Map Name Fixity
62type DocPaths      = (FilePath, Maybe FilePath) -- paths to HTML and sources
63
64
65-----------------------------------------------------------------------------
66-- * Interface
67-----------------------------------------------------------------------------
68
69
70-- | 'Interface' holds all information used to render a single Haddock page.
71-- It represents the /interface/ of a module. The core business of Haddock
72-- lies in creating this structure. Note that the record contains some fields
73-- that are only used to create the final record, and that are not used by the
74-- backends.
75data Interface = Interface
76  {
77    -- | The module behind this interface.
78    ifaceMod             :: !Module
79
80    -- | Is this a signature?
81  , ifaceIsSig           :: !Bool
82
83    -- | Original file name of the module.
84  , ifaceOrigFilename    :: !FilePath
85
86    -- | Textual information about the module.
87  , ifaceInfo            :: !(HaddockModInfo Name)
88
89    -- | Documentation header.
90  , ifaceDoc             :: !(Documentation Name)
91
92    -- | Documentation header with cross-reference information.
93  , ifaceRnDoc           :: !(Documentation DocName)
94
95    -- | Haddock options for this module (prune, ignore-exports, etc).
96  , ifaceOptions         :: ![DocOption]
97
98    -- | Declarations originating from the module. Excludes declarations without
99    -- names (instances and stand-alone documentation comments). Includes
100    -- names of subordinate declarations mapped to their parent declarations.
101  , ifaceDeclMap         :: !(Map Name [LHsDecl GhcRn])
102
103    -- | Documentation of declarations originating from the module (including
104    -- subordinates).
105  , ifaceDocMap          :: !(DocMap Name)
106  , ifaceArgMap          :: !(ArgMap Name)
107
108    -- | Documentation of declarations originating from the module (including
109    -- subordinates).
110  , ifaceRnDocMap        :: !(DocMap DocName)
111  , ifaceRnArgMap        :: !(ArgMap DocName)
112
113  , ifaceFixMap          :: !(Map Name Fixity)
114
115  , ifaceExportItems     :: ![ExportItem GhcRn]
116  , ifaceRnExportItems   :: ![ExportItem DocNameI]
117
118    -- | All names exported by the module.
119  , ifaceExports         :: ![Name]
120
121    -- | All \"visible\" names exported by the module.
122    -- A visible name is a name that will show up in the documentation of the
123    -- module.
124  , ifaceVisibleExports  :: ![Name]
125
126    -- | Aliases of module imports as in @import A.B.C as C@.
127  , ifaceModuleAliases   :: !AliasMap
128
129    -- | Instances exported by the module.
130  , ifaceInstances       :: ![ClsInst]
131  , ifaceFamInstances    :: ![FamInst]
132
133    -- | Orphan instances
134  , ifaceOrphanInstances :: ![DocInstance GhcRn]
135  , ifaceRnOrphanInstances :: ![DocInstance DocNameI]
136
137    -- | The number of haddockable and haddocked items in the module, as a
138    -- tuple. Haddockable items are the exports and the module itself.
139  , ifaceHaddockCoverage :: !(Int, Int)
140
141    -- | Warnings for things defined in this module.
142  , ifaceWarningMap :: !WarningMap
143
144    -- | Tokenized source code of module (avaliable if Haddock is invoked with
145    -- source generation flag).
146  , ifaceHieFile :: !(Maybe FilePath)
147  , ifaceDynFlags :: !DynFlags
148  }
149
150type WarningMap = Map Name (Doc Name)
151
152
153-- | A subset of the fields of 'Interface' that we store in the interface
154-- files.
155data InstalledInterface = InstalledInterface
156  {
157    -- | The module represented by this interface.
158    instMod              :: Module
159
160    -- | Is this a signature?
161  , instIsSig            :: Bool
162
163    -- | Textual information about the module.
164  , instInfo             :: HaddockModInfo Name
165
166    -- | Documentation of declarations originating from the module (including
167    -- subordinates).
168  , instDocMap           :: DocMap Name
169
170  , instArgMap           :: ArgMap Name
171
172    -- | All names exported by this module.
173  , instExports          :: [Name]
174
175    -- | All \"visible\" names exported by the module.
176    -- A visible name is a name that will show up in the documentation of the
177    -- module.
178  , instVisibleExports   :: [Name]
179
180    -- | Haddock options for this module (prune, ignore-exports, etc).
181  , instOptions          :: [DocOption]
182
183  , instFixMap           :: Map Name Fixity
184  }
185
186
187-- | Convert an 'Interface' to an 'InstalledInterface'
188toInstalledIface :: Interface -> InstalledInterface
189toInstalledIface interface = InstalledInterface
190  { instMod              = ifaceMod              interface
191  , instIsSig            = ifaceIsSig            interface
192  , instInfo             = ifaceInfo             interface
193  , instDocMap           = ifaceDocMap           interface
194  , instArgMap           = ifaceArgMap           interface
195  , instExports          = ifaceExports          interface
196  , instVisibleExports   = ifaceVisibleExports   interface
197  , instOptions          = ifaceOptions          interface
198  , instFixMap           = ifaceFixMap           interface
199  }
200
201
202-----------------------------------------------------------------------------
203-- * Export items & declarations
204-----------------------------------------------------------------------------
205
206
207data ExportItem name
208
209  -- | An exported declaration.
210  = ExportDecl
211      {
212        -- | A declaration.
213        expItemDecl :: !(LHsDecl name)
214
215        -- | Bundled patterns for a data type declaration
216      , expItemPats :: ![(HsDecl name, DocForDecl (IdP name))]
217
218        -- | Maybe a doc comment, and possibly docs for arguments (if this
219        -- decl is a function or type-synonym).
220      , expItemMbDoc :: !(DocForDecl (IdP name))
221
222        -- | Subordinate names, possibly with documentation.
223      , expItemSubDocs :: ![(IdP name, DocForDecl (IdP name))]
224
225        -- | Instances relevant to this declaration, possibly with
226        -- documentation.
227      , expItemInstances :: ![DocInstance name]
228
229        -- | Fixity decls relevant to this declaration (including subordinates).
230      , expItemFixities :: ![(IdP name, Fixity)]
231
232        -- | Whether the ExportItem is from a TH splice or not, for generating
233        -- the appropriate type of Source link.
234      , expItemSpliced :: !Bool
235      }
236
237  -- | An exported entity for which we have no documentation (perhaps because it
238  -- resides in another package).
239  | ExportNoDecl
240      { expItemName :: !(IdP name)
241
242        -- | Subordinate names.
243      , expItemSubs :: ![IdP name]
244      }
245
246  -- | A section heading.
247  | ExportGroup
248      {
249        -- | Section level (1, 2, 3, ...).
250        expItemSectionLevel :: !Int
251
252        -- | Section id (for hyperlinks).
253      , expItemSectionId :: !String
254
255        -- | Section heading text.
256      , expItemSectionText :: !(Doc (IdP name))
257      }
258
259  -- | Some documentation.
260  | ExportDoc !(MDoc (IdP name))
261
262  -- | A cross-reference to another module.
263  | ExportModule !Module
264
265data Documentation name = Documentation
266  { documentationDoc :: Maybe (MDoc name)
267  , documentationWarning :: !(Maybe (Doc name))
268  } deriving Functor
269
270
271-- | Arguments and result are indexed by Int, zero-based from the left,
272-- because that's the easiest to use when recursing over types.
273type FnArgsDoc name = Map Int (MDoc name)
274type DocForDecl name = (Documentation name, FnArgsDoc name)
275
276
277noDocForDecl :: DocForDecl name
278noDocForDecl = (Documentation Nothing Nothing, mempty)
279
280
281-----------------------------------------------------------------------------
282-- * Cross-referencing
283-----------------------------------------------------------------------------
284
285
286-- | Type of environment used to cross-reference identifiers in the syntax.
287type LinkEnv = Map Name Module
288
289-- | An 'RdrName' tagged with some type/value namespace information.
290data NsRdrName = NsRdrName
291  { namespace :: !Namespace
292  , rdrName :: !RdrName
293  }
294
295-- | Extends 'Name' with cross-reference information.
296data DocName
297  = Documented Name Module
298     -- ^ This thing is part of the (existing or resulting)
299     -- documentation. The 'Module' is the preferred place
300     -- in the documentation to refer to.
301  | Undocumented Name
302     -- ^ This thing is not part of the (existing or resulting)
303     -- documentation, as far as Haddock knows.
304  deriving (Eq, Data)
305
306data DocNameI
307
308type instance IdP DocNameI = DocName
309
310
311instance NamedThing DocName where
312  getName (Documented name _) = name
313  getName (Undocumented name) = name
314
315-- | Useful for debugging
316instance Outputable DocName where
317  ppr = ppr . getName
318
319instance OutputableBndr DocName where
320  pprBndr _ = ppr . getName
321  pprPrefixOcc = pprPrefixOcc . getName
322  pprInfixOcc = pprInfixOcc . getName
323
324class NamedThing name => SetName name where
325
326    setName :: Name -> name -> name
327
328
329instance SetName Name where
330
331    setName name' _ = name'
332
333
334instance SetName DocName where
335
336    setName name' (Documented _ mdl) = Documented name' mdl
337    setName name' (Undocumented _) = Undocumented name'
338
339-- | Adds extra "wrapper" information to a name.
340--
341-- This is to work around the fact that most name types in GHC ('Name', 'RdrName',
342-- 'OccName', ...) don't include backticks or parens.
343data Wrap n
344  = Unadorned { unwrap :: n  }     -- ^ don't do anything to the name
345  | Parenthesized { unwrap :: n }  -- ^ add parentheses around the name
346  | Backticked { unwrap :: n }     -- ^ add backticks around the name
347  deriving (Show, Functor, Foldable, Traversable)
348
349-- | Useful for debugging
350instance Outputable n => Outputable (Wrap n) where
351  ppr (Unadorned n)     = ppr n
352  ppr (Parenthesized n) = hcat [ char '(', ppr n, char ')' ]
353  ppr (Backticked n)    = hcat [ char '`', ppr n, char '`' ]
354
355showWrapped :: (a -> String) -> Wrap a -> String
356showWrapped f (Unadorned n) = f n
357showWrapped f (Parenthesized n) = "(" ++ f n ++ ")"
358showWrapped f (Backticked n) = "`" ++ f n ++ "`"
359
360instance HasOccName DocName where
361
362    occName = occName . getName
363
364-----------------------------------------------------------------------------
365-- * Instances
366-----------------------------------------------------------------------------
367
368-- | The three types of instances
369data InstType name
370  = ClassInst
371      { clsiCtx :: [HsType name]
372      , clsiTyVars :: LHsQTyVars name
373      , clsiSigs :: [Sig name]
374      , clsiAssocTys :: [PseudoFamilyDecl name]
375      }
376  | TypeInst  (Maybe (HsType name)) -- ^ Body (right-hand side)
377  | DataInst (TyClDecl name)        -- ^ Data constructors
378
379instance (OutputableBndrId p)
380         => Outputable (InstType (GhcPass p)) where
381  ppr (ClassInst { .. }) = text "ClassInst"
382      <+> ppr clsiCtx
383      <+> ppr clsiTyVars
384      <+> ppr clsiSigs
385  ppr (TypeInst  a) = text "TypeInst"  <+> ppr a
386  ppr (DataInst  a) = text "DataInst"  <+> ppr a
387
388
389-- | Almost the same as 'FamilyDecl' except for type binders.
390--
391-- In order to perform type specialization for class instances, we need to
392-- substitute class variables to appropriate type. However, type variables in
393-- associated type are specified using 'LHsTyVarBndrs' instead of 'HsType'.
394-- This makes type substitution impossible and to overcome this issue,
395-- 'PseudoFamilyDecl' type is introduced.
396data PseudoFamilyDecl name = PseudoFamilyDecl
397    { pfdInfo :: FamilyInfo name
398    , pfdLName :: Located (IdP name)
399    , pfdTyVars :: [LHsType name]
400    , pfdKindSig :: LFamilyResultSig name
401    }
402
403
404mkPseudoFamilyDecl :: FamilyDecl (GhcPass p) -> PseudoFamilyDecl (GhcPass p)
405mkPseudoFamilyDecl (FamilyDecl { .. }) = PseudoFamilyDecl
406    { pfdInfo = fdInfo
407    , pfdLName = fdLName
408    , pfdTyVars = [ L loc (mkType bndr) | L loc bndr <- hsq_explicit fdTyVars ]
409    , pfdKindSig = fdResultSig
410    }
411  where
412    mkType (KindedTyVar _ (L loc name) lkind) =
413        HsKindSig noExtField tvar lkind
414      where
415        tvar = L loc (HsTyVar noExtField NotPromoted (L loc name))
416    mkType (UserTyVar _ name) = HsTyVar noExtField NotPromoted name
417    mkType (XTyVarBndr nec) = noExtCon nec
418mkPseudoFamilyDecl (XFamilyDecl nec) = noExtCon nec
419
420
421-- | An instance head that may have documentation and a source location.
422type DocInstance name = (InstHead name, Maybe (MDoc (IdP name)), Located (IdP name), Maybe Module)
423
424-- | The head of an instance. Consists of a class name, a list of type
425-- parameters (which may be annotated with kinds), and an instance type
426data InstHead name = InstHead
427    { ihdClsName :: IdP name
428    , ihdTypes :: [HsType name]
429    , ihdInstType :: InstType name
430    }
431
432
433-- | An instance origin information.
434--
435-- This is used primarily in HTML backend to generate unique instance
436-- identifiers (for expandable sections).
437data InstOrigin name
438    = OriginClass name
439    | OriginData name
440    | OriginFamily name
441
442
443instance NamedThing name => NamedThing (InstOrigin name) where
444
445    getName (OriginClass name) = getName name
446    getName (OriginData name) = getName name
447    getName (OriginFamily name) = getName name
448
449
450-----------------------------------------------------------------------------
451-- * Documentation comments
452-----------------------------------------------------------------------------
453
454
455type LDoc id = Located (Doc id)
456
457type Doc id = DocH (Wrap (ModuleName, OccName)) (Wrap id)
458type MDoc id = MetaDoc (Wrap (ModuleName, OccName)) (Wrap id)
459
460type DocMarkup id a = DocMarkupH (Wrap (ModuleName, OccName)) id a
461
462instance (NFData a, NFData mod)
463         => NFData (DocH mod a) where
464  rnf doc = case doc of
465    DocEmpty                  -> ()
466    DocAppend a b             -> a `deepseq` b `deepseq` ()
467    DocString a               -> a `deepseq` ()
468    DocParagraph a            -> a `deepseq` ()
469    DocIdentifier a           -> a `deepseq` ()
470    DocIdentifierUnchecked a  -> a `deepseq` ()
471    DocModule a               -> a `deepseq` ()
472    DocWarning a              -> a `deepseq` ()
473    DocEmphasis a             -> a `deepseq` ()
474    DocBold a                 -> a `deepseq` ()
475    DocMonospaced a           -> a `deepseq` ()
476    DocUnorderedList a        -> a `deepseq` ()
477    DocOrderedList a          -> a `deepseq` ()
478    DocDefList a              -> a `deepseq` ()
479    DocCodeBlock a            -> a `deepseq` ()
480    DocHyperlink a            -> a `deepseq` ()
481    DocPic a                  -> a `deepseq` ()
482    DocMathInline a           -> a `deepseq` ()
483    DocMathDisplay a          -> a `deepseq` ()
484    DocAName a                -> a `deepseq` ()
485    DocProperty a             -> a `deepseq` ()
486    DocExamples a             -> a `deepseq` ()
487    DocHeader a               -> a `deepseq` ()
488    DocTable a                -> a `deepseq` ()
489
490#if !MIN_VERSION_ghc(8,0,2)
491-- These were added to GHC itself in 8.0.2
492instance NFData Name where rnf x = seq x ()
493instance NFData OccName where rnf x = seq x ()
494instance NFData ModuleName where rnf x = seq x ()
495#endif
496
497instance NFData id => NFData (Header id) where
498  rnf (Header a b) = a `deepseq` b `deepseq` ()
499
500instance NFData id => NFData (Hyperlink id) where
501  rnf (Hyperlink a b) = a `deepseq` b `deepseq` ()
502
503instance NFData id => NFData (ModLink id) where
504  rnf (ModLink a b) = a `deepseq` b `deepseq` ()
505
506instance NFData Picture where
507  rnf (Picture a b) = a `deepseq` b `deepseq` ()
508
509instance NFData Example where
510  rnf (Example a b) = a `deepseq` b `deepseq` ()
511
512instance NFData id => NFData (Table id) where
513    rnf (Table h b) = h `deepseq` b `deepseq` ()
514
515instance NFData id => NFData (TableRow id) where
516    rnf (TableRow cs) = cs `deepseq` ()
517
518instance NFData id => NFData (TableCell id) where
519    rnf (TableCell i j c) = i `deepseq` j `deepseq` c `deepseq` ()
520
521exampleToString :: Example -> String
522exampleToString (Example expression result) =
523    ">>> " ++ expression ++ "\n" ++  unlines result
524
525data HaddockModInfo name = HaddockModInfo
526  { hmi_description :: Maybe (Doc name)
527  , hmi_copyright   :: Maybe String
528  , hmi_license     :: Maybe String
529  , hmi_maintainer  :: Maybe String
530  , hmi_stability   :: Maybe String
531  , hmi_portability :: Maybe String
532  , hmi_safety      :: Maybe String
533  , hmi_language    :: Maybe Language
534  , hmi_extensions  :: [LangExt.Extension]
535  }
536
537
538emptyHaddockModInfo :: HaddockModInfo a
539emptyHaddockModInfo = HaddockModInfo
540  { hmi_description = Nothing
541  , hmi_copyright   = Nothing
542  , hmi_license     = Nothing
543  , hmi_maintainer  = Nothing
544  , hmi_stability   = Nothing
545  , hmi_portability = Nothing
546  , hmi_safety      = Nothing
547  , hmi_language    = Nothing
548  , hmi_extensions  = []
549  }
550
551
552-----------------------------------------------------------------------------
553-- * Options
554-----------------------------------------------------------------------------
555
556
557-- | Source-level options for controlling the documentation.
558data DocOption
559  = OptHide            -- ^ This module should not appear in the docs.
560  | OptPrune
561  | OptIgnoreExports   -- ^ Pretend everything is exported.
562  | OptNotHome         -- ^ Not the best place to get docs for things
563                       -- exported by this module.
564  | OptShowExtensions  -- ^ Render enabled extensions for this module.
565  deriving (Eq, Show)
566
567
568-- | Option controlling how to qualify names
569data QualOption
570  = OptNoQual         -- ^ Never qualify any names.
571  | OptFullQual       -- ^ Qualify all names fully.
572  | OptLocalQual      -- ^ Qualify all imported names fully.
573  | OptRelativeQual   -- ^ Like local, but strip module prefix
574                      --   from modules in the same hierarchy.
575  | OptAliasedQual    -- ^ Uses aliases of module names
576                      --   as suggested by module import renamings.
577                      --   However, we are unfortunately not able
578                      --   to maintain the original qualifications.
579                      --   Image a re-export of a whole module,
580                      --   how could the re-exported identifiers be qualified?
581
582type AliasMap = Map Module ModuleName
583
584data Qualification
585  = NoQual
586  | FullQual
587  | LocalQual Module
588  | RelativeQual Module
589  | AliasedQual AliasMap Module
590       -- ^ @Module@ contains the current module.
591       --   This way we can distinguish imported and local identifiers.
592
593makeContentsQual :: QualOption -> Qualification
594makeContentsQual qual =
595  case qual of
596    OptNoQual -> NoQual
597    _         -> FullQual
598
599makeModuleQual :: QualOption -> AliasMap -> Module -> Qualification
600makeModuleQual qual aliases mdl =
601  case qual of
602    OptLocalQual      -> LocalQual mdl
603    OptRelativeQual   -> RelativeQual mdl
604    OptAliasedQual    -> AliasedQual aliases mdl
605    OptFullQual       -> FullQual
606    OptNoQual         -> NoQual
607
608-- | Whether to hide empty contexts
609-- Since pattern synonyms have two contexts with different semantics, it is
610-- important to all of them, even if one of them is empty.
611data HideEmptyContexts
612  = HideEmptyContexts
613  | ShowEmptyToplevelContexts
614
615-- | When to qualify @since@ annotations with their package
616data SinceQual
617  = Always
618  | External -- ^ only qualify when the thing being annotated is from
619             -- an external package
620
621-----------------------------------------------------------------------------
622-- * Error handling
623-----------------------------------------------------------------------------
624
625
626-- A monad which collects error messages, locally defined to avoid a dep on mtl
627
628
629type ErrMsg = String
630newtype ErrMsgM a = Writer { runWriter :: (a, [ErrMsg]) }
631
632
633instance Functor ErrMsgM where
634        fmap f (Writer (a, msgs)) = Writer (f a, msgs)
635
636instance Applicative ErrMsgM where
637    pure a = Writer (a, [])
638    (<*>)  = ap
639
640instance Monad ErrMsgM where
641        return   = pure
642        m >>= k  = Writer $ let
643                (a, w)  = runWriter m
644                (b, w') = runWriter (k a)
645                in (b, w ++ w')
646
647
648tell :: [ErrMsg] -> ErrMsgM ()
649tell w = Writer ((), w)
650
651
652-- Exceptions
653
654
655-- | Haddock's own exception type.
656data HaddockException
657  = HaddockException String
658  | WithContext [String] SomeException
659  deriving Typeable
660
661
662instance Show HaddockException where
663  show (HaddockException str) = str
664  show (WithContext ctxts se)  = unlines $ ["While " ++ ctxt ++ ":\n" | ctxt <- reverse ctxts] ++ [show se]
665
666throwE :: String -> a
667instance Exception HaddockException
668throwE str = throw (HaddockException str)
669
670withExceptionContext :: ExceptionMonad m => String -> m a -> m a
671withExceptionContext ctxt =
672  ghandle (\ex ->
673      case ex of
674        HaddockException _ -> throw $ WithContext [ctxt] (toException ex)
675        WithContext ctxts se -> throw $ WithContext (ctxt:ctxts) se
676          ) .
677  ghandle (throw . WithContext [ctxt])
678
679-- In "Haddock.Interface.Create", we need to gather
680-- @Haddock.Types.ErrMsg@s a lot, like @ErrMsgM@ does,
681-- but we can't just use @GhcT ErrMsgM@ because GhcT requires the
682-- transformed monad to be MonadIO.
683newtype ErrMsgGhc a = WriterGhc { runWriterGhc :: Ghc (a, [ErrMsg]) }
684--instance MonadIO ErrMsgGhc where
685--  liftIO = WriterGhc . fmap (\a->(a,[])) liftIO
686--er, implementing GhcMonad involves annoying ExceptionMonad and
687--WarnLogMonad classes, so don't bother.
688liftGhcToErrMsgGhc :: Ghc a -> ErrMsgGhc a
689liftGhcToErrMsgGhc = WriterGhc . fmap (\a->(a,[]))
690liftErrMsg :: ErrMsgM a -> ErrMsgGhc a
691liftErrMsg = WriterGhc . return . runWriter
692--  for now, use (liftErrMsg . tell) for this
693--tell :: [ErrMsg] -> ErrMsgGhc ()
694--tell msgs = WriterGhc $ return ( (), msgs )
695
696
697instance Functor ErrMsgGhc where
698  fmap f (WriterGhc x) = WriterGhc (fmap (first f) x)
699
700instance Applicative ErrMsgGhc where
701    pure a = WriterGhc (return (a, []))
702    (<*>) = ap
703
704instance Monad ErrMsgGhc where
705  return = pure
706  m >>= k = WriterGhc $ runWriterGhc m >>= \ (a, msgs1) ->
707               fmap (second (msgs1 ++)) (runWriterGhc (k a))
708
709instance MonadIO ErrMsgGhc where
710  liftIO m = WriterGhc (fmap (\x -> (x, [])) (liftIO m))
711
712instance ExceptionMonad ErrMsgGhc where
713  gcatch act hand = WriterGhc $
714    runWriterGhc act `gcatch` (runWriterGhc . hand)
715  gmask act = WriterGhc $ gmask $ \mask' ->
716    runWriterGhc $ act (WriterGhc . mask'  . runWriterGhc)
717
718-----------------------------------------------------------------------------
719-- * Pass sensitive types
720-----------------------------------------------------------------------------
721
722type instance XRec DocNameI f = Located (f DocNameI)
723
724type instance XForAllTy        DocNameI = NoExtField
725type instance XQualTy          DocNameI = NoExtField
726type instance XTyVar           DocNameI = NoExtField
727type instance XStarTy          DocNameI = NoExtField
728type instance XAppTy           DocNameI = NoExtField
729type instance XAppKindTy       DocNameI = NoExtField
730type instance XFunTy           DocNameI = NoExtField
731type instance XListTy          DocNameI = NoExtField
732type instance XTupleTy         DocNameI = NoExtField
733type instance XSumTy           DocNameI = NoExtField
734type instance XOpTy            DocNameI = NoExtField
735type instance XParTy           DocNameI = NoExtField
736type instance XIParamTy        DocNameI = NoExtField
737type instance XKindSig         DocNameI = NoExtField
738type instance XSpliceTy        DocNameI = Void       -- see `renameHsSpliceTy`
739type instance XDocTy           DocNameI = NoExtField
740type instance XBangTy          DocNameI = NoExtField
741type instance XRecTy           DocNameI = NoExtField
742type instance XExplicitListTy  DocNameI = NoExtField
743type instance XExplicitTupleTy DocNameI = NoExtField
744type instance XTyLit           DocNameI = NoExtField
745type instance XWildCardTy      DocNameI = NoExtField
746type instance XXType           DocNameI = NewHsTypeX
747
748type instance XUserTyVar    DocNameI = NoExtField
749type instance XKindedTyVar  DocNameI = NoExtField
750type instance XXTyVarBndr   DocNameI = NoExtCon
751
752type instance XCFieldOcc   DocNameI = DocName
753type instance XXFieldOcc   DocNameI = NoExtField
754
755type instance XFixitySig   DocNameI = NoExtField
756type instance XFixSig      DocNameI = NoExtField
757type instance XPatSynSig   DocNameI = NoExtField
758type instance XClassOpSig  DocNameI = NoExtField
759type instance XTypeSig     DocNameI = NoExtField
760type instance XMinimalSig  DocNameI = NoExtField
761
762type instance XForeignExport  DocNameI = NoExtField
763type instance XForeignImport  DocNameI = NoExtField
764type instance XConDeclGADT    DocNameI = NoExtField
765type instance XConDeclH98     DocNameI = NoExtField
766type instance XXConDecl       DocNameI = NoExtCon
767
768type instance XDerivD     DocNameI = NoExtField
769type instance XInstD      DocNameI = NoExtField
770type instance XForD       DocNameI = NoExtField
771type instance XSigD       DocNameI = NoExtField
772type instance XTyClD      DocNameI = NoExtField
773
774type instance XNoSig            DocNameI = NoExtField
775type instance XCKindSig         DocNameI = NoExtField
776type instance XTyVarSig         DocNameI = NoExtField
777type instance XXFamilyResultSig DocNameI = NoExtCon
778
779type instance XCFamEqn       DocNameI _ = NoExtField
780type instance XXFamEqn       DocNameI _ = NoExtCon
781
782type instance XCClsInstDecl DocNameI = NoExtField
783type instance XCDerivDecl   DocNameI = NoExtField
784type instance XViaStrategy  DocNameI = LHsSigType DocNameI
785type instance XDataFamInstD DocNameI = NoExtField
786type instance XTyFamInstD   DocNameI = NoExtField
787type instance XClsInstD     DocNameI = NoExtField
788type instance XCHsDataDefn  DocNameI = NoExtField
789type instance XCFamilyDecl  DocNameI = NoExtField
790type instance XClassDecl    DocNameI = NoExtField
791type instance XDataDecl     DocNameI = NoExtField
792type instance XSynDecl      DocNameI = NoExtField
793type instance XFamDecl      DocNameI = NoExtField
794type instance XXFamilyDecl  DocNameI = NoExtCon
795type instance XXTyClDecl    DocNameI = NoExtCon
796
797type instance XHsIB             DocNameI _ = NoExtField
798type instance XHsWC             DocNameI _ = NoExtField
799type instance XXHsImplicitBndrs DocNameI _ = NoExtCon
800
801type instance XHsQTvs        DocNameI = NoExtField
802type instance XConDeclField  DocNameI = NoExtField
803type instance XXConDeclField DocNameI = NoExtCon
804
805type instance XXPat DocNameI = NoExtCon
806