e01287a · ormolu · git.iko.soy

git.iko.soy/ormolu

Implement rendering of type synonyms

commite01287aa2476b14c8682e456ce50fa72584f443a authormrkkrp <mark.karpov@tweag.io> dateSun 7 Apr 2019, 20:50 (8 years ago) parent576f943

12 files changed+91−20

compare with master

unifiedsplit

data/examples/declaration/type-families/closed-type-family/multi-line.hs+2−2 data/examples/declaration/type-synonyms/multi-line-out.hs+7 data/examples/declaration/type-synonyms/multi-line.hs+7 data/examples/declaration/type-synonyms/simple-out.hs+2 data/examples/declaration/type-synonyms/simple.hs+3 ormolu.cabal+1 src/Ormolu/Printer/Combinators.hs+20−2 src/Ormolu/Printer/Meat/Declaration.hs+4−1 src/Ormolu/Printer/Meat/Declaration/Type.hs+32 src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs+8−11 src/Ormolu/Printer/Meat/Module.hs+1−2 src/Ormolu/Printer/Meat/Type.hs+4−2

data/examples/declaration/type-families/closed-type-family/multi-line.hs+2−2

@@ -1,7 +1,7 @@

11type family Id a

22 = result | result -> a where

3− Id

4− a = a

3+ Id a

4+ = a

55type family G (a :: k)

66 b c = foo | foo -> k b where

77 G a b c =

data/examples/declaration/type-synonyms/multi-line-out.hsnew file+7

@@ -0,0 +1,7 @@

1+type Foo a b c

2+ = Bar c a b

4+type Foo

5+ = Bar

6+ Baz

7+ Quux

data/examples/declaration/type-synonyms/multi-line.hsnew file+7

@@ -0,0 +1,7 @@

1+type Foo a b c

2+ = Bar c a b

4+type Foo =

5+ Bar

6+ Baz

7+ Quux

data/examples/declaration/type-synonyms/simple-out.hsnew file+2

@@ -0,0 +1,2 @@

1+-- | Documentation.

2+type Foo a b c = Bar c a b

data/examples/declaration/type-synonyms/simple.hsnew file+3

@@ -0,0 +1,3 @@

1+-- | Documentation.

3+type Foo a b c = Bar c a b

ormolu.cabal+1

@@ -50,6 +50,7 @@ library

5050 , Ormolu.Printer.Internal

5151 , Ormolu.Printer.Meat.Common

5252 , Ormolu.Printer.Meat.Declaration

53+ , Ormolu.Printer.Meat.Declaration.Type

5354 , Ormolu.Printer.Meat.Declaration.TypeFamily

5455 , Ormolu.Printer.Meat.ImportExport

5556 , Ormolu.Printer.Meat.Module

src/Ormolu/Printer/Combinators.hs+20−2

@@ -21,6 +21,8 @@ module Ormolu.Printer.Combinators

2121 , velt'

2222 , vlayout

2323 , withSep

24+ , spaceSep

25+ , newlineSep

2426 -- ** Wrapping

2527 , line

2628 , braces

@@ -80,7 +82,7 @@ locatedVia

8082 :: Data a

8183 => Maybe SrcSpan -- ^ Span that controls layout selection

8284 -> Located a -- ^ Thing to enter

83− -> (a -> R ()) -- ^ How to renedr inner value

85+ -> (a -> R ()) -- ^ How to render inner value

8486 -> R ()

8587locatedVia ml loc@(L l a) f = do

8688 mann <- lookupAnn loc

@@ -96,7 +98,7 @@ locatedVia ml loc@(L l a) f = do

9698 case mann of

9799 Nothing -> m

98100 Just Ann {..} ->

99− enterLayout MultiLine . sitcc $ do

101+ sitcc $ do

100102 -- There are three things in 'Ann' which contain comments:

101103

102104 let cmode =

@@ -170,6 +172,22 @@ withSep sep f = \case

170172 let g a = sep >> f a

171173 in f x : fmap g xs

172174

175+-- | Render space-separated elements.

176+

177+spaceSep

178+ :: (a -> R ()) -- ^ How to render list items

179+ -> [a] -- ^ List to render

180+ -> R ()

181+spaceSep f = sequence_ . withSep space f

182+

183+-- | Render newline-separated elements.

184+

185+newlineSep

186+ :: (a -> R ()) -- ^ How to render list items

187+ -> [a] -- ^ List to render

188+ -> R ()

189+newlineSep f = sequence_ . withSep newline f

190+

173191----------------------------------------------------------------------------

174192-- Wrapping

175193

src/Ormolu/Printer/Meat/Declaration.hs+4−1

@@ -1,4 +1,5 @@

