34b9b71 · ormolu · git.iko.soy

git.iko.soy/ormolu

Build the project with Nix and switct to GHC 8.6.4

It was decided that we're going to make the project compatible with just one GHC version at a time. Right now this version is going to be 8.6.4. A small refactoring included, plus support for the “deriving via” feature.

commit34b9b716015b26a8f9292273bca127e427391923 authormrkkrp <mark.karpov@tweag.io> dateMon 27 May 2019, 22:20 (7 years ago) parentcce75c7

24 files changed+343−249

compare with master

unifiedsplit

.circleci/config.yml+21−24

@@ -1,34 +1,31 @@

11version: 2

23jobs:

3− build:

4+ build_ghc864:

45 docker:

5− - image: mrkkrp/haskell-ghc-8.4.4:0.1.0

6+ - image: nixos/nix:2.1.3

67 steps:

78 - checkout

8− - restore_cache:

9− keys:

10− - cabal-packages-{{ checksum "ormolu.cabal" }}

11− - cabal-packages-

12− - restore_cache:

13− keys:

14− - cabal-store-{{ checksum "ormolu.cabal" }}

15− - cabal-store-

16− - run: cabal --version

17− - run: ghc --version

18− - run: cabal update

19− - run: cabal new-build --enable-tests --flags=dev

20− - run: cabal new-test --enable-tests --flags=dev

21− - run: cabal new-haddock

22− - run: cabal new-sdist

23− - save_cache:

24− key: cabal-packages-{{ checksum "ormolu.cabal" }}

25− paths: "~/.cabal/packages"

26− - save_cache:

27− key: cabal-store-{{ checksum "ormolu.cabal" }}

28− paths: "~/.cabal/store"

9+ - run:

10+ name: Setup Cachix

11+ command: |

12+ nix-env -f nix/nixpkgs/ -iA cachix

13+ USER=dummy cachix use tweag

14+ - run:

15+ name: Build environment

16+ command: |

17+ nix-shell --pure --run :

18+ - run:

19+ name: Push Cachix

20+ command: |

21+ nix-store -qR --include-outputs $(nix-instantiate default.nix) | cachix push tweag

22+ - run:

23+ name: Build the package (includes running the tests)

24+ command: nix-build

2925

3026workflows:

3127 version: 2

3228 build:

3329 jobs:

34− - build

30+ - build_ghc864:

31+ context: org-global

data/examples/declaration/data/deriving-strategies-out.hs+5−1

@@ -5,4 +5,8 @@ newtype Foo = Foo Int

55 ( ToJSON

66 , FromJSON

77 )

8− deriving newtype (Num)

8+ deriving newtype Num

9+ deriving Monoid via (Sum Int)

10+ deriving

11+ Semigroup

12+ via (Sum Int)

data/examples/declaration/data/deriving-strategies.hs+3

@@ -7,3 +7,6 @@ newtype Foo = Foo Int

77 , FromJSON

88 )

99 deriving newtype (Num)

10+ deriving Monoid via (Sum Int)

11+ deriving Semigroup

12+ via (Sum Int)

data/examples/declaration/data/gadt/multiline-out.hs+2−2

@@ -5,8 +5,8 @@ data Foo a where

55 -- | 'Foo' is wonderful.

66 Foo

77 :: forall a b. (Show a, Eq b) -- foo

8− => -- bar

9− a

8+ -- bar

9+ => a

1010 -> b

1111 -> Foo 'Int

1212 -- | But 'Bar' is also not too bad.

data/examples/declaration/data/multiline-arg-parens-out.hs+2−2

@@ -3,6 +3,6 @@ data Foo

33 = Foo

44 Bar

55 (Set Baz) -- and here we go

6− -- and that's it

6+ -- and that's it

77 Text

8− deriving (Eq)

8+ deriving Eq

data/examples/declaration/data/multiline-out.hs+2−1

@@ -3,4 +3,5 @@ data Foo

33 = Foo -- ^ One

44 | Bar Int -- ^ Two

55 | Baz -- ^ Three

6− deriving (Eq, Show)

6+ deriving

7+ (Eq, Show)

data/examples/declaration/data/multiline.hs+2−1

@@ -4,4 +4,5 @@ data Foo

44 = Foo -- ^ One

55 | Bar Int -- ^ Two

66 | Baz -- ^ Three

7− deriving (Eq, Show)

7+ deriving

8+ (Eq, Show)

data/examples/declaration/data/simple-broken-out.hs+2−2

@@ -1,8 +1,8 @@

11-- | Here we go.

22data Foo

33 = Foo {unFoo :: Int}

4− deriving (Eq)

4+ deriving Eq

66-- | And once again.

77data Bar = Bar {unBar :: Int}

8− deriving (Eq)

8+ deriving Eq

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

@@ -1,16 +1,16 @@

11type family Id a

22 = result | result -> a where

3− Id a

4− = a

3+ Id a =

4+ a

66type family G (a :: k) b c

77 = foo | foo -> k b where

8− G a b c

9− = (a, b)

8+ G a b c =

9+ (a, b)

1010

1111type family F a

1212 :: * -> * where

1313 F Int = Double

14− F Bool

15− = Char

14+ F Bool =

15+ Char

1616 F a = String

default.nixnew file+24

@@ -0,0 +1,24 @@

1+let pkgs = import ./nix/nixpkgs;

2+ compiler = "ghc864";

3+ sourceRegex = [

4+ "^app.*$"

5+ "^data.*$"

6+ "^ormolu.cabal$"

7+ "^src.*$"

8+ "^tests.*$"

9+ "^.*\.md$"

10+ ];

11+ haskellPackages = pkgs.haskell.packages.${compiler}.override

12+ { overrides = (self: super:

13+ super //

14+ { "ormolu" = super.callCabal2nix "ormolu" (pkgs.lib.sourceByRegex ./. sourceRegex) {};

15+ });

16+ };

17+in if pkgs.lib.inNixShell

