Merge branch 'ghc-8.6'

.travis.yml

@@ -40,26 +40,6 @@ before_cache:
 #     addons: {apt: {packages: [libfcgi-dev,libgmp-dev]}}
 matrix:
   include:
-  # We grab the appropriate GHC and cabal-install versions from hvr's PPA. See:
-  # https://github.com/hvr/multi-ghc-travis
-  #- env: BUILD=cabal GHCVER=7.0.4 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7
-  #  compiler: ": #GHC 7.0.4"
-  #  addons: {apt: {packages: [cabal-install-1.16,ghc-7.0.4,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
-  #- env: BUILD=cabal GHCVER=7.2.2 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7
-  #  compiler: ": #GHC 7.2.2"
-  #  addons: {apt: {packages: [cabal-install-1.16,ghc-7.2.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
-  #- env: BUILD=cabal GHCVER=7.4.2 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7
-  #  compiler: ": #GHC 7.4.2"
-  #  addons: {apt: {packages: [cabal-install-1.16,ghc-7.4.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
-  #- env: BUILD=cabal GHCVER=7.6.3 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7
-  #  compiler: ": #GHC 7.6.3"
-  #  addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
-  #- env: BUILD=cabal GHCVER=7.8.4 CABALVER=1.18 HAPPYVER=1.19.5 ALEXVER=3.1.7
-  #  compiler: ": #GHC 7.8.4"
-  #  addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
-  #- env: BUILD=cabal GHCVER=7.10.3 CABALVER=1.22 HAPPYVER=1.19.5 ALEXVER=3.1.7
-  #  compiler: ": #GHC 7.10.3"
-  #  addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
   
   ##### OSX test via stack #####
 
