Get everything building with (only) GHC 9.0

pull/357/head
Taylor Fausak 2021-10-30 16:20:13 +00:00 committed by GitHub
parent 7bd98ffb1c
commit 116930ac2b
20 changed files with 162 additions and 382 deletions

5
.vscode/extensions.json vendored Normal file
View File

@ -0,0 +1,5 @@
{
"recommendations": [
"haskell.haskell"
]
}

View File

@ -53,21 +53,17 @@ import Language.Haskell.Brittany.Internal.Transformations.Indent
import qualified GHC as GHC
hiding ( parseModule )
import ApiAnnotation ( AnnKeywordId(..) )
import GHC.Parser.Annotation ( AnnKeywordId(..) )
import GHC ( Located
, runGhc
, GenLocated(L)
, moduleNameString
)
import RdrName ( RdrName(..) )
import SrcLoc ( SrcSpan )
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Types.Name.Reader ( RdrName(..) )
import GHC.Types.SrcLoc ( SrcSpan )
import GHC.Hs
import Bag
#else
import HsSyn
#endif
import qualified DynFlags as GHC
import GHC.Data.Bag
import qualified GHC.Driver.Session as GHC
import qualified GHC.LanguageExtensions.Type as GHC
import Data.Char ( isSpace )
@ -226,7 +222,7 @@ extractCommentConfigs anns (TopLevelDeclNameMap declNameMap) = do
getTopLevelDeclNameMap :: GHC.ParsedSource -> TopLevelDeclNameMap
getTopLevelDeclNameMap (L _ (HsModule _name _exports _ decls _ _)) =
getTopLevelDeclNameMap (L _ (HsModule _ _name _exports _ decls _ _)) =
TopLevelDeclNameMap $ Map.fromList
[ (ExactPrint.mkAnnKey decl, name)
| decl <- decls
@ -385,11 +381,7 @@ parsePrintModuleTests conf filename input = do
let inputStr = Text.unpack input
parseResult <- ExactPrint.Parsers.parseModuleFromString filename inputStr
case parseResult of
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
Left err -> return $ Left $ "parsing error: " ++ show (bagToList (show <$> err))
#else
Left (_ , s ) -> return $ Left $ "parsing error: " ++ s
#endif
Right (anns, parsedModule) -> runExceptT $ do
(inlineConf, perItemConf) <-
case extractCommentConfigs anns (getTopLevelDeclNameMap parsedModule) of
@ -460,8 +452,8 @@ toLocal conf anns m = do
MultiRWSS.mGetRawW >>= \w -> MultiRWSS.mPutRawW (w `mappend` write)
pure x
ppModule :: GenLocated SrcSpan (HsModule GhcPs) -> PPM ()
ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do
ppModule :: GenLocated SrcSpan HsModule -> PPM ()
ppModule lmod@(L _loc _m@(HsModule _ _name _exports _ decls _ _)) = do
post <- ppPreamble lmod
decls `forM_` \decl -> do
let declAnnKey = ExactPrint.mkAnnKey decl
@ -505,10 +497,10 @@ ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do
(ExactPrint.AnnComment (ExactPrint.Comment cmStr _ _), l) -> do
ppmMoveToExactLoc l
mTell $ Text.Builder.fromString cmStr
(ExactPrint.G AnnEofPos, (ExactPrint.DP (eofZ, eofX))) ->
(ExactPrint.G _, (ExactPrint.DP (eofZ, eofX))) ->
let folder (acc, _) (kw, ExactPrint.DP (y, x)) = case kw of
ExactPrint.AnnComment cm
| GHC.RealSrcSpan span <- ExactPrint.commentIdentifier cm
| span <- ExactPrint.commentIdentifier cm
-> ( acc + y + GHC.srcSpanEndLine span - GHC.srcSpanStartLine span
, x + GHC.srcSpanEndCol span - GHC.srcSpanStartCol span
)
@ -520,16 +512,16 @@ ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do
getDeclBindingNames :: LHsDecl GhcPs -> [String]
getDeclBindingNames (L _ decl) = case decl of
SigD _ (TypeSig _ ns _) -> ns <&> \(L _ n) -> Text.unpack (rdrNameToText n)
ValD _ (FunBind _ (L _ n) _ _ _) -> [Text.unpack $ rdrNameToText n]
ValD _ (FunBind _ (L _ n) _ _) -> [Text.unpack $ rdrNameToText n]
_ -> []
-- Prints the information associated with the module annotation
-- This includes the imports
ppPreamble
:: GenLocated SrcSpan (HsModule GhcPs)
:: GenLocated SrcSpan HsModule
-> PPM [(ExactPrint.KeywordId, ExactPrint.DeltaPos)]
ppPreamble lmod@(L loc m@(HsModule _ _ _ _ _ _)) = do
ppPreamble lmod@(L loc m@(HsModule _ _ _ _ _ _ _)) = do
filteredAnns <- mAsk <&> \annMap ->
Map.findWithDefault Map.empty (ExactPrint.mkAnnKey lmod) annMap
-- Since ghc-exactprint adds annotations following (implicit)
@ -550,15 +542,10 @@ ppPreamble lmod@(L loc m@(HsModule _ _ _ _ _ _)) = do
modAnnsDp = ExactPrint.annsDP mAnn
isWhere (ExactPrint.G AnnWhere) = True
isWhere _ = False
isEof (ExactPrint.G AnnEofPos) = True
isEof _ = False
whereInd = List.findIndex (isWhere . fst) modAnnsDp
eofInd = List.findIndex (isEof . fst) modAnnsDp
(pre, post') = case (whereInd, eofInd) of
(Nothing, Nothing) -> ([], modAnnsDp)
(Just i , Nothing) -> List.splitAt (i + 1) modAnnsDp
(Nothing, Just _i) -> ([], modAnnsDp)
(Just i , Just j ) -> List.splitAt (min (i + 1) j) modAnnsDp
(pre, post') = case whereInd of
Nothing -> ([], modAnnsDp)
Just i -> List.splitAt (i + 1) modAnnsDp
mAnn' = mAnn { ExactPrint.annsDP = pre }
filteredAnns'' =
Map.insert (ExactPrint.mkAnnKey lmod) mAnn' filteredAnns
@ -585,7 +572,7 @@ _sigHead = \case
_bindHead :: HsBind GhcPs -> String
_bindHead = \case
FunBind _ fId _ _ [] -> "FunBind " ++ (Text.unpack $ lrdrNameToText $ fId)
FunBind _ fId _ [] -> "FunBind " ++ (Text.unpack $ lrdrNameToText $ fId)
PatBind _ _pat _ ([], []) -> "PatBind smth"
_ -> "unknown bind"

View File

@ -340,16 +340,16 @@ data ExactPrintFallbackMode
-- A PROGRAM BY TRANSFORMING IT.
deriving (Show, Generic, Data)
instance CFunctor CDebugConfig
instance CFunctor CLayoutConfig
instance CFunctor CErrorHandlingConfig
instance CFunctor CForwardOptions
instance CFunctor CPreProcessorConfig
instance CFunctor CConfig
deriveCZipWith ''CDebugConfig
deriveCZipWith ''CLayoutConfig
deriveCZipWith ''CErrorHandlingConfig
deriveCZipWith ''CForwardOptions
deriveCZipWith ''CPreProcessorConfig
deriveCZipWith ''CConfig
instance CFunctor CDebugConfig
instance CFunctor CLayoutConfig
instance CFunctor CErrorHandlingConfig
instance CFunctor CForwardOptions
instance CFunctor CPreProcessorConfig
instance CFunctor CConfig

View File

@ -21,6 +21,7 @@ where
#include "prelude.inc"
import Data.Yaml
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.Types as Aeson
import Language.Haskell.Brittany.Internal.Config.Types
@ -113,18 +114,17 @@ makeToJSONMaybe(CConfig)
-- config file content.
instance FromJSON (CConfig Maybe) where
parseJSON (Object v) = Config
<$> v .:? Text.pack "conf_version"
<*> v .:?= Text.pack "conf_debug"
<*> v .:?= Text.pack "conf_layout"
<*> v .:?= Text.pack "conf_errorHandling"
<*> v .:?= Text.pack "conf_forward"
<*> v .:?= Text.pack "conf_preprocessor"
<*> v .:? Text.pack "conf_roundtrip_exactprint_only"
<*> v .:? Text.pack "conf_disable_formatting"
<*> v .:? Text.pack "conf_obfuscate"
<$> v .:? Key.fromString "conf_version"
<*> v .:?= Key.fromString "conf_debug"
<*> v .:?= Key.fromString "conf_layout"
<*> v .:?= Key.fromString "conf_errorHandling"
<*> v .:?= Key.fromString "conf_forward"
<*> v .:?= Key.fromString "conf_preprocessor"
<*> v .:? Key.fromString "conf_roundtrip_exactprint_only"
<*> v .:? Key.fromString "conf_disable_formatting"
<*> v .:? Key.fromString "conf_obfuscate"
parseJSON invalid = Aeson.typeMismatch "Config" invalid
-- Pretends that the value is {} when the key is not present.
(.:?=) :: FromJSON a => Object -> Text -> Parser a
(.:?=) :: FromJSON a => Object -> Key.Key -> Parser a
o .:?= k = o .:? k >>= maybe (parseJSON (Aeson.object [])) pure

View File

@ -20,27 +20,22 @@ import Language.Haskell.Brittany.Internal.Utils
import Data.Data
import Data.HList.HList
import DynFlags ( getDynFlags )
import GHC.Driver.Session ( getDynFlags )
import GHC ( runGhc, GenLocated(L), moduleNameString )
import qualified DynFlags as GHC
import qualified GHC.Driver.Session as GHC
import qualified GHC as GHC hiding (parseModule)
import qualified Parser as GHC
import qualified SrcLoc as GHC
import qualified FastString as GHC
import qualified GHC as GHC hiding (parseModule)
import qualified Lexer as GHC
import qualified StringBuffer as GHC
import qualified Outputable as GHC
import qualified CmdLineParser as GHC
import qualified GHC.Parser as GHC
import qualified GHC.Types.SrcLoc as GHC
import qualified GHC.Data.FastString as GHC
import qualified GHC.Parser.Lexer as GHC
import qualified GHC.Data.StringBuffer as GHC
import qualified GHC.Utils.Outputable as GHC
import qualified GHC.Driver.CmdLine as GHC
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
import Bag
#else
import HsSyn
#endif
import GHC.Data.Bag
import SrcLoc ( SrcSpan, Located )
import GHC.Types.SrcLoc ( SrcSpan, Located )
import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
@ -96,11 +91,7 @@ parseModuleWithCpp cpp opts args fp dynCheck =
++ show (warnings <&> warnExtractorCompat)
x <- ExceptT.ExceptT $ liftIO $ dynCheck dflags2
res <- lift $ ExactPrint.parseModuleApiAnnsWithCppInternal cpp dflags2 fp
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
either (\err -> ExceptT.throwE $ "transform error: " ++ show (bagToList (show <$> err)))
#else
either (\(span, err) -> ExceptT.throwE $ show span ++ ": " ++ err)
#endif
(\(a, m) -> pure (a, m, x))
$ ExactPrint.postParseTransform res opts
@ -133,11 +124,7 @@ parseModuleFromString args fp dynCheck str =
dynCheckRes <- ExceptT.ExceptT $ liftIO $ dynCheck dflags1
let res = ExactPrint.parseModuleFromStringInternal dflags1 fp str
case res of
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
Left err -> ExceptT.throwE $ "parse error: " ++ show (bagToList (show <$> err))
#else
Left (span, err) -> ExceptT.throwE $ showOutputable span ++ ": " ++ err
#endif
Right (a , m ) -> pure (a, m, dynCheckRes)
@ -153,7 +140,7 @@ commentAnnFixTransformGlob ast = do
annsMap = Map.fromListWith
(flip const)
[ (GHC.realSrcSpanEnd span, annKey)
| (GHC.RealSrcSpan span, annKey) <- Foldable.toList nodes
| (GHC.RealSrcSpan span _, annKey) <- Foldable.toList nodes
]
nodes `forM_` (snd .> processComs annsMap)
where
@ -168,9 +155,8 @@ commentAnnFixTransformGlob ast = do
:: (ExactPrint.Comment, ExactPrint.DeltaPos)
-> ExactPrint.TransformT Identity Bool
processCom comPair@(com, _) =
case GHC.srcSpanStart $ ExactPrint.commentIdentifier com of
GHC.UnhelpfulLoc{} -> return True -- retain comment at current node.
GHC.RealSrcLoc comLoc -> case Map.lookupLE comLoc annsMap of
case GHC.realSrcSpanStart $ ExactPrint.commentIdentifier com of
comLoc -> case Map.lookupLE comLoc annsMap of
Just (_, annKey2) | loc1 /= loc2 -> case (con1, con2) of
(ExactPrint.CN "RecordCon", ExactPrint.CN "HsRecField") ->
move $> False
@ -179,8 +165,8 @@ commentAnnFixTransformGlob ast = do
where
ExactPrint.AnnKey annKeyLoc1 con1 = annKey1
ExactPrint.AnnKey annKeyLoc2 con2 = annKey2
loc1 = GHC.srcSpanStart annKeyLoc1
loc2 = GHC.srcSpanStart annKeyLoc2
loc1 = GHC.realSrcSpanStart annKeyLoc1
loc2 = GHC.realSrcSpanStart annKeyLoc2
move = ExactPrint.modifyAnnsT $ \anns ->
let
ann2 = Data.Maybe.fromJust $ Map.lookup annKey2 anns
@ -271,12 +257,12 @@ moveTrailingComments astFrom astTo = do
-- elements to the relevant annotations. Avoids quadratic behaviour a trivial
-- implementation would have.
extractToplevelAnns
:: Located (HsModule GhcPs)
:: Located HsModule
-> ExactPrint.Anns
-> Map ExactPrint.AnnKey ExactPrint.Anns
extractToplevelAnns lmod anns = output
where
(L _ (HsModule _ _ _ ldecls _ _)) = lmod
(L _ (HsModule _ _ _ _ ldecls _ _)) = lmod
declMap1 :: Map ExactPrint.AnnKey ExactPrint.AnnKey
declMap1 = Map.unions $ ldecls <&> \ldecl ->
Map.fromSet (const (ExactPrint.mkAnnKey ldecl)) (foldedAnnKeys ldecl)

View File

@ -99,13 +99,13 @@ import Language.Haskell.Brittany.Internal.Types
import Language.Haskell.Brittany.Internal.Utils
import Language.Haskell.Brittany.Internal.ExactPrintUtils
import RdrName ( RdrName(..) )
import GHC.Types.Name.Reader ( RdrName(..) )
import GHC ( Located, runGhc, GenLocated(L), moduleNameString )
import qualified SrcLoc as GHC
import OccName ( occNameString )
import Name ( getOccString )
import Module ( moduleName )
import ApiAnnotation ( AnnKeywordId(..) )
import qualified GHC.Types.SrcLoc as GHC
import GHC.Types.Name.Occurrence ( occNameString )
import GHC.Types.Name ( getOccString )
import GHC ( moduleName )
import GHC.Parser.Annotation ( AnnKeywordId(..) )
import Data.Data
import Data.Generics.Schemes
@ -299,7 +299,7 @@ filterAnns ast =
-- b) after (in source code order) the node.
hasAnyCommentsBelow :: Data ast => GHC.Located ast -> ToBriDocM Bool
hasAnyCommentsBelow ast@(L l _) =
List.any (\(c, _) -> ExactPrint.commentIdentifier c > l)
List.any (\(c, _) -> ExactPrint.commentIdentifier c > ExactPrint.Utils.rs l)
<$> astConnectedComments ast
hasCommentsBetween

View File

@ -16,16 +16,12 @@ import Language.Haskell.Brittany.Internal.Types
import Language.Haskell.Brittany.Internal.LayouterBasics
import Language.Haskell.Brittany.Internal.Config.Types
import RdrName ( RdrName(..) )
import GHC.Types.Name.Reader ( RdrName(..) )
import GHC ( Located, runGhc, GenLocated(L), moduleNameString )
import qualified GHC
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn
#endif
import Name
import BasicTypes
import GHC.Types.Name
import GHC.Types.Basic
import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey )
import Language.Haskell.Brittany.Internal.Layouters.Type
@ -34,7 +30,7 @@ import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Stmt
import Language.Haskell.Brittany.Internal.Layouters.Pattern
import Language.Haskell.Brittany.Internal.Utils
import Bag ( mapBagM )
import GHC.Data.Bag ( mapBagM )
@ -242,11 +238,11 @@ createContextDoc (t1 : tR) = do
]
]
createBndrDoc :: [LHsTyVarBndr GhcPs] -> ToBriDocM BriDocNumbered
createBndrDoc :: [LHsTyVarBndr tag GhcPs] -> ToBriDocM BriDocNumbered
createBndrDoc bs = do
tyVarDocs <- bs `forM` \case
(L _ (UserTyVar _ext vname)) -> return $ (lrdrNameToText vname, Nothing)
(L _ (KindedTyVar _ext lrdrName kind)) -> do
(L _ (UserTyVar _ _ext vname)) -> return $ (lrdrNameToText vname, Nothing)
(L _ (KindedTyVar _ _ext lrdrName kind)) -> do
d <- docSharedWrapper layoutType kind
return $ (lrdrNameToText lrdrName, Just $ d)
(L _ (XTyVarBndr ext)) -> absurdExt ext
@ -334,21 +330,21 @@ createDetailsDoc consNameStr details = case details of
, docForceSingleline
$ docSeq
$ List.intersperse docSeparator
$ args <&> layoutType
$ fmap hsScaledThing args <&> layoutType
]
leftIndented = docSetParSpacing
. docAddBaseY BrIndentRegular
. docPar (docLit consNameStr)
. docLines
$ layoutType <$> args
$ layoutType <$> fmap hsScaledThing args
multiAppended = docSeq
[ docLit consNameStr
, docSeparator
, docSetBaseY $ docLines $ layoutType <$> args
, docSetBaseY $ docLines $ layoutType <$> fmap hsScaledThing args
]
multiIndented = docSetBaseY $ docAddBaseY BrIndentRegular $ docPar
(docLit consNameStr)
(docLines $ layoutType <$> args)
(docLines $ layoutType <$> fmap hsScaledThing args)
case indentPolicy of
IndentPolicyLeft -> docAlt [singleLine, leftIndented]
IndentPolicyMultiple -> docAlt [singleLine, multiAppended, leftIndented]
@ -424,11 +420,11 @@ createDetailsDoc consNameStr details = case details of
]
)
InfixCon arg1 arg2 -> docSeq
[ layoutType arg1
[ layoutType $ hsScaledThing arg1
, docSeparator
, docLit consNameStr
, docSeparator
, layoutType arg2
, layoutType $ hsScaledThing arg2
]
where
mkFieldDocs
@ -438,7 +434,7 @@ createDetailsDoc consNameStr details = case details of
L _ (ConDeclField _ext names t _) -> createNamesAndTypeDoc lField names t
L _ (XConDeclField x) -> absurdExt x
createForallDoc :: [LHsTyVarBndr GhcPs] -> Maybe (ToBriDocM BriDocNumbered)
createForallDoc :: [LHsTyVarBndr tag GhcPs] -> Maybe (ToBriDocM BriDocNumbered)
createForallDoc [] = Nothing
createForallDoc lhsTyVarBndrs = Just $ docSeq
[docLitS "forall ", createBndrDoc lhsTyVarBndrs]

View File

@ -27,6 +27,7 @@ import Language.Haskell.Brittany.Internal.Layouters.Type
import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
import qualified Language.Haskell.GHC.ExactPrint.Utils as ExactPrint
import Language.Haskell.Brittany.Internal.ExactPrintUtils
import Language.Haskell.Brittany.Internal.Utils
@ -35,17 +36,12 @@ import GHC ( runGhc
, moduleNameString
, AnnKeywordId(..)
)
import SrcLoc ( SrcSpan, noSrcSpan, Located , getLoc, unLoc )
import qualified FastString
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Types.SrcLoc ( SrcSpan, noSrcSpan, Located , getLoc, unLoc )
import qualified GHC.Data.FastString as FastString
import GHC.Hs
import GHC.Hs.Extension (NoExtField (..))
#else
import HsSyn
import HsExtension (NoExt (..))
#endif
import Name
import BasicTypes ( InlinePragma(..)
import GHC.Types.Name
import GHC.Types.Basic ( InlinePragma(..)
, Activation(..)
, InlineSpec(..)
, RuleMatchInfo(..)
@ -59,7 +55,7 @@ import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Stmt
import Language.Haskell.Brittany.Internal.Layouters.Pattern
import Language.Haskell.Brittany.Internal.Layouters.DataDecl
import Bag ( mapBagM, bagToList, emptyBag )
import GHC.Data.Bag ( mapBagM, bagToList, emptyBag )
import Data.Char (isUpper)
@ -145,7 +141,7 @@ specStringCompat ast = \case
layoutGuardLStmt :: ToBriDoc' (Stmt GhcPs (LHsExpr GhcPs))
layoutGuardLStmt lgstmt@(L _ stmtLR) = docWrapNode lgstmt $ case stmtLR of
BodyStmt _ body _ _ -> layoutExpr body
BindStmt _ lPat expr _ _ -> do
BindStmt _ lPat expr -> do
patDoc <- docSharedWrapper layoutPat lPat
expDoc <- docSharedWrapper layoutExpr expr
docCols ColBindStmt
@ -164,7 +160,7 @@ layoutBind
(HsBindLR GhcPs GhcPs)
(Either [BriDocNumbered] BriDocNumbered)
layoutBind lbind@(L _ bind) = case bind of
FunBind _ fId (MG _ lmatches@(L _ matches) _) _ [] -> do
FunBind _ fId (MG _ lmatches@(L _ matches) _) [] -> do
idStr <- lrdrNameToTextAnn fId
binderDoc <- docLit $ Text.pack "="
funcPatDocs <-
@ -186,11 +182,7 @@ layoutBind lbind@(L _ bind) = case bind of
clauseDocs
mWhereArg
hasComments
#if MIN_VERSION_ghc(8,8,0)
PatSynBind _ (PSB _ patID lpat rpat dir) -> do
#else
PatSynBind _ (PSB _ patID lpat rpat dir) -> do
#endif
fmap Right $ docWrapNode lbind $ layoutPatSynBind patID
lpat
dir
@ -226,7 +218,7 @@ layoutLocalBinds lbinds@(L _ binds) = case binds of
let unordered =
[ BagBind b | b <- Data.Foldable.toList bindlrs ]
++ [ BagSig s | s <- sigs ]
ordered = sortBy (comparing bindOrSigtoSrcSpan) unordered
ordered = sortBy (comparing $ ExactPrint.rs . bindOrSigtoSrcSpan) unordered
docs <- docWrapNode lbinds $ join <$> ordered `forM` \case
BagBind b -> either id return <$> layoutBind b
BagSig s -> return <$> layoutSig s
@ -734,7 +726,7 @@ layoutSynDecl
:: Bool
-> (ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered)
-> Located (IdP GhcPs)
-> [LHsTyVarBndr GhcPs]
-> [LHsTyVarBndr () GhcPs]
-> LHsType GhcPs
-> ToBriDocM BriDocNumbered
layoutSynDecl isInfix wrapNodeRest name vars typ = do
@ -771,14 +763,14 @@ layoutSynDecl isInfix wrapNodeRest name vars typ = do
hasComments <- hasAnyCommentsConnected typ
layoutLhsAndType hasComments sharedLhs "=" typeDoc
layoutTyVarBndr :: Bool -> ToBriDoc HsTyVarBndr
layoutTyVarBndr :: Bool -> ToBriDoc (HsTyVarBndr ())
layoutTyVarBndr needsSep lbndr@(L _ bndr) = do
docWrapNodePrior lbndr $ case bndr of
XTyVarBndr{} -> error "brittany internal error: XTyVarBndr"
UserTyVar _ name -> do
UserTyVar _ _ name -> do
nameStr <- lrdrNameToTextAnn name
docSeq $ [docSeparator | needsSep] ++ [docLit nameStr]
KindedTyVar _ name kind -> do
KindedTyVar _ _ name kind -> do
nameStr <- lrdrNameToTextAnn name
docSeq
$ [ docSeparator | needsSep ]
@ -804,16 +796,10 @@ layoutTyFamInstDecl
-> ToBriDocM BriDocNumbered
layoutTyFamInstDecl inClass outerNode tfid = do
let
#if MIN_VERSION_ghc(8,8,0)
FamEqn _ name bndrsMay pats _fixity typ = hsib_body $ tfid_eqn tfid
-- bndrsMay isJust e.g. with
-- type instance forall a . MyType (Maybe a) = Either () a
innerNode = outerNode
#else
FamEqn _ name pats _fixity typ = hsib_body $ tfid_eqn tfid
bndrsMay = Nothing
innerNode = outerNode
#endif
docWrapNodePrior outerNode $ do
nameStr <- lrdrNameToTextAnn name
needsParens <- hasAnnKeyword outerNode AnnOpenP
@ -822,7 +808,7 @@ layoutTyFamInstDecl inClass outerNode tfid = do
then docLit $ Text.pack "type"
else docSeq
[appSep . docLit $ Text.pack "type", docLit $ Text.pack "instance"]
makeForallDoc :: [LHsTyVarBndr GhcPs] -> ToBriDocM BriDocNumbered
makeForallDoc :: [LHsTyVarBndr () GhcPs] -> ToBriDocM BriDocNumbered
makeForallDoc bndrs = do
bndrDocs <- layoutTyVarBndrs bndrs
docSeq
@ -845,7 +831,6 @@ layoutTyFamInstDecl inClass outerNode tfid = do
layoutLhsAndType hasComments lhs "=" typeDoc
#if MIN_VERSION_ghc(8,8,0)
layoutHsTyPats :: [HsArg (LHsType GhcPs) (LHsKind GhcPs)] -> [ToBriDocM BriDocNumbered]
layoutHsTyPats pats = pats <&> \case
HsValArg tm -> layoutType tm
@ -854,10 +839,6 @@ layoutHsTyPats pats = pats <&> \case
-- is a bit strange. Hopefully this does not ignore any important
-- annotations.
HsArgPar _l -> error "brittany internal error: HsArgPar{}"
#else
layoutHsTyPats :: [LHsType GhcPs] -> [ToBriDocM BriDocNumbered]
layoutHsTyPats pats = layoutType <$> pats
#endif
--------------------------------------------------------------------------------
-- ClsInstDecl
@ -881,21 +862,12 @@ layoutClsInst lcid@(L _ cid) = docLines
]
where
layoutInstanceHead :: ToBriDocM BriDocNumbered
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
layoutInstanceHead =
briDocByExactNoComment
$ InstD NoExtField
. ClsInstD NoExtField
. removeChildren
<$> lcid
#else
layoutInstanceHead =
briDocByExactNoComment
$ InstD NoExt
. ClsInstD NoExt
. removeChildren
<$> lcid
#endif
removeChildren :: ClsInstDecl p -> ClsInstDecl p
removeChildren c = c
@ -909,7 +881,7 @@ layoutClsInst lcid@(L _ cid) = docLines
docSortedLines
:: [ToBriDocM (Located BriDocNumbered)] -> ToBriDocM BriDocNumbered
docSortedLines l =
allocateNode . BDFLines . fmap unLoc . List.sortOn getLoc =<< sequence l
allocateNode . BDFLines . fmap unLoc . List.sortOn (ExactPrint.rs . getLoc) =<< sequence l
layoutAndLocateSig :: ToBriDocC (Sig GhcPs) (Located BriDocNumbered)
layoutAndLocateSig lsig@(L loc _) = L loc <$> layoutSig lsig

View File

@ -19,14 +19,10 @@ import Language.Haskell.Brittany.Internal.Config.Types
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
import GHC ( runGhc, GenLocated(L), SrcSpan, moduleNameString, AnnKeywordId(..), RdrName(..) )
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn
#endif
import Name
import qualified FastString
import BasicTypes
import GHC.Types.Name
import qualified GHC.Data.FastString as FastString
import GHC.Types.Basic
import Language.Haskell.Brittany.Internal.Utils
import Language.Haskell.Brittany.Internal.Layouters.Pattern
@ -46,9 +42,8 @@ layoutExpr lexpr@(L _ expr) = do
docWrapNode lexpr $ case expr of
HsVar _ vname -> do
docLit =<< lrdrNameToTextAnn vname
HsUnboundVar _ var -> case var of
OutOfScope oname _ -> docLit $ Text.pack $ occNameString oname
TrueExprHole oname -> docLit $ Text.pack $ occNameString oname
HsUnboundVar _ oname ->
docLit $ Text.pack $ occNameString oname
HsRecFld{} -> do
-- TODO
briDocByExactInlineOnly "HsRecFld" lexpr
@ -79,8 +74,8 @@ layoutExpr lexpr@(L _ expr) = do
-- by wrapping it in docSeq below. We _could_ add alignments for
-- stuff like lists-of-lambdas. Nothing terribly important..)
let shouldPrefixSeparator = case p of
(ghcDL -> L _ LazyPat{}) -> isFirst
(ghcDL -> L _ BangPat{}) -> isFirst
L _ LazyPat{} -> isFirst
L _ BangPat{} -> isFirst
_ -> False
patDocSeq <- layoutPat p
fixed <- case Seq.viewl patDocSeq of
@ -235,15 +230,9 @@ layoutExpr lexpr@(L _ expr) = do
expDoc1
expDoc2
]
#if MIN_VERSION_ghc(8,8,0) /* ghc-8.8 */
HsAppType _ _ XHsWildCardBndrs{} ->
error "brittany internal error: HsAppType XHsWildCardBndrs"
HsAppType _ exp1 (HsWC _ ty1) -> do
#else
HsAppType XHsWildCardBndrs{} _ ->
error "brittany internal error: HsAppType XHsWildCardBndrs"
HsAppType (HsWC _ ty1) exp1 -> do
#endif
t <- docSharedWrapper layoutType ty1
e <- docSharedWrapper layoutExpr exp1
docAlt
@ -400,17 +389,10 @@ layoutExpr lexpr@(L _ expr) = do
rightDoc <- docSharedWrapper layoutExpr right
docSeq [opDoc, docSeparator, rightDoc]
ExplicitTuple _ args boxity -> do
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
let argExprs = args <&> \arg -> case arg of
(L _ (Present _ e)) -> (arg, Just e);
(L _ (Missing NoExtField)) -> (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 NoExt)) -> (arg, Nothing)
(L _ XTupArg{}) -> error "brittany internal error: XTupArg"
#endif
argDocs <- forM argExprs
$ docSharedWrapper
$ \(arg, exprM) -> docWrapNode arg $ maybe docEmpty layoutExpr exprM
@ -496,7 +478,7 @@ layoutExpr lexpr@(L _ expr) = do
(docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs)
)
]
HsIf _ _ ifExpr thenExpr elseExpr -> do
HsIf _ ifExpr thenExpr elseExpr -> do
ifExprDoc <- docSharedWrapper layoutExpr ifExpr
thenExprDoc <- docSharedWrapper layoutExpr thenExpr
elseExprDoc <- docSharedWrapper layoutExpr elseExpr
@ -723,14 +705,14 @@ layoutExpr lexpr@(L _ expr) = do
_ -> docSeq [appSep $ docLit $ Text.pack "let in", expDoc1]
-- docSeq [appSep $ docLit "let in", expDoc1]
HsDo _ stmtCtx (L _ stmts) -> case stmtCtx of
DoExpr -> do
DoExpr _ -> do
stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
docSetParSpacing
$ docAddBaseY BrIndentRegular
$ docPar
(docLit $ Text.pack "do")
(docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs)
MDoExpr -> do
MDoExpr _ -> do
stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts
docSetParSpacing
$ docAddBaseY BrIndentRegular
@ -829,18 +811,10 @@ layoutExpr lexpr@(L _ expr) = do
else Just <$> docSharedWrapper layoutExpr rFExpr
return $ (lfield, lrdrNameToText lnameF, rFExpDoc)
recordExpression False indentPolicy lexpr nameDoc rFs
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
HsRecFields [] (Just (L _ 0)) -> do
#else
HsRecFields [] (Just 0) -> do
#endif
let t = lrdrNameToText lname
docWrapNode lname $ docLit $ t <> Text.pack " { .. }"
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
HsRecFields fs@(_:_) (Just (L _ dotdoti)) | dotdoti == length fs -> do
#else
HsRecFields fs@(_:_) (Just dotdoti) | dotdoti == length fs -> do
#endif
let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname
fieldDocs <- fs `forM` \fieldl@(L _ (HsRecField (L _ fieldOcc) fExpr pun)) -> do
let FieldOcc _ lnameF = fieldOcc
@ -863,19 +837,11 @@ layoutExpr lexpr@(L _ expr) = do
XAmbiguousFieldOcc{} ->
error "brittany internal error: XAmbiguousFieldOcc"
recordExpression False indentPolicy lexpr rExprDoc rFs
#if MIN_VERSION_ghc(8,8,0) /* ghc-8.6 */
ExprWithTySig _ _ (HsWC _ XHsImplicitBndrs{}) ->
error "brittany internal error: ExprWithTySig HsWC XHsImplicitBndrs"
ExprWithTySig _ _ XHsWildCardBndrs{} ->
error "brittany internal error: ExprWithTySig XHsWildCardBndrs"
ExprWithTySig _ exp1 (HsWC _ (HsIB _ typ1)) -> do
#else
ExprWithTySig (HsWC _ XHsImplicitBndrs{}) _ ->
error "brittany internal error: ExprWithTySig HsWC XHsImplicitBndrs"
ExprWithTySig XHsWildCardBndrs{} _ ->
error "brittany internal error: ExprWithTySig XHsWildCardBndrs"
ExprWithTySig (HsWC _ (HsIB _ typ1)) exp1 -> do
#endif
expDoc <- docSharedWrapper layoutExpr exp1
typDoc <- docSharedWrapper layoutType typ1
docSeq
@ -927,12 +893,6 @@ layoutExpr lexpr@(L _ expr) = do
]
ArithSeq{} ->
briDocByExactInlineOnly "ArithSeq" lexpr
HsSCC{} -> do
-- TODO
briDocByExactInlineOnly "HsSCC{}" lexpr
HsCoreAnn{} -> do
-- TODO
briDocByExactInlineOnly "HsCoreAnn{}" lexpr
HsBracket{} -> do
-- TODO
briDocByExactInlineOnly "HsBracket{}" lexpr
@ -959,43 +919,12 @@ layoutExpr lexpr@(L _ expr) = do
HsStatic{} -> do
-- TODO
briDocByExactInlineOnly "HsStatic{}" lexpr
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
#else
HsArrApp{} -> do
-- TODO
briDocByExactInlineOnly "HsArrApp{}" lexpr
HsArrForm{} -> do
-- TODO
briDocByExactInlineOnly "HsArrForm{}" lexpr
#endif
HsTick{} -> do
-- TODO
briDocByExactInlineOnly "HsTick{}" lexpr
HsBinTick{} -> do
-- TODO
briDocByExactInlineOnly "HsBinTick{}" lexpr
HsTickPragma{} -> do
-- TODO
briDocByExactInlineOnly "HsTickPragma{}" lexpr
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
#else
EWildPat{} -> do
docLit $ Text.pack "_"
EAsPat _ asName asExpr -> do
docSeq
[ docLit $ lrdrNameToText asName <> Text.pack "@"
, layoutExpr asExpr
]
EViewPat{} -> do
-- TODO
briDocByExactInlineOnly "EViewPat{}" lexpr
ELazyPat{} -> do
-- TODO
briDocByExactInlineOnly "ELazyPat{}" lexpr
#endif
HsWrap{} -> do
-- TODO
briDocByExactInlineOnly "HsWrap{}" lexpr
HsConLikeOut{} -> do
-- TODO
briDocByExactInlineOnly "HsWrap{}" lexpr