18+ then haskellPackages.shellFor

19+ { packages = (ps: [ ps.ormolu ]);

20+ buildInputs = [

21+ pkgs.cabal-install

22+ ];

23+ }

24+ else haskellPackages.ormolu

nix/nixpkgs/default.nixnew file+8

@@ -0,0 +1,8 @@

1+let

2+ rev = "f52505fac8c82716872a616c501ad9eff188f97f";

3+ sha256 = "0q2m2qhyga9yq29yz90ywgjbn9hdahs7i8wwlq7b55rdbyiwa5dy";

4+ pkgs = import (builtins.fetchTarball {

5+ url = "https://github.com/NixOS/nixpkgs/archive/${rev}.tar.gz";

6+ inherit sha256;

7+ }) { config.allowUnfree = true; };

8+in pkgs

ormolu.cabal+4−4

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

11name: ormolu

22version: 0.0.1.0

33cabal-version: 1.18

4−tested-with: GHC==8.4.4

4+tested-with: GHC==8.6.4

55license: BSD3

66license-file: LICENSE.md

77maintainer: Mark Karpov <mark.karpov@tweag.io>

@@ -35,7 +35,7 @@ flag dev

3535

3636library

3737 hs-source-dirs: src

38− build-depends: base >= 4.8 && < 5.0

38+ build-depends: base >= 4.12 && < 5.0

3939 , containers >= 0.5 && < 0.7

4040 , dlist >= 0.8 && < 0.9

4141 , exceptions >= 0.6 && < 0.11

@@ -84,7 +84,7 @@ test-suite tests

8484 main-is: Spec.hs

8585 hs-source-dirs: tests

8686 type: exitcode-stdio-1.0

87− build-depends: base >= 4.8 && < 5.0

87+ build-depends: base >= 4.12 && < 5.0

8888 , containers >= 0.5 && < 0.7

8989 , filepath >= 1.2 && < 1.5

9090 , hspec >= 2.0 && < 3.0

@@ -106,7 +106,7 @@ test-suite tests

106106executable ormolu

107107 main-is: Main.hs

108108 hs-source-dirs: app

109− build-depends: base >= 4.8 && < 5.0

109+ build-depends: base >= 4.12 && < 5.0

110110 , ghc >= 8.4.3

111111 , gitrev >= 1.3 && < 1.4

112112 , optparse-applicative >= 0.14 && < 0.15

src/Ormolu/Imports.hs+12−11

@@ -14,7 +14,7 @@ import Data.List (sortBy)

1414import GHC hiding (GhcPs, IE)

1515import HsExtension

1616import HsImpExp (IE (..))

17−import Ormolu.Utils (unL)

17+import Ormolu.Utils (unL, notImplemented)

1818

1919-- | Sort imports by module name. This also sorts explicit import lists for

2020-- each declaration.

@@ -50,8 +50,8 @@ sortLies = sortBy (compareIE `on` unL) . fmap (fmap sortThings)

5050

5151sortThings :: IE GhcPs -> IE GhcPs

5252sortThings = \case

53− IEThingWith x w xs fl ->

54− IEThingWith x w (sortBy (compareIewn `on` unL) xs) fl

53+ IEThingWith NoExt x w xs fl ->

54+ IEThingWith NoExt x w (sortBy (compareIewn `on` unL) xs) fl

5555 other -> other

5656

5757-- | Compare two located imports or exports.

@@ -63,14 +63,15 @@ compareIE = compareIewn `on` getIewn

6363

6464getIewn :: IE GhcPs -> IEWrappedName RdrName

6565getIewn = \case

66− IEVar x -> unL x

67− IEThingAbs x -> unL x

68− IEThingAll x -> unL x

69− IEThingWith x _ _ _ -> unL x

70− IEModuleContents _ -> error "Ormolu.Imports.projectName: IEModuleContents"

71− IEGroup _ _ -> error "Ormolu.Imports.projectName: IEGroup"

72− IEDoc _ -> error "Ormolu.Imports.projectName: IEGroup"

73− IEDocNamed _ -> error "Ormolu.Imports.projectName: IEGroup"

66+ IEVar NoExt x -> unL x

67+ IEThingAbs NoExt x -> unL x

68+ IEThingAll NoExt x -> unL x

69+ IEThingWith NoExt x _ _ _ -> unL x

70+ IEModuleContents NoExt _ -> notImplemented "IEModuleContents"

71+ IEGroup NoExt _ _ -> notImplemented "IEGroup"

72+ IEDoc NoExt _ -> notImplemented "IEDoc"

73+ IEDocNamed NoExt _ -> notImplemented "IEDocNamed"

74+ XIE NoExt -> notImplemented "XIE"

7475

7576-- | Compare two @'IEWrapppedName' 'RdrName'@ things.

7677

src/Ormolu/Printer/Combinators.hs+1−3

@@ -162,9 +162,7 @@ velt xs = sequence_ (intersperse sep (sitcc <$> xs))

162162-- line.

163163

164164velt' :: [R ()] -> R ()

165−velt' xs = sitcc $ sequence_ (intersperse sep (sitcc <$> xs))

166− where

167− sep = vlayout (spit " ") newline

165+velt' xs = sitcc $ sequence_ (intersperse breakpoint (sitcc <$> xs))

168166

169167-- | Put separator between renderings of items of a list.

170168

src/Ormolu/Printer/Comments.hs+9−3

@@ -167,7 +167,10 @@ commentFollowsElt

167167 -> Bool

168168commentFollowsElt ref mnSpn meSpn mlastSpn (L l comment) =

169169 -- A comment follows a AST element if all 4 conditions are satisfied:

170− goesAfter && logicallyFollows && noEltBetween && supersedesParentElt

170+ goesAfter

171+ && logicallyFollows

172+ && noEltBetween

173+ && (continuation || supersedesParentElt)

171174 where

172175 -- 1) The comment starts after end of the AST element:

173176 goesAfter =