@@ -79,6 +59,9 @@ matrix:
   - env: BUILD=cabal GHCVER=8.4.3 CABALVER=1.24 HAPPYVER=1.19.5 ALEXVER=3.1.7
     compiler: ": #cabal 8.4.3"
     addons: {apt: {packages: [cabal-install-1.24,ghc-8.4.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
+  - env: BUILD=cabal GHCVER=8.6.1 CABALVER=1.24 HAPPYVER=1.19.5 ALEXVER=3.1.7
+    compiler: ": #cabal 8.6.1"
+    addons: {apt: {packages: [cabal-install-1.24,ghc-8.6.1,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
 
   # Build with the newest GHC and cabal-install. This is an accepted failure,
   # see below.
@@ -106,18 +89,6 @@ matrix:
     compiler: ": #stack default"
     addons: {apt: {packages: [libgmp-dev]}}
 
-  #- env: BUILD=stack ARGS="--resolver lts-2"
-  #  compiler: ": #stack 7.8.4"
-  #  addons: {apt: {packages: [libgmp-dev]}}
-  #- env: BUILD=stack ARGS="--resolver lts-3"
-  #  compiler: ": #stack 7.10.2"
-  #  addons: {apt: {packages: [libgmp-dev]}}
-  #- env: BUILD=stack ARGS="--resolver lts-6"
-  #  compiler: ": #stack 7.10.3"
-  #  addons: {apt: {packages: [libgmp-dev]}}
-  #- env: BUILD=stack ARGS="--resolver lts-7"
-  #  compiler: ": #stack 8.0.1"
-  #  addons: {apt: {packages: [libgmp-dev]}}
   - env: BUILD=stack ARGS="--stack-yaml stack-8.0.2.yaml"
     compiler: ": #stack 8.0.2"
     addons: {apt: {packages: [libgmp-dev]}}
@@ -130,27 +101,6 @@ matrix:
     compiler: ": #stack nightly"
     addons: {apt: {packages: [libgmp-dev]}}
 
-  # Travis includes an macOS which is incompatible with GHC 7.8.4
-  #- env: BUILD=stack ARGS="--resolver lts-2"
-  #  compiler: ": #stack 7.8.4 osx"
-  #  os: osx
-
-  #- env: BUILD=stack ARGS="--resolver lts-3"
-  #  compiler: ": #stack 7.10.2 osx"
-  #  os: osx
-  #- env: BUILD=stack ARGS="--resolver lts-6"
-  #  compiler: ": #stack 7.10.3 osx"
-  #  os: osx
-  #- env: BUILD=stack ARGS="--resolver lts-7"
-  #  compiler: ": #stack 8.0.1 osx"
-  #  os: osx
-  #- env: BUILD=stack ARGS="--resolver lts-8"
-  #  compiler: ": #stack 8.0.2 osx"
-  #  os: osx
-  #- env: BUILD=stack ARGS="--resolver nightly"
-  #  compiler: ": #stack nightly osx"
-  #  os: osx
-
   allow_failures:
   #- env: BUILD=cabal GHCVER=head  CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7
   - env: BUILD=stack ARGS="--resolver nightly"

brittany.cabal

@@ -83,12 +83,12 @@ library {
     -fno-warn-redundant-constraints
   }
   build-depends:
-    { base >=4.9 && <4.12
+    { base >=4.9 && <4.13
-    , ghc >=8.0.1 && <8.5
+    , ghc >=8.0.1 && <8.7
     , ghc-paths >=0.1.0.9 && <0.2
     , ghc-exactprint >=0.5.8 && <0.5.9
     , transformers >=0.5.2.0 && <0.6
-    , containers >=0.5.7.1 && <0.6
+    , containers >=0.5.7.1 && <0.7
     , mtl >=2.2.1 && <2.3
     , text >=1.2 && <1.3
     , multistate >=0.7.1.1 && <0.9
@@ -111,7 +111,7 @@ library {
     , semigroups >=0.18.2 && <0.19
     , cmdargs >=0.10.14 && <0.11
     , czipwith >=1.0.1.0 && <1.1
-    , ghc-boot-th >=8.0.1 && <8.5
+    , ghc-boot-th >=8.0.1 && <8.7
     , filepath >=1.4.1.0 && <1.5
     , random >= 1.1 && <1.2
     }

src/Language/Haskell/Brittany/Internal.hs

@@ -487,10 +487,17 @@ ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do
 
 
 getDeclBindingNames :: LHsDecl GhcPs -> [String]
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+getDeclBindingNames (L _ decl) = case decl of
+  SigD _ (TypeSig _ ns _) -> ns <&> \(L _ n) -> Text.unpack (rdrNameToText n)
+  ValD _ (FunBind _ (L _ n) _ _ _) -> [Text.unpack $ rdrNameToText n]
+  _                              -> []
+#else
 getDeclBindingNames (L _ decl) = case decl of
   SigD (TypeSig ns _) -> ns <&> \(L _ n) -> Text.unpack (rdrNameToText n)
   ValD (FunBind (L _ n) _ _ _ _) -> [Text.unpack $ rdrNameToText n]
   _                              -> []
+#endif
 
 
 -- Prints the information associated with the module annotation
@@ -564,15 +571,26 @@ ppPreamble lmod@(L loc m@(HsModule _ _ _ _ _ _)) = do
 
 _sigHead :: Sig GhcPs -> String
 _sigHead = \case
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+  TypeSig _ names _ ->
+#else
   TypeSig names _ ->
+#endif
     "TypeSig " ++ intercalate "," (Text.unpack . lrdrNameToText <$> names)
   _ -> "unknown sig"
 
 _bindHead :: HsBind GhcPs -> String
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+_bindHead = \case
+  FunBind _ fId _ _ [] -> "FunBind " ++ (Text.unpack $ lrdrNameToText $ fId)
+  PatBind _ _pat _ ([], []) -> "PatBind smth"
+  _                           -> "unknown bind"
+#else
 _bindHead = \case
   FunBind fId _ _ _ [] -> "FunBind " ++ (Text.unpack $ lrdrNameToText $ fId)
   PatBind _pat _ _ _ ([], []) -> "PatBind smth"
   _                           -> "unknown bind"
+#endif
 
 
 

src/Language/Haskell/Brittany/Internal/Config.hs

@@ -231,6 +231,7 @@ cmdlineConfigParser = do
 readConfig
   :: MonadIO m => System.IO.FilePath -> MaybeT m (Maybe (CConfig Option))
 readConfig path = do
+  -- TODO: probably should catch IOErrors and then omit the existence check.
   exists <- liftIO $ System.Directory.doesFileExist path
   if exists
     then do

src/Language/Haskell/Brittany/Internal/ExactPrintUtils.hs

@@ -197,9 +197,17 @@ commentAnnFixTransform modul = SYB.everything (>>) genF modul
   genF = (\_ -> return ()) `SYB.extQ` exprF
   exprF :: Located (HsExpr GhcPs) -> ExactPrint.Transform ()
   exprF lexpr@(L _ expr) = case expr of
-    RecordCon _lname _ _ (HsRecFields fs@(_:_) Nothing) ->
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    RecordCon _ _ (HsRecFields fs@(_:_) Nothing) ->
+#else
+    RecordCon _ _ _ (HsRecFields fs@(_:_) Nothing) ->
+#endif
       moveTrailingComments lexpr (List.last fs)
-    RecordUpd _lname fs@(_:_) _ _ _ _ ->
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    RecordUpd _ _e fs@(_:_) ->
+#else
+    RecordUpd _e fs@(_:_) _cons _ _ _ ->
+#endif
       moveTrailingComments lexpr (List.last fs)
     _ -> return ()
 
@@ -280,13 +288,13 @@ withTransformedAnns
   => ast
   -> MultiRWSS.MultiRWS '[Config, ExactPrint.Anns] w s a
   -> MultiRWSS.MultiRWS '[Config, ExactPrint.Anns] w s a
-withTransformedAnns ast m = do
+withTransformedAnns ast m = MultiRWSS.mGetRawR >>= \case
-  -- TODO: implement `local` for MultiReader/MultiRWS
+  readers@(conf :+: anns :+: HNil) -> do
-  readers@(conf :+: anns :+: HNil) <- MultiRWSS.mGetRawR
+    -- TODO: implement `local` for MultiReader/MultiRWS
-  MultiRWSS.mPutRawR (conf :+: f anns :+: HNil)
+    MultiRWSS.mPutRawR (conf :+: f anns :+: HNil)
-  x <- m
+    x <- m
-  MultiRWSS.mPutRawR readers
+    MultiRWSS.mPutRawR readers
-  pure x
+    pure x
  where
   f anns =
     let ((), (annsBalanced, _), _) =

src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs

@@ -55,28 +55,43 @@ import           Data.Char (isUpper)
 
 
 layoutDecl :: ToBriDoc HsDecl
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+layoutDecl d@(L loc decl) = case decl of
+  SigD _ sig  -> withTransformedAnns d $ layoutSig (L loc sig)
+  ValD _ bind -> withTransformedAnns d $ layoutBind (L loc bind) >>= \case
+    Left  ns -> docLines $ return <$> ns
+    Right n  -> return n
+  TyClD _ tycl           -> withTransformedAnns d $ layoutTyCl (L loc tycl)
+  InstD _ (TyFamInstD{}) -> layoutTyFamInstDWorkaround d
+  InstD _ (ClsInstD _ inst) ->
+    withTransformedAnns d $ layoutClsInst (L loc inst)
+  _ -> briDocByExactNoComment d
+#else
 layoutDecl d@(L loc decl) = case decl of
   SigD sig  -> withTransformedAnns d $ layoutSig (L loc sig)
   ValD bind -> withTransformedAnns d $ layoutBind (L loc bind) >>= \case
     Left  ns -> docLines $ return <$> ns
     Right n  -> return n
   TyClD tycl -> withTransformedAnns d $ layoutTyCl (L loc tycl)
-  InstD (TyFamInstD{}) -> do
+  InstD (TyFamInstD{}) -> layoutTyFamInstDWorkaround d
-    -- this is a (temporary (..)) workaround for "type instance" decls
-    -- that do not round-trip through exactprint properly.
-    let fixer s = case List.stripPrefix "type " s of
-          Just rest | not ("instance" `isPrefixOf` rest) ->
-            "type instance " ++ rest
-          _ -> s
-    str <- mAsk <&> \anns ->
-      intercalate "\n" $ fmap fixer $ lines' $ ExactPrint.exactPrint d anns
-    allocateNode $ BDFExternal (ExactPrint.mkAnnKey d)
-                               (foldedAnnKeys d)
-                               False
-                               (Text.pack str)
   InstD (ClsInstD inst) -> withTransformedAnns d $ layoutClsInst (L loc inst)
-  _ -> briDocByExactNoComment d
+  _                    -> briDocByExactNoComment d
+#endif
 
+layoutTyFamInstDWorkaround :: ToBriDoc HsDecl
+layoutTyFamInstDWorkaround d = do
+  -- this is a (temporary (..)) workaround for "type instance" decls
+  -- that do not round-trip through exactprint properly.
+  let fixer s = case List.stripPrefix "type " s of
+        Just rest | not ("instance" `isPrefixOf` rest) ->
+          "type instance " ++ rest
+        _ -> s
+  str <- mAsk <&> \anns ->
+    intercalate "\n" $ fmap fixer $ lines' $ ExactPrint.exactPrint d anns
+  allocateNode $ BDFExternal (ExactPrint.mkAnnKey d)
+                             (foldedAnnKeys d)
+                             False
+                             (Text.pack str)
 
 --------------------------------------------------------------------------------
 -- Sig
@@ -84,12 +99,18 @@ layoutDecl d@(L loc decl) = case decl of
 
 layoutSig :: ToBriDoc Sig
 layoutSig lsig@(L _loc sig) = case sig of
-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+  TypeSig _ names (HsWC _ (HsIB _ typ)) -> layoutNamesAndType names typ
+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4 */
   TypeSig names (HsWC _ (HsIB _ typ _)) -> layoutNamesAndType names typ
 #else /* ghc-8.0 */
   TypeSig names (HsIB _ (HsWC _ _ typ)) -> layoutNamesAndType names typ
 #endif
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+  InlineSig _ name (InlinePragma _ spec _arity phaseAct conlike) ->
+#else
   InlineSig name (InlinePragma _ spec _arity phaseAct conlike) ->
+#endif
     docWrapNode lsig $ do
       nameStr <- lrdrNameToTextAnn name
       specStr <- specStringCompat lsig spec
@@ -106,7 +127,9 @@ layoutSig lsig@(L _loc sig) = case sig of
         $  Text.pack ("{-# " ++ specStr ++ conlikeStr ++ phaseStr)
         <> nameStr
         <> Text.pack " #-}"
-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
+#if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */
+  ClassOpSig _ False names (HsIB _ typ) -> layoutNamesAndType names typ
+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4 */
   ClassOpSig False names (HsIB _ typ _) -> layoutNamesAndType names typ
 #else /* ghc-8.0 */
   ClassOpSig False names (HsIB _ typ) -> layoutNamesAndType names typ
@@ -152,7 +175,6 @@ layoutSig lsig@(L _loc sig) = case sig of
                )
              ]
 
-
 specStringCompat
   :: MonadMultiWriter [BrittanyError] m => LSig GhcPs -> InlineSpec -> m String
 #if MIN_VERSION_ghc(8,4,0)
@@ -171,8 +193,16 @@ specStringCompat _ = \case
 
 layoutGuardLStmt :: ToBriDoc' (Stmt GhcPs (LHsExpr GhcPs))
 layoutGuardLStmt lgstmt@(L _ stmtLR) = docWrapNode lgstmt $ case stmtLR of
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+  BodyStmt _ body _ _      -> layoutExpr body
+#else
   BodyStmt body _ _ _      -> layoutExpr body
+#endif
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+  BindStmt _ lPat expr _ _ -> do
+#else
   BindStmt lPat expr _ _ _ -> do
+#endif
     patDoc <- docSharedWrapper layoutPat lPat
     expDoc <- docSharedWrapper layoutExpr expr
     docCols ColBindStmt
@@ -191,7 +221,11 @@ layoutBind
        (HsBindLR GhcPs GhcPs)
        (Either [BriDocNumbered] BriDocNumbered)
 layoutBind lbind@(L _ bind) = case bind of
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+  FunBind _ fId (MG _ lmatches@(L _ matches) _) _ [] -> do
+#else
   FunBind fId (MG lmatches@(L _ matches) _ _ _) _ _ [] -> do
+#endif
     idStr       <- lrdrNameToTextAnn fId
     binderDoc   <- docLit $ Text.pack "="
     funcPatDocs <-
@@ -200,7 +234,11 @@ layoutBind lbind@(L _ bind) = case bind of
         $      layoutPatternBind (Just idStr) binderDoc
         `mapM` matches
     return $ Left $ funcPatDocs
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+  PatBind _ pat (GRHSs _ grhss whereBinds) ([], []) -> do
+#else
   PatBind pat (GRHSs grhss whereBinds) _ _ ([], []) -> do
+#endif
     patDocs    <- colsWrapPat =<< layoutPat pat
     clauseDocs <- layoutGrhs `mapM` grhss
     mWhereDocs <- layoutLocalBinds whereBinds
@@ -229,7 +267,11 @@ layoutLocalBinds lbinds@(L _ binds) = case binds of
   --   Just . (>>= either id return) . Data.Foldable.toList <$> mapBagM layoutBind lhsBindsLR -- TODO: fix ordering
   -- x@(HsValBinds (ValBindsIn{})) ->
   --   Just . (:[]) <$> unknownNodeError "HsValBinds (ValBindsIn _ (_:_))" x
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+  HsValBinds _ (ValBinds _ bindlrs sigs) -> do
+#else
   HsValBinds (ValBindsIn bindlrs sigs) -> do
+#endif
     let unordered =
           [ BagBind b | b <- Data.Foldable.toList bindlrs ]
             ++ [ BagSig s | s <- sigs ]
@@ -238,23 +280,36 @@ layoutLocalBinds lbinds@(L _ binds) = case binds of
       BagBind b -> either id return <$> layoutBind b
       BagSig  s -> return <$> layoutSig s
     return $ Just $ docs
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+--  x@(HsValBinds (ValBindsOut _binds _lsigs)) ->
+  HsValBinds _ (XValBindsLR{}) -> error "brittany internal error: XValBindsLR"
+  XHsLocalBindsLR{} -> error "brittany internal error: XHsLocalBindsLR"
+#else
   x@(HsValBinds (ValBindsOut _binds _lsigs)) ->
     -- i _think_ this case never occurs in non-processed ast
     Just . (: []) <$> unknownNodeError "HsValBinds ValBindsOut{}"
                                        (L noSrcSpan x)
-  x@(HsIPBinds _ipBinds) ->
+#endif
+  x@(HsIPBinds{}) ->
     Just . (: []) <$> unknownNodeError "HsIPBinds" (L noSrcSpan x)
-  EmptyLocalBinds -> return $ Nothing
+  EmptyLocalBinds{} -> return $ Nothing
 
 -- TODO: we don't need the `LHsExpr GhcPs` anymore, now that there is
 -- parSpacing stuff.B
 layoutGrhs
   :: LGRHS GhcPs (LHsExpr GhcPs)
   -> ToBriDocM ([BriDocNumbered], BriDocNumbered, LHsExpr GhcPs)
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+layoutGrhs lgrhs@(L _ (GRHS _ guards body)) = do
+#else
 layoutGrhs lgrhs@(L _ (GRHS guards body)) = do
+#endif
   guardDocs <- docWrapNode lgrhs $ layoutStmt `mapM` guards
   bodyDoc   <- layoutExpr body
   return (guardDocs, bodyDoc, body)
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+layoutGrhs (L _ (XGRHS{})) = error "brittany internal error: XGRHS"
+#endif
 
 layoutPatternBind
   :: Maybe Text
@@ -263,7 +318,11 @@ layoutPatternBind
   -> ToBriDocM BriDocNumbered
 layoutPatternBind mIdStr binderDoc lmatch@(L _ match) = do
   let pats                     = m_pats match
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+  let (GRHSs _ grhss whereBinds) = m_grhss match
+#else
   let (GRHSs grhss whereBinds) = m_grhss match
+#endif
   patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p
   let isInfix = isInfixMatch match
   let mIdStr' = fixPatternBindIdentifier match <$> mIdStr
@@ -629,7 +688,12 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
 
 layoutTyCl :: ToBriDoc TyClDecl
 layoutTyCl ltycl@(L _loc tycl) = case tycl of
-#if MIN_VERSION_ghc(8,2,0)
+#if MIN_VERSION_ghc(8,6,0)
+  SynDecl _ name vars fixity typ -> do
+    let isInfix = case fixity of
+          Prefix -> False
+          Infix  -> True
+#elif MIN_VERSION_ghc(8,2,0)
   SynDecl name vars fixity typ _ -> do
     let isInfix = case fixity of
           Prefix -> False
@@ -700,10 +764,19 @@ layoutSynDecl isInfix wrapNodeRest name vars typ = do
 layoutTyVarBndr :: Bool -> ToBriDoc HsTyVarBndr
 layoutTyVarBndr needsSep lbndr@(L _ bndr) = do
   docWrapNodePrior lbndr $ case bndr of
+#if MIN_VERSION_ghc(8,6,0)    /* 8.6 */
+    XTyVarBndr{} -> error "brittany internal error: XTyVarBndr"
+    UserTyVar _ name -> do
+#else                         /* 8.0 8.2 8.4 */
     UserTyVar name -> do
+#endif
       nameStr <- lrdrNameToTextAnn name
       docSeq $ [docSeparator | needsSep] ++ [docLit nameStr]
+#if MIN_VERSION_ghc(8,6,0)    /* 8.6 */
+    KindedTyVar _ name kind -> do
+#else                         /* 8.0 8.2 8.4 */
     KindedTyVar name kind -> do
+#endif
       nameStr <- lrdrNameToTextAnn name
       docSeq
         $  [ docSeparator | needsSep ]
@@ -736,8 +809,21 @@ layoutClsInst lcid@(L _ cid) = docLines
   ]
  where
   layoutInstanceHead :: ToBriDocM BriDocNumbered
+#if MIN_VERSION_ghc(8,6,0)    /* 8.6 */
   layoutInstanceHead =
-    briDocByExactNoComment $ InstD . ClsInstD . removeChildren <$> lcid
+    briDocByExactNoComment
+      $   InstD NoExt
+      .   ClsInstD NoExt
+      .   removeChildren
+      <$> lcid
+#else
+  layoutInstanceHead =
+    briDocByExactNoComment
+      $   InstD
+      .   ClsInstD
+      .   removeChildren
+      <$> lcid
+#endif
 
   removeChildren :: ClsInstDecl p -> ClsInstDecl p
   removeChildren c = c

src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs

@@ -37,9 +37,17 @@ layoutExpr lexpr@(L _ expr) = do
     .>  confUnpack
   let allowFreeIndent = indentPolicy == IndentPolicyFree
   docWrapNode lexpr $ case expr of
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    HsVar _ vname -> do
+#else
     HsVar vname -> do
+#endif
       docLit =<< lrdrNameToTextAnn vname
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    HsUnboundVar _ var -> case var of
+#else
     HsUnboundVar var -> case var of
+#endif
       OutOfScope oname _ -> docLit $ Text.pack $ occNameString oname
       TrueExprHole oname -> docLit $ Text.pack $ occNameString oname
     HsRecFld{} -> do
@@ -51,15 +59,35 @@ layoutExpr lexpr@(L _ expr) = do
     HsIPVar{} -> do
       -- TODO
       briDocByExactInlineOnly "HsOverLabel{}" lexpr
-    HsOverLit (OverLit olit _ _ _) -> do
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
-      allocateNode $ overLitValBriDoc olit
+    HsOverLit _ olit -> do
+#else
+    HsOverLit olit -> do
+#endif
+      allocateNode $ overLitValBriDoc $ ol_val olit
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    HsLit _ lit -> do
+#else
     HsLit lit -> do
+#endif
       allocateNode $ litBriDoc lit
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    HsLam _ (MG _ (L _ [lmatch@(L _ match)]) _)
+#else
     HsLam (MG (L _ [lmatch@(L _ match)]) _ _ _)
+#endif
       |  pats                  <- m_pats match
-      ,  GRHSs [lgrhs] llocals <- m_grhss match
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
-      ,  L _ EmptyLocalBinds   <- llocals
+      ,  GRHSs _ [lgrhs] llocals <- m_grhss match
-      ,  L _ (GRHS [] body)    <- lgrhs
+#else
+      ,  GRHSs [lgrhs] llocals  <- m_grhss match
+#endif
+      ,  L _ EmptyLocalBinds {} <- llocals
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+      ,  L _ (GRHS _ [] body)     <- lgrhs
+#else
+      ,  L _ (GRHS [] body)     <- lgrhs
+#endif
       -> do
       patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p
       bodyDoc <- docAddBaseY BrIndentRegular <$> docSharedWrapper layoutExpr body
@@ -105,9 +133,13 @@ layoutExpr lexpr@(L _ expr) = do
         ]
     HsLam{} ->
       unknownNodeError "HsLam too complex" lexpr
-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    HsLamCase _ XMatchGroup{} ->
+      error "brittany internal error: HsLamCase XMatchGroup"
+    HsLamCase _ (MG _ lmatches@(L _ matches) _) -> do
+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4*/
     HsLamCase (MG lmatches@(L _ matches) _ _ _) -> do
-#else /* ghc-8.0 */
+#else                        /* ghc-8.0 */
     HsLamCase _ (MG lmatches@(L _ matches) _ _ _) -> do
 #endif
       binderDoc   <- docLit $ Text.pack "->"
@@ -116,14 +148,26 @@ layoutExpr lexpr@(L _ expr) = do
       docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
         (docLit $ Text.pack "\\case")
         (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs)
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    HsApp _ exp1@(L _ HsApp{}) exp2 -> do
+#else
     HsApp exp1@(L _ HsApp{}) exp2 -> do
+#endif
       let gather :: [LHsExpr GhcPs] -> LHsExpr GhcPs -> (LHsExpr GhcPs, [LHsExpr GhcPs])
           gather list = \case
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+            L _ (HsApp _ l r) -> gather (r:list) l
+#else
             L _ (HsApp l r) -> gather (r:list) l
+#endif
             x               -> (x, list)
       let (headE, paramEs) = gather [exp2] exp1
       let colsOrSequence = case headE of
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+            L _ (HsVar _ (L _ (Unqual occname))) ->
+#else
             L _ (HsVar (L _ (Unqual occname))) ->
+#endif
               docCols (ColApp $ Text.pack $ occNameString occname)
             _ -> docSeq
       headDoc <- docSharedWrapper layoutExpr headE
@@ -168,7 +212,11 @@ layoutExpr lexpr@(L _ expr) = do
             ( docNonBottomSpacing
             $ docLines paramDocs
             )
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    HsApp _ exp1 exp2 -> do
+#else
     HsApp exp1 exp2 -> do
+#endif
       -- TODO: if expDoc1 is some literal, we may want to create a docCols here.
       expDoc1 <- docSharedWrapper layoutExpr exp1
       expDoc2 <- docSharedWrapper layoutExpr exp2
@@ -206,9 +254,13 @@ layoutExpr lexpr@(L _ expr) = do
           expDoc1
           expDoc2
         ]
-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    HsAppType XHsWildCardBndrs{} _ ->
+      error "brittany internal error: HsAppType XHsWildCardBndrs"
+    HsAppType (HsWC _ ty1) exp1 -> do
+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4 */
     HsAppType exp1 (HsWC _ ty1) -> do
-#else /* ghc-8.0 */
+#else                        /* ghc-8.0 */
     HsAppType exp1 (HsWC _ _ ty1) -> do
 #endif
       t <- docSharedWrapper layoutType ty1
@@ -224,13 +276,23 @@ layoutExpr lexpr@(L _ expr) = do
             e
             (docSeq [docLit $ Text.pack "@", t ])
         ]
+#if !MIN_VERSION_ghc(8,6,0)   /* ghc-8.0 8.2 8.4 */
     HsAppTypeOut{} -> do
       -- TODO
       briDocByExactInlineOnly "HsAppTypeOut{}" lexpr
+#endif
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    OpApp _ expLeft@(L _ OpApp{}) expOp expRight -> do
+#else
     OpApp expLeft@(L _ OpApp{}) expOp _ expRight -> do
+#endif
       let gather :: [(LHsExpr GhcPs, LHsExpr GhcPs)] -> LHsExpr GhcPs -> (LHsExpr GhcPs, [(LHsExpr GhcPs, LHsExpr GhcPs)])
           gather opExprList = \case
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+            (L _ (OpApp _ l1 op1 r1)) -> gather ((op1, r1): opExprList) l1
+#else
             (L _ (OpApp l1 op1 _ r1)) -> gather ((op1, r1): opExprList) l1
+#endif
             final -> (final, opExprList)
           (leftOperand, appList) = gather [] expLeft
       leftOperandDoc <- docSharedWrapper layoutExpr leftOperand
@@ -244,11 +306,19 @@ layoutExpr lexpr@(L _ expr) = do
         hasComLeft <- hasAnyCommentsConnected expLeft
         hasComOp   <- hasAnyCommentsConnected expOp
         pure $ not hasComLeft && not hasComOp
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+      let allowPar = case (expOp, expRight) of
+            (L _ (HsVar _ (L _ (Unqual occname))), _)
+              | occNameString occname == "$" -> True
+            (_, L _ (HsApp _ _ (L _ HsVar{}))) -> False
+            _ -> True
+#else
       let allowPar = case (expOp, expRight) of
             (L _ (HsVar (L _ (Unqual occname))), _)
               | occNameString occname == "$" -> True
             (_, L _ (HsApp _ (L _ HsVar{}))) -> False
             _ -> True
+#endif
       runFilteredAlternative $ do
         -- > one + two + three
         -- or
@@ -286,15 +356,27 @@ layoutExpr lexpr@(L _ expr) = do
             $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed])
               ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]]
             )
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    OpApp _ expLeft expOp expRight -> do
+#else
     OpApp expLeft expOp _ expRight -> do