View File

@ -15,12 +15,8 @@ import Language.Haskell.Brittany.Internal.Types
import Language.Haskell.Brittany.Internal.LayouterBasics
import GHC ( runGhc, GenLocated(L), moduleNameString )
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn
#endif
import Name
import GHC.Types.Name

View File

@ -20,17 +20,12 @@ import GHC ( unLoc
, Located
, ModuleName
)
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
import GHC.Hs.ImpExp
#else
import HsSyn
import HsImpExp
#endif
import Name
import FieldLabel
import qualified FastString
import BasicTypes
import GHC.Types.Name
import GHC.Types.FieldLabel
import qualified GHC.Data.FastString
import GHC.Types.Basic
import Language.Haskell.Brittany.Internal.Utils

View File

@ -12,15 +12,12 @@ import GHC ( unLoc
, moduleNameString
, Located
)
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn
#endif
import Name
import FieldLabel
import qualified FastString
import BasicTypes
import GHC.Types.Name
import GHC.Types.FieldLabel
import qualified GHC.Data.FastString
import GHC.Types.Basic
import GHC.Unit.Types (IsBootInterface(..))
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
import Language.Haskell.Brittany.Internal.Utils
@ -50,14 +47,10 @@ layoutImport importD = case importD of
hiding = maybe False fst mllies
minQLength = length "import qualified "
qLengthReal =
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
let qualifiedPart = if q /= NotQualified then length "qualified " else 0
#else
let qualifiedPart = if q then length "qualified " else 0
#endif
safePart = if safe then length "safe " else 0
pkgPart = maybe 0 ((+ 1) . Text.length) pkgNameT
srcPart = if src then length "{-# SOURCE #-} " else 0
srcPart = case src of { IsBoot -> length "{-# SOURCE #-} "; NotBoot -> 0 }
in length "import " + srcPart + safePart + qualifiedPart + pkgPart
qLength = max minQLength qLengthReal
-- Cost in columns of importColumn
@ -66,13 +59,9 @@ layoutImport importD = case importD of
nameCost = Text.length modNameT + qLength
importQualifiers = docSeq
[ appSep $ docLit $ Text.pack "import"
, if src then appSep $ docLit $ Text.pack "{-# SOURCE #-}" else docEmpty
, case src of { IsBoot -> appSep $ docLit $ Text.pack "{-# SOURCE #-}"; NotBoot -> docEmpty }
, if safe then appSep $ docLit $ Text.pack "safe" else docEmpty
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
, if q /= NotQualified then appSep $ docLit $ Text.pack "qualified" else docEmpty
#else
, if q then appSep $ docLit $ Text.pack "qualified" else docEmpty
#endif
, maybe docEmpty (appSep . docLit) pkgNameT
]
indentName =