@@ -176,20 +179,22 @@ commentFollowsElt ref mnSpn meSpn mlastSpn (L l comment) =

176179 logicallyFollows

177180 = theSameLine l ref -- a) it's on the same line

178181 || isPrevHaddock comment -- b) it's a Haddock string starting with -- ^

179− || isJust mlastSpn -- c) it's a continuation of a comment block

182+ || continuation -- c) it's a continuation of a comment block

180183 -- 3) There is no other AST element between this element and the comment:

181184 noEltBetween =

182185 case mnSpn of

183186 Nothing -> True

184187 Just nspn ->

185188 realSrcSpanStart nspn >= realSrcSpanEnd l

186− -- Less obvious: if column of comment is closer to the start of

189+ -- 4) Less obvious: if column of comment is closer to the start of

187190 -- enclosing element, it probably related to that parent element, not to

188191 -- the current child element. This rule is important because otherwise

189192 -- all comments would end up assigned to closest inner elements, and

190193 -- parent elements won't have a chance to get any comments assigned to

191194 -- them. This is not OK because comments will get indented according to

192195 -- the AST elements they are attached to.

196+ --

197+ -- Skip this rule if the comment is a continuation of a comment block.

193198 supersedesParentElt =

194199 case meSpn of

195200 Nothing -> True

@@ -197,6 +202,7 @@ commentFollowsElt ref mnSpn meSpn mlastSpn (L l comment) =

197202 let startColumn = srcLocCol . realSrcSpanStart

198203 in abs (startColumn espn - startColumn l)

199204 > abs (startColumn ref - startColumn l)

205+ continuation = isJust mlastSpn

200206

201207-- | Output a 'Comment'. This is a low-level printing function.

202208

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

@@ -19,14 +19,14 @@ import Ormolu.Utils

1919

2020p_hsDecl :: HsDecl GhcPs -> R ()

2121p_hsDecl = \case

22− TyClD x -> p_tyClDecl x

23− ValD x -> p_valDecl x

24− SigD x -> p_sigDecl x

22+ TyClD NoExt x -> p_tyClDecl x

23+ ValD NoExt x -> p_valDecl x

24+ SigD NoExt x -> p_sigDecl x

2525 _ -> notImplemented "certain kinds of declarations"

2626

2727p_tyClDecl :: TyClDecl GhcPs -> R ()

2828p_tyClDecl = \case

29− FamDecl x -> p_famDecl x

29+ FamDecl NoExt x -> p_famDecl x

3030 SynDecl {..} -> p_synDecl tcdLName tcdTyVars tcdRhs

3131 DataDecl {..} -> p_dataDecl tcdLName tcdTyVars tcdDataDefn

3232 _ -> notImplemented "certain kinds of declarations"

src/Ormolu/Printer/Meat/Declaration/Data.hs+84−42

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

99 )

1010where

1111

12−import BasicTypes (DerivStrategy (..))

1312import Control.Monad

1413import Data.List.NonEmpty (NonEmpty (..))

1514import Data.Maybe (isJust)

@@ -17,7 +16,7 @@ import GHC

1716import Ormolu.Printer.Combinators

1817import Ormolu.Printer.Meat.Common

1918import Ormolu.Printer.Meat.Type

20−import Ormolu.Utils (unL, getSpan, combineSrcSpans')

19+import Ormolu.Utils

2120import RdrName (RdrName (..))

2221import SrcLoc (Located)

2322

@@ -55,32 +54,34 @@ p_dataDecl name tvars HsDataDefn {..} = do

5554 newline

5655 inci . located dd_derivs $ \xs ->

5756 forM_ xs (line . located' p_hsDerivingClause)

57+p_dataDecl _ _ (XHsDataDefn NoExt) = notImplemented "XHsDataDefn"

5858

5959p_conDecl :: ConDecl GhcPs -> R ()

6060p_conDecl = \case

61− ConDeclGADT {..} -> velt'

62− [ spaceSep (located' p_rdrName) con_names

63− , inci $ do

64− txt ":: "

65− locatedVia Nothing (hsib_body con_type) p_hsType

66− ]

61+ ConDeclGADT {..} -> do

62+ spaceSep (located' p_rdrName) con_names

63+ breakpoint

64+ inci $ do

65+ txt ":: "

66+ p_forallBndrs (hsq_explicit con_qvars)

67+ forM_ con_mb_cxt p_lhsContext

68+ case con_args of

69+ PrefixCon xs -> do

70+ velt' (located' p_hsType <$> xs)

71+ unless (null xs) $ do

72+ breakpoint

73+ txt "-> "

74+ RecCon l -> do

75+ located l p_conDeclFields

76+ unless (null $ unL l) $ do

77+ breakpoint

78+ txt "-> "

79+ InfixCon _ _ -> notImplemented "InfixCon"

80+ locatedVia Nothing con_res_ty p_hsType

6781 ConDeclH98 {..} -> do

68− case hsq_explicit <$> con_qvars of

69− Nothing -> return ()

70− Just bndrs -> do

71− txt "forall "

72− spaceSep (located' p_hsTyVarBndr) bndrs

73− txt "."

74− breakpoint

75− case con_cxt of

76− Nothing -> return ()

77− Just ctx -> located ctx $ \case

78− [] -> pure ()

79− xs -> do

80− p_hsContext xs

81− breakpoint

82− txt "=> "

83− case con_details of

82+ p_forallBndrs con_ex_tvs

83+ forM_ con_mb_cxt p_lhsContext

84+ case con_args of

8485 PrefixCon xs -> do

8586 located con_name p_rdrName

8687 unless (null xs) breakpoint

@@ -89,33 +90,74 @@ p_conDecl = \case

8990 located con_name p_rdrName

9091 breakpoint

9192 inci $ located l p_conDeclFields

92− InfixCon x y -> velt'

93− [ located x p_hsType

94− , inci $ velt'

95− [ backticks (located con_name p_rdrName)

96− , inci $ located y p_hsType

97− ]

98− ]

93+ InfixCon x y -> do

94+ located x p_hsType

95+ breakpoint

96+ inci $ do

97+ backticks (located con_name p_rdrName)

98+ breakpoint

99+ inci (located y p_hsType)

100+ XConDecl NoExt -> notImplemented "XConDecl"

101+

102+p_forallBndrs

103+ :: [LHsTyVarBndr GhcPs]

104+ -> R ()

105+p_forallBndrs = \case

106+ [] -> return ()

107+ bndrs -> do

108+ txt "forall "

109+ spaceSep (located' p_hsTyVarBndr) bndrs

110+ txt ". "

111+

112+p_lhsContext

113+ :: LHsContext GhcPs

114+ -> R ()

115+p_lhsContext = \case

116+ L _ [] -> pure ()

117+ ctx -> do

118+ located ctx p_hsContext

119+ breakpoint

120+ txt "=> "

99121

100122isGadt :: ConDecl GhcPs -> Bool

101123isGadt = \case

102124 ConDeclGADT {} -> True

103125 ConDeclH98 {} -> False

126+ XConDecl {} -> False

104127

105128p_hsDerivingClause

106129 :: HsDerivingClause GhcPs

107130 -> R ()

108131p_hsDerivingClause HsDerivingClause {..} = do

109132 txt "deriving"

133+ let derivingWhat = located deriv_clause_tys $ \case

134+ [] -> txt "()"

135+ [x] -> located (hsib_body x) p_hsType

136+ xs -> parens . velt $ withSep comma (located' p_hsType . hsib_body) xs

110137 case deriv_clause_strategy of

111− Nothing -> return ()

112− Just l -> do

113− space

114− located l $ \case

115− StockStrategy -> txt "stock"

116− AnyclassStrategy -> txt "anyclass"

117− NewtypeStrategy -> txt "newtype"

118− breakpoint

119− inci . located deriv_clause_tys $ \case

120− [] -> txt "()"

121− xs -> parens . velt $ withSep comma (located' p_hsType . hsib_body) xs

138+ Nothing -> do

139+ breakpoint

140+ inci derivingWhat

141+ Just l -> locatedVia Nothing l $ \case

142+ StockStrategy -> do

143+ txt " stock"

144+ breakpoint

145+ inci derivingWhat

146+ AnyclassStrategy -> do

147+ txt " anyclass"

148+ breakpoint

149+ inci derivingWhat

150+ NewtypeStrategy -> do

151+ txt " newtype"

152+ breakpoint

153+ inci derivingWhat

154+ ViaStrategy HsIB {..} -> do

155+ breakpoint

156+ inci $ do

157+ derivingWhat

158+ breakpoint

159+ txt "via "

160+ located hsib_body p_hsType

161+ ViaStrategy (XHsImplicitBndrs NoExt) ->

162+ notImplemented "XHsImplicitBndrs"

163+p_hsDerivingClause (XHsDerivingClause NoExt) = notImplemented "XHsDerivingClause"

src/Ormolu/Printer/Meat/Declaration/Pat.hs+13−15

@@ -16,33 +16,31 @@ import Ormolu.Utils

1616

1717p_pat :: Pat GhcPs -> R ()

1818p_pat = \case

19− WildPat _ -> txt "_"

20− VarPat name -> located name p_rdrName

21− LazyPat pat -> do

19+ WildPat NoExt -> txt "_"

20+ VarPat NoExt name -> located name p_rdrName

21+ LazyPat NoExt pat -> do

2222 txt "~"

2323 located pat p_pat

24− AsPat name pat -> do

24+ AsPat NoExt name pat -> do

2525 located name p_rdrName

2626 txt "@"

2727 located pat p_pat

28− ParPat pat ->

28+ ParPat NoExt pat ->

2929 located pat (parens . p_pat)

30− BangPat pat -> do

30+ BangPat NoExt pat -> do

3131 txt "!"

3232 located pat p_pat

33− ListPat pats _ _ -> do

33+ ListPat NoExt pats -> do

3434 brackets $ velt (withSep comma (located' p_pat) pats)

35− TuplePat pats boxing _ -> do

35+ TuplePat NoExt pats boxing -> do

3636 let f =

3737 case boxing of

3838 Boxed -> parens

3939 Unboxed -> parensHash

4040 f $ velt (withSep comma (located' p_pat) pats)

41− SumPat pat _ _ _ -> do

41+ SumPat NoExt pat _ _ -> do

4242 -- XXX I'm not sure about this one.

4343 located pat p_pat

44− PArrPat pats _ -> do

45− bracketsPar $ velt (withSep comma (located' p_pat) pats)

4644 ConPatIn pat details ->

4745 case details of

4846 PrefixCon xs -> do

@@ -63,12 +61,12 @@ p_pat = \case

6361 ConPatOut {} -> notImplemented "ConPatOut"

6462 ViewPat {} -> notImplemented "ViewPat"

6563 SplicePat {} -> notImplemented "SplicePat"

66− LitPat p -> atom p

67− NPat v _ _ _ -> located v (atom . ol_val)

64+ LitPat NoExt p -> atom p

65+ NPat NoExt v _ _ -> located v (atom . ol_val)

6866 NPlusKPat {} -> notImplemented "NPlusKPat"

69− SigPatIn {} -> notImplemented "SigPatIn"

70− SigPatOut {} -> notImplemented "SigPatOut"

67+ SigPat {} -> notImplemented "SigPat"

7168 CoPat {} -> notImplemented "CoPat"

69+ XPat NoExt -> notImplemented "XPat"

7270

7371p_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()

7472p_hsRecField HsRecField {..} =

src/Ormolu/Printer/Meat/Declaration/Signature.hs+2−1

@@ -21,7 +21,7 @@ p_sigDecl = line . p_sigDecl'

2121

2222p_sigDecl' :: Sig GhcPs -> R ()

2323p_sigDecl' = \case

24− TypeSig names hswc -> p_typeSig names hswc

24+ TypeSig NoExt names hswc -> p_typeSig names hswc

2525 _ -> notImplemented "certain types of signature declarations"

2626

2727p_typeSig

@@ -34,3 +34,4 @@ p_typeSig names HsWC {..} = do

3434 inci $ do

3535 txt ":: "

3636 located (hsib_body hswc_body) p_hsType

37+p_typeSig _ (XHsWildCardBndrs NoExt) = notImplemented "XHsWildCardBndrs"

src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs+20−12

@@ -15,6 +15,7 @@ import GHC

1515import Ormolu.Printer.Combinators

1616import Ormolu.Printer.Meat.Common

1717import Ormolu.Printer.Meat.Type

18+import Ormolu.Utils

1819import SrcLoc (Located, GenLocated (..))

1920

2021p_famDecl :: FamilyDecl GhcPs -> R ()

@@ -42,18 +43,24 @@ p_famDecl FamilyDecl {..} = do

4243 Just eqs -> do

4344 newline

4445 forM_ eqs (located' (line . inci . p_tyFamInstEqn))

46+p_famDecl (XFamilyDecl NoExt) = notImplemented "XFamilyDecl"

4547

46−p_familyResultSigL :: Bool -> Located (FamilyResultSig GhcPs) -> Maybe (R ())

48+p_familyResultSigL

49+ :: Bool

50+ -> Located (FamilyResultSig GhcPs)

51+ -> Maybe (R ())

4752p_familyResultSigL injAnn l =

4853 case l of

4954 L _ a -> case a of

50− NoSig -> Nothing

51− KindSig k -> Just $ do

55+ NoSig NoExt -> Nothing

56+ KindSig NoExt k -> Just $ do

5257 if injAnn then txt "= " else txt ":: "

5358 located k p_hsType

54− TyVarSig bndr -> Just $ do

59+ TyVarSig NoExt bndr -> Just $ do

5560 if injAnn then txt "= " else txt ":: "

5661 located bndr p_hsTyVarBndr

62+ XFamilyResultSig NoExt ->

63+ notImplemented "XFamilyResultSig"

5764

5865p_injectivityAnn :: InjectivityAnn GhcPs -> R ()

5966p_injectivityAnn (InjectivityAnn a bs) = do

@@ -64,11 +71,12 @@ p_injectivityAnn (InjectivityAnn a bs) = do

6471 spaceSep (located' p_rdrName) bs

6572

6673p_tyFamInstEqn :: TyFamInstEqn GhcPs -> R ()

67−p_tyFamInstEqn HsIB {..} = velt'

68− [ do located feqn_tycon p_rdrName

69− space

70− spaceSep (located' p_hsType) feqn_pats

71− , inci $ txt "= " >> inci (located feqn_rhs p_hsType)

72− ]

73− where

74− FamEqn {..} = hsib_body

74+p_tyFamInstEqn HsIB {..} = do

75+ let FamEqn {..} = hsib_body

76+ located feqn_tycon p_rdrName

77+ space

78+ spaceSep (located' p_hsType) feqn_pats

79+ txt " ="

80+ breakpoint

81+ inci (located feqn_rhs p_hsType)

82+p_tyFamInstEqn (XHsImplicitBndrs NoExt) = notImplemented "XHsImplicitBndrs"

src/Ormolu/Printer/Meat/Declaration/Value.hs+40−36

@@ -25,7 +25,7 @@ p_valDecl = line . p_valDecl'

2525

2626p_valDecl' :: HsBindLR GhcPs GhcPs -> R ()

2727p_valDecl' = \case

28− FunBind funId funMatches _ _ _ -> p_funBind funId funMatches

28+ FunBind NoExt funId funMatches _ _ -> p_funBind funId funMatches

2929 _ -> notImplemented "certain kinds of binding declarations"

3030

3131p_funBind

@@ -48,6 +48,7 @@ p_matchGroup

4848p_matchGroup style MG {..} =

4949 locatedVia Nothing mg_alts $

5050 newlineSep (located' (p_match style))

51+p_matchGroup _ (XMatchGroup NoExt) = notImplemented "XMatchGroup"

5152

5253p_match

5354 :: MatchGroupStyle

@@ -97,13 +98,14 @@ p_match style Match {..} = do

9798 Lambda -> return ()

9899 _ -> breakpoint

99100 newlineSep (located' p_grhs) grhssGRHSs

100− unless (GHC.isEmptyLocalBinds (unL grhssLocalBinds)) $ do

101+ unless (GHC.isEmptyLocalBindsPR (unL grhssLocalBinds)) $ do

101102 newline

102103 line (txt "where")

103104 inci (located grhssLocalBinds p_hsLocalBinds)

105+p_match _ (XMatch NoExt) = notImplemented "XMatchGroup"

104106

105107p_grhs :: GRHS GhcPs (LHsExpr GhcPs) -> R ()

106−p_grhs (GRHS guards body) =

108+p_grhs (GRHS NoExt guards body) =

107109 case guards of

108110 [] -> p_body

109111 xs -> do

@@ -114,21 +116,23 @@ p_grhs (GRHS guards body) =

114116 inci p_body

115117 where

116118 p_body = located body p_hsExpr

119+p_grhs (XGRHS NoExt) = notImplemented "XGRHS"

117120

118121p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R ()

119122p_stmt = \case

120123 LastStmt {} -> notImplemented "do notation"

121124 BindStmt {} -> notImplemented "do notation"

122125 ApplicativeStmt {} -> notImplemented "applicative stmt"

123− BodyStmt body _ _ _ -> located body p_hsExpr

124− LetStmt binds -> located binds p_hsLocalBinds

126+ BodyStmt NoExt body _ _ -> located body p_hsExpr

127+ LetStmt NoExt binds -> located binds p_hsLocalBinds

125128 ParStmt {} -> notImplemented "ParStmt"

126129 TransStmt {} -> notImplemented "TransStmt"

127130 RecStmt {} -> notImplemented "RecStmt"

131+ XStmtLR {} -> notImplemented "XStmtLR"

128132

129133p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()

130134p_hsLocalBinds = \case

131− HsValBinds (ValBindsIn bag lsigs) -> do

135+ HsValBinds NoExt (ValBinds NoExt bag lsigs) -> do

132136 let ssStart = either

133137 (srcSpanStart . getSpan)

134138 (srcSpanStart . getSpan)

@@ -137,62 +141,63 @@ p_hsLocalBinds = \case

137141 p_item (Left x) = located x p_valDecl'

138142 p_item (Right x) = located x p_sigDecl'

139143 newlineSep p_item (sortOn ssStart items)

140− HsValBinds _ -> notImplemented "HsValBinds"

141− HsIPBinds _ -> notImplemented "HsIPBinds"

142− EmptyLocalBinds -> return ()

144+ HsValBinds NoExt _ -> notImplemented "HsValBinds"

145+ HsIPBinds NoExt _ -> notImplemented "HsIPBinds"

146+ EmptyLocalBinds NoExt -> return ()

147+ XHsLocalBindsLR _ -> notImplemented "XHsLocalBindsLR"

143148

144149p_hsExpr :: HsExpr GhcPs -> R ()

145150p_hsExpr = \case

146− HsVar name -> located name p_rdrName'

147− HsUnboundVar _ -> notImplemented "HsUnboundVar"

148− HsConLikeOut _ -> notImplemented "HsConLikeOut"

149− HsRecFld x ->

151+ HsVar NoExt name -> located name p_rdrName'

152+ HsUnboundVar NoExt _ -> notImplemented "HsUnboundVar"

153+ HsConLikeOut NoExt _ -> notImplemented "HsConLikeOut"

154+ HsRecFld NoExt x ->

150155 case x of

151− Unambiguous name _ -> located name p_rdrName'

152− Ambiguous name _ -> located name p_rdrName'

153− HsOverLabel _ _ -> notImplemented "HsOverLabel"

154− HsIPVar (HsIPName name) -> atom name

155− HsOverLit v -> atom (ol_val v)

156− HsLit lit -> atom lit

157− HsLam mgroup ->

156+ Unambiguous NoExt name -> located name p_rdrName'

157+ Ambiguous NoExt name -> located name p_rdrName'

158+ XAmbiguousFieldOcc NoExt -> notImplemented "XAmbiguousFieldOcc"

159+ HsOverLabel NoExt _ _ -> notImplemented "HsOverLabel"

160+ HsIPVar NoExt (HsIPName name) -> atom name

161+ HsOverLit NoExt v -> atom (ol_val v)

162+ HsLit NoExt lit -> atom lit

163+ HsLam NoExt mgroup ->

158164 p_matchGroup Lambda mgroup

159− HsLamCase mgroup -> do

165+ HsLamCase NoExt mgroup -> do

160166 txt "\\case"

161167 newline

162168 inci (p_matchGroup LambdaCase mgroup)

163− HsApp f x -> do

169+ HsApp NoExt f x -> do

164170 located f p_hsExpr

165171 breakpoint

166172 inci (located x p_hsExpr)

167173 HsAppType a e -> do

168− located a p_hsExpr

174+ located e p_hsExpr

169175 breakpoint

170176 inci $ do

171177 txt "@"

172− located (hswc_body e) p_hsType

173− HsAppTypeOut {} -> notImplemented "HsAppTypeOut"

174− OpApp x op _ y -> do

178+ located (hswc_body a) p_hsType

179+ OpApp NoExt x op y -> do

175180 located x p_hsExpr

176181 breakpoint

177182 inci $ do

178183 located op p_hsExpr

179184 space

180185 located y p_hsExpr

181− NegApp e _ -> do

186+ NegApp NoExt e _ -> do

182187 txt "-"

183188 located e p_hsExpr

184− HsPar e -> parens (located e p_hsExpr)

189+ HsPar NoExt e -> parens (located e p_hsExpr)

185190 SectionL {} -> notImplemented "SectionL"

186191 SectionR {} -> notImplemented "SectionR"

187192 ExplicitTuple {} -> notImplemented "ExplicitTuple"

188193 ExplicitSum {} -> notImplemented "ExplicitSum"

189− HsCase e mgroup -> do

194+ HsCase NoExt e mgroup -> do

190195 txt "case "

191196 located e p_hsExpr

192197 txt " of"

193198 breakpoint

194199 inci (p_matchGroup Case mgroup)

195− HsIf _ if' then' else' -> do

200+ HsIf NoExt _ if' then' else' -> do

196201 txt "if "

197202 located if' p_hsExpr

198203 breakpoint

@@ -206,7 +211,7 @@ p_hsExpr = \case

206211 breakpoint

207212 inci (p_hsExpr x)

208213 HsMultiIf {} -> notImplemented "MulitiIf"

209− HsLet localBinds e -> do

214+ HsLet NoExt localBinds e -> do

210215 txt "let "

211216 sitcc (located localBinds p_hsLocalBinds)

212217 breakpoint

@@ -215,13 +220,10 @@ p_hsExpr = \case

215220 HsDo {} -> notImplemented "HsDo"

216221 ExplicitList _ _ xs -> do

217222 brackets $ velt (withSep comma (located' p_hsExpr) xs)

218− ExplicitPArr {} -> notImplemented "ExplicitPArr"

219223 RecordCon {} -> notImplemented "RecordCon"

220224 RecordUpd {} -> notImplemented "RecordUpd"

221225 ExprWithTySig {} -> notImplemented "ExprWithTySig"

222− ExprWithTySigOut {} -> notImplemented "ExprWithTySigOut"

223226 ArithSeq {} -> notImplemented "ArithSeq"

224− PArrSeq {} -> notImplemented "PArrSeq"

225227 HsSCC {} -> notImplemented "HsSCC"

226228 HsCoreAnn {} -> notImplemented "HsCoreAnn"

227229 HsBracket {} -> notImplemented "HsBracket"

@@ -238,14 +240,16 @@ p_hsExpr = \case

238240 HsTick {} -> notImplemented "HsTick"

239241 HsBinTick {} -> notImplemented "HsBinTick"

240242 HsTickPragma {} -> notImplemented "HsTickPragma"

241− EWildPat -> notImplemented "EWildPat"

243+ EWildPat NoExt -> notImplemented "EWildPat"

242244 EAsPat {} -> notImplemented "EAsPat"

243245 EViewPat {} -> notImplemented "EViewPat"

244246 ELazyPat {} -> notImplemented "ELazyPat"

245247 HsWrap {} -> notImplemented "HsWrap"

248+ XExpr {} -> notImplemented "XExpr"

246249

247250----------------------------------------------------------------------------

248251-- Helpers

249252

250253getGRHSSpan :: GRHS GhcPs (LHsExpr GhcPs) -> SrcSpan

251−getGRHSSpan (GRHS _ body) = getSpan body

254+getGRHSSpan (GRHS NoExt _ body) = getSpan body

255+getGRHSSpan (XGRHS NoExt) = notImplemented "XGRHS"

src/Ormolu/Printer/Meat/ImportExport.hs+16−14

@@ -15,6 +15,7 @@ import GHC

1515import HsImpExp (IE (..))

1616import Ormolu.Printer.Combinators

1717import Ormolu.Printer.Meat.Common

18+import Ormolu.Utils

1819

1920p_hsmodExports :: [LIE GhcPs] -> R ()

2021p_hsmodExports xs = do

@@ -51,24 +52,25 @@ p_hsmodImport ImportDecl {..} = line $ do

5152 breakpoint

5253 inci . locatedVia Nothing l $

5354 parens . velt . withSep comma (located' p_lie)

55+p_hsmodImport (XImportDecl NoExt) = notImplemented "XImportDecl"

5456

5557p_lie :: IE GhcPs -> R ()

5658p_lie = \case

57− IEVar l1 -> located l1 p_ieWrappedName

58− IEThingAbs l1 -> located l1 p_ieWrappedName

59− IEThingAll l1 -> do

59+ IEVar NoExt l1 -> located l1 p_ieWrappedName

60+ IEThingAbs NoExt l1 -> located l1 p_ieWrappedName

61+ IEThingAll NoExt l1 -> do

6062 located l1 p_ieWrappedName

6163 txt " (..)"

62− IEThingWith l1 w xs _ -> velt'

63− [ located l1 p_ieWrappedName

64− , inci $ do

65− p_ieWildcard w

66− parens . velt $ withSep comma (located' p_ieWrappedName) xs

67− ]

64+ IEThingWith NoExt l1 w xs _ -> sitcc $ do

65+ located l1 p_ieWrappedName

66+ breakpoint

6867 -- XXX I have no idea what field labels are in this context.

69− -- parens . velt $ withSep comma (located' p_FieldLbl) fls

70− IEModuleContents l1 -> located l1 p_hsmodName

68+ inci $ do

69+ p_ieWildcard w

70+ parens . velt $ withSep comma (located' p_ieWrappedName) xs

71+ IEModuleContents NoExt l1 -> located l1 p_hsmodName

7172 -- XXX I have no idea what these things are for.

72− IEGroup _ _ -> return ()

73− IEDoc _ -> return ()

74− IEDocNamed _ -> return ()

73+ IEGroup NoExt _ _ -> return ()

74+ IEDoc NoExt _ -> return ()

75+ IEDocNamed NoExt _ -> return ()

76+ XIE NoExt -> notImplemented "XIE"

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

@@ -64,6 +64,6 @@ separatedDecls

6464 :: HsDecl GhcPs

6565 -> HsDecl GhcPs

6666 -> Bool

67−separatedDecls (SigD (TypeSig (n:_) _)) (ValD (FunBind n' _ _ _ _)) =

67+separatedDecls (SigD NoExt (TypeSig NoExt (n:_) _)) (ValD NoExt (FunBind NoExt n' _ _ _)) =

6868 unL n /= unL n'

6969separatedDecls _ _ = True

src/Ormolu/Printer/Meat/Type.hs+60−64

@@ -15,33 +15,30 @@ where

1515import GHC

1616import Ormolu.Printer.Combinators

1717import Ormolu.Printer.Meat.Common

18+import Ormolu.Utils

1819

1920p_hsType :: HsType GhcPs -> R ()

2021p_hsType = \case

21− HsForAllTy bndrs t -> do

22+ HsForAllTy NoExt bndrs t -> do

2223 txt "forall "

2324 spaceSep (located' p_hsTyVarBndr) bndrs

2425 txt ". "

2526 locatedVia Nothing t p_hsType

26− HsQualTy qs t -> do

27+ HsQualTy NoExt qs t -> do

2728 located qs p_hsContext

2829 breakpoint

2930 txt "=> "

3031 locatedVia Nothing t p_hsType

31− HsTyVar p n -> do

32+ HsTyVar NoExt p n -> do

3233 case p of

3334 Promoted -> txt "'"

3435 NotPromoted -> return ()

35− located n p_rdrName

36− HsAppsTy apps ->

37− velt' $ case apps of

38− [] -> []

39− (x:xs) -> located' p_hsAppType x : (located' (inci . p_hsAppType) <$> xs)

40− HsAppTy f x -> velt'

41− [ located f p_hsType

42− , inci $ located x p_hsType

43− ]

44− HsFunTy f x@(L _ x') -> do

36+ located n p_rdrName'

37+ HsAppTy NoExt f x -> sitcc $ do

38+ located f p_hsType

39+ breakpoint

40+ inci (located x p_hsType)

41+ HsFunTy NoExt f x@(L _ x') -> do

4542 located f p_hsType

4643 breakpoint

4744 txt "-> "

@@ -49,9 +46,8 @@ p_hsType = \case

4946 HsFunTy{} -> locatedVia Nothing

5047 _ -> located

5148 located_ x p_hsType

52− HsListTy t -> located t (brackets . p_hsType)

53− HsPArrTy t -> located t (bracketsPar . p_hsType)

54− HsTupleTy tsort xs ->

49+ HsListTy NoExt t -> located t (brackets . p_hsType)

50+ HsTupleTy NoExt tsort xs ->

5551 let parens' =

5652 case tsort of

5753 HsUnboxedTuple -> parensHash

@@ -59,29 +55,32 @@ p_hsType = \case

5955 HsConstraintTuple -> parens

6056 HsBoxedOrConstraintTuple -> parens

6157 in parens' . velt $ withSep comma (located' p_hsType) xs

62− HsSumTy xs ->

58+ HsSumTy NoExt xs ->

6359 parensHash . velt $ withSep (txt "| ") (located' p_hsType) xs

64− HsOpTy x op y -> velt'

65− [ located x p_hsType

66− , inci $ located op p_rdrName >> space >> located y p_hsType

67− ]

68− HsParTy t ->

60+ HsOpTy NoExt x op y -> do

61+ located x p_hsType

62+ breakpoint

63+ inci $ do

64+ located op p_rdrName'

65+ space

66+ located y p_hsType

67+ HsParTy NoExt t ->

6968 parens (located t p_hsType)

70− HsIParamTy n t -> velt'

71− [ located n atom

72− , inci $ txt ":: " >> located t p_hsType

73− ]

74− HsEqTy x y -> velt'

75− [ located x p_hsType

76− , inci $ txt "~ " >> located y p_hsType

77− ]

78− HsKindSig t k -> velt'

79− [ located t p_hsType

80− , inci $ txt ":: " >> located k p_hsType

81− ]

69+ HsIParamTy NoExt n t -> do

70+ located n atom

71+ breakpoint

72+ inci $ do

73+ txt ":: "

74+ located t p_hsType

75+ HsStarTy NoExt _ -> txt "*"

76+ HsKindSig NoExt t k -> do

77+ located t p_hsType

78+ inci $ do

79+ txt ":: "

80+ located k p_hsType

8281 HsSpliceTy _ _ -> error "HsSpliceTy"

83− HsDocTy _ _ -> error "HsDocTy"

84− HsBangTy (HsSrcBang _ u s) t -> do

82+ HsDocTy NoExt _ _ -> error "HsDocTy"

83+ HsBangTy NoExt (HsSrcBang _ u s) t -> do

8584 case u of

8685 SrcUnpack -> txt "{-# UNPACK #-} "

8786 SrcNoUnpack -> txt "{-# NOUNPACK #-} "

@@ -91,19 +90,19 @@ p_hsType = \case

9190 SrcStrict -> txt "!"

9291 NoSrcStrict -> return ()

9392 located t p_hsType

94− HsRecTy fields ->

93+ HsRecTy NoExt fields ->

9594 p_conDeclFields fields

96− HsCoreTy t -> atom t

97− HsExplicitListTy p _ xs -> do

98− case p of -- XXX not sure about this one

95+ HsExplicitListTy NoExt p xs -> do

96+ case p of

9997 Promoted -> txt "'"

10098 NotPromoted -> return ()

10199 brackets . velt $ withSep comma (located' p_hsType) xs

102− HsExplicitTupleTy _ xs -> do

100+ HsExplicitTupleTy NoExt xs -> do

103101 txt "'"

104102 parens . velt $ withSep comma (located' p_hsType) xs

105− HsTyLit t -> atom t

106− HsWildCardTy (AnonWildCard PlaceHolder) -> txt "_"

103+ HsTyLit NoExt t -> atom t

104+ HsWildCardTy NoExt -> txt "_"

105+ XHsType (NHsCoreTy t) -> atom t

107106

108107p_hsContext :: HsContext GhcPs -> R ()

109108p_hsContext = \case

@@ -113,31 +112,28 @@ p_hsContext = \case

113112

114113p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()

115114p_hsTyVarBndr = \case

116− UserTyVar l ->

115+ UserTyVar NoExt l ->

117116 located l p_rdrName

118− KindedTyVar l k -> parens $ velt'

119− [ located l atom

120− , inci $ txt ":: " >> located k p_hsType

121− ]

122−

123−p_hsAppType :: HsAppType GhcPs -> R ()

124−p_hsAppType = \case

125− HsAppInfix l ->

126− located l p_rdrName'

127− HsAppPrefix l ->

128− located l p_hsType

117+ KindedTyVar NoExt l k -> parens $ do

118+ located l atom

119+ breakpoint

120+ inci $ do

121+ txt ":: "

122+ located k p_hsType

123+ XTyVarBndr NoExt -> notImplemented "XTyVarBndr"

129124

130125p_conDeclFields :: [LConDeclField GhcPs] -> R ()

131126p_conDeclFields =

132127 braces . velt . withSep comma (sitcc . located' p_conDeclField)

133128

134129p_conDeclField :: ConDeclField GhcPs -> R ()

135−p_conDeclField ConDeclField {..} = velt'

136− [ velt $ withSep

137− comma

138− (located' (located' p_rdrName . rdrNameFieldOcc))

139− cd_fld_names

140− , inci $ do

141− txt ":: "

142− locatedVia Nothing cd_fld_type p_hsType

143− ]

130+p_conDeclField ConDeclField {..} = do

131+ sitcc . velt $ withSep

132+ comma

133+ (located' (located' p_rdrName . rdrNameFieldOcc))

134+ cd_fld_names

135+ breakpoint

136+ sitcc . inci $ do

137+ txt ":: "

138+ locatedVia Nothing cd_fld_type p_hsType

139+p_conDeclField (XConDeclField NoExt) = notImplemented "XConDeclField"