1{-
2(c) The University of Glasgow 2006
3(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
5\section{Haskell abstract syntax definition}
6
7This module glues together the pieces of the Haskell abstract syntax,
8which is declared in the various \tr{Hs*} modules.  This module,
9therefore, is almost nothing but re-exporting.
10-}
11
12{-# LANGUAGE DeriveDataTypeable #-}
13{-# LANGUAGE StandaloneDeriving #-}
14{-# LANGUAGE FlexibleContexts #-}
15{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
16                                      -- in module GHC.Hs.PlaceHolder
17{-# LANGUAGE ConstraintKinds #-}
18{-# LANGUAGE TypeFamilies #-}
19{-# LANGUAGE FlexibleInstances #-} -- For deriving instance Data
20
21module GHC.Hs (
22        module GHC.Hs.Binds,
23        module GHC.Hs.Decls,
24        module GHC.Hs.Expr,
25        module GHC.Hs.ImpExp,
26        module GHC.Hs.Lit,
27        module GHC.Hs.Pat,
28        module GHC.Hs.Types,
29        module GHC.Hs.Utils,
30        module GHC.Hs.Doc,
31        module GHC.Hs.PlaceHolder,
32        module GHC.Hs.Extension,
33        Fixity,
34
35        HsModule(..),
36) where
37
38-- friends:
39import GhcPrelude
40
41import GHC.Hs.Decls
42import GHC.Hs.Binds
43import GHC.Hs.Expr
44import GHC.Hs.ImpExp
45import GHC.Hs.Lit
46import GHC.Hs.PlaceHolder
47import GHC.Hs.Extension
48import GHC.Hs.Pat
49import GHC.Hs.Types
50import BasicTypes       ( Fixity, WarningTxt )
51import GHC.Hs.Utils
52import GHC.Hs.Doc
53import GHC.Hs.Instances () -- For Data instances
54
55-- others:
56import Outputable
57import SrcLoc
58import Module           ( ModuleName )
59
60-- libraries:
61import Data.Data hiding ( Fixity )
62
63-- | Haskell Module
64--
65-- All we actually declare here is the top-level structure for a module.
66data HsModule pass
67  = HsModule {
68      hsmodName :: Maybe (Located ModuleName),
69        -- ^ @Nothing@: \"module X where\" is omitted (in which case the next
70        --     field is Nothing too)
71      hsmodExports :: Maybe (Located [LIE pass]),
72        -- ^ Export list
73        --
74        --  - @Nothing@: export list omitted, so export everything
75        --
76        --  - @Just []@: export /nothing/
77        --
78        --  - @Just [...]@: as you would expect...
79        --
80        --
81        --  - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen'
82        --                                   ,'ApiAnnotation.AnnClose'
83
84        -- For details on above see note [Api annotations] in ApiAnnotation
85      hsmodImports :: [LImportDecl pass],
86        -- ^ We snaffle interesting stuff out of the imported interfaces early
87        -- on, adding that info to TyDecls/etc; so this list is often empty,
88        -- downstream.
89      hsmodDecls :: [LHsDecl pass],
90        -- ^ Type, class, value, and interface signature decls
91      hsmodDeprecMessage :: Maybe (Located WarningTxt),
92        -- ^ reason\/explanation for warning/deprecation of this module
93        --
94        --  - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen'
95        --                                   ,'ApiAnnotation.AnnClose'
96        --
97
98        -- For details on above see note [Api annotations] in ApiAnnotation
99      hsmodHaddockModHeader :: Maybe LHsDocString
100        -- ^ Haddock module info and description, unparsed
101        --
102        --  - 'ApiAnnotation.AnnKeywordId's : 'ApiAnnotation.AnnOpen'
103        --                                   ,'ApiAnnotation.AnnClose'
104
105        -- For details on above see note [Api annotations] in ApiAnnotation
106   }
107     -- ^ 'ApiAnnotation.AnnKeywordId's
108     --
109     --  - 'ApiAnnotation.AnnModule','ApiAnnotation.AnnWhere'
110     --
111     --  - 'ApiAnnotation.AnnOpen','ApiAnnotation.AnnSemi',
112     --    'ApiAnnotation.AnnClose' for explicit braces and semi around
113     --    hsmodImports,hsmodDecls if this style is used.
114
115     -- For details on above see note [Api annotations] in ApiAnnotation
116-- deriving instance (DataIdLR name name) => Data (HsModule name)
117deriving instance Data (HsModule GhcPs)
118deriving instance Data (HsModule GhcRn)
119deriving instance Data (HsModule GhcTc)
120
121instance (OutputableBndrId p) => Outputable (HsModule (GhcPass p)) where
122
123    ppr (HsModule Nothing _ imports decls _ mbDoc)
124      = pp_mb mbDoc $$ pp_nonnull imports
125                    $$ pp_nonnull decls
126
127    ppr (HsModule (Just name) exports imports decls deprec mbDoc)
128      = vcat [
129            pp_mb mbDoc,
130            case exports of
131              Nothing -> pp_header (text "where")
132              Just es -> vcat [
133                           pp_header lparen,
134                           nest 8 (fsep (punctuate comma (map ppr (unLoc es)))),
135                           nest 4 (text ") where")
136                          ],
137            pp_nonnull imports,
138            pp_nonnull decls
139          ]
140      where
141        pp_header rest = case deprec of
142           Nothing -> pp_modname <+> rest
143           Just d -> vcat [ pp_modname, ppr d, rest ]
144
145        pp_modname = text "module" <+> ppr name
146
147pp_mb :: Outputable t => Maybe t -> SDoc
148pp_mb (Just x) = ppr x
149pp_mb Nothing  = empty
150
151pp_nonnull :: Outputable t => [t] -> SDoc
152pp_nonnull [] = empty
153pp_nonnull xs = vcat (map ppr xs)
154