1−{-# LANGUAGE LambdaCase #-}

1+{-# LANGUAGE LambdaCase #-}

2+{-# LANGUAGE RecordWildCards #-}

34-- | Rendering of declarations.

@@ -10,6 +11,7 @@ where

1011import HsDecls

1112import Language.Haskell.GHC.ExactPrint.Types

1213import Ormolu.Printer.Combinators

14+import Ormolu.Printer.Meat.Declaration.Type

1315import Ormolu.Printer.Meat.Declaration.TypeFamily

1416

1517p_hsDecl :: HsDecl GhcPs -> R ()

@@ -20,4 +22,5 @@ p_hsDecl = \case

2022p_tyClDecl :: TyClDecl GhcPs -> R ()

2123p_tyClDecl = \case

2224 FamDecl x -> p_famDecl x

25+ SynDecl {..} -> p_synDecl tcdLName tcdTyVars tcdRhs

2326 _ -> error "this is not yet supported"

src/Ormolu/Printer/Meat/Declaration/Type.hsnew file+32

@@ -0,0 +1,32 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE RecordWildCards #-}

4+-- | Rendering of type synonym declarations.

6+module Ormolu.Printer.Meat.Declaration.Type

7+ ( p_synDecl

8+ )

9+where

10+

11+import Control.Monad

12+import HsTypes

13+import Language.Haskell.GHC.ExactPrint.Types

14+import Ormolu.Printer.Combinators

15+import Ormolu.Printer.Meat.Common

16+import Ormolu.Printer.Meat.Type

17+import RdrName (RdrName (..))

18+import SrcLoc (Located)

19+

20+p_synDecl

21+ :: Located RdrName -- ^ Type constructor

22+ -> LHsQTyVars GhcPs -- ^ Type variables

23+ -> LHsType GhcPs -- ^ RHS of type declaration

24+ -> R ()

25+p_synDecl name tvars t = line $ do

26+ txt "type "

27+ located name p_rdrName'

28+ let HsQTvs {..} = tvars

29+ unless (null hsq_explicit) space

30+ spaceSep (located' p_hsTyVarBndr) hsq_explicit

31+ vlayout space newline

32+ inci (txt "= " >> located t p_hsType)

src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs+8−11

@@ -10,7 +10,6 @@ module Ormolu.Printer.Meat.Declaration.TypeFamily

1010where

1111

1212import Control.Monad

13−import Data.List (intersperse)

1413import Data.Maybe (maybeToList, isJust)

1514import HsDecls

1615import HsTypes

@@ -23,21 +22,19 @@ import SrcLoc (Located, GenLocated (..))

2322p_famDecl :: FamilyDecl GhcPs -> R ()

2423p_famDecl FamilyDecl {..} = do

2524 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

25+ DataFamily -> Nothing <$ txt "data family "

26+ OpenTypeFamily -> Nothing <$ txt "type family "

27+ ClosedTypeFamily eqs -> Just eqs <$ txt "type family "

3028 located fdLName p_rdrName

3129 space

3230 let HsQTvs {..} = fdTyVars

3331 items =

3432 maybeToList (p_familyResultSigL (isJust fdInjectivityAnn) fdResultSig)

3533 ++ (located' p_injectivityAnn <$> maybeToList fdInjectivityAnn)

36− unless (null hsq_explicit) $

37− sequence_ $ withSep space (located' p_hsTyVarBndr) hsq_explicit

34+ spaceSep (located' p_hsTyVarBndr) hsq_explicit

3835 unless (null items) $

3936 vlayout space newline

40− inci . inci . sequence_ $ intersperse space items

37+ inci . inci $ spaceSep id items

4138 case mmeqs of

4239 Nothing -> newline

4340 Just meqs -> do

@@ -66,14 +63,14 @@ p_injectivityAnn (InjectivityAnn a bs) = do

6663 located a p_rdrName

6764 space

6865 rarrow

69− sequence_ $ withSep space (located' p_rdrName) bs

66+ spaceSep (located' p_rdrName) bs

7067

7168p_tyFamInstEqn :: TyFamInstEqn GhcPs -> R ()

7269p_tyFamInstEqn HsIB {..} = velt'

7370 [ do located feqn_tycon p_rdrName

7471 space

75− sequence_ $ withSep space (located' p_hsType) feqn_pats

76− , inci $ txt "= " >> located feqn_rhs p_hsType

72+ spaceSep (located' p_hsType) feqn_pats

73+ , inci $ txt "= " >> inci (located feqn_rhs p_hsType)

7774 ]

7875 where

7976 FamEqn {..} = hsib_body

src/Ormolu/Printer/Meat/Module.hs+1−2

@@ -9,7 +9,6 @@ module Ormolu.Printer.Meat.Module

99where

1010

1111import Control.Monad

12−import Data.List (intersperse)

1312import GHC hiding (GhcPs, IE)

1413import Ormolu.Imports

1514import Ormolu.Printer.Combinators

@@ -43,4 +42,4 @@ p_hsModule loc@(L moduleSpan hsModule) = do

4342 unless (null hsmodImports) newline

4443 forM_ (sortImports hsmodImports) (located' p_hsmodImport)

4544 when (not (null hsmodImports) && not (null hsmodDecls)) newline

46− sequence_ . intersperse newline $ located' p_hsDecl <$> hsmodDecls

45+ newlineSep (located' p_hsDecl) hsmodDecls

src/Ormolu/Printer/Meat/Type.hs+4−2

@@ -34,8 +34,10 @@ p_hsType = \case

3434 Promoted -> txt "'"

3535 NotPromoted -> return ()

3636 located n p_rdrName

37− HsAppsTy apps ->

38− velt' (located' p_hsAppType <$> apps)

37+ HsAppsTy apps -> do

38+ velt' $ case apps of

39+ [] -> []

40+ (x:xs) -> located' p_hsAppType x : (located' (inci . p_hsAppType) <$> xs)

3941 HsAppTy f x -> velt'

4042 [ located f p_hsType

4143 , inci $ located x p_hsType