@@ -9,19 +9,11 @@ module Ormolu.Printer
99 )
1010where
1111
12−import Control.Monad
13−import Data.Char (isAlphaNum)
1412import Data.Text (Text)
15−import GHC hiding (GhcPs, IE)
16−import HsImpExp (IE (..))
13+import GHC (ParsedSource)
1714import Language.Haskell.GHC.ExactPrint.Types
18−import Module (Module (..))
19−import OccName (OccName (..))
20−import Ormolu.Imports (sortImports)
2115import Ormolu.Printer.Combinators
22−import Outputable (Outputable (..), showSDocUnsafe)
23−import RdrName (RdrName (..), rdrNameOcc)
24−import SrcLoc (combineSrcSpans)
16+import Ormolu.Printer.Meat.Module
2517
2618-- | Render a module.
2719
@@ -31,133 +23,4 @@ printModule
3123 -> ParsedSource -- ^ Parsed source
3224 -> Text -- ^ Resulting rendition
3325printModule debugOn anns src =
34− runR debugOn (p_HsModule src) anns
35−
36−p_HsModule :: ParsedSource -> R ()
37−p_HsModule loc@(L moduleSpan hsModule) = do
38− -- NOTE If span of exports in multiline, the whole thing is multiline.
39− -- This is especially important because span of module itself always seems
40− -- to have length zero, so it's not reliable for layout selection.
41− let spn =
42− case hsmodExports hsModule of
43− Nothing -> moduleSpan
44− Just (L exportsSpan _) -> combineSrcSpans moduleSpan exportsSpan
45− locatedVia (Just spn) loc $ \HsModule {..} -> do
46− case hsmodName of
47− Nothing -> pure ()
48− Just hsmodName' -> do
49− line . velt' $
50− [ located hsmodName' p_hsmodName ] ++
51− (case hsmodExports of
52− Nothing -> []
53− Just hsmodExports' ->
54− [ inci (locatedVia Nothing hsmodExports' p_hsmodExports)
55− ])
56− ++ [ txt "where"
57− ]
58− unless (null hsmodImports) newline
59− forM_ (sortImports hsmodImports) (located' p_hsmodImports)
60−
61−p_hsmodName :: ModuleName -> R ()
62−p_hsmodName mname = do
63− txt "module "
64− atom mname
65−
66−p_hsmodExports :: [LIE GhcPs] -> R ()
67−p_hsmodExports xs = do
68− parens . velt $ withSep comma (located' p_lie) xs
69−
70−p_lie :: IE GhcPs -> R ()
71−p_lie = \case
72− IEVar l1 -> located l1 p_ieWrappedName
73− IEThingAbs l1 -> located l1 p_ieWrappedName
74− IEThingAll l1 -> do
75− located l1 p_ieWrappedName
76− txt " (..)"
77− IEThingWith l1 w xs _ -> velt'
78− [ located l1 p_ieWrappedName
79− , inci $ do
80− p_ieWildcard w
81− parens . velt $ withSep comma (located' p_ieWrappedName) xs
82− ]
83− -- XXX I have no idea what field labels are in this context.
84− -- parens . velt $ withSep comma (located' p_FieldLbl) fls
85− IEModuleContents l1 -> located l1 p_hsmodName
86− -- XXX I have no idea what these things are for.
87− IEGroup _ _ -> return ()
88− IEDoc _ -> return ()
89− IEDocNamed _ -> return ()
90−
91−p_hsmodImports :: ImportDecl GhcPs -> R ()
92−p_hsmodImports ImportDecl {..} = line . velt' $
93− [ do txt "import "
94− when ideclSource $
95− txt "{-# SOURCE #-} "
96− when ideclSafe $
97− txt "safe "
98− when ideclQualified $
99− txt "qualified "
100− case ideclPkgQual of
101− Nothing -> return ()
102− Just slit -> do
103− atom slit
104− space
105− located ideclName atom
106− case ideclAs of
107− Nothing -> return ()
108− Just l -> do
109− txt " as "
110− located l atom
111− case ideclHiding of
112− Nothing -> return ()
113− Just (hiding, _) ->
114− when hiding $
115− txt " hiding"
116− ] ++ (case ideclHiding of
117− Nothing -> []
118− Just (_, l) ->
119− [ inci . locatedVia Nothing l $ parens . velt . withSep comma (located' p_lie)
120− ])
121−
122−p_ieWrappedName :: IEWrappedName RdrName -> R ()
123−p_ieWrappedName = \case
124− IEName l2 -> located l2 p_rdrName
125− IEPattern l2 -> located l2 $ \x -> do
126− txt "pattern "
127− p_rdrName x
128− IEType l2 -> located l2 $ \x -> do
129− txt "type "
130− p_rdrName x
131−
132−p_rdrName :: RdrName -> R ()
133−p_rdrName x = opParens (rdrNameOcc x) $ case x of
134− Unqual occName -> atom occName
135− Qual mname occName -> p_qualName mname occName
136− Orig (Module _ mname) occName -> p_qualName mname occName
137− Exact name -> atom name
138−
139−-- p_FieldLbl :: FieldLbl RdrName -> R ()
140−-- p_FieldLbl (FieldLabel x _ _) = atom x
141−
142−p_qualName :: ModuleName -> OccName -> R ()
143−p_qualName mname occName = do
144− atom mname
145− txt "."
146− atom occName
147−
148−p_ieWildcard :: IEWildcard -> R ()
149−p_ieWildcard = \case
150− NoIEWildcard -> return ()
151− IEWildcard n -> parens (atom n)
152−
153−----------------------------------------------------------------------------
154−-- Helpers
155−
156−-- | Put parentheses around the second argument if the 'Outputable' thing
157−-- consists only of punctuation characters.
158−
159−opParens :: Outputable a => a -> R () -> R ()
160−opParens x m =
161− if all (not . isAlphaNum) (showSDocUnsafe (ppr x))
162− then txt "(" >> m >> txt ")"
163− else m
26+ runR debugOn (p_hsModule src) anns