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.

.circleci/config.yml

@@ -1,34 +1,31 @@
 version: 2
+
 jobs:
-  build:
+  build_ghc864:
     docker:
-      - image: mrkkrp/haskell-ghc-8.4.4:0.1.0
+      - image: nixos/nix:2.1.3
     steps:
       - checkout
-      - restore_cache:
-          keys:
-            - cabal-packages-{{ checksum "ormolu.cabal" }}
-            - cabal-packages-
-      - restore_cache:
-          keys:
-            - cabal-store-{{ checksum "ormolu.cabal" }}
-            - cabal-store-
-      - run: cabal --version
-      - run: ghc --version
-      - run: cabal update
-      - run: cabal new-build --enable-tests --flags=dev
-      - run: cabal new-test --enable-tests --flags=dev
-      - run: cabal new-haddock
-      - run: cabal new-sdist
-      - save_cache:
-          key: cabal-packages-{{ checksum "ormolu.cabal" }}
-          paths: "~/.cabal/packages"
-      - save_cache:
-          key: cabal-store-{{ checksum "ormolu.cabal" }}
-          paths: "~/.cabal/store"
+      - run:
+          name: Setup Cachix
+          command: |
+            nix-env -f nix/nixpkgs/ -iA cachix
+            USER=dummy cachix use tweag
+      - run:
+          name: Build environment
+          command: |
+            nix-shell --pure --run :
+      - run:
+          name: Push Cachix
+          command: |
+            nix-store -qR --include-outputs $(nix-instantiate default.nix) | cachix push tweag
+      - run:
+          name: Build the package (includes running the tests)
+          command: nix-build
 
 workflows:
   version: 2
   build:
     jobs:
-      - build
+      - build_ghc864:
+          context: org-global

data/examples/declaration/data/deriving-strategies-out.hs

@@ -5,4 +5,8 @@ newtype Foo = Foo Int
     ( ToJSON
     , FromJSON
     )
-  deriving newtype (Num)
+  deriving newtype Num
+  deriving Monoid via (Sum Int)
+  deriving
+    Semigroup
+    via (Sum Int)

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

@@ -7,3 +7,6 @@ newtype Foo = Foo Int
     , FromJSON
     )
   deriving newtype (Num)
+  deriving Monoid via (Sum Int)
+  deriving Semigroup
+    via (Sum Int)

data/examples/declaration/data/gadt/multiline-out.hs

@@ -5,8 +5,8 @@ data Foo a where
   -- | 'Foo' is wonderful.
   Foo
     :: forall a b. (Show a, Eq b) -- foo
-    => -- bar
-    a
+      -- bar
+    => a
     -> b
     -> Foo 'Int
   -- | But 'Bar' is also not too bad.

data/examples/declaration/data/multiline-arg-parens-out.hs

@@ -3,6 +3,6 @@ data Foo
   = Foo
       Bar
       (Set Baz) -- and here we go
-      -- and that's it
+        -- and that's it
       Text
-  deriving (Eq)
+  deriving Eq

data/examples/declaration/data/multiline-out.hs

@@ -3,4 +3,5 @@ data Foo
   = Foo -- ^ One
   | Bar Int -- ^ Two
   | Baz -- ^ Three
-  deriving (Eq, Show)
+  deriving
+    (Eq, Show)

data/examples/declaration/data/multiline.hs

@@ -4,4 +4,5 @@ data Foo
   = Foo -- ^ One
   | Bar Int -- ^ Two
   | Baz -- ^ Three
-  deriving (Eq, Show)
+  deriving
+    (Eq, Show)

data/examples/declaration/data/simple-broken-out.hs

@@ -1,8 +1,8 @@
 -- | Here we go.
 data Foo
   = Foo {unFoo :: Int}
-  deriving (Eq)
+  deriving Eq
 
 -- | And once again.
 data Bar = Bar {unBar :: Int}
-  deriving (Eq)
+  deriving Eq

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

@@ -1,16 +1,16 @@
 type family Id a
     = result | result -> a where
-  Id a
-    = a
+  Id a =
+    a
 
 type family G (a :: k) b c
     = foo | foo -> k b where
-  G a b c
-    = (a, b)
+  G a b c =
+    (a, b)
 
 type family F a
     :: * -> * where
   F Int = Double
-  F Bool
-    = Char
+  F Bool =
+    Char
   F a = String

default.nix

@@ -0,0 +1,24 @@
+let pkgs = import ./nix/nixpkgs;
+    compiler = "ghc864";
+    sourceRegex = [
+      "^app.*$"
+      "^data.*$"
+      "^ormolu.cabal$"
+      "^src.*$"
+      "^tests.*$"
+      "^.*\.md$"
+    ];
+    haskellPackages = pkgs.haskell.packages.${compiler}.override
+      { overrides = (self: super:
+          super //
+          { "ormolu" = super.callCabal2nix "ormolu" (pkgs.lib.sourceByRegex ./. sourceRegex) {};
+          });
+      };
+in if pkgs.lib.inNixShell
+     then haskellPackages.shellFor
+       { packages = (ps: [ ps.ormolu ]);
+         buildInputs = [
+           pkgs.cabal-install
+         ];
+       }
+     else haskellPackages.ormolu

nix/nixpkgs/default.nix

@@ -0,0 +1,8 @@
+let
+  rev = "f52505fac8c82716872a616c501ad9eff188f97f";
+  sha256 = "0q2m2qhyga9yq29yz90ywgjbn9hdahs7i8wwlq7b55rdbyiwa5dy";
+  pkgs = import (builtins.fetchTarball {
+    url = "https://github.com/NixOS/nixpkgs/archive/${rev}.tar.gz";
+    inherit sha256;
+  }) { config.allowUnfree = true; };
+in pkgs

ormolu.cabal

@@ -1,7 +1,7 @@
 name:                 ormolu
 version:              0.0.1.0
 cabal-version:        1.18
-tested-with:          GHC==8.4.4
+tested-with:          GHC==8.6.4
 license:              BSD3
 license-file:         LICENSE.md
 maintainer:           Mark Karpov <mark.karpov@tweag.io>
@@ -35,7 +35,7 @@ flag dev
 
 library
   hs-source-dirs:     src
-  build-depends:      base           >= 4.8 && < 5.0
+  build-depends:      base           >= 4.12 && < 5.0
                     , containers     >= 0.5 && < 0.7
                     , dlist          >= 0.8 && < 0.9
                     , exceptions     >= 0.6 && < 0.11
@@ -84,7 +84,7 @@ test-suite tests
   main-is:            Spec.hs
   hs-source-dirs:     tests
   type:               exitcode-stdio-1.0
-  build-depends:      base           >= 4.8 && < 5.0
+  build-depends:      base           >= 4.12 && < 5.0
                     , containers     >= 0.5 && < 0.7
                     , filepath       >= 1.2 && < 1.5
                     , hspec          >= 2.0 && < 3.0
@@ -106,7 +106,7 @@ test-suite tests
 executable ormolu
   main-is:            Main.hs
   hs-source-dirs:     app
-  build-depends:      base           >= 4.8 && < 5.0
+  build-depends:      base           >= 4.12 && < 5.0
                     , ghc            >= 8.4.3
                     , gitrev         >= 1.3 && < 1.4
                     , optparse-applicative >= 0.14 && < 0.15

src/Ormolu/Imports.hs

@@ -14,7 +14,7 @@ import Data.List (sortBy)
 import GHC hiding (GhcPs, IE)
 import HsExtension
 import HsImpExp (IE (..))
-import Ormolu.Utils (unL)
+import Ormolu.Utils (unL, notImplemented)
 
 -- | Sort imports by module name. This also sorts explicit import lists for
 -- each declaration.
@@ -50,8 +50,8 @@ sortLies = sortBy (compareIE `on` unL) . fmap (fmap sortThings)
 
 sortThings :: IE GhcPs -> IE GhcPs
 sortThings = \case
-  IEThingWith x w xs fl ->
-    IEThingWith x w (sortBy (compareIewn `on` unL) xs) fl
+  IEThingWith NoExt x w xs fl ->
+    IEThingWith NoExt x w (sortBy (compareIewn `on` unL) xs) fl
   other -> other
 
 -- | Compare two located imports or exports.
@@ -63,14 +63,15 @@ compareIE = compareIewn `on` getIewn
 
 getIewn :: IE GhcPs -> IEWrappedName RdrName
 getIewn = \case
-  IEVar x -> unL x
-  IEThingAbs x -> unL x
-  IEThingAll x -> unL x
-  IEThingWith x _ _ _ -> unL x
-  IEModuleContents _ -> error "Ormolu.Imports.projectName: IEModuleContents"
-  IEGroup _ _ -> error "Ormolu.Imports.projectName: IEGroup"
-  IEDoc _ -> error "Ormolu.Imports.projectName: IEGroup"
-  IEDocNamed _ -> error "Ormolu.Imports.projectName: IEGroup"
+  IEVar NoExt x -> unL x
+  IEThingAbs NoExt x -> unL x
+  IEThingAll NoExt x -> unL x
+  IEThingWith NoExt x _ _ _ -> unL x
+  IEModuleContents NoExt _ -> notImplemented "IEModuleContents"
+  IEGroup NoExt _ _ -> notImplemented "IEGroup"
+  IEDoc NoExt _ -> notImplemented "IEDoc"
+  IEDocNamed NoExt _ -> notImplemented "IEDocNamed"
+  XIE NoExt -> notImplemented "XIE"
 
 -- | Compare two @'IEWrapppedName' 'RdrName'@ things.
 

src/Ormolu/Printer/Combinators.hs

@@ -162,9 +162,7 @@ velt xs = sequence_ (intersperse sep (sitcc <$> xs))
 -- line.
 
 velt' :: [R ()] -> R ()
-velt' xs = sitcc $ sequence_ (intersperse sep (sitcc <$> xs))
-  where
-    sep = vlayout (spit " ") newline
+velt' xs = sitcc $ sequence_ (intersperse breakpoint (sitcc <$> xs))
 
 -- | Put separator between renderings of items of a list.
 

src/Ormolu/Printer/Comments.hs

@@ -167,7 +167,10 @@ commentFollowsElt
   -> Bool
 commentFollowsElt ref mnSpn meSpn mlastSpn (L l comment) =
   -- A comment follows a AST element if all 4 conditions are satisfied:
-  goesAfter && logicallyFollows && noEltBetween && supersedesParentElt
+  goesAfter
+    && logicallyFollows
+    && noEltBetween
+    && (continuation || supersedesParentElt)
   where
     -- 1) The comment starts after end of the AST element:
     goesAfter =
@@ -176,20 +179,22 @@ commentFollowsElt ref mnSpn meSpn mlastSpn (L l comment) =
     logicallyFollows
       = theSameLine l ref -- a) it's on the same line
       || isPrevHaddock comment -- b) it's a Haddock string starting with -- ^
-      || isJust mlastSpn -- c) it's a continuation of a comment block
+      || continuation -- c) it's a continuation of a comment block
     -- 3) There is no other AST element between this element and the comment:
     noEltBetween =
       case mnSpn of
         Nothing -> True
         Just nspn ->
           realSrcSpanStart nspn >= realSrcSpanEnd l
-    -- Less obvious: if column of comment is closer to the start of
+    -- 4) Less obvious: if column of comment is closer to the start of
     -- enclosing element, it probably related to that parent element, not to
     -- the current child element. This rule is important because otherwise
     -- all comments would end up assigned to closest inner elements, and
     -- parent elements won't have a chance to get any comments assigned to
     -- them. This is not OK because comments will get indented according to
     -- the AST elements they are attached to.
+    --
+    -- Skip this rule if the comment is a continuation of a comment block.
     supersedesParentElt =
       case meSpn of
         Nothing -> True
@@ -197,6 +202,7 @@ commentFollowsElt ref mnSpn meSpn mlastSpn (L l comment) =
           let startColumn = srcLocCol . realSrcSpanStart
           in abs (startColumn espn - startColumn l)
                > abs (startColumn ref - startColumn l)
+    continuation = isJust mlastSpn
 
 -- | Output a 'Comment'. This is a low-level printing function.
 

src/Ormolu/Printer/Meat/Declaration.hs

@@ -19,14 +19,14 @@ import Ormolu.Utils
 
 p_hsDecl :: HsDecl GhcPs -> R ()
 p_hsDecl = \case
-  TyClD x -> p_tyClDecl x
-  ValD x -> p_valDecl x
-  SigD x -> p_sigDecl x
+  TyClD NoExt x -> p_tyClDecl x
+  ValD NoExt x -> p_valDecl x
+  SigD NoExt x -> p_sigDecl x
   _ -> notImplemented "certain kinds of declarations"
 
 p_tyClDecl :: TyClDecl GhcPs -> R ()
 p_tyClDecl = \case
-  FamDecl x -> p_famDecl x
+  FamDecl NoExt x -> p_famDecl x
   SynDecl {..} -> p_synDecl tcdLName tcdTyVars tcdRhs
   DataDecl {..} -> p_dataDecl tcdLName tcdTyVars tcdDataDefn
   _ -> notImplemented "certain kinds of declarations"

src/Ormolu/Printer/Meat/Declaration/Data.hs

@@ -9,7 +9,6 @@ module Ormolu.Printer.Meat.Declaration.Data
   )
 where
 
-import BasicTypes (DerivStrategy (..))
 import Control.Monad
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Maybe (isJust)
@@ -17,7 +16,7 @@ import GHC
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Meat.Common
 import Ormolu.Printer.Meat.Type
-import Ormolu.Utils (unL, getSpan, combineSrcSpans')
+import Ormolu.Utils
 import RdrName (RdrName (..))
 import SrcLoc (Located)
 
@@ -55,32 +54,34 @@ p_dataDecl name tvars HsDataDefn {..} = do
   newline
   inci . located dd_derivs $ \xs ->
     forM_ xs (line . located' p_hsDerivingClause)
+p_dataDecl _ _ (XHsDataDefn NoExt) = notImplemented "XHsDataDefn"
 
 p_conDecl :: ConDecl GhcPs -> R ()
 p_conDecl = \case
-  ConDeclGADT {..} -> velt'
-    [ spaceSep (located' p_rdrName) con_names
-    , inci $ do
-        txt ":: "
-        locatedVia Nothing (hsib_body con_type) p_hsType
-    ]
+  ConDeclGADT {..} -> do
+    spaceSep (located' p_rdrName) con_names
+    breakpoint
+    inci $ do
+      txt ":: "
+      p_forallBndrs (hsq_explicit con_qvars)
+      forM_ con_mb_cxt p_lhsContext
+      case con_args of
+        PrefixCon xs -> do
+          velt' (located' p_hsType <$> xs)
+          unless (null xs) $ do
+            breakpoint
+            txt "-> "
+        RecCon l -> do
+          located l p_conDeclFields
+          unless (null $ unL l) $ do
+            breakpoint
+            txt "-> "
+        InfixCon _ _ -> notImplemented "InfixCon"
+      locatedVia Nothing con_res_ty p_hsType
   ConDeclH98 {..} -> do
-    case hsq_explicit <$> con_qvars of
-      Nothing -> return ()
-      Just bndrs -> do
-        txt "forall "
-        spaceSep (located' p_hsTyVarBndr) bndrs
-        txt "."
-        breakpoint
-    case con_cxt of
-      Nothing -> return ()
-      Just ctx -> located ctx $ \case
-        [] -> pure ()
-        xs -> do
-          p_hsContext xs
-          breakpoint
-          txt "=> "
-    case con_details of
+    p_forallBndrs con_ex_tvs
+    forM_ con_mb_cxt p_lhsContext
+    case con_args of
       PrefixCon xs -> do
         located con_name p_rdrName
         unless (null xs) breakpoint
@@ -89,33 +90,74 @@ p_conDecl = \case
         located con_name p_rdrName
         breakpoint
         inci $ located l p_conDeclFields
-      InfixCon x y -> velt'
-        [ located x p_hsType
-        , inci $ velt'
-          [ backticks (located con_name p_rdrName)
-          , inci $ located y p_hsType
-          ]
-        ]
+      InfixCon x y -> do
+        located x p_hsType
+        breakpoint
+        inci $ do
+          backticks (located con_name p_rdrName)
+          breakpoint
+          inci (located y p_hsType)
+  XConDecl NoExt -> notImplemented "XConDecl"
+
+p_forallBndrs
+  :: [LHsTyVarBndr GhcPs]
+  -> R ()
+p_forallBndrs = \case
+  [] -> return ()
+  bndrs -> do
+    txt "forall "
+    spaceSep (located' p_hsTyVarBndr) bndrs
+    txt ". "
+
+p_lhsContext
+  :: LHsContext GhcPs
+  -> R ()
+p_lhsContext = \case
+  L _ [] -> pure ()
+  ctx -> do
+    located ctx p_hsContext
+    breakpoint
+    txt "=> "
 
 isGadt :: ConDecl GhcPs -> Bool
 isGadt = \case
   ConDeclGADT {} -> True
   ConDeclH98 {} -> False
+  XConDecl {} -> False
 
 p_hsDerivingClause
   :: HsDerivingClause GhcPs
   -> R ()
 p_hsDerivingClause HsDerivingClause {..} = do
   txt "deriving"
+  let derivingWhat = located deriv_clause_tys $ \case
+        [] -> txt "()"
+        [x] -> located (hsib_body x) p_hsType
+        xs -> parens . velt $ withSep comma (located' p_hsType . hsib_body) xs
   case deriv_clause_strategy of
-    Nothing -> return ()
-    Just l -> do
-      space
-      located l $ \case
-        StockStrategy -> txt "stock"
-        AnyclassStrategy -> txt "anyclass"
-        NewtypeStrategy -> txt "newtype"
-  breakpoint
-  inci . located deriv_clause_tys $ \case
-    [] -> txt "()"
-    xs -> parens . velt $ withSep comma (located' p_hsType . hsib_body) xs
+    Nothing -> do
+      breakpoint
+      inci derivingWhat
+    Just l -> locatedVia Nothing l $ \case
+      StockStrategy -> do
+        txt " stock"
+        breakpoint
+        inci derivingWhat
+      AnyclassStrategy -> do
+        txt " anyclass"
+        breakpoint
+        inci derivingWhat
+      NewtypeStrategy -> do
+        txt " newtype"
+        breakpoint
+        inci derivingWhat
+      ViaStrategy HsIB {..} -> do
+        breakpoint
+        inci $ do
+          derivingWhat
+          breakpoint
+          txt "via "
+          located hsib_body p_hsType
+      ViaStrategy (XHsImplicitBndrs NoExt) ->
+        notImplemented "XHsImplicitBndrs"
+p_hsDerivingClause (XHsDerivingClause NoExt) = notImplemented "XHsDerivingClause"

src/Ormolu/Printer/Meat/Declaration/Pat.hs

@@ -16,33 +16,31 @@ import Ormolu.Utils
 
 p_pat :: Pat GhcPs -> R ()
 p_pat = \case
-  WildPat _ -> txt "_"
-  VarPat name -> located name p_rdrName
-  LazyPat pat -> do
+  WildPat NoExt -> txt "_"
+  VarPat NoExt name -> located name p_rdrName
+  LazyPat NoExt pat -> do
     txt "~"
     located pat p_pat
-  AsPat name pat -> do
+  AsPat NoExt name pat -> do
     located name p_rdrName
     txt "@"
     located pat p_pat
-  ParPat pat ->
+  ParPat NoExt pat ->
     located pat (parens . p_pat)
-  BangPat pat -> do
+  BangPat NoExt pat -> do
     txt "!"
     located pat p_pat
-  ListPat pats _ _ -> do
+  ListPat NoExt pats -> do
     brackets $ velt (withSep comma (located' p_pat) pats)
-  TuplePat pats boxing _ -> do
+  TuplePat NoExt pats boxing -> do
     let f =
           case boxing of
             Boxed -> parens
             Unboxed -> parensHash
     f $ velt (withSep comma (located' p_pat) pats)
-  SumPat pat _ _ _ -> do
+  SumPat NoExt pat _ _ -> do
     -- XXX I'm not sure about this one.
     located pat p_pat
-  PArrPat pats _ -> do
-    bracketsPar $ velt (withSep comma (located' p_pat) pats)
   ConPatIn pat details ->
     case details of
       PrefixCon xs -> do
@@ -63,12 +61,12 @@ p_pat = \case
   ConPatOut {} -> notImplemented "ConPatOut"
   ViewPat {} -> notImplemented "ViewPat"
   SplicePat {} -> notImplemented "SplicePat"
-  LitPat p -> atom p
-  NPat v _ _ _ -> located v (atom . ol_val)
+  LitPat NoExt p -> atom p
+  NPat NoExt v _ _ -> located v (atom . ol_val)
   NPlusKPat {} -> notImplemented "NPlusKPat"
-  SigPatIn {} -> notImplemented "SigPatIn"
-  SigPatOut {} -> notImplemented "SigPatOut"
+  SigPat {} -> notImplemented "SigPat"
   CoPat {} -> notImplemented "CoPat"
+  XPat NoExt -> notImplemented "XPat"
 
 p_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()
 p_hsRecField HsRecField {..} =

src/Ormolu/Printer/Meat/Declaration/Signature.hs

@@ -21,7 +21,7 @@ p_sigDecl = line . p_sigDecl'
 
 p_sigDecl' :: Sig GhcPs -> R ()
 p_sigDecl' = \case
-  TypeSig names hswc -> p_typeSig names hswc
+  TypeSig NoExt names hswc -> p_typeSig names hswc
   _ -> notImplemented "certain types of signature declarations"
 
 p_typeSig
@@ -34,3 +34,4 @@ p_typeSig names HsWC {..} = do
   inci $ do
     txt ":: "
     located (hsib_body hswc_body) p_hsType
+p_typeSig _ (XHsWildCardBndrs NoExt) = notImplemented "XHsWildCardBndrs"

src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs

@@ -15,6 +15,7 @@ import GHC
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Meat.Common
 import Ormolu.Printer.Meat.Type
+import Ormolu.Utils
 import SrcLoc (Located, GenLocated (..))
 
 p_famDecl :: FamilyDecl GhcPs -> R ()
@@ -42,18 +43,24 @@ p_famDecl FamilyDecl {..} = do
         Just eqs -> do
           newline
           forM_ eqs (located' (line . inci . p_tyFamInstEqn))
+p_famDecl (XFamilyDecl NoExt) = notImplemented "XFamilyDecl"
 
-p_familyResultSigL :: Bool -> Located (FamilyResultSig GhcPs) -> Maybe (R ())
+p_familyResultSigL
+  :: Bool
+  -> Located (FamilyResultSig GhcPs)
+  -> Maybe (R ())
 p_familyResultSigL injAnn l =
   case l of
     L _ a -> case a of
-      NoSig -> Nothing
-      KindSig k -> Just $ do
+      NoSig NoExt -> Nothing
+      KindSig NoExt k -> Just $ do
         if injAnn then txt "= " else txt ":: "
         located k p_hsType
-      TyVarSig bndr -> Just $ do
+      TyVarSig NoExt bndr -> Just $ do
         if injAnn then txt "= " else txt ":: "
         located bndr p_hsTyVarBndr
+      XFamilyResultSig NoExt ->
+        notImplemented "XFamilyResultSig"
 
 p_injectivityAnn :: InjectivityAnn GhcPs -> R ()
 p_injectivityAnn (InjectivityAnn a bs) = do
@@ -64,11 +71,12 @@ p_injectivityAnn (InjectivityAnn a bs) = do
   spaceSep (located' p_rdrName) bs
 
 p_tyFamInstEqn :: TyFamInstEqn GhcPs -> R ()
-p_tyFamInstEqn HsIB {..} = velt'
-  [ do located feqn_tycon p_rdrName
-       space
-       spaceSep (located' p_hsType) feqn_pats
-  , inci $ txt "= " >> inci (located feqn_rhs p_hsType)
-  ]
-  where
-    FamEqn {..} = hsib_body
+p_tyFamInstEqn HsIB {..} = do
+  let FamEqn {..} = hsib_body
+  located feqn_tycon p_rdrName
+  space
+  spaceSep (located' p_hsType) feqn_pats
+  txt " ="
+  breakpoint
+  inci (located feqn_rhs p_hsType)
+p_tyFamInstEqn (XHsImplicitBndrs NoExt) = notImplemented "XHsImplicitBndrs"

src/Ormolu/Printer/Meat/Declaration/Value.hs

@@ -25,7 +25,7 @@ p_valDecl = line . p_valDecl'
 
 p_valDecl' :: HsBindLR GhcPs GhcPs -> R ()
 p_valDecl' = \case
-  FunBind funId funMatches _ _ _ -> p_funBind funId funMatches
+  FunBind NoExt funId funMatches _ _ -> p_funBind funId funMatches
   _ -> notImplemented "certain kinds of binding declarations"
 
 p_funBind
@@ -48,6 +48,7 @@ p_matchGroup
 p_matchGroup style MG {..} =
   locatedVia Nothing mg_alts $
     newlineSep (located' (p_match style))
+p_matchGroup _ (XMatchGroup NoExt) = notImplemented "XMatchGroup"
 
 p_match
   :: MatchGroupStyle
@@ -97,13 +98,14 @@ p_match style Match {..} = do
         Lambda -> return ()
         _ -> breakpoint
       newlineSep (located' p_grhs) grhssGRHSs
-      unless (GHC.isEmptyLocalBinds (unL grhssLocalBinds)) $ do
+      unless (GHC.isEmptyLocalBindsPR (unL grhssLocalBinds)) $ do
         newline
         line (txt "where")
         inci (located grhssLocalBinds p_hsLocalBinds)
+p_match _ (XMatch NoExt) = notImplemented "XMatchGroup"
 
 p_grhs :: GRHS GhcPs (LHsExpr GhcPs) -> R ()
-p_grhs (GRHS guards body) =
+p_grhs (GRHS NoExt guards body) =
   case guards of
     [] -> p_body
     xs -> do
@@ -114,21 +116,23 @@ p_grhs (GRHS guards body) =
       inci p_body
   where
     p_body = located body p_hsExpr
+p_grhs (XGRHS NoExt) = notImplemented "XGRHS"
 
 p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R ()
 p_stmt = \case
   LastStmt {} -> notImplemented "do notation"
   BindStmt {} -> notImplemented "do notation"
   ApplicativeStmt {} -> notImplemented "applicative stmt"
-  BodyStmt body _ _ _ -> located body p_hsExpr
-  LetStmt binds -> located binds p_hsLocalBinds
+  BodyStmt NoExt body _ _ -> located body p_hsExpr
+  LetStmt NoExt binds -> located binds p_hsLocalBinds
   ParStmt {} -> notImplemented "ParStmt"
   TransStmt {} -> notImplemented "TransStmt"
   RecStmt {} -> notImplemented "RecStmt"
+  XStmtLR {} -> notImplemented "XStmtLR"
 
 p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()
 p_hsLocalBinds = \case
-  HsValBinds (ValBindsIn bag lsigs) -> do
+  HsValBinds NoExt (ValBinds NoExt bag lsigs) -> do
     let ssStart = either
           (srcSpanStart . getSpan)
           (srcSpanStart . getSpan)
@@ -137,62 +141,63 @@ p_hsLocalBinds = \case
         p_item (Left x) = located x p_valDecl'
         p_item (Right x) = located x p_sigDecl'
     newlineSep p_item (sortOn ssStart items)
-  HsValBinds _ -> notImplemented "HsValBinds"
-  HsIPBinds _ -> notImplemented "HsIPBinds"
-  EmptyLocalBinds -> return ()
+  HsValBinds NoExt _ -> notImplemented "HsValBinds"
+  HsIPBinds NoExt _ -> notImplemented "HsIPBinds"
+  EmptyLocalBinds NoExt -> return ()
+  XHsLocalBindsLR _ -> notImplemented "XHsLocalBindsLR"
 
 p_hsExpr :: HsExpr GhcPs -> R ()
 p_hsExpr = \case
-  HsVar name -> located name p_rdrName'
-  HsUnboundVar _ -> notImplemented "HsUnboundVar"
-  HsConLikeOut _ -> notImplemented "HsConLikeOut"
-  HsRecFld x ->
+  HsVar NoExt name -> located name p_rdrName'
+  HsUnboundVar NoExt _ -> notImplemented "HsUnboundVar"
+  HsConLikeOut NoExt _ -> notImplemented "HsConLikeOut"
+  HsRecFld NoExt x ->
     case x of
-      Unambiguous name _ -> located name p_rdrName'
-      Ambiguous name _ -> located name p_rdrName'
-  HsOverLabel _ _ -> notImplemented "HsOverLabel"
-  HsIPVar (HsIPName name) -> atom name
-  HsOverLit v -> atom (ol_val v)
-  HsLit lit -> atom lit
-  HsLam mgroup ->
+      Unambiguous NoExt name -> located name p_rdrName'
+      Ambiguous NoExt name -> located name p_rdrName'
+      XAmbiguousFieldOcc NoExt -> notImplemented "XAmbiguousFieldOcc"
+  HsOverLabel NoExt _ _ -> notImplemented "HsOverLabel"
+  HsIPVar NoExt (HsIPName name) -> atom name
+  HsOverLit NoExt v -> atom (ol_val v)
+  HsLit NoExt lit -> atom lit
+  HsLam NoExt mgroup ->
     p_matchGroup Lambda mgroup
-  HsLamCase mgroup -> do
+  HsLamCase NoExt mgroup -> do
     txt "\\case"
     newline
     inci (p_matchGroup LambdaCase mgroup)
-  HsApp f x -> do
+  HsApp NoExt f x -> do
     located f p_hsExpr
     breakpoint
     inci (located x p_hsExpr)
   HsAppType a e -> do
-    located a p_hsExpr
+    located e p_hsExpr
     breakpoint
     inci $ do
       txt "@"
-      located (hswc_body e) p_hsType
-  HsAppTypeOut {} -> notImplemented "HsAppTypeOut"
-  OpApp x op _ y -> do
+      located (hswc_body a) p_hsType
+  OpApp NoExt x op y -> do
     located x p_hsExpr
     breakpoint
     inci $ do
       located op p_hsExpr
       space
       located y p_hsExpr
-  NegApp e _ -> do
+  NegApp NoExt e _ -> do
     txt "-"
     located e p_hsExpr
-  HsPar e -> parens (located e p_hsExpr)
+  HsPar NoExt e -> parens (located e p_hsExpr)
   SectionL {} -> notImplemented "SectionL"
   SectionR {} -> notImplemented "SectionR"
   ExplicitTuple {} -> notImplemented "ExplicitTuple"
   ExplicitSum {} -> notImplemented "ExplicitSum"
-  HsCase e mgroup -> do
+  HsCase NoExt e mgroup -> do
     txt "case "
     located e p_hsExpr
     txt " of"
     breakpoint
     inci (p_matchGroup Case mgroup)
-  HsIf _ if' then' else' -> do
+  HsIf NoExt _ if' then' else' -> do
     txt "if "
     located if' p_hsExpr
     breakpoint
@@ -206,7 +211,7 @@ p_hsExpr = \case
       breakpoint
       inci (p_hsExpr x)
   HsMultiIf {} -> notImplemented "MulitiIf"
-  HsLet localBinds e -> do
+  HsLet NoExt localBinds e -> do
     txt "let "
     sitcc (located localBinds p_hsLocalBinds)
     breakpoint
@@ -215,13 +220,10 @@ p_hsExpr = \case
   HsDo {} -> notImplemented "HsDo"
   ExplicitList _ _ xs -> do
     brackets $ velt (withSep comma (located' p_hsExpr) xs)
-  ExplicitPArr {} -> notImplemented "ExplicitPArr"
   RecordCon {} -> notImplemented "RecordCon"
   RecordUpd {} -> notImplemented "RecordUpd"
   ExprWithTySig {} -> notImplemented "ExprWithTySig"
-  ExprWithTySigOut {} -> notImplemented "ExprWithTySigOut"
   ArithSeq {} -> notImplemented "ArithSeq"
-  PArrSeq {} -> notImplemented "PArrSeq"
   HsSCC {} -> notImplemented "HsSCC"
   HsCoreAnn {} -> notImplemented "HsCoreAnn"
   HsBracket {} -> notImplemented "HsBracket"
@@ -238,14 +240,16 @@ p_hsExpr = \case
   HsTick {} -> notImplemented "HsTick"
   HsBinTick {} -> notImplemented "HsBinTick"
   HsTickPragma {} -> notImplemented "HsTickPragma"
-  EWildPat -> notImplemented "EWildPat"
+  EWildPat NoExt -> notImplemented "EWildPat"
   EAsPat {} -> notImplemented "EAsPat"
   EViewPat {} -> notImplemented "EViewPat"
   ELazyPat {} -> notImplemented "ELazyPat"
   HsWrap {} -> notImplemented "HsWrap"
+  XExpr {} -> notImplemented "XExpr"
 
 ----------------------------------------------------------------------------
 -- Helpers
 
 getGRHSSpan :: GRHS GhcPs (LHsExpr GhcPs) -> SrcSpan
-getGRHSSpan (GRHS _ body) = getSpan body
+getGRHSSpan (GRHS NoExt _ body) = getSpan body
+getGRHSSpan (XGRHS NoExt) = notImplemented "XGRHS"

src/Ormolu/Printer/Meat/ImportExport.hs

@@ -15,6 +15,7 @@ import GHC
 import HsImpExp (IE (..))
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Meat.Common
+import Ormolu.Utils
 
 p_hsmodExports :: [LIE GhcPs] -> R ()
 p_hsmodExports xs = do
@@ -51,24 +52,25 @@ p_hsmodImport ImportDecl {..} = line $ do
       breakpoint
       inci . locatedVia Nothing l $
         parens . velt . withSep comma (located' p_lie)
+p_hsmodImport (XImportDecl NoExt) = notImplemented "XImportDecl"
 
 p_lie :: IE GhcPs -> R ()
 p_lie = \case
-  IEVar l1 -> located l1 p_ieWrappedName
-  IEThingAbs l1 -> located l1 p_ieWrappedName
-  IEThingAll l1 -> do
+  IEVar NoExt l1 -> located l1 p_ieWrappedName
+  IEThingAbs NoExt l1 -> located l1 p_ieWrappedName
+  IEThingAll NoExt l1 -> do
     located l1 p_ieWrappedName
     txt " (..)"
-  IEThingWith l1 w xs _ -> velt'
-    [ located l1 p_ieWrappedName
-    , inci $ do
-        p_ieWildcard w
-        parens . velt $ withSep comma (located' p_ieWrappedName) xs
-    ]
+  IEThingWith NoExt l1 w xs _ -> sitcc $ do
+    located l1 p_ieWrappedName
+    breakpoint
     -- XXX I have no idea what field labels are in this context.
-    -- parens . velt $ withSep comma (located' p_FieldLbl) fls
-  IEModuleContents l1 -> located l1 p_hsmodName
+    inci $ do
+      p_ieWildcard w
+      parens . velt $ withSep comma (located' p_ieWrappedName) xs
+  IEModuleContents NoExt l1 -> located l1 p_hsmodName
   -- XXX I have no idea what these things are for.
-  IEGroup _ _ -> return ()
-  IEDoc _ -> return ()
-  IEDocNamed _ -> return ()
+  IEGroup NoExt _ _ -> return ()
+  IEDoc NoExt _ -> return ()
+  IEDocNamed NoExt _ -> return ()
+  XIE NoExt -> notImplemented "XIE"

src/Ormolu/Printer/Meat/Module.hs

@@ -64,6 +64,6 @@ separatedDecls
   :: HsDecl GhcPs
   -> HsDecl GhcPs
   -> Bool
-separatedDecls (SigD (TypeSig (n:_) _)) (ValD (FunBind n' _ _ _ _)) =
+separatedDecls (SigD NoExt (TypeSig NoExt (n:_) _)) (ValD NoExt (FunBind NoExt n' _ _ _)) =
   unL n /= unL n'
 separatedDecls _ _ = True

src/Ormolu/Printer/Meat/Type.hs

@@ -15,33 +15,30 @@ where
 import GHC
 import Ormolu.Printer.Combinators
 import Ormolu.Printer.Meat.Common
+import Ormolu.Utils
 
 p_hsType :: HsType GhcPs -> R ()
 p_hsType = \case
-  HsForAllTy bndrs t -> do
+  HsForAllTy NoExt bndrs t -> do
     txt "forall "
     spaceSep (located' p_hsTyVarBndr) bndrs
     txt ". "
     locatedVia Nothing t p_hsType
-  HsQualTy qs t -> do
+  HsQualTy NoExt qs t -> do
     located qs p_hsContext
     breakpoint
     txt "=> "
     locatedVia Nothing t p_hsType
-  HsTyVar p n -> do
+  HsTyVar NoExt p n -> do
     case p of
       Promoted -> txt "'"
       NotPromoted -> return ()
-    located n p_rdrName
-  HsAppsTy apps ->
-    velt' $ case apps of
-      [] -> []
-      (x:xs) -> located' p_hsAppType x : (located' (inci . p_hsAppType) <$> xs)
-  HsAppTy f x -> velt'
-    [ located f p_hsType
-    , inci $ located x p_hsType
-    ]
-  HsFunTy f x@(L _ x') -> do
+    located n p_rdrName'
+  HsAppTy NoExt f x -> sitcc $ do
+    located f p_hsType
+    breakpoint
+    inci (located x p_hsType)
+  HsFunTy NoExt f x@(L _ x') -> do
     located f p_hsType
     breakpoint
     txt "-> "
@@ -49,9 +46,8 @@ p_hsType = \case
           HsFunTy{} -> locatedVia Nothing
           _ -> located
     located_ x p_hsType
-  HsListTy t -> located t (brackets . p_hsType)
-  HsPArrTy t -> located t (bracketsPar . p_hsType)
-  HsTupleTy tsort xs ->
+  HsListTy NoExt t -> located t (brackets . p_hsType)
+  HsTupleTy NoExt tsort xs ->
     let parens' =
           case tsort of
             HsUnboxedTuple -> parensHash
@@ -59,29 +55,32 @@ p_hsType = \case
             HsConstraintTuple -> parens
             HsBoxedOrConstraintTuple -> parens
     in parens' . velt $ withSep comma (located' p_hsType) xs
-  HsSumTy xs ->
+  HsSumTy NoExt xs ->
     parensHash . velt $ withSep (txt "| ") (located' p_hsType) xs
-  HsOpTy x op y -> velt'
-    [ located x p_hsType
-    , inci $ located op p_rdrName >> space >> located y p_hsType
-    ]
-  HsParTy t ->
+  HsOpTy NoExt x op y -> do
+    located x p_hsType
+    breakpoint
+    inci $ do
+      located op p_rdrName'
+      space
+      located y p_hsType
+  HsParTy NoExt t ->
     parens (located t p_hsType)
-  HsIParamTy n t -> velt'
-    [ located n atom
-    , inci $ txt ":: " >> located t p_hsType
-    ]
-  HsEqTy x y -> velt'
-    [ located x p_hsType
-    , inci $ txt "~ " >> located y p_hsType
-    ]
-  HsKindSig t k -> velt'
-    [ located t p_hsType
-    , inci $ txt ":: " >> located k p_hsType
-    ]
+  HsIParamTy NoExt n t -> do
+    located n atom
+    breakpoint
+    inci $ do
+      txt ":: "
+      located t p_hsType
+  HsStarTy NoExt _ -> txt "*"
+  HsKindSig NoExt t k -> do
+    located t p_hsType
+    inci $ do
+      txt ":: "
+      located k p_hsType
   HsSpliceTy _ _ -> error "HsSpliceTy"
-  HsDocTy _ _ -> error "HsDocTy"
-  HsBangTy (HsSrcBang _ u s) t -> do
+  HsDocTy NoExt _ _ -> error "HsDocTy"
+  HsBangTy NoExt (HsSrcBang _ u s) t -> do
     case u of
       SrcUnpack -> txt "{-# UNPACK #-} "
       SrcNoUnpack -> txt "{-# NOUNPACK #-} "
@@ -91,19 +90,19 @@ p_hsType = \case
       SrcStrict -> txt "!"
       NoSrcStrict -> return ()
     located t p_hsType
-  HsRecTy fields ->
+  HsRecTy NoExt fields ->
     p_conDeclFields fields
-  HsCoreTy t -> atom t
-  HsExplicitListTy p _ xs -> do
-    case p of -- XXX not sure about this one
+  HsExplicitListTy NoExt p xs -> do
+    case p of
       Promoted -> txt "'"
       NotPromoted -> return ()
     brackets . velt $ withSep comma (located' p_hsType) xs
-  HsExplicitTupleTy _ xs -> do
+  HsExplicitTupleTy NoExt xs -> do
     txt "'"
     parens . velt $ withSep comma (located' p_hsType) xs
-  HsTyLit t -> atom t
-  HsWildCardTy (AnonWildCard PlaceHolder) -> txt "_"
+  HsTyLit NoExt t -> atom t
+  HsWildCardTy NoExt -> txt "_"
+  XHsType (NHsCoreTy t) -> atom t
 
 p_hsContext :: HsContext GhcPs -> R ()
 p_hsContext = \case
@@ -113,31 +112,28 @@ p_hsContext = \case
 
 p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()
 p_hsTyVarBndr = \case
-  UserTyVar l ->
+  UserTyVar NoExt l ->
     located l p_rdrName
-  KindedTyVar l k -> parens $ velt'
-    [ located l atom
-    , inci $ txt ":: " >> located k p_hsType
-    ]
-
-p_hsAppType :: HsAppType GhcPs -> R ()
-p_hsAppType = \case
-  HsAppInfix l ->
-    located l p_rdrName'
-  HsAppPrefix l ->
-    located l p_hsType
+  KindedTyVar NoExt l k -> parens $ do
+    located l atom
+    breakpoint
+    inci $ do
+      txt ":: "
+      located k p_hsType
+  XTyVarBndr NoExt -> notImplemented "XTyVarBndr"
 
 p_conDeclFields :: [LConDeclField GhcPs] -> R ()
 p_conDeclFields =
   braces . velt . withSep comma (sitcc . located' p_conDeclField)
 
 p_conDeclField :: ConDeclField GhcPs -> R ()
-p_conDeclField ConDeclField {..} = velt'
-  [ velt $ withSep
-      comma
-      (located' (located' p_rdrName . rdrNameFieldOcc))
-      cd_fld_names
-  , inci $ do
-      txt ":: "
-      locatedVia Nothing cd_fld_type p_hsType
-  ]
+p_conDeclField ConDeclField {..} = do
+  sitcc . velt $ withSep
+    comma
+    (located' (located' p_rdrName . rdrNameFieldOcc))
+    cd_fld_names
+  breakpoint
+  sitcc . inci $ do
+    txt ":: "
+    locatedVia Nothing cd_fld_type p_hsType
+p_conDeclField (XConDeclField NoExt) = notImplemented "XConDeclField"