+#endif
       expDocLeft  <- docSharedWrapper layoutExpr expLeft
       expDocOp    <- docSharedWrapper layoutExpr expOp
       expDocRight <- docSharedWrapper layoutExpr expRight
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+      let allowPar = case (expOp, expRight) of
+            (L _ (HsVar _ (L _ (Unqual occname))), _)
+              | occNameString occname == "$" -> True
+            (_, L _ (HsApp _ _ (L _ HsVar{}))) -> False
+            _ -> True
+#else
       let allowPar = case (expOp, expRight) of
             (L _ (HsVar (L _ (Unqual occname))), _)
               | occNameString occname == "$" -> True
             (_, L _ (HsApp _ (L _ HsVar{}))) -> False
             _ -> True
+#endif
       runFilteredAlternative $ do
         -- one-line
         addAlternative
@@ -334,12 +416,20 @@ layoutExpr lexpr@(L _ expr) = do
           $ docPar
               expDocLeft
               (docCols ColOpPrefix [appSep expDocOp, docSetBaseY expDocRight])
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    NegApp _ op _ -> do
+#else
     NegApp op _ -> do
+#endif
       opDoc <- docSharedWrapper layoutExpr op
       docSeq [ docLit $ Text.pack "-"
              , opDoc
              ]
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    HsPar _ innerExp -> do
+#else
     HsPar innerExp -> do
