git.iko.soy/ormolu
on master help sign in
Implement rendering of types and type families declarations
576f943mrkkrp
README.md+1−1
compare with master
unifiedsplit
@@ -6,4 +6,4 @@ Ormolu is a formatter for Haskell source code.
6
6
7## License
7## License
8
8
9−Copyright © 2018 Tweag I/O
9+Copyright © 2018–2019 Tweag I/O
data/examples/declaration/type-families/closed-type-family/injective-out.hsnew file+5
@@ -0,0 +1,5 @@
1+type family Id a = result | result -> a where
2+ Id a = a
3+
4+type family G (a :: k) b c = foo | foo -> k b where
5+ G a b c = (a, b)
data/examples/declaration/type-families/closed-type-family/injective.hsnew file+4
@@ -0,0 +1,4 @@
1+type family Id a = result | result -> a where
2+ Id a = a
3+type family G (a :: k) b c = foo | foo -> k b where
4+ G a b c = (a, b)
data/examples/declaration/type-families/closed-type-family/multi-line-out.hsnew file+16
@@ -0,0 +1,16 @@
1+type family Id a
2+ = result | result -> a where
3+ Id a
4+ = a
5+
6+type family G (a :: k) b c
7+ = foo | foo -> k b where
8+ G a b c
9+ = (a, b)
10+
11+type family F a
12+ :: * -> * where
13+ F Int = Double
14+ F Bool
15+ = Char
16+ F a = String
data/examples/declaration/type-families/closed-type-family/multi-line.hsnew file+14
@@ -0,0 +1,14 @@
1+type family Id a
2+ = result | result -> a where
3+ Id
4+ a = a
5+type family G (a :: k)
6+ b c = foo | foo -> k b where
7+ G a b c =
8+ (a, b)
9+type family F a
10+ :: * -> * where
11+ F Int = Double
12+ F Bool =
13+ Char
14+ F a = String
data/examples/declaration/type-families/closed-type-family/no-annotation-out.hsnew file+4
@@ -0,0 +1,4 @@
1+type family F a where
2+ F Int = Double
3+ F Bool = Char
4+ F a = String
data/examples/declaration/type-families/closed-type-family/no-annotation.hsnew file+4
@@ -0,0 +1,4 @@
1+type family F a where
2+ F Int = Double
3+ F Bool = Char
4+ F a = String
data/examples/declaration/type-families/closed-type-family/simple-out.hsnew file+5
@@ -0,0 +1,5 @@
1+-- | Documentation.
2+type family F a :: * -> * where
3+ F Int = Double
4+ F Bool = Char
5+ F a = String
data/examples/declaration/type-families/closed-type-family/simple.hsnew file+6
@@ -0,0 +1,6 @@
1+-- | Documentation.
2+
3+type family F a :: * -> * where
4+ F Int = Double
5+ F Bool = Char
6+ F a = String
data/examples/declaration/type-families/data-family/no-annotation-out.hsnew file+2
@@ -0,0 +1,2 @@
1+-- | Documentation.
2+data family Array e
data/examples/declaration/type-families/data-family/no-annotation.hsnew file+3
@@ -0,0 +1,3 @@
1+-- | Documentation.
2+
3+data family Array e
data/examples/declaration/type-families/data-family/simple-out.hsnew file+2
@@ -0,0 +1,2 @@
1+-- | Documentation.
2+data family GMap k :: Type -> Type
data/examples/declaration/type-families/data-family/simple.hsnew file+3
@@ -0,0 +1,3 @@
1+-- | Documentation.
2+
3+data family GMap k :: Type -> Type
data/examples/declaration/type-families/type-family/injective-out.hsnew file+3
@@ -0,0 +1,3 @@
1+type family Id a = r | r -> a
2+
3+type family F a b c = d | d -> a c b
data/examples/declaration/type-families/type-family/injective.hsnew file+2
@@ -0,0 +1,2 @@
1+type family Id a = r | r -> a
2+type family F a b c = d | d -> a c b
data/examples/declaration/type-families/type-family/no-annotation-out.hsnew file+2
@@ -0,0 +1,2 @@
1+-- | Documentation.
2+type family F a b :: Type -> Type
data/examples/declaration/type-families/type-family/no-annotation.hsnew file+3
@@ -0,0 +1,3 @@
1+-- | Documentation.
2+
3+type family F a b :: Type -> Type
data/examples/declaration/type-families/type-family/simple-out.hsnew file+2
@@ -0,0 +1,2 @@
1+-- | Documentation.
2+type family Elem c :: Type
data/examples/declaration/type-families/type-family/simple.hsnew file+3
@@ -0,0 +1,3 @@
1+-- | Documentation.
2+
3+type family Elem c :: Type
ormolu.cabal+6
@@ -48,6 +48,12 @@ library
48 , Ormolu.Printer.Combinators
48 , Ormolu.Printer.Combinators
49 , Ormolu.Printer.Comments
49 , Ormolu.Printer.Comments
50 , Ormolu.Printer.Internal
50 , Ormolu.Printer.Internal
51+ , Ormolu.Printer.Meat.Common
52+ , Ormolu.Printer.Meat.Declaration
53+ , Ormolu.Printer.Meat.Declaration.TypeFamily
54+ , Ormolu.Printer.Meat.ImportExport
55+ , Ormolu.Printer.Meat.Module
56+ , Ormolu.Printer.Meat.Type
51 if flag(dev)
57 if flag(dev)
52 ghc-options: -Wall -Werror -Wcompat
58 ghc-options: -Wall -Werror -Wcompat
53 -Wincomplete-record-updates
59 -Wincomplete-record-updates
src/Ormolu/Printer.hs+3−140
@@ -9,19 +9,11 @@ module Ormolu.Printer
9 )
9 )
10where
10where
11
11
12−import Control.Monad
13−import Data.Char (isAlphaNum)
14import Data.Text (Text)
12import Data.Text (Text)
15−import GHC hiding (GhcPs, IE)
13+import GHC (ParsedSource)
16−import HsImpExp (IE (..))
17import Language.Haskell.GHC.ExactPrint.Types
14import Language.Haskell.GHC.ExactPrint.Types
18−import Module (Module (..))
19−import OccName (OccName (..))
20−import Ormolu.Imports (sortImports)
21import Ormolu.Printer.Combinators
15import Ormolu.Printer.Combinators
22−import Outputable (Outputable (..), showSDocUnsafe)
16+import Ormolu.Printer.Meat.Module
23−import RdrName (RdrName (..), rdrNameOcc)
24−import SrcLoc (combineSrcSpans)
25
17
26-- | Render a module.
18-- | Render a module.
27
19
@@ -31,133 +23,4 @@ printModule
31 -> ParsedSource -- ^ Parsed source
23 -> ParsedSource -- ^ Parsed source
32 -> Text -- ^ Resulting rendition
24 -> Text -- ^ Resulting rendition
33printModule debugOn anns src =
25printModule debugOn anns src =
34− runR debugOn (p_HsModule src) anns
26+ 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
src/Ormolu/Printer/Combinators.hs+28−3
@@ -19,16 +19,20 @@ module Ormolu.Printer.Combinators
19 , located'
19 , located'
20 , velt
20 , velt
21 , velt'
21 , velt'
22+ , vlayout
22 , withSep
23 , withSep
23 -- ** Wrapping
24 -- ** Wrapping
24 , line
25 , line
25 , braces
26 , braces
26 , brackets
27 , brackets
28+ , bracketsPar
27 , parens
29 , parens
30+ , parensHash
28 -- ** Literals
31 -- ** Literals
29 , comma
32 , comma
30 , ofType
33 , ofType
31− , sarrow
34+ , larrow
35+ , rarrow
32 , darrow
36 , darrow
33 , space
37 , space
34 )
38 )
@@ -192,6 +196,14 @@ brackets m = sitcc $ do
192 ospaces m
196 ospaces m
193 txt "]"
197 txt "]"
194
198
199+-- | Surround given entity by parallel array brackets @[:@ ond @:]@.
200+
201+bracketsPar :: R () -> R ()
202+bracketsPar m = sitcc $ do
203+ txt "[:"
204+ m
205+ txt ":]"
206+
195-- | Surround given entity by parentheses.
207-- | Surround given entity by parentheses.
196
208
197parens :: R () -> R ()
209parens :: R () -> R ()
@@ -200,6 +212,14 @@ parens m = sitcc $ do
200 ospaces m
212 ospaces m
201 txt ")"
213 txt ")"
202
214
215+-- | Surround given entity by @(# @ and @ #)@.
216+
217+parensHash :: R () -> R ()
218+parensHash m = sitcc $ do
219+ txt "(# "
220+ m
221+ txt " #)"
222+
203-- | Surround given entity by optional space before and a newline after, iff
223-- | Surround given entity by optional space before and a newline after, iff
204-- current layout is multiline.
224-- current layout is multiline.
205
225
@@ -219,10 +239,15 @@ comma = txt ", "
219ofType :: R ()
239ofType :: R ()
220ofType = txt ":: "
240ofType = txt ":: "
221
241
242+-- | Print @<-@ followed by a space.
243+
244+larrow :: R ()
245+larrow = txt "<- "
246+
222-- | Print @->@ followed by a space.
247-- | Print @->@ followed by a space.
223
248
224−sarrow :: R ()
249+rarrow :: R ()
225−sarrow = txt "-> "
250+rarrow = txt "-> "
226
251
227-- | Print @=>@ followed by a space.
252-- | Print @=>@ followed by a space.
228
253
src/Ormolu/Printer/Meat/Common.hsnew file+71
@@ -0,0 +1,71 @@
1+{-# LANGUAGE LambdaCase #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+
4+-- | Rendering of commonly useful bits.
5+
6+module Ormolu.Printer.Meat.Common
7+ ( p_hsmodName
8+ , p_ieWrappedName
9+ , p_rdrName
10+ , p_rdrName'
11+ , p_qualName
12+ , p_ieWildcard
13+ , opParens
14+ )
15+where
16+
17+import Data.Char (isAlphaNum)
18+import GHC hiding (GhcPs, IE)
19+import Module (Module (..))
20+import OccName (OccName (..))
21+import Ormolu.Printer.Combinators
22+import Outputable (Outputable (..), showSDocUnsafe)
23+import RdrName (RdrName (..), rdrNameOcc)
24+
25+p_hsmodName :: ModuleName -> R ()
26+p_hsmodName mname = do
27+ txt "module "
28+ atom mname
29+
30+p_ieWrappedName :: IEWrappedName RdrName -> R ()
31+p_ieWrappedName = \case
32+ IEName l2 -> located l2 p_rdrName
33+ IEPattern l2 -> located l2 $ \x -> do
34+ txt "pattern "
35+ p_rdrName x
36+ IEType l2 -> located l2 $ \x -> do
37+ txt "type "
38+ p_rdrName x
39+
40+p_rdrName :: RdrName -> R ()
41+p_rdrName x = opParens (rdrNameOcc x) (p_rdrName' x)
42+
43+p_rdrName' :: RdrName -> R ()
44+p_rdrName' x = case x of
45+ Unqual occName -> atom occName
46+ Qual mname occName -> p_qualName mname occName
47+ Orig (Module _ mname) occName -> p_qualName mname occName
48+ Exact name -> atom name
49+
50+p_qualName :: ModuleName -> OccName -> R ()
51+p_qualName mname occName = do
52+ atom mname
53+ txt "."
54+ atom occName
55+
56+p_ieWildcard :: IEWildcard -> R ()
57+p_ieWildcard = \case
58+ NoIEWildcard -> return ()
59+ IEWildcard n -> parens (atom n)
60+
61+----------------------------------------------------------------------------
62+-- Helpers
63+
64+-- | Put parentheses around the second argument if the 'Outputable' thing
65+-- consists only of punctuation characters.
66+
67+opParens :: Outputable a => a -> R () -> R ()
68+opParens x m =
69+ if all (not . isAlphaNum) (showSDocUnsafe (ppr x))
70+ then txt "(" >> m >> txt ")"
71+ else m
src/Ormolu/Printer/Meat/Declaration.hsnew file+23
@@ -0,0 +1,23 @@
1+{-# LANGUAGE LambdaCase #-}
2+
3+-- | Rendering of declarations.
4+
5+module Ormolu.Printer.Meat.Declaration
6+ ( p_hsDecl
7+ )
8+where
9+
10+import HsDecls
11+import Language.Haskell.GHC.ExactPrint.Types
12+import Ormolu.Printer.Combinators
13+import Ormolu.Printer.Meat.Declaration.TypeFamily
14+
15+p_hsDecl :: HsDecl GhcPs -> R ()
16+p_hsDecl = \case
17+ TyClD x -> p_tyClDecl x
18+ _ -> error "this is not yet supported"
19+
20+p_tyClDecl :: TyClDecl GhcPs -> R ()
21+p_tyClDecl = \case
22+ FamDecl x -> p_famDecl x
23+ _ -> error "this is not yet supported"
src/Ormolu/Printer/Meat/Declaration/TypeFamily.hsnew file+79
@@ -0,0 +1,79 @@
1+{-# LANGUAGE LambdaCase #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE RecordWildCards #-}
4+
5+-- | Rendering of data\/type families.
6+
7+module Ormolu.Printer.Meat.Declaration.TypeFamily
8+ ( p_famDecl
9+ )
10+where
11+
12+import Control.Monad
13+import Data.List (intersperse)
14+import Data.Maybe (maybeToList, isJust)
15+import HsDecls
16+import HsTypes
17+import Language.Haskell.GHC.ExactPrint.Types
18+import Ormolu.Printer.Combinators
19+import Ormolu.Printer.Meat.Common
20+import Ormolu.Printer.Meat.Type
21+import SrcLoc (Located, GenLocated (..))
22+
23+p_famDecl :: FamilyDecl GhcPs -> R ()
24+p_famDecl FamilyDecl {..} = do
25+ mmeqs <- case fdInfo of
26+ DataFamily -> Nothing <$ txt "data family"
27+ OpenTypeFamily -> Nothing <$ txt "type family"
28+ ClosedTypeFamily eqs -> Just eqs <$ txt "type family"
29+ space
30+ located fdLName p_rdrName
31+ space
32+ let HsQTvs {..} = fdTyVars
33+ items =
34+ maybeToList (p_familyResultSigL (isJust fdInjectivityAnn) fdResultSig)
35+ ++ (located' p_injectivityAnn <$> maybeToList fdInjectivityAnn)
36+ unless (null hsq_explicit) $
37+ sequence_ $ withSep space (located' p_hsTyVarBndr) hsq_explicit
38+ unless (null items) $
39+ vlayout space newline
40+ inci . inci . sequence_ $ intersperse space items
41+ case mmeqs of
42+ Nothing -> newline
43+ Just meqs -> do
44+ txt " where"
45+ case meqs of
46+ Nothing -> txt " .." >> newline
47+ Just eqs -> do
48+ newline
49+ forM_ eqs (located' (line . inci . p_tyFamInstEqn))
50+
51+p_familyResultSigL :: Bool -> Located (FamilyResultSig GhcPs) -> Maybe (R ())
52+p_familyResultSigL injAnn l =
53+ case l of
54+ L _ a -> case a of
55+ NoSig -> Nothing
56+ KindSig k -> Just $ do
57+ if injAnn then txt "= " else ofType
58+ located k p_hsType
59+ TyVarSig bndr -> Just $ do
60+ if injAnn then txt "= " else ofType
61+ located bndr p_hsTyVarBndr
62+
63+p_injectivityAnn :: InjectivityAnn GhcPs -> R ()
64+p_injectivityAnn (InjectivityAnn a bs) = do
65+ txt "| "
66+ located a p_rdrName
67+ space
68+ rarrow
69+ sequence_ $ withSep space (located' p_rdrName) bs
70+
71+p_tyFamInstEqn :: TyFamInstEqn GhcPs -> R ()
72+p_tyFamInstEqn HsIB {..} = velt'
73+ [ do located feqn_tycon p_rdrName
74+ space
75+ sequence_ $ withSep space (located' p_hsType) feqn_pats
76+ , inci $ txt "= " >> located feqn_rhs p_hsType
77+ ]
78+ where
79+ FamEqn {..} = hsib_body
src/Ormolu/Printer/Meat/ImportExport.hsnew file+75
@@ -0,0 +1,75 @@
1+{-# LANGUAGE LambdaCase #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE RecordWildCards #-}
4+
5+-- | Rendering of import and export lists.
6+
7+module Ormolu.Printer.Meat.ImportExport
8+ ( p_hsmodExports
9+ , p_hsmodImport
10+ )
11+where
12+
13+import Control.Monad
14+import GHC hiding (GhcPs, IE)
15+import HsImpExp (IE (..))
16+import Language.Haskell.GHC.ExactPrint.Types
17+import Ormolu.Printer.Combinators
18+import Ormolu.Printer.Meat.Common
19+
20+p_hsmodExports :: [LIE GhcPs] -> R ()
21+p_hsmodExports xs = do
22+ parens . velt $ withSep comma (located' p_lie) xs
23+
24+p_hsmodImport :: ImportDecl GhcPs -> R ()
25+p_hsmodImport ImportDecl {..} = line . velt' $
26+ [ do txt "import "
27+ when ideclSource $
28+ txt "{-# SOURCE #-} "
29+ when ideclSafe $
30+ txt "safe "
31+ when ideclQualified $
32+ txt "qualified "
33+ case ideclPkgQual of
34+ Nothing -> return ()
35+ Just slit -> do
36+ atom slit
37+ space
38+ located ideclName atom
39+ case ideclAs of
40+ Nothing -> return ()
41+ Just l -> do
42+ txt " as "
43+ located l atom
44+ case ideclHiding of
45+ Nothing -> return ()
46+ Just (hiding, _) ->
47+ when hiding $
48+ txt " hiding"
49+ ] ++ (case ideclHiding of
50+ Nothing -> []
51+ Just (_, l) ->
52+ [ inci . locatedVia Nothing l $
53+ parens . velt . withSep comma (located' p_lie)
54+ ])
55+
56+p_lie :: IE GhcPs -> R ()
57+p_lie = \case
58+ IEVar l1 -> located l1 p_ieWrappedName
59+ IEThingAbs l1 -> located l1 p_ieWrappedName
60+ IEThingAll l1 -> do
61+ located l1 p_ieWrappedName
62+ txt " (..)"
63+ IEThingWith l1 w xs _ -> velt'
64+ [ located l1 p_ieWrappedName
65+ , inci $ do
66+ p_ieWildcard w
67+ parens . velt $ withSep comma (located' p_ieWrappedName) xs
68+ ]
69+ -- XXX I have no idea what field labels are in this context.
70+ -- parens . velt $ withSep comma (located' p_FieldLbl) fls
71+ IEModuleContents l1 -> located l1 p_hsmodName
72+ -- XXX I have no idea what these things are for.
73+ IEGroup _ _ -> return ()
74+ IEDoc _ -> return ()
75+ IEDocNamed _ -> return ()
src/Ormolu/Printer/Meat/Module.hsnew file+46
@@ -0,0 +1,46 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE RecordWildCards #-}
3+
4+-- | Rendering of modules.
5+
6+module Ormolu.Printer.Meat.Module
7+ ( p_hsModule
8+ )
9+where
10+
11+import Control.Monad
12+import Data.List (intersperse)
13+import GHC hiding (GhcPs, IE)
14+import Ormolu.Imports
15+import Ormolu.Printer.Combinators
16+import Ormolu.Printer.Meat.Common
17+import Ormolu.Printer.Meat.Declaration
18+import Ormolu.Printer.Meat.ImportExport
19+import SrcLoc (combineSrcSpans)
20+
21+p_hsModule :: ParsedSource -> R ()
22+p_hsModule loc@(L moduleSpan hsModule) = do
23+ -- NOTE If span of exports in multiline, the whole thing is multiline.
24+ -- This is especially important because span of module itself always seems
25+ -- to have length zero, so it's not reliable for layout selection.
26+ let spn =
27+ case hsmodExports hsModule of
28+ Nothing -> moduleSpan
29+ Just (L exportsSpan _) -> combineSrcSpans moduleSpan exportsSpan
30+ locatedVia (Just spn) loc $ \HsModule {..} -> do
31+ case hsmodName of
32+ Nothing -> pure ()
33+ Just hsmodName' -> do
34+ line . velt' $
35+ [ located hsmodName' p_hsmodName ] ++
36+ (case hsmodExports of
37+ Nothing -> []
38+ Just hsmodExports' ->
39+ [ inci (locatedVia Nothing hsmodExports' p_hsmodExports)
40+ ])
41+ ++ [ txt "where"
42+ ]
43+ unless (null hsmodImports) newline
44+ forM_ (sortImports hsmodImports) (located' p_hsmodImport)
45+ when (not (null hsmodImports) && not (null hsmodDecls)) newline
46+ sequence_ . intersperse newline $ located' p_hsDecl <$> hsmodDecls
src/Ormolu/Printer/Meat/Type.hsnew file+116
@@ -0,0 +1,116 @@
1+{-# LANGUAGE LambdaCase #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+
4+-- | Rendering of types.
5+
6+module Ormolu.Printer.Meat.Type
7+ ( p_hsType
8+ , p_hsTyVarBndr
9+ )
10+where
11+
12+import GHC hiding (GhcPs, IE)
13+import Language.Haskell.GHC.ExactPrint.Types
14+import Ormolu.Printer.Combinators
15+import Ormolu.Printer.Meat.Common
16+
17+p_hsType :: HsType GhcPs -> R ()
18+p_hsType = \case
19+ HsForAllTy bndrs t -> velt'
20+ [ do txt "forall"
21+ velt' (located' p_hsTyVarBndr <$> bndrs)
22+ txt "."
23+ , located t p_hsType
24+ ]
25+ HsQualTy qs t -> velt'
26+ [ locatedVia Nothing qs $ \case
27+ [] -> txt "()"
28+ [x] -> located x p_hsType
29+ xs -> parens . velt $ withSep comma (located' p_hsType) xs
30+ , inci $ darrow >> located t p_hsType
31+ ]
32+ HsTyVar p n -> do
33+ case p of
34+ Promoted -> txt "'"
35+ NotPromoted -> return ()
36+ located n p_rdrName
37+ HsAppsTy apps ->
38+ velt' (located' p_hsAppType <$> apps)
39+ HsAppTy f x -> velt'
40+ [ located f p_hsType
41+ , inci $ located x p_hsType
42+ ]
43+ HsFunTy f x -> velt'
44+ [ located f p_hsType
45+ , inci $ rarrow >> located x p_hsType
46+ ]
47+ HsListTy t -> located t (brackets . p_hsType)
48+ HsPArrTy t -> located t (bracketsPar . p_hsType)
49+ HsTupleTy tsort xs ->
50+ let parens' =
51+ case tsort of
52+ HsUnboxedTuple -> parensHash
53+ HsBoxedTuple -> parens
54+ HsConstraintTuple -> parens
55+ HsBoxedOrConstraintTuple -> parens
56+ in parens' . velt $ withSep comma (located' p_hsType) xs
57+ HsSumTy xs ->
58+ parensHash . velt $ withSep (txt "| ") (located' p_hsType) xs
59+ HsOpTy x op y -> velt'
60+ [ located x p_hsType
61+ , inci $ located op p_rdrName >> space >> located y p_hsType
62+ ]
63+ HsParTy t ->
64+ parens (located t p_hsType)
65+ HsIParamTy n t -> velt'
66+ [ located n atom
67+ , inci $ ofType >> located t p_hsType
68+ ]
69+ HsEqTy x y -> velt'
70+ [ located x p_hsType
71+ , inci $ txt "~ " >> located y p_hsType
72+ ]
73+ HsKindSig t k -> velt'
74+ [ located t p_hsType
75+ , inci $ ofType >> located k p_hsType
76+ ]
77+ HsSpliceTy _ _ -> error "HsSpliceTy"
78+ HsDocTy _ _ -> error "HsDocTy"
79+ HsBangTy (HsSrcBang _ u s) t -> do
80+ case u of
81+ SrcUnpack -> txt "{-# UNPACK #-} "
82+ SrcNoUnpack -> txt "{-# NOUNPACK #-} "
83+ NoSrcUnpack -> return ()
84+ case s of
85+ SrcLazy -> txt "~"
86+ SrcStrict -> txt "!"
87+ NoSrcStrict -> return ()
88+ located t p_hsType
89+ HsRecTy _ -> error "HsRecTy"
90+ HsCoreTy t -> atom t
91+ HsExplicitListTy p _ xs -> do
92+ case p of -- XXX not sure about this one
93+ Promoted -> txt "'"
94+ NotPromoted -> return ()
95+ brackets . velt $ withSep comma (located' p_hsType) xs
96+ HsExplicitTupleTy _ xs -> do
97+ txt "'"
98+ parens . velt $ withSep comma (located' p_hsType) xs
99+ HsTyLit t -> atom t
100+ HsWildCardTy (AnonWildCard PlaceHolder) -> txt "_"
101+
102+p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()
103+p_hsTyVarBndr = \case
104+ UserTyVar l ->
105+ located l p_rdrName
106+ KindedTyVar l k -> parens $ velt'
107+ [ located l atom
108+ , inci $ ofType >> located k p_hsType
109+ ]
110+
111+p_hsAppType :: HsAppType GhcPs -> R ()
112+p_hsAppType = \case
113+ HsAppInfix l ->
114+ located l p_rdrName'
115+ HsAppPrefix l ->
116+ located l p_hsType
tests/Ormolu/Printer/CombinatorsSpec.hs+2−2
@@ -69,9 +69,9 @@ rFn = velt'
69 [ do ofType
69 [ do ofType
70 parens $ velt'
70 parens $ velt'
71 [ txt "Int"
71 [ txt "Int"
72− , sarrow >> txt "Int"
72+ , rarrow >> txt "Int"
73 ]
73 ]
74− , sarrow >> txt "Bool"
74+ , rarrow >> txt "Bool"
75 ]
75 ]
76 ]
76 ]
77
77