View File

@ -11,17 +11,12 @@ import Language.Haskell.Brittany.Internal.Layouters.Import
import Language.Haskell.Brittany.Internal.Config.Types
import GHC (unLoc, runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..))
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
import GHC.Hs.ImpExp
#else
import HsSyn
import HsImpExp
#endif
import Name
import FieldLabel
import qualified FastString
import BasicTypes
import GHC.Types.Name
import GHC.Types.FieldLabel
import qualified GHC.Data.FastString
import GHC.Types.Basic
import Language.Haskell.GHC.ExactPrint as ExactPrint
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
import Language.Haskell.GHC.ExactPrint.Types
@ -34,16 +29,16 @@ import Language.Haskell.Brittany.Internal.Utils
layoutModule :: ToBriDoc HsModule
layoutModule :: ToBriDoc' HsModule
layoutModule lmod@(L _ mod') = case mod' of
-- Implicit module Main
HsModule Nothing _ imports _ _ _ -> do
HsModule _ Nothing _ imports _ _ _ -> do
commentedImports <- transformToCommentedImport imports
-- groupify commentedImports `forM_` tellDebugMessShow
docLines (commentedImportsToDoc <$> sortCommentedImports commentedImports)
-- sortedImports <- sortImports imports
-- docLines $ [layoutImport y i | (y, i) <- sortedImports]
HsModule (Just n) les imports _ _ _ -> do
HsModule _ (Just n) les imports _ _ _ -> do
commentedImports <- transformToCommentedImport imports
-- groupify commentedImports `forM_` tellDebugMessShow
-- sortedImports <- sortImports imports

View File

@ -21,13 +21,9 @@ import GHC ( Located
, ol_val
)
import qualified GHC
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn
#endif
import Name
import BasicTypes
import GHC.Types.Name
import GHC.Types.Basic
import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr
import Language.Haskell.Brittany.Internal.Layouters.Type
@ -45,7 +41,7 @@ import Language.Haskell.Brittany.Internal.Layouters.Type
-- We will use `case .. of` as the imagined prefix to the examples used in
-- the different cases below.
layoutPat :: LPat GhcPs -> ToBriDocM (Seq BriDocNumbered)
layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of
layoutPat lpat@(L _ pat) = docWrapNode lpat $ case pat of
WildPat _ -> fmap Seq.singleton $ docLit $ Text.pack "_"
-- _ -> expr
VarPat _ n ->
@ -54,11 +50,7 @@ layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of
LitPat _ lit ->
fmap Seq.singleton $ allocateNode $ litBriDoc lit
-- 0 -> expr
#if MIN_VERSION_ghc(8,8,0) /* ghc-8.8 */
ParPat _ inner -> do
#else
ParPat _ inner -> do
#endif
-- (nestedpat) -> expr
left <- docLit $ Text.pack "("
right <- docLit $ Text.pack ")"
@ -78,7 +70,7 @@ layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of
-- x1' <- docSeq [docLit $ Text.pack "(", return x1]
-- xN' <- docSeq [return xN, docLit $ Text.pack ")"]
-- return $ (x1' Seq.<| middle) Seq.|> xN'
ConPatIn lname (PrefixCon args) -> do
ConPat _ lname (PrefixCon args) -> do
-- Abc a b c -> expr
nameDoc <- lrdrNameToTextAnn lname
argDocs <- layoutPat `mapM` args
@ -91,18 +83,18 @@ layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of
$ spacifyDocs
$ fmap colsWrapPat argDocs
return $ x1 Seq.<| xR
ConPatIn lname (InfixCon left right) -> do
ConPat _ lname (InfixCon left right) -> do
-- a :< b -> expr
nameDoc <- lrdrNameToTextAnn lname
leftDoc <- appSep . colsWrapPat =<< layoutPat left
rightDoc <- colsWrapPat =<< layoutPat right
middle <- appSep $ docLit nameDoc
return $ Seq.empty Seq.|> leftDoc Seq.|> middle Seq.|> rightDoc
ConPatIn lname (RecCon (HsRecFields [] Nothing)) -> do
ConPat _ lname (RecCon (HsRecFields [] Nothing)) -> do
-- Abc{} -> expr
let t = lrdrNameToText lname
fmap Seq.singleton $ docLit $ t <> Text.pack "{}"
ConPatIn lname (RecCon (HsRecFields fs@(_:_) Nothing)) -> do
ConPat _ lname (RecCon (HsRecFields fs@(_:_) Nothing)) -> do
-- Abc { a = locA, b = locB, c = locC } -> expr1
-- Abc { a, b, c } -> expr2
let t = lrdrNameToText lname
@ -126,22 +118,14 @@ layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of
, docSeparator
, docLit $ Text.pack "}"
]
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
ConPatIn lname (RecCon (HsRecFields [] (Just (L _ 0)))) -> do
#else
ConPatIn lname (RecCon (HsRecFields [] (Just 0))) -> do
#endif
ConPat _ lname (RecCon (HsRecFields [] (Just (L _ 0)))) -> do
-- Abc { .. } -> expr
let t = lrdrNameToText lname
Seq.singleton <$> docSeq
[ appSep $ docLit t
, docLit $ Text.pack "{..}"
]
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
ConPatIn lname (RecCon (HsRecFields fs@(_:_) (Just (L _ dotdoti)))) | dotdoti == length fs -> do
#else
ConPatIn lname (RecCon (HsRecFields fs@(_:_) (Just dotdoti))) | dotdoti == length fs -> do
#endif
ConPat _ lname (RecCon (HsRecFields fs@(_:_) (Just (L _ dotdoti)))) | dotdoti == length fs -> do
-- Abc { a = locA, .. }
let t = lrdrNameToText lname
fds <- fs `forM` \(L _ (HsRecField (L _ fieldOcc) fPat pun)) -> do
@ -172,11 +156,7 @@ layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of
AsPat _ asName asPat -> do
-- bind@nestedpat -> expr
wrapPatPrepend asPat (docLit $ lrdrNameToText asName <> Text.pack "@")
#if MIN_VERSION_ghc(8,8,0) /* ghc-8.8 */
SigPat _ pat1 (HsWC _ (HsIB _ ty1)) -> do
#else
SigPat (HsWC _ (HsIB _ ty1)) pat1 -> do
#endif
SigPat _ pat1 (HsPS _ ty1) -> do
-- i :: Int -> expr
patDocs <- layoutPat pat1
tyDoc <- docSharedWrapper layoutType ty1
@ -214,7 +194,7 @@ layoutPat (ghcDL -> lpat@(L _ pat)) = docWrapNode lpat $ case pat of
Just{} -> Seq.fromList [negDoc, litDoc]
Nothing -> Seq.singleton litDoc
_ -> return <$> briDocByExactInlineOnly "some unknown pattern" (ghcDL lpat)
_ -> return <$> briDocByExactInlineOnly "some unknown pattern" lpat
colsWrapPat :: Seq BriDocNumbered -> ToBriDocM BriDocNumbered
colsWrapPat = docCols ColPatterns . fmap return . Foldable.toList

View File

@ -17,14 +17,10 @@ import GHC ( runGhc
, GenLocated(L)
, moduleNameString
)
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn
#endif
import Name
import qualified FastString
import BasicTypes
import GHC.Types.Name
import qualified GHC.Data.FastString as FastString
import GHC.Types.Basic
import Language.Haskell.Brittany.Internal.Layouters.Pattern
import Language.Haskell.Brittany.Internal.Layouters.Decl
@ -38,9 +34,9 @@ layoutStmt lstmt@(L _ stmt) = do
indentAmount :: Int <-
mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
docWrapNode lstmt $ case stmt of
LastStmt _ body False _ -> do
LastStmt _ body (Just False) _ -> do
layoutExpr body
BindStmt _ lPat expr _ _ -> do
BindStmt _ lPat expr -> do
patDoc <- fmap return $ colsWrapPat =<< layoutPat lPat
expDoc <- docSharedWrapper layoutExpr expr
docAlt

View File

@ -13,14 +13,10 @@ import Language.Haskell.Brittany.Internal.Types
import Language.Haskell.Brittany.Internal.LayouterBasics
import GHC ( runGhc, GenLocated(L), moduleNameString )
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn
#endif
import Name
import qualified FastString
import BasicTypes
import GHC.Types.Name
import qualified GHC.Data.FastString
import GHC.Types.Basic

View File

@ -25,15 +25,11 @@ import GHC ( runGhc
, AnnKeywordId (..)
)
import Language.Haskell.GHC.ExactPrint.Types ( mkAnnKey )
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs
#else
import HsSyn
#endif
import Name
import Outputable ( ftext, showSDocUnsafe )
import BasicTypes
import qualified SrcLoc
import GHC.Types.Name
import GHC.Utils.Outputable ( ftext, showSDocUnsafe )
import GHC.Types.Basic
import qualified GHC.Types.SrcLoc
import DataTreePrint
@ -45,21 +41,14 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
HsTyVar _ promoted name -> do
t <- lrdrNameToTextAnnTypeEqualityIsSpecial name
case promoted of
#if MIN_VERSION_ghc(8,8,0)
IsPromoted -> docSeq
#else /* ghc-8.6 */
Promoted -> docSeq
#endif
[ docSeparator
, docTick
, docWrapNode name $ docLit t
]
NotPromoted -> docWrapNode name $ docLit t
#if MIN_VERSION_ghc(8,10,1)
HsForAllTy _ _ bndrs (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do
#else
HsForAllTy _ bndrs (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do
#endif
HsForAllTy _ hsf (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do
let bndrs = hsf_vis_bndrs hsf
typeDoc <- docSharedWrapper layoutType typ2
tyVarDocs <- layoutTyVarBndrs bndrs
cntxtDocs <- cntxts `forM` docSharedWrapper layoutType
@ -145,11 +134,8 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
]
)
]
#if MIN_VERSION_ghc(8,10,1)
HsForAllTy _ _ bndrs typ2 -> do
#else
HsForAllTy _ bndrs typ2 -> do
#endif
HsForAllTy _ hsf typ2 -> do
let bndrs = hsf_vis_bndrs hsf
typeDoc <- layoutType typ2
tyVarDocs <- layoutTyVarBndrs bndrs
let maybeForceML = case typ2 of
@ -254,7 +240,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
]
)
]
HsFunTy _ typ1 typ2 -> do
HsFunTy _ _ typ1 typ2 -> do
typeDoc1 <- docSharedWrapper layoutType typ1
typeDoc2 <- docSharedWrapper layoutType typ2
let maybeForceML = case typ2 of
@ -624,7 +610,6 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
then docLit $ Text.pack "\x2605" -- Unicode star
else docLit $ Text.pack "*"
XHsType{} -> error "brittany internal error: XHsType"
#if MIN_VERSION_ghc(8,8,0)
HsAppKindTy _ ty kind -> do
t <- docSharedWrapper layoutType ty
k <- docSharedWrapper layoutType kind
@ -639,14 +624,13 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
t
(docSeq [docLit $ Text.pack "@", k ])
]
#endif
layoutTyVarBndrs
:: [LHsTyVarBndr GhcPs]
:: [LHsTyVarBndr () GhcPs]
-> ToBriDocM [(Text, Maybe (ToBriDocM BriDocNumbered))]
layoutTyVarBndrs = mapM $ \case
(L _ (UserTyVar _ name)) -> return $ (lrdrNameToText name, Nothing)
(L _ (KindedTyVar _ lrdrName kind)) -> do
(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"

View File

@ -8,16 +8,9 @@ where
-- rather project-specific stuff:
---------------------------------
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import GHC.Hs.Extension as E ( GhcPs )
#else
import HsExtension as E ( GhcPs )
#endif /* ghc-8.10.1 */
import RdrName as E ( RdrName )
#if MIN_VERSION_ghc(8,8,0)
import qualified GHC ( dL, HasSrcSpan, SrcSpanLess )
#endif
import GHC.Types.Name.Reader as E ( RdrName )
import qualified GHC ( Located )
@ -402,12 +395,3 @@ import Data.Data as E ( toConstr
todo :: a
todo = error "todo"
#if MIN_VERSION_ghc(8,8,0)
ghcDL :: GHC.HasSrcSpan a => a -> GHC.Located (GHC.SrcSpanLess a)
ghcDL = GHC.dL
#else /* ghc-8.6 */
ghcDL :: GHC.Located a -> GHC.Located a
ghcDL x = x
#endif

View File

@ -46,11 +46,11 @@ import Data.Generics.Aliases
import qualified Text.PrettyPrint as PP
import Text.PrettyPrint ( ($+$), (<+>) )
import qualified Outputable as GHC
import qualified DynFlags as GHC
import qualified FastString as GHC
import qualified SrcLoc as GHC
import OccName ( occNameString )
import qualified GHC.Utils.Outputable as GHC
import qualified GHC.Driver.Session as GHC
import qualified GHC.Data.FastString as GHC
import qualified GHC.Types.SrcLoc as GHC
import GHC.Types.Name.Occurrence as OccName ( occNameString )
import qualified Data.ByteString as B
import DataTreePrint
@ -59,11 +59,7 @@ import Language.Haskell.Brittany.Internal.Config.Types
import Language.Haskell.Brittany.Internal.Types
import qualified Data.Generics.Uniplate.Direct as Uniplate
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
import qualified GHC.Hs.Extension as HsExtension
#else
import qualified HsExtension
#endif /* ghc-8.10.1 */
@ -301,11 +297,5 @@ lines' s = case break (== '\n') s of
(s1, [_]) -> [s1, ""]
(s1, (_:r)) -> s1 : lines' r
#if MIN_VERSION_ghc(8,10,1) /* ghc-8.10.1 */
absurdExt :: HsExtension.NoExtCon -> a
absurdExt = HsExtension.noExtCon
#else
-- | A method to dismiss NoExt patterns for total matches
absurdExt :: HsExtension.NoExt -> a
absurdExt = error "cannot construct NoExt"
#endif

View File

@ -16,7 +16,7 @@ import qualified Data.Map as Map
import qualified Data.Monoid
import GHC ( GenLocated(L) )
import Outputable ( Outputable(..)
import GHC.Utils.Outputable ( Outputable(..)
, showSDocUnsafe
)
@ -46,7 +46,7 @@ import qualified System.Exit
import qualified System.Directory as Directory
import qualified System.FilePath.Posix as FilePath
import qualified DynFlags as GHC
import qualified GHC.Driver.Session as GHC
import qualified GHC.LanguageExtensions.Type as GHC
import Paths_brittany