+#endif
       innerExpDoc <- docSharedWrapper (docWrapNode lexpr . layoutExpr) innerExp
       docAlt
         [ docSeq
@@ -355,18 +445,37 @@ layoutExpr lexpr@(L _ expr) = do
           , docLit $ Text.pack ")"
           ]
         ]
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    SectionL _ left op -> do -- TODO: add to testsuite
+#else
     SectionL left op -> do -- TODO: add to testsuite
+#endif
       leftDoc <- docSharedWrapper layoutExpr left
       opDoc   <- docSharedWrapper layoutExpr op
       docSeq [leftDoc, docSeparator, opDoc]
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    SectionR _ op right -> do -- TODO: add to testsuite
+#else
     SectionR op right -> do -- TODO: add to testsuite
+#endif
       opDoc    <- docSharedWrapper layoutExpr op
       rightDoc <- docSharedWrapper layoutExpr right
       docSeq [opDoc, docSeparator, rightDoc]
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    ExplicitTuple _ args boxity -> do
+#else
     ExplicitTuple args boxity -> do
+#endif
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+      let argExprs = args <&> \arg -> case arg of
+            (L _ (Present _ e)) -> (arg, Just e);
+            (L _ (Missing NoExt)) -> (arg, Nothing)
+            (L _ XTupArg{}) -> error "brittany internal error: XTupArg"
+#else
       let argExprs = args <&> \arg -> case arg of
             (L _ (Present e)) -> (arg, Just e);
             (L _ (Missing PlaceHolder)) -> (arg, Nothing)
+#endif
       argDocs <- forM argExprs
         $ docSharedWrapper
         $ \(arg, exprM) -> docWrapNode arg $ maybe docEmpty layoutExpr exprM
@@ -408,7 +517,13 @@ layoutExpr lexpr@(L _ expr) = do
               lineN = docCols ColTuples [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) eN]
               end   = closeLit
             in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN, end]
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    HsCase _ _ XMatchGroup{} ->
+      error "brittany internal error: HsCase XMatchGroup"
+    HsCase _ cExp (MG _ lmatches@(L _ matches) _) -> do
+#else
     HsCase cExp (MG lmatches@(L _ matches) _ _ _) -> do
+#endif
       cExpDoc <- docSharedWrapper layoutExpr cExp
       binderDoc <- docLit $ Text.pack "->"
       funcPatDocs <- docWrapNode lmatches
@@ -432,7 +547,11 @@ layoutExpr lexpr@(L _ expr) = do
               (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs)
             )
         ]
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    HsIf _ _ ifExpr thenExpr elseExpr -> do
+#else
     HsIf _ ifExpr thenExpr elseExpr -> do
+#endif
       ifExprDoc   <- docSharedWrapper layoutExpr ifExpr
       thenExprDoc <- docSharedWrapper layoutExpr thenExpr
       elseExprDoc <- docSharedWrapper layoutExpr elseExpr
@@ -552,7 +671,11 @@ layoutExpr lexpr@(L _ expr) = do
       docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
         (docLit $ Text.pack "if")
         (layoutPatternBindFinal Nothing binderDoc Nothing clauseDocs Nothing hasComments)
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    HsLet _ binds exp1 -> do
+#else
     HsLet binds exp1 -> do
+#endif
       expDoc1   <- docSharedWrapper layoutExpr exp1
       -- We jump through some ugly hoops here to ensure proper sharing.
       mBindDocs <- mapM (fmap (fmap return) . docWrapNodeRest lexpr . return)
@@ -655,60 +778,65 @@ layoutExpr lexpr@(L _ expr) = do
             ]
         _ -> docSeq [appSep $ docLit $ Text.pack "let in", expDoc1]
       -- docSeq [appSep $ docLit "let in", expDoc1]
-    HsDo DoExpr (L _ stmts) _ -> do
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
-      stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
+    HsDo _ stmtCtx (L _ stmts) -> case stmtCtx of
-      docSetParSpacing
+#else
-        $ docAddBaseY BrIndentRegular
+    HsDo stmtCtx (L _ stmts) _ -> case stmtCtx of
-        $ docPar
+#endif
-            (docLit $ Text.pack "do")
+      DoExpr -> do
-            (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs)
+        stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
-    HsDo MDoExpr (L _ stmts) _ -> do
+        docSetParSpacing
-      stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
+          $ docAddBaseY BrIndentRegular
-      docSetParSpacing
+          $ docPar
-        $ docAddBaseY BrIndentRegular
+              (docLit $ Text.pack "do")
-        $ docPar
+              (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs)
-            (docLit $ Text.pack "mdo")
+      MDoExpr -> do
-            (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs)
+        stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
-    HsDo x  (L _ stmts) _ | case x of { ListComp -> True
+        docSetParSpacing
-                                      ; MonadComp -> True
+          $ docAddBaseY BrIndentRegular
-                                      ; _ -> False } -> do
+          $ docPar
-      stmtDocs    <- docSharedWrapper layoutStmt `mapM` stmts
+              (docLit $ Text.pack "mdo")
-      hasComments <- hasAnyCommentsBelow lexpr
+              (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs)
-      runFilteredAlternative $ do
+      x | case x of { ListComp -> True
-        addAlternativeCond (not hasComments)
+                    ; MonadComp -> True
-          $ docSeq
+                    ; _ -> False } -> do
-          [ docNodeAnnKW lexpr Nothing
+        stmtDocs    <- docSharedWrapper layoutStmt `mapM` stmts
-          $ appSep
+        hasComments <- hasAnyCommentsBelow lexpr
-          $ docLit
+        runFilteredAlternative $ do
-          $ Text.pack "["
+          addAlternativeCond (not hasComments)
-          , docNodeAnnKW lexpr (Just AnnOpenS)
+            $ docSeq
-          $ appSep
+            [ docNodeAnnKW lexpr Nothing
-          $ docForceSingleline
+            $ appSep
-          $ List.last stmtDocs
+            $ docLit
-          , appSep $ docLit $ Text.pack "|"
+            $ Text.pack "["
-          , docSeq $ List.intersperse docCommaSep
+            , docNodeAnnKW lexpr (Just AnnOpenS)
-          $ docForceSingleline <$> List.init stmtDocs
+            $ appSep
-          , docLit $ Text.pack " ]"
+            $ docForceSingleline
-          ]
+            $ List.last stmtDocs
-        addAlternative $
+            , appSep $ docLit $ Text.pack "|"
-          let
+            , docSeq $ List.intersperse docCommaSep
-            start = docCols ColListComp
+            $ docForceSingleline <$> List.init stmtDocs
-                      [ docNodeAnnKW lexpr Nothing
+            , docLit $ Text.pack " ]"
-                      $ appSep $ docLit $ Text.pack "["
+            ]
-                      , docSetBaseY
+          addAlternative $
-                      $ docNodeAnnKW lexpr (Just AnnOpenS)
+            let
-                      $ List.last stmtDocs
+              start = docCols ColListComp
-                      ]
+                        [ docNodeAnnKW lexpr Nothing
-            (s1:sM) = List.init stmtDocs
+                        $ appSep $ docLit $ Text.pack "["
-            line1 = docCols ColListComp
+                        , docSetBaseY
-                      [appSep $ docLit $ Text.pack "|", s1]
+                        $ docNodeAnnKW lexpr (Just AnnOpenS)
-            lineM = sM <&> \d ->
+                        $ List.last stmtDocs
-                    docCols ColListComp [docCommaSep, d]
+                        ]
-            end   = docLit $ Text.pack "]"
+              (s1:sM) = List.init stmtDocs
-          in docSetBaseY $ docLines $ [start, line1] ++ lineM ++ [end]
+              line1 = docCols ColListComp
-    HsDo{} -> do
+                        [appSep $ docLit $ Text.pack "|", s1]
-      -- TODO
+              lineM = sM <&> \d ->
-      unknownNodeError "HsDo{} no comp" lexpr
+                      docCols ColListComp [docCommaSep, d]
+              end   = docLit $ Text.pack "]"
+            in docSetBaseY $ docLines $ [start, line1] ++ lineM ++ [end]
+      _ -> do
+        -- TODO
+        unknownNodeError "HsDo{} unknown stmtCtx" lexpr
     ExplicitList _ _ elems@(_:_) -> do
       elemDocs    <- elems `forM` docSharedWrapper layoutExpr
       hasComments <- hasAnyCommentsBelow lexpr
@@ -749,80 +877,101 @@ layoutExpr lexpr@(L _ expr) = do
             in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end]
     ExplicitList _ _ [] ->
       docLit $ Text.pack "[]"
+#if !MIN_VERSION_ghc(8,6,0)  /* ghc-8.0 8.2 8.4 */
     ExplicitPArr{} -> do
       -- TODO
       briDocByExactInlineOnly "ExplicitPArr{}" lexpr
-    RecordCon lname _ _ (HsRecFields fields Nothing) -> do
+#endif
-      let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
-      rFs <- fields
+    RecordCon _ lname fields ->
-        `forM` \lfield@(L _ (HsRecField (L _ (FieldOcc lnameF _)) rFExpr pun)) -> do
+#else
-          rFExpDoc <- if pun
+    RecordCon lname _ _ fields ->
-            then return Nothing
+#endif
-            else Just <$> docSharedWrapper layoutExpr rFExpr
+      case fields of
-          return $ (lfield, lrdrNameToText lnameF, rFExpDoc)
+        HsRecFields fs Nothing -> do
-      recordExpression indentPolicy lexpr nameDoc rFs
+          let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname
-
+          rFs <- fs
-    RecordCon lname _ _ (HsRecFields [] (Just 0)) -> do
+            `forM` \lfield@(L _ (HsRecField (L _ fieldOcc) rFExpr pun)) -> do
-      let t = lrdrNameToText lname
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
-      docWrapNode lname $ docLit $ t <> Text.pack " { .. }"
+              let FieldOcc _ lnameF = fieldOcc
-    RecordCon lname _ _ (HsRecFields fs@(_:_) (Just dotdoti)) | dotdoti == length fs -> do
+#else
-      -- TODO this should be consolidated into `recordExpression`
+              let FieldOcc lnameF _ = fieldOcc
-      let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname
+#endif
-      ((fd1l, fd1n, fd1e):fdr) <- fs `forM` \fieldl@(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr pun)) -> do
+              rFExpDoc <- if pun
-        fExpDoc <- if pun
+                then return Nothing
-          then return Nothing
+                else Just <$> docSharedWrapper layoutExpr rFExpr
-          else Just <$> docSharedWrapper layoutExpr fExpr
+              return $ (lfield, lrdrNameToText lnameF, rFExpDoc)
-        return (fieldl, lrdrNameToText lnameF, fExpDoc)
+          recordExpression indentPolicy lexpr nameDoc rFs
-      let line1 wrapper =
+        HsRecFields [] (Just 0) -> do
-            [ appSep $ docLit $ Text.pack "{"
+          let t = lrdrNameToText lname
-            , docWrapNodePrior fd1l $ appSep $ docLit fd1n
+          docWrapNode lname $ docLit $ t <> Text.pack " { .. }"
-            , case fd1e of
+        HsRecFields fs@(_:_) (Just dotdoti) | dotdoti == length fs -> do
-                Just x -> docSeq
+          -- TODO this should be consolidated into `recordExpression`
-                  [ appSep $ docLit $ Text.pack "="
+          let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname
-                  , docWrapNodeRest fd1l $ wrapper x
+          fieldDocs <- fs `forM` \fieldl@(L _ (HsRecField (L _ fieldOcc) fExpr pun)) -> do
-                  ]
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
-                Nothing -> docEmpty
+            let FieldOcc _ lnameF = fieldOcc
+#else
+            let FieldOcc lnameF _ = fieldOcc
+#endif
+            fExpDoc <- if pun
+              then return Nothing
+              else Just <$> docSharedWrapper layoutExpr fExpr
+            return (fieldl, lrdrNameToText lnameF, fExpDoc)
+          let ((fd1l, fd1n, fd1e):fdr) = fieldDocs
+          let line1 wrapper =
+                [ appSep $ docLit $ Text.pack "{"
+                , docWrapNodePrior fd1l $ appSep $ docLit fd1n
+                , case fd1e of
+                    Just x -> docSeq
+                      [ appSep $ docLit $ Text.pack "="
+                      , docWrapNodeRest fd1l $ wrapper x
+                      ]
+                    Nothing -> docEmpty
+                ]
+          let lineR wrapper = fdr <&> \(lfield, fText, fDoc) ->
+                [ docCommaSep
+                , appSep $ docLit fText
+                , case fDoc of
+                    Just x -> docWrapNode lfield $ docSeq
+                      [ appSep $ docLit $ Text.pack "="
+                      , wrapper x
+                      ]
+                    Nothing -> docEmpty
+                ]
+          let lineDot =
+                [ docCommaSep
+                , docLit $ Text.pack ".."
+                ]
+          let lineN =
+                [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty
+                , docLit $ Text.pack "}"
+                ]
+          docAlt -- TODO: make this addFilteredAlternative and a hanging layout when Free
+            [  docSeq
+            $  [docNodeAnnKW lexpr Nothing nameDoc, docSeparator]
+            ++ line1 docForceSingleline
+            ++ join (lineR docForceSingleline)
+            ++ lineDot
+            ++ [docSeparator]
+            ++ lineN
+            , docSetParSpacing
+            $ docAddBaseY BrIndentRegular
+            $ docPar
+                (docNodeAnnKW lexpr Nothing nameDoc)
+                ( docNonBottomSpacing
+                $ docLines
+                $  [docCols ColRec $ line1 (docAddBaseY BrIndentRegular)]
+                ++ (docCols ColRec <$> lineR (docAddBaseY BrIndentRegular))
+                ++ [docSeq lineDot, docSeq lineN]
+                )
             ]
-      let lineR wrapper = fdr <&> \(lfield, fText, fDoc) ->
+        _ -> unknownNodeError "RecordCon with puns" lexpr
-            [ docCommaSep
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
-            , appSep $ docLit fText
+    RecordUpd _ rExpr fields -> do
-            , case fDoc of
+#else
-                Just x -> docWrapNode lfield $ docSeq
-                  [ appSep $ docLit $ Text.pack "="
-                  , wrapper x
-                  ]
-                Nothing -> docEmpty
-            ]
-      let lineDot =
-            [ docCommaSep
-            , docLit $ Text.pack ".."
-            ]
-      let lineN =
-            [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty
-            , docLit $ Text.pack "}"
-            ]
-      docAlt -- TODO: make this addFilteredAlternative and a hanging layout when Free
-        [  docSeq
-        $  [docNodeAnnKW lexpr Nothing nameDoc, docSeparator]
-        ++ line1 docForceSingleline
-        ++ join (lineR docForceSingleline)
-        ++ lineDot
-        ++ [docSeparator]
-        ++ lineN
-        , docSetParSpacing
-        $ docAddBaseY BrIndentRegular
-        $ docPar
-            (docNodeAnnKW lexpr Nothing nameDoc)
-            ( docNonBottomSpacing
-            $ docLines
-            $  [docCols ColRec $ line1 (docAddBaseY BrIndentRegular)]
-            ++ (docCols ColRec <$> lineR (docAddBaseY BrIndentRegular))
-            ++ [docSeq lineDot, docSeq lineN]
-            )
-        ]
-    RecordCon{} ->
-      unknownNodeError "RecordCon with puns" lexpr
     RecordUpd rExpr fields _ _ _ _ -> do
+#endif
       rExprDoc <- docSharedWrapper layoutExpr rExpr
       rFs <- fields
         `forM` \lfield@(L _ (HsRecField (L _ ambName) rFExpr pun)) -> do
@@ -830,10 +979,23 @@ layoutExpr lexpr@(L _ expr) = do
             then return Nothing
             else Just <$> docSharedWrapper layoutExpr rFExpr
           return $ case ambName of
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+            Unambiguous _ n -> (lfield, lrdrNameToText n, rFExpDoc)
+            Ambiguous   _ n -> (lfield, lrdrNameToText n, rFExpDoc)
+            XAmbiguousFieldOcc{} ->
+              error "brittany internal error: XAmbiguousFieldOcc"
+#else
             Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)
             Ambiguous   n _ -> (lfield, lrdrNameToText n, rFExpDoc)
+#endif
       recordExpression indentPolicy lexpr rExprDoc rFs
-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    ExprWithTySig (HsWC _ XHsImplicitBndrs{}) _ ->
+      error "brittany internal error: ExprWithTySig HsWC XHsImplicitBndrs"
+    ExprWithTySig XHsWildCardBndrs{} _ ->
+      error "brittany internal error: ExprWithTySig XHsWildCardBndrs"
+    ExprWithTySig (HsWC _ (HsIB _ typ1)) exp1 -> do
+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8,4 */
     ExprWithTySig exp1 (HsWC _ (HsIB _ typ1 _)) -> do
 #else /* ghc-8.0 */
     ExprWithTySig exp1 (HsIB _ (HsWC _ _ typ1)) -> do
@@ -845,9 +1007,11 @@ layoutExpr lexpr@(L _ expr) = do
         , appSep $ docLit $ Text.pack "::"
         , typDoc
         ]
+#if !MIN_VERSION_ghc(8,6,0)  /* ghc-8.0 8.2 8.4 */
     ExprWithTySigOut{} -> do
       -- TODO
       briDocByExactInlineOnly "ExprWithTySigOut{}" lexpr
+#endif
     ArithSeq _ Nothing info ->
       case info of
         From e1 -> do
@@ -892,9 +1056,11 @@ layoutExpr lexpr@(L _ expr) = do
             ]
     ArithSeq{} ->
       briDocByExactInlineOnly "ArithSeq" lexpr
+#if !MIN_VERSION_ghc(8,6,0)  /* ghc-8.0 8.2 8.4 */
     PArrSeq{} -> do
       -- TODO
       briDocByExactInlineOnly "PArrSeq{}" lexpr
+#endif
     HsSCC{} -> do
       -- TODO
       briDocByExactInlineOnly "HsSCC{}" lexpr
@@ -936,7 +1102,11 @@ layoutExpr lexpr@(L _ expr) = do
       briDocByExactInlineOnly "HsTickPragma{}" lexpr
     EWildPat{} -> do
       docLit $ Text.pack "_"
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    EAsPat _ asName asExpr -> do
+#else
     EAsPat asName asExpr -> do
+#endif
       docSeq
         [ docLit $ lrdrNameToText asName <> Text.pack "@"
         , layoutExpr asExpr
@@ -958,6 +1128,9 @@ layoutExpr lexpr@(L _ expr) = do
       -- TODO
       briDocByExactInlineOnly "ExplicitSum{}" lexpr
 #endif
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    XExpr{} -> error "brittany internal error: XExpr"
+#endif
 
 recordExpression
   :: (Data.Data.Data lExpr, Data.Data.Data name)
@@ -1073,7 +1246,6 @@ recordExpression indentPolicy lexpr nameDoc rFs@((rF1f, rF1n, rF1e):rFr) =
             in [line1] ++ lineR ++ [lineN]
           )
 
-
 #if MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */
 litBriDoc :: HsLit GhcPs -> BriDocFInt
 litBriDoc = \case

src/Language/Haskell/Brittany/Internal/Layouters/IE.hs

@@ -39,12 +39,32 @@ prepareName = id
 
 layoutIE :: ToBriDoc IE
 layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
-  IEVar      x -> layoutWrapped lie x
+#if MIN_VERSION_ghc(8,6,0)
+  IEVar _ x -> layoutWrapped lie x
+#else
+  IEVar x -> layoutWrapped lie x
+#endif
+#if MIN_VERSION_ghc(8,6,0)
+  IEThingAbs _ x -> layoutWrapped lie x
+#else
   IEThingAbs x -> layoutWrapped lie x
+#endif
+#if MIN_VERSION_ghc(8,6,0)
+  IEThingAll _ x -> docSeq [layoutWrapped lie x, docLit $ Text.pack "(..)"]
+#else
   IEThingAll x -> docSeq [layoutWrapped lie x, docLit $ Text.pack "(..)"]
+#endif
+#if MIN_VERSION_ghc(8,6,0)
+  IEThingWith _ x (IEWildcard _) _ _ ->
+#else
   IEThingWith x (IEWildcard _) _ _ ->
+#endif
     docSeq [layoutWrapped lie x, docLit $ Text.pack "(..)"]
+#if MIN_VERSION_ghc(8,6,0)
+  IEThingWith _ x _ ns _ -> do
+#else
   IEThingWith x _ ns _ -> do
+#endif
     hasComments <- hasAnyCommentsBelow lie
     runFilteredAlternative $ do
       addAlternativeCond (not hasComments)
@@ -68,7 +88,11 @@ layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
         $  [docSeq [docParenLSep, docWrapNode n1 $ nameDoc n1]]
         ++ map layoutItem nMs
         ++ [docSeq [docCommaSep, docWrapNodeRest lie $ nameDoc nN], docParenR]
+#if MIN_VERSION_ghc(8,6,0)
+  IEModuleContents _ n -> docSeq
+#else
   IEModuleContents n -> docSeq
+#endif
     [ docLit $ Text.pack "module"
     , docSeparator
     , docLit . Text.pack . moduleNameString $ unLoc n

src/Language/Haskell/Brittany/Internal/Layouters/Import.hs

@@ -43,7 +43,11 @@ prepModName = id
 
 layoutImport :: ToBriDoc ImportDecl
 layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of
+#if MIN_VERSION_ghc(8,6,0)
+  ImportDecl _ _ (L _ modName) pkg src safe q False mas mllies -> do
+#else
   ImportDecl _ (L _ modName) pkg src safe q False mas mllies -> do
+#endif
     importCol <- mAsk <&> _conf_layout .> _lconfig_importColumn .> confUnpack
     importAsCol <- mAsk <&> _conf_layout .> _lconfig_importAsColumn .> confUnpack
     indentPolicy <- mAsk <&>  _conf_layout .> _lconfig_indentPolicy .> confUnpack

src/Language/Haskell/Brittany/Internal/Layouters/Pattern.hs

@@ -13,7 +13,7 @@ where
 import           Language.Haskell.Brittany.Internal.Types
 import           Language.Haskell.Brittany.Internal.LayouterBasics
 
-import           GHC ( Located, runGhc, GenLocated(L), moduleNameString )
+import           GHC ( Located, runGhc, GenLocated(L), moduleNameString, ol_val )
 import           HsSyn
 import           Name
 import           BasicTypes
@@ -37,11 +37,25 @@ layoutPat :: ToBriDocC (Pat GhcPs) (Seq BriDocNumbered)
 layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
   WildPat _  -> fmap Seq.singleton $ docLit $ Text.pack "_"
     -- _ -> expr
-  VarPat n   -> fmap Seq.singleton $ docLit $ lrdrNameToText n
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+  VarPat _ n ->
+#else                        /* ghc-8.0 8.2 8.4 */
+  VarPat   n ->
+#endif
+    fmap Seq.singleton $ docLit $ lrdrNameToText n
     -- abc -> expr
-  LitPat lit -> fmap Seq.singleton $ allocateNode $ litBriDoc lit
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+  LitPat _ lit ->
+#else                        /* ghc-8.0 8.2 8.4 */
+  LitPat lit ->
+#endif
+    fmap Seq.singleton $ allocateNode $ litBriDoc lit
     -- 0 -> expr
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+  ParPat _ inner -> do
+#else                        /* ghc-8.0 8.2 8.4 */
   ParPat inner -> do
+#endif
     -- (nestedpat) -> expr
     left  <- docLit $ Text.pack "("
     right <- docLit $ Text.pack ")"
@@ -89,7 +103,12 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
     -- Abc { a = locA, b = locB, c = locC } -> expr1
     -- Abc { a, b, c } -> expr2
     let t = lrdrNameToText lname
-    fds <- fs `forM` \(L _ (HsRecField (L _ (FieldOcc lnameF _)) fPat pun)) -> do
+    fds <- fs `forM` \(L _ (HsRecField (L _ fieldOcc) fPat pun)) -> do
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+      let FieldOcc _ lnameF = fieldOcc
+#else
+      let FieldOcc lnameF _ = fieldOcc
+#endif
       fExpDoc <- if pun
         then return Nothing
         else Just <$> docSharedWrapper layoutPat fPat
@@ -118,7 +137,12 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
   ConPatIn lname (RecCon (HsRecFields fs@(_:_) (Just dotdoti))) | dotdoti == length fs -> do
     -- Abc { a = locA, .. }
     let t = lrdrNameToText lname
-    fds <- fs `forM` \(L _ (HsRecField (L _ (FieldOcc lnameF _)) fPat pun)) -> do
+    fds <- fs `forM` \(L _ (HsRecField (L _ fieldOcc) fPat pun)) -> do
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+      let FieldOcc _ lnameF = fieldOcc
+#else
+      let FieldOcc lnameF _ = fieldOcc
+#endif
       fExpDoc <- if pun
         then return Nothing
         else Just <$> docSharedWrapper layoutPat fPat
@@ -136,18 +160,28 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
           (fieldName, Nothing) -> [docLit fieldName, docCommaSep]
       , docLit $ Text.pack "..}"
       ]
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+  TuplePat _ args boxity -> do
+#else
   TuplePat args boxity _ -> do
+#endif
     -- (nestedpat1, nestedpat2, nestedpat3) -> expr
     -- (#nestedpat1, nestedpat2, nestedpat3#) -> expr
     case boxity of
       Boxed   -> wrapPatListy args "()" docParenL docParenR
       Unboxed -> wrapPatListy args "(##)" docParenHashLSep docParenHashRSep
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+  AsPat _ asName asPat -> do
+#else
   AsPat asName asPat -> do
+#endif
     -- bind@nestedpat -> expr
     wrapPatPrepend asPat (docLit $ lrdrNameToText asName <> Text.pack "@")
-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+  SigPat (HsWC _ (HsIB _ ty1)) pat1 -> do
+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4 */
   SigPatIn pat1 (HsWC _ (HsIB _ ty1 _)) -> do
-#else /* ghc-8.0 */
+#else                        /* ghc-8.0 */
   SigPatIn pat1 (HsIB _ (HsWC _ _ ty1)) -> do
 #endif
     -- i :: Int -> expr
@@ -169,19 +203,35 @@ layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
           , docForceSingleline tyDoc
           ]
         return $ xR Seq.|> xN'
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+  ListPat _ elems ->
+#else
   ListPat elems _ _ ->
+#endif
     -- [] -> expr1
     -- [nestedpat1, nestedpat2, nestedpat3] -> expr2
     wrapPatListy elems "[]" docBracketL docBracketR
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+  BangPat _ pat1 -> do
+#else
   BangPat pat1 -> do
+#endif
     -- !nestedpat -> expr
     wrapPatPrepend pat1 (docLit $ Text.pack "!")
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+  LazyPat _ pat1 -> do
+#else
   LazyPat pat1 -> do
+#endif
     -- ~nestedpat -> expr
     wrapPatPrepend pat1 (docLit $ Text.pack "~")
-  NPat llit@(L _ (OverLit olit _ _ _)) mNegative _ _ -> do
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+  NPat _ llit@(L _ ol) mNegative _ -> do
+#else
+  NPat llit@(L _ ol) mNegative _ _ -> do
+#endif
     -- -13 -> expr
-    litDoc <- docWrapNode llit $ allocateNode $ overLitValBriDoc olit
+    litDoc <- docWrapNode llit $ allocateNode $ overLitValBriDoc $ GHC.ol_val ol
     negDoc <- docLit $ Text.pack "-"
     pure $ case mNegative of
       Just{}  -> Seq.fromList [negDoc, litDoc]

src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs

@@ -34,9 +34,17 @@ layoutStmt lstmt@(L _ stmt) = do
   indentAmount :: Int <-
     mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
   docWrapNode lstmt $ case stmt of
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    LastStmt _ body False _ -> do
+#else
     LastStmt body False _ -> do
+#endif
       layoutExpr body
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    BindStmt _ lPat expr _ _ -> do
+#else
     BindStmt lPat expr _ _ _ -> do
+#endif
       patDoc <- fmap return $ colsWrapPat =<< layoutPat lPat
       expDoc <- docSharedWrapper layoutExpr expr
       docAlt
@@ -52,7 +60,11 @@ layoutStmt lstmt@(L _ stmt) = do
             $ docPar (docLit $ Text.pack "<-") (expDoc)
           ]
         ]
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    LetStmt _ binds -> do
+#else
     LetStmt binds -> do
+#endif
       let isFree         = indentPolicy == IndentPolicyFree
       let indentFourPlus = indentAmount >= 4
       layoutLocalBinds binds >>= \case
@@ -97,7 +109,11 @@ layoutStmt lstmt@(L _ stmt) = do
             $ docAddBaseY BrIndentRegular
             $ docPar (docLit $ Text.pack "let")
                      (docSetBaseAndIndent $ docLines $ return <$> bindDocs)
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    RecStmt _ stmts _ _ _ _ _ -> runFilteredAlternative $ do
+#else
     RecStmt stmts _ _ _ _ _ _ _ _ _ -> runFilteredAlternative $ do
+#endif
       -- rec stmt1
       --     stmt2
       --     stmt3
@@ -113,7 +129,11 @@ layoutStmt lstmt@(L _ stmt) = do
       addAlternative $ docAddBaseY BrIndentRegular $ docPar
         (docLit (Text.pack "rec"))
         (docLines $ layoutStmt <$> stmts)
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+    BodyStmt _ expr _ _ -> do
+#else
     BodyStmt expr _ _ _ -> do
+#endif
       expDoc <- docSharedWrapper layoutExpr expr
       docAddBaseY BrIndentRegular $ expDoc
     _ -> briDocByExactInlineOnly "some unknown statement" lstmt

src/Language/Haskell/Brittany/Internal/Layouters/Type.hs

@@ -23,6 +23,7 @@ import           HsSyn
 import           Name
 import           Outputable ( ftext, showSDocUnsafe )
 import           BasicTypes
+import qualified SrcLoc
 
 import           DataTreePrint
 
@@ -31,7 +32,17 @@ import           DataTreePrint
 layoutType :: ToBriDoc HsType
 layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
   -- _ | traceShow (ExactPrint.Types.mkAnnKey ltype) False -> error "impossible"
-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
+#if MIN_VERSION_ghc(8,6,0)
+  HsTyVar _ promoted name -> do
+    t <- lrdrNameToTextAnn name
+    case promoted of
+      Promoted -> docSeq
+        [ docSeparator
+        , docTick
+        , docWrapNode name $ docLit t
+        ]
+      NotPromoted -> docWrapNode name $ docLit t
+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
   HsTyVar promoted name -> do
     t <- lrdrNameToTextAnn name
     case promoted of
@@ -46,13 +57,25 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
     t <- lrdrNameToTextAnn name
     docWrapNode name $ docLit t
 #endif
+#if MIN_VERSION_ghc(8,6,0)
+  HsForAllTy _ bndrs (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do
+#else
   HsForAllTy bndrs (L _ (HsQualTy (L _ cntxts) typ2)) -> do
+#endif
     typeDoc <- docSharedWrapper layoutType typ2
     tyVarDocs <- bndrs `forM` \case
+#if MIN_VERSION_ghc(8,6,0)
+      (L _ (UserTyVar _ name)) -> return $ (lrdrNameToText name, Nothing)
+      (L _ (KindedTyVar _ lrdrName kind)) -> do
+        d <- docSharedWrapper layoutType kind
+        return $ (lrdrNameToText lrdrName, Just $ d)
+      (L _ (XTyVarBndr{})) -> error "brittany internal error: XTyVarBndr"
+#else
       (L _ (UserTyVar name)) -> return $ (lrdrNameToText name, Nothing)
       (L _ (KindedTyVar lrdrName kind)) -> do
         d <- docSharedWrapper layoutType kind
         return $ (lrdrNameToText lrdrName, Just $ d)
+#endif
     cntxtDocs <- cntxts `forM` docSharedWrapper layoutType
     let maybeForceML = case typ2 of
           (L _ HsFunTy{}) -> docForceMultiline
@@ -143,13 +166,25 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
             ]
           )
       ]
+#if MIN_VERSION_ghc(8,6,0)
+  HsForAllTy _ bndrs typ2 -> do
+#else
   HsForAllTy bndrs typ2 -> do
+#endif
     typeDoc <- layoutType typ2
     tyVarDocs <- bndrs `forM` \case
+#if MIN_VERSION_ghc(8,6,0)
+      (L _ (UserTyVar _ name)) -> return $ (lrdrNameToText name, Nothing)
+      (L _ (KindedTyVar _ lrdrName kind)) -> do
+        d <- layoutType kind
+        return $ (lrdrNameToText lrdrName, Just $ return d)
+      (L _ (XTyVarBndr{})) -> error "brittany internal error: XTyVarBndr"
+#else
       (L _ (UserTyVar name)) -> return $ (lrdrNameToText name, Nothing)
       (L _ (KindedTyVar lrdrName kind)) -> do
         d <- layoutType kind
         return $ (lrdrNameToText lrdrName, Just $ return d)
+#endif
     let maybeForceML = case typ2 of
           (L _ HsFunTy{}) -> docForceMultiline
           _               -> id
@@ -210,7 +245,11 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
             ]
           )
       ]
+#if MIN_VERSION_ghc(8,6,0)
+  HsQualTy _ lcntxts@(L _ cntxts) typ1 -> do
+#else
   HsQualTy lcntxts@(L _ cntxts) typ1 -> do
+#endif
     typeDoc <- docSharedWrapper layoutType typ1
     cntxtDocs <- cntxts `forM` docSharedWrapper layoutType
     let
@@ -260,7 +299,11 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
             ]
           )
       ]
+#if MIN_VERSION_ghc(8,6,0)
+  HsFunTy _ typ1 typ2 -> do
+#else
   HsFunTy typ1 typ2 -> do
+#endif
     typeDoc1 <- docSharedWrapper layoutType typ1
     typeDoc2 <- docSharedWrapper layoutType typ2
     let maybeForceML = case typ2 of
@@ -284,7 +327,11 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
           ]
         )
       ]
+#if MIN_VERSION_ghc(8,6,0)
+  HsParTy _ typ1 -> do
+#else
   HsParTy typ1 -> do
+#endif
     typeDoc1 <- docSharedWrapper layoutType typ1
     docAlt
       [ docSeq
@@ -299,6 +346,35 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
             ])
           (docLit $ Text.pack ")")
       ]
+#if MIN_VERSION_ghc(8,6,0)
+  HsAppTy _ typ1@(L _ HsAppTy{}) typ2 -> do
+    let gather :: [LHsType GhcPs] -> LHsType GhcPs -> (LHsType GhcPs, [LHsType GhcPs])
+        gather list = \case
+          L _ (HsAppTy _ ty1 ty2) -> gather (ty2:list) ty1
+          final -> (final, list)
+    let (typHead, typRest) = gather [typ2] typ1
+    docHead <- docSharedWrapper layoutType typHead
+    docRest <- docSharedWrapper layoutType `mapM` typRest
+    docAlt
+      [ docSeq
+      $ docForceSingleline docHead : (docRest >>= \d ->
+        [ docSeparator, docForceSingleline d ])
+      , docPar docHead (docLines $ docEnsureIndent BrIndentRegular <$> docRest)
+      ]
+  HsAppTy _ typ1 typ2 -> do
+    typeDoc1 <- docSharedWrapper layoutType typ1
+    typeDoc2 <- docSharedWrapper layoutType typ2
+    docAlt
+      [ docSeq
+        [ docForceSingleline typeDoc1
+        , docSeparator
+        , docForceSingleline typeDoc2
+        ]
+      , docPar
+          typeDoc1
+          (docEnsureIndent BrIndentRegular typeDoc2)
+      ]
+#else
   HsAppTy typ1 typ2 -> do
     typeDoc1 <- docSharedWrapper layoutType typ1
     typeDoc2 <- docSharedWrapper layoutType typ2
@@ -351,7 +427,12 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
       layoutAppType (L _ (HsAppPrefix t)) = layoutType t
       layoutAppType lt@(L _ (HsAppInfix t)) =
         docLit =<< lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick lt t
+#endif
+#if MIN_VERSION_ghc(8,6,0)
+  HsListTy _ typ1 -> do
+#else
   HsListTy typ1 -> do
+#endif
     typeDoc1 <- docSharedWrapper layoutType typ1
     docAlt
       [ docSeq
@@ -366,6 +447,8 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
             ])
           (docLit $ Text.pack "]")
       ]
+#if MIN_VERSION_ghc(8,6,0)
+#else
   HsPArrTy typ1 -> do
     typeDoc1 <- docSharedWrapper layoutType typ1
     docAlt
@@ -381,13 +464,19 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
             ])
           (docLit $ Text.pack ":]")
       ]
+#endif
+#if MIN_VERSION_ghc(8,6,0)
+  HsTupleTy _ tupleSort typs -> case tupleSort of
+#else
   HsTupleTy tupleSort typs -> case tupleSort of
+#endif
     HsUnboxedTuple           -> unboxed
     HsBoxedTuple             -> simple
     HsConstraintTuple        -> simple
     HsBoxedOrConstraintTuple -> simple
    where
-    unboxed = if null typs then error "unboxed unit?" else unboxedL
+    unboxed = if null typs then error "brittany internal error: unboxed unit"
+                           else unboxedL
     simple = if null typs then unitL else simpleL
     unitL = docLit $ Text.pack "()"
     simpleL = do
@@ -480,9 +569,11 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
   --               }
   --     , _layouter_ast = ltype
   --     }
-#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
+#if MIN_VERSION_ghc(8,6,0)   /* ghc-8.6 */
+  HsIParamTy _ (L _ (HsIPName ipName)) typ1 -> do
+#elif MIN_VERSION_ghc(8,2,0) /* ghc-8.2 8.4 */
   HsIParamTy (L _ (HsIPName ipName)) typ1 -> do
-#else /* ghc-8.0 */
+#else                        /* ghc-8.0 */
   HsIParamTy (HsIPName ipName) typ1 -> do
 #endif
     typeDoc1 <- docSharedWrapper layoutType typ1
@@ -503,6 +594,8 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
             , docAddBaseY (BrIndentSpecial 2) typeDoc1
             ])
       ]
+#if MIN_VERSION_ghc(8,6,0)
+#else
   HsEqTy typ1 typ2 -> do
     typeDoc1 <- docSharedWrapper layoutType typ1
     typeDoc2 <- docSharedWrapper layoutType typ2
@@ -521,8 +614,13 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
               , docAddBaseY (BrIndentSpecial 2) typeDoc2
               ])
       ]
+#endif
   -- TODO: test KindSig
+#if MIN_VERSION_ghc(8,6,0)
+  HsKindSig _ typ1 kind1 -> do
+#else
   HsKindSig typ1 kind1 -> do
+#endif
     typeDoc1 <- docSharedWrapper layoutType typ1
     kindDoc1 <- docSharedWrapper layoutType kind1
     hasParens <- hasAnnKeyword ltype AnnOpenP
@@ -640,7 +738,11 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
       ]
   HsExplicitTupleTy{} -> -- TODO
     briDocByExactInlineOnly "HsExplicitTupleTy{}" ltype
+#if MIN_VERSION_ghc(8,6,0)
+  HsTyLit _ lit -> case lit of
+#else
   HsTyLit lit -> case lit of
+#endif
 #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
     HsNumTy (SourceText srctext) _ -> docLit $ Text.pack srctext
     HsNumTy NoSourceText _ ->
@@ -652,11 +754,20 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
     HsNumTy srctext _ -> docLit $ Text.pack srctext
     HsStrTy srctext _ -> docLit $ Text.pack srctext
 #endif
+#if !MIN_VERSION_ghc(8,6,0)
   HsCoreTy{} -> -- TODO
     briDocByExactInlineOnly "HsCoreTy{}" ltype
+#endif
   HsWildCardTy _ ->
     docLit $ Text.pack "_"
 #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */
   HsSumTy{} -> -- TODO
     briDocByExactInlineOnly "HsSumTy{}" ltype
 #endif
+#if MIN_VERSION_ghc(8,6,0)
+  HsStarTy _ isUnicode -> do
+    if isUnicode
+      then docLit $ Text.pack "\x2605" -- Unicode star
+      else docLit $ Text.pack "*"
+  XHsType{} -> error "brittany internal error: XHsType"
+#endif

src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs

@@ -203,6 +203,7 @@ transformAlts =
                       AltLineModeStateForceSL{} -> p == VerticalSpacingParNone
                       AltLineModeStateForceML{} -> p /= VerticalSpacingParNone
                       AltLineModeStateContradiction -> False
+                  -- TODO: use COMPLETE pragma instead?
                   lineCheck _ = error "ghc exhaustive check is insufficient"
               lconf <- _conf_layout <$> mAsk
 #if INSERTTRACESALT
@@ -462,7 +463,8 @@ getSpacing !bridoc = rec bridoc
         $ LineModeValid
         $ VerticalSpacing 0 VerticalSpacingParNone False
       BDFLines ls@(_:_) -> do
-        lSps@(mVs:_) <- rec `mapM` ls
+        lSps <- rec `mapM` ls
+        let (mVs:_) = lSps -- separated into let to avoid MonadFail
         return $ [ VerticalSpacing lsp (VerticalSpacingParSome $ lineMax) False
                  | VerticalSpacing lsp _ _ <- mVs
                  , lineMax <- getMaxVS $ maxVs $ lSps