hindent 6.1.0 → 6.1.1
raw patch · 11 files changed
+251/−152 lines, 11 filesdep ~ghc-lib-parserPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: ghc-lib-parser
API changes (from Hackage documentation)
- HIndent: type HsModule' = HsModule
+ HIndent: type HsModule' = HsModule GhcPs
Files
- CHANGELOG.md +11/−0
- LICENSE.md +2/−0
- README.md +3/−5
- TESTS.md +25/−0
- hindent.cabal +9/−53
- src/HIndent.hs +5/−20
- src/HIndent/Parse.hs +27/−1
- src/HIndent/Pretty.hs +120/−60
- src/HIndent/Pretty/NodeComments.hs +29/−6
- src/HIndent/Pretty/Types.hs +0/−6
- src/HIndent/Printer.hs +20/−1
CHANGELOG.md view
@@ -4,10 +4,16 @@ ### Added +- Support for GHC 9.8 ([#775]).+ ### Changed ### Fixed +- Wrong default HIndent configuration in [`README.md`] ([#750]).+- Fix the bug of panicking when the given source code has CPP lines and space-prefixed lines ([#780]).+- Fix not pretty-printing multiple signatures in a `SPECIALISE` ([#784]).+ ### Removed ## [6.1.0] - 2023-05-17@@ -362,6 +368,10 @@ [@uhbif19]: https://github.com/uhbif19 [@toku-sa-n]: https://github.com/toku-sa-n +[#784]: https://github.com/mihaimaruseac/hindent/pull/784+[#780]: https://github.com/mihaimaruseac/hindent/pull/780+[#775]: https://github.com/mihaimaruseac/hindent/pull/775+[#750]: https://github.com/mihaimaruseac/hindent/pull/750 [#742]: https://github.com/mihaimaruseac/hindent/pull/742 [#741]: https://github.com/mihaimaruseac/hindent/pull/741 [#739]: https://github.com/mihaimaruseac/hindent/pull/739@@ -407,5 +417,6 @@ [`TESTS.md`]: TESTS.md [`BENCHMARKS.md`]: BENCHMARKS.md+[`README.md`]: README.md [Johan Tibell's Haskell Style Guide]: https://github.com/tibbe/haskell-style-guide/blob/master/haskell-style.md
LICENSE.md view
@@ -1,4 +1,6 @@ Copyright (c) 2014, Chris Done+Copyright (c) 2015, Andrew Gibiansky+Copyright (c) 2021, Mihai Maruseac All rights reserved.
README.md view
@@ -56,11 +56,9 @@ indent-size: 2 line-length: 80 force-trailing-newline: true-line-breaks: [":>", ":<|>"]-extensions:- - DataKinds- - GADTs- - TypeApplications+sort-imports: true+line-breaks: []+extensions: [] ``` By default, hindent preserves the newline or lack of newline in your input. With `force-trailing-newline`, it will make sure there is always a trailing newline.
TESTS.md view
@@ -1416,6 +1416,13 @@ {-# SPECIALISE lookup :: [(Int, Int)] -> Int -> Maybe Int #-} ``` +Multiple signatures in a `SPECIALISE`++```haskell+-- https://github.com/mihaimaruseac/hindent/pull/784+{-# SPECIALISE foo :: Int -> Int, Double -> Double #-}+```+ A `SCC` ```haskell@@ -3408,6 +3415,24 @@ isDebug = True #else isDebug = False+#endif+```++Conditionals inside a `where` with empty lines and CPP++```haskell+-- https://github.com/mihaimaruseac/hindent/issues/779+foo = bar + baz+ where++#if 0+ bar = 1+ + baz = 1+#else+ bar = 2+ + baz = 2 #endif ```
hindent.cabal view
@@ -1,13 +1,14 @@ cabal-version: 2.0 --- This file has been generated from package.yaml by hpack version 0.35.1.+-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack name: hindent-version: 6.1.0+version: 6.1.1 synopsis: Extensible Haskell pretty printer-description: Extensible Haskell pretty printer. Both a library and an executable. See the GitHub page for usage / explanation: <https://github.com/mihaimaruseac/hindent>+description: Extensible Haskell pretty printer. Both a library and an executable.+ See the GitHub page for usage \/ explanation: <https://github.com/mihaimaruseac/hindent> category: Development stability: Unstable homepage: https://github.com/mihaimaruseac/hindent@@ -85,6 +86,7 @@ , directory , exceptions , filepath+ , ghc-lib-parser >=9.2 && <9.9 , ghc-lib-parser-ex , monad-loops , mtl@@ -99,16 +101,6 @@ , utf8-string , yaml default-language: Haskell2010- if impl(ghc >= 9.6.1)- build-depends:- ghc-lib-parser >=9.6.1.20230312 && <9.7- else- if impl(ghc >= 9.4.1)- build-depends:- ghc-lib-parser >=9.4.1.20220807 && <9.5- else- build-depends:- ghc-lib-parser >=9.2.3.20220527 && <9.3 library hindent-internal exposed-modules:@@ -129,6 +121,7 @@ , directory , exceptions , filepath+ , ghc-lib-parser >=9.2 && <9.9 , ghc-lib-parser-ex , monad-loops , mtl@@ -143,16 +136,6 @@ , utf8-string , yaml default-language: Haskell2010- if impl(ghc >= 9.6.1)- build-depends:- ghc-lib-parser >=9.6.1.20230312 && <9.7- else- if impl(ghc >= 9.4.1)- build-depends:- ghc-lib-parser >=9.4.1.20220807 && <9.5- else- build-depends:- ghc-lib-parser >=9.2.3.20220527 && <9.3 executable hindent main-is: Main.hs@@ -171,6 +154,7 @@ , directory , exceptions , filepath+ , ghc-lib-parser >=9.2 && <9.9 , ghc-lib-parser-ex , hindent , monad-loops@@ -186,16 +170,6 @@ , utf8-string , yaml default-language: Haskell2010- if impl(ghc >= 9.6.1)- build-depends:- ghc-lib-parser >=9.6.1.20230312 && <9.7- else- if impl(ghc >= 9.4.1)- build-depends:- ghc-lib-parser >=9.4.1.20220807 && <9.5- else- build-depends:- ghc-lib-parser >=9.2.3.20220527 && <9.3 test-suite hindent-test type: exitcode-stdio-1.0@@ -216,6 +190,7 @@ , directory , exceptions , filepath+ , ghc-lib-parser >=9.2 && <9.9 , ghc-lib-parser-ex , hindent , hindent-internal@@ -233,16 +208,6 @@ , utf8-string , yaml default-language: Haskell2010- if impl(ghc >= 9.6.1)- build-depends:- ghc-lib-parser >=9.6.1.20230312 && <9.7- else- if impl(ghc >= 9.4.1)- build-depends:- ghc-lib-parser >=9.4.1.20220807 && <9.5- else- build-depends:- ghc-lib-parser >=9.2.3.20220527 && <9.3 benchmark hindent-bench type: exitcode-stdio-1.0@@ -264,6 +229,7 @@ , directory , exceptions , filepath+ , ghc-lib-parser >=9.2 && <9.9 , ghc-lib-parser-ex , hindent , hindent-internal@@ -280,13 +246,3 @@ , utf8-string , yaml default-language: Haskell2010- if impl(ghc >= 9.6.1)- build-depends:- ghc-lib-parser >=9.6.1.20230312 && <9.7- else- if impl(ghc >= 9.4.1)- build-depends:- ghc-lib-parser >=9.4.1.20220807 && <9.5- else- build-depends:- ghc-lib-parser >=9.2.3.20220527 && <9.3
src/HIndent.hs view
@@ -25,7 +25,6 @@ import Control.Exception import Control.Monad-import Control.Monad.State.Strict import Data.ByteString (ByteString) import qualified Data.ByteString as S import Data.ByteString.Builder (Builder)@@ -123,7 +122,11 @@ processBlock (HaskellSource yPos text) = let ls = S8.lines text prefix = findPrefix ls- code = unlines' (map (stripPrefix prefix) ls)+ code = unlines' (map stripPrefixIfNotNull ls)+ stripPrefixIfNotNull s =+ if S.null s+ then s+ else stripPrefix prefix s in case parseModule mfilepath allExts (UTF8.toString code) of POk _ m -> Right@@ -180,21 +183,3 @@ prettyPrint :: Config -> HsModule' -> Builder prettyPrint config m = runPrinterStyle config (pretty $ modifyASTForPrettyPrinting m)---- | Pretty print the given printable thing.-runPrinterStyle :: Config -> Printer () -> Builder-runPrinterStyle config m =- maybe (error "Printer failed with mzero call.") psOutput- $ execStateT (runPrinter m) initState- where- initState =- PrintState- { psIndentLevel = 0- , psOutput = mempty- , psNewline = False- , psColumn = 0- , psLine = 1- , psConfig = config- , psFitOnOneLine = False- , psEolComment = False- }
src/HIndent/Parse.hs view
@@ -20,6 +20,9 @@ import GHC.Utils.Error import GHC.Utils.Outputable hiding ((<>), empty, text) #endif+#if MIN_VERSION_ghc_lib_parser(9,8,1)+import GHC.Unit.Module.Warnings+#endif -- | This function parses the given Haskell source code with the given file -- path (if any) and parse options. parseModule ::@@ -49,7 +52,30 @@ -- The 'StarIsType' extension is always enabled to compile a code using -- kinds like '* -> *'. parserOptsFromExtensions :: [GLP.Extension] -> ParserOpts-#if MIN_VERSION_ghc_lib_parser(9,4,1)+#if MIN_VERSION_ghc_lib_parser(9,8,1)+parserOptsFromExtensions opts =+ mkParserOpts+ opts'+ diagOpts+ [] -- There are no supported languages and extensions (this list is used only in error messages)+ False -- Safe imports are off.+ False -- Haddock comments are treated as normal comments.+ True -- Comments are kept in an AST.+ False -- Do not update the internal position of a comment.+ where+ opts' = ES.fromList $ GLP.StarIsType : opts+ diagOpts =+ DiagOpts+ { diag_warning_flags = ES.empty+ , diag_fatal_warning_flags = ES.empty+ , diag_custom_warning_categories = emptyWarningCategorySet+ , diag_fatal_custom_warning_categories = emptyWarningCategorySet+ , diag_warn_is_error = False+ , diag_reverse_errors = False+ , diag_max_errors = Nothing+ , diag_ppr_ctx = defaultSDocContext+ }+#elif MIN_VERSION_ghc_lib_parser(9,4,1) parserOptsFromExtensions opts = mkParserOpts opts'
src/HIndent/Pretty.hs view
@@ -139,6 +139,7 @@ , (importsExist m, prettyImports) , (declsExist m, prettyDecls) ]+ prettyModuleDecl :: HsModule GhcPs -> Printer () prettyModuleDecl HsModule {hsmodName = Nothing} = error "The module declaration does not exist." prettyModuleDecl HsModule { hsmodName = Just name@@ -249,7 +250,7 @@ pretty' (InstD _ inst) = pretty inst pretty' (DerivD _ x) = pretty x pretty' (ValD _ bind) = pretty bind- pretty' (SigD _ s) = pretty $ DeclSig s+ pretty' (SigD _ s) = pretty s pretty' (KindSigD _ x) = pretty x pretty' (DefD _ x) = pretty x pretty' (ForD _ x) = pretty x@@ -401,18 +402,21 @@ string " ::" horizontal <-|> vertical where- horizontal = space >> pretty (hswc_body params)+ horizontal = do+ space+ pretty $ HsSigTypeInsideDeclSig <$> hswc_body params vertical = do headLen <- printerLength printFunName indentSpaces <- getIndentSpaces if headLen < indentSpaces- then space- else newline- indentedBlock- $ indentedWithSpace 3- $ pretty- $ HsSigTypeInsideVerticalFuncSig <$> hswc_body params- printFunName = pretty $ head funName+ then space |=> pretty (HsSigTypeInsideDeclSig <$> hswc_body params)+ else do+ newline+ indentedBlock+ $ indentedWithSpace 3+ $ pretty+ $ HsSigTypeInsideDeclSig <$> hswc_body params+ printFunName = hCommaSep $ fmap pretty funName pretty' (PatSynSig _ names sig) = spaced [string "pattern", hCommaSep $ fmap pretty names, string "::", pretty sig]@@ -437,12 +441,12 @@ pretty' (FixSig _ x) = pretty x pretty' (InlineSig _ name detail) = spaced [string "{-#", pretty detail, pretty name, string "#-}"]- pretty' (SpecSig _ name sig _) =+ pretty' (SpecSig _ name sigs _) = spaced [ string "{-# SPECIALISE" , pretty name , string "::"- , pretty $ head sig+ , hCommaSep $ fmap pretty sigs , string "#-}" ] pretty' (SpecInstSig _ sig) =@@ -466,18 +470,21 @@ string " ::" horizontal <-|> vertical where- horizontal = space >> pretty (hswc_body params)+ horizontal = do+ space+ pretty $ HsSigTypeInsideDeclSig <$> hswc_body params vertical = do headLen <- printerLength printFunName indentSpaces <- getIndentSpaces if headLen < indentSpaces- then space- else newline- indentedBlock- $ indentedWithSpace 3- $ pretty- $ HsSigTypeInsideVerticalFuncSig <$> hswc_body params- printFunName = pretty $ head funName+ then space |=> pretty (HsSigTypeInsideDeclSig <$> hswc_body params)+ else do+ newline+ indentedBlock+ $ indentedWithSpace 3+ $ pretty+ $ HsSigTypeInsideDeclSig <$> hswc_body params+ printFunName = hCommaSep $ fmap pretty funName pretty' (PatSynSig _ names sig) = spaced [string "pattern", hCommaSep $ fmap pretty names, string "::", pretty sig]@@ -503,12 +510,12 @@ pretty' (FixSig _ x) = pretty x pretty' (InlineSig _ name detail) = spaced [string "{-#", pretty detail, pretty name, string "#-}"]- pretty' (SpecSig _ name sig _) =+ pretty' (SpecSig _ name sigs _) = spaced [ string "{-# SPECIALISE" , pretty name , string "::"- , pretty $ head sig+ , hCommaSep $ fmap pretty sigs , string "#-}" ] pretty' (SpecInstSig _ _ sig) =@@ -526,28 +533,6 @@ , string "#-}" ] #endif-instance Pretty DeclSig where- pretty' (DeclSig (TypeSig _ funName params)) = do- printFunName- string " ::"- horizontal <-|> vertical- where- horizontal = do- space- pretty $ HsSigTypeInsideDeclSig <$> hswc_body params- vertical = do- headLen <- printerLength printFunName- indentSpaces <- getIndentSpaces- if headLen < indentSpaces- then space |=> pretty (HsSigTypeInsideDeclSig <$> hswc_body params)- else do- newline- indentedBlock- $ indentedWithSpace 3- $ pretty- $ HsSigTypeInsideDeclSig <$> hswc_body params- printFunName = hCommaSep $ fmap pretty funName- pretty' (DeclSig x) = pretty x #if MIN_VERSION_ghc_lib_parser(9,6,1) instance Pretty (HsDataDefn GhcPs) where pretty' HsDataDefn {..} =@@ -714,7 +699,7 @@ string " @" pretty r #endif-prettyHsExpr (OpApp _ l o r) = pretty (InfixApp l o r False)+prettyHsExpr (OpApp _ l o r) = pretty (InfixApp l o r) prettyHsExpr (NegApp _ x _) = string "-" >> pretty x #if MIN_VERSION_ghc_lib_parser(9,4,1) prettyHsExpr (HsPar _ _ expr _) = parens $ pretty expr@@ -797,9 +782,35 @@ vertical = do pretty name (space >> pretty fields) <-|> (newline >> indentedBlock (pretty fields))-#if MIN_VERSION_ghc_lib_parser(9,4,1)+#if MIN_VERSION_ghc_lib_parser(9,8,1) prettyHsExpr (RecordUpd _ name fields) = hor <-|> ver where+ hor = spaced [pretty name, printHorFields fields]+ ver = do+ pretty name+ newline+ indentedBlock $ printHorFields fields <-|> printVerFields fields+ printHorFields RegularRecUpdFields {..} =+ hFields $ fmap (`printCommentsAnd` horField) recUpdFields+ printHorFields OverloadedRecUpdFields {..} =+ hFields $ fmap (`printCommentsAnd` horField) olRecUpdFields+ printVerFields RegularRecUpdFields {..} =+ vFields $ fmap printField recUpdFields+ printVerFields OverloadedRecUpdFields {..} =+ vFields $ fmap printField olRecUpdFields+ printField x = printCommentsAnd x $ (<-|>) <$> horField <*> verField+ horField HsFieldBind {..} = do+ pretty hfbLHS+ string " = "+ pretty hfbRHS+ verField HsFieldBind {..} = do+ pretty hfbLHS+ string " ="+ newline+ indentedBlock $ pretty hfbRHS+#elif MIN_VERSION_ghc_lib_parser(9,4,1)+prettyHsExpr (RecordUpd _ name fields) = hor <-|> ver+ where hor = spaced [pretty name, either printHorFields printHorFields fields] ver = do pretty name@@ -1207,7 +1218,7 @@ ver = newline >> indentedBlock (pretty body) pretty' ApplicativeStmt {} = notGeneratedByParser pretty' (BodyStmt _ (L loc (OpApp _ l o r)) _ _) =- pretty (L loc (InfixApp l o r True))+ pretty (L loc (InfixApp l o r)) pretty' (BodyStmt _ body _ _) = pretty body pretty' (LetStmt _ l) = string "let " |=> pretty l pretty' (ParStmt _ xs _ _) = hvBarSep $ fmap pretty xs@@ -1308,7 +1319,11 @@ where hor = spaced $ fmap pretty [l, r] ver = pretty $ HsTypeWithVerticalAppTy x+#if MIN_VERSION_ghc_lib_parser(9,8,1)+prettyHsType (HsAppKindTy _ l _ r) = pretty l >> string " @" >> pretty r+#else prettyHsType (HsAppKindTy _ l r) = pretty l >> string " @" >> pretty r+#endif prettyHsType (HsFunTy _ _ a b) = (pretty a >> string " -> ") |=> pretty b prettyHsType (HsListTy _ xs) = brackets $ pretty xs prettyHsType (HsTupleTy _ HsUnboxedTuple []) = string "(# #)"@@ -1317,11 +1332,11 @@ prettyHsType (HsTupleTy _ HsBoxedOrConstraintTuple xs) = hvTuple' $ fmap pretty xs prettyHsType (HsSumTy _ xs) = hvUnboxedSum' $ fmap pretty xs- -- For `HsOpTy`, we do not need a single quote for the infix operator. An- -- explicit promotion is necessary if there is a data constructor and- -- a type with the same name. However, infix data constructors never- -- share their names with types because types cannot contain symbols.- -- Thus there is no ambiguity.+-- For `HsOpTy`, we do not need a single quote for the infix operator. An+-- explicit promotion is necessary if there is a data constructor and+-- a type with the same name. However, infix data constructors never+-- share their names with types because types cannot contain symbols.+-- Thus there is no ambiguity. #if MIN_VERSION_ghc_lib_parser(9,4,1) prettyHsType (HsOpTy _ _ l op r) = do lineBreak <- gets (configLineBreaks . psConfig)@@ -1608,7 +1623,7 @@ pretty' (TExpBr _ x) = typedBrackets $ pretty x #endif instance Pretty SigBindFamily where- pretty' (Sig x) = pretty $ DeclSig x+ pretty' (Sig x) = pretty x pretty' (Bind x) = pretty x pretty' (TypeFamily x) = pretty x pretty' (TyFamInst x) = pretty x@@ -2053,15 +2068,25 @@ case famEqnFor of DataFamInstDeclForTopLevel -> "data instance" DataFamInstDeclForInsideClassInst -> "data"- -- | HsArg (LHsType GhcPs) (LHsType GhcPs)+#if MIN_VERSION_ghc_lib_parser(9,8,1) instance Pretty (HsArg+ GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)) (GenLocated SrcSpanAnnA (HsType GhcPs))) where pretty' (HsValArg x) = pretty x pretty' (HsTypeArg _ x) = string "@" >> pretty x pretty' HsArgPar {} = notUsedInParsedStage+#else+instance Pretty+ (HsArg+ (GenLocated SrcSpanAnnA (HsType GhcPs))+ (GenLocated SrcSpanAnnA (HsType GhcPs))) where+ pretty' (HsValArg x) = pretty x+ pretty' (HsTypeArg _ x) = string "@" >> pretty x+ pretty' HsArgPar {} = notUsedInParsedStage+#endif #if MIN_VERSION_ghc_lib_parser(9,4,1) instance Pretty (HsQuote GhcPs) where pretty' (ExpBr _ x) = brackets $ wrapWithBars $ pretty x@@ -2080,10 +2105,25 @@ instance Pretty (WarnDecls GhcPs) where pretty' (Warnings _ _ x) = lined $ fmap pretty x #endif+#if MIN_VERSION_ghc_lib_parser(9,8,1) instance Pretty (WarnDecl GhcPs) where pretty' (Warning _ names deprecatedOrWarning) = case deprecatedOrWarning of DeprecatedTxt _ reasons -> prettyWithTitleReasons "DEPRECATED" reasons+ WarningTxt _ _ reasons -> prettyWithTitleReasons "WARNING" reasons+ where+ prettyWithTitleReasons title reasons =+ lined+ [ string $ "{-# " ++ title+ , spaced+ [hCommaSep $ fmap pretty names, hCommaSep $ fmap pretty reasons]+ , string " #-}"+ ]+#else+instance Pretty (WarnDecl GhcPs) where+ pretty' (Warning _ names deprecatedOrWarning) =+ case deprecatedOrWarning of+ DeprecatedTxt _ reasons -> prettyWithTitleReasons "DEPRECATED" reasons WarningTxt _ reasons -> prettyWithTitleReasons "WARNING" reasons where prettyWithTitleReasons title reasons =@@ -2093,6 +2133,7 @@ [hCommaSep $ fmap pretty names, hCommaSep $ fmap pretty reasons] , string " #-}" ]+#endif #if MIN_VERSION_ghc_lib_parser(9,4,1) instance Pretty (WithHsDocIdentifiers StringLiteral GhcPs) where pretty' WithHsDocIdentifiers {..} = pretty hsDocString@@ -2218,11 +2259,16 @@ , string "::" , pretty fd_sig_ty ]-#if MIN_VERSION_ghc_lib_parser(9,6,1)+#if MIN_VERSION_ghc_lib_parser(9,8,0) instance Pretty (ForeignImport GhcPs) where pretty' (CImport (L _ (SourceText s)) conv safety _ _) =- spaced [pretty conv, pretty safety, string s]+ spaced [pretty conv, pretty safety, output s] pretty' (CImport _ conv safety _ _) = spaced [pretty conv, pretty safety]+#elif MIN_VERSION_ghc_lib_parser(9,6,0)+instance Pretty (ForeignImport GhcPs) where+ pretty' (CImport (L _ (SourceText s)) conv safety _ _ ) =+ spaced [pretty conv, pretty safety, string s]+ pretty' (CImport _ conv safety _ _) = spaced [pretty conv, pretty safety] #else instance Pretty ForeignImport where pretty' (CImport conv safety _ _ (L _ (SourceText s))) =@@ -2230,8 +2276,12 @@ pretty' (CImport conv safety _ _ _) = spaced [pretty conv, pretty safety] #endif -#if MIN_VERSION_ghc_lib_parser(9,6,1)+#if MIN_VERSION_ghc_lib_parser(9,8,0) instance Pretty (ForeignExport GhcPs) where+ pretty' (CExport (L _ (SourceText s)) conv) = spaced [pretty conv, output s]+ pretty' (CExport _ conv) = pretty conv+#elif MIN_VERSION_ghc_lib_parser(9,6,0)+instance Pretty (ForeignExport GhcPs) where pretty' (CExport (L _ (SourceText s)) conv) = spaced [pretty conv, string s] pretty' (CExport _ conv) = pretty conv #else@@ -2359,11 +2409,15 @@ pretty' (HsIntegral x) = pretty x pretty' (HsFractional x) = pretty x pretty' (HsIsString _ x) = string $ unpackFS x-+#if MIN_VERSION_ghc_lib_parser(9,8,1) instance Pretty IntegralLit where+ pretty' IL {il_text = SourceText s} = output s+ pretty' IL {..} = string $ show il_value+#else+instance Pretty IntegralLit where pretty' IL {il_text = SourceText s} = string s pretty' IL {..} = string $ show il_value-+#endif instance Pretty FractionalLit where pretty' = output @@ -2553,13 +2607,19 @@ pretty' StdCallConv = string "stdcall" pretty' PrimCallConv = string "prim" pretty' JavaScriptCallConv = string "javascript"-+#if MIN_VERSION_ghc_lib_parser(9,8,1) instance Pretty ModuleDeprecatedPragma where+ pretty' (ModuleDeprecatedPragma (WarningTxt _ _ xs)) =+ spaced [string "{-# WARNING", spaced $ fmap pretty xs, string "#-}"]+ pretty' (ModuleDeprecatedPragma (DeprecatedTxt _ xs)) =+ spaced [string "{-# DEPRECATED", spaced $ fmap pretty xs, string "#-}"]+#else+instance Pretty ModuleDeprecatedPragma where pretty' (ModuleDeprecatedPragma (WarningTxt _ xs)) = spaced [string "{-# WARNING", spaced $ fmap pretty xs, string "#-}"] pretty' (ModuleDeprecatedPragma (DeprecatedTxt _ xs)) = spaced [string "{-# DEPRECATED", spaced $ fmap pretty xs, string "#-}"]-+#endif instance Pretty HsSrcBang where pretty' (HsSrcBang _ unpack strictness) = do pretty unpack
src/HIndent/Pretty/NodeComments.hs view
@@ -147,9 +147,6 @@ nodeComments (SCCFunSig x _ _ _) = nodeComments x nodeComments (CompleteMatchSig x _ _ _) = nodeComments x #endif-instance CommentExtraction DeclSig where- nodeComments (DeclSig x) = nodeComments x- instance CommentExtraction (HsDataDefn GhcPs) where nodeComments HsDataDefn {} = emptyNodeComments @@ -623,9 +620,19 @@ instance CommentExtraction ModuleNameWithPrefix where nodeComments ModuleNameWithPrefix {} = emptyNodeComments-+#if MIN_VERSION_ghc_lib_parser(9,8,1) instance CommentExtraction (IE GhcPs) where nodeComments IEVar {} = emptyNodeComments+ nodeComments (IEThingAbs (_, x) _) = nodeComments x+ nodeComments (IEThingAll (_, x) _) = nodeComments x+ nodeComments (IEThingWith (_, x) _ _ _) = nodeComments x+ nodeComments (IEModuleContents (_, x) _) = nodeComments x+ nodeComments IEGroup {} = emptyNodeComments+ nodeComments IEDoc {} = emptyNodeComments+ nodeComments IEDocNamed {} = emptyNodeComments+#else+instance CommentExtraction (IE GhcPs) where+ nodeComments IEVar {} = emptyNodeComments nodeComments (IEThingAbs x _) = nodeComments x nodeComments (IEThingAll x _) = nodeComments x nodeComments (IEThingWith x _ _ _) = nodeComments x@@ -633,7 +640,7 @@ nodeComments IEGroup {} = emptyNodeComments nodeComments IEDoc {} = emptyNodeComments nodeComments IEDocNamed {} = emptyNodeComments-+#endif instance CommentExtraction (FamEqn GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))) where nodeComments FamEqn {..} = nodeComments feqn_ext@@ -644,15 +651,25 @@ -- | Pretty-print a data instance. instance CommentExtraction (FamEqn GhcPs (HsDataDefn GhcPs)) where nodeComments FamEqn {..} = nodeComments feqn_ext- -- | HsArg (LHsType GhcPs) (LHsType GhcPs)+#if MIN_VERSION_ghc_lib_parser(9,8,1) instance CommentExtraction (HsArg+ GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)) (GenLocated SrcSpanAnnA (HsType GhcPs))) where nodeComments HsValArg {} = emptyNodeComments nodeComments HsTypeArg {} = emptyNodeComments nodeComments HsArgPar {} = emptyNodeComments+#else+instance CommentExtraction+ (HsArg+ (GenLocated SrcSpanAnnA (HsType GhcPs))+ (GenLocated SrcSpanAnnA (HsType GhcPs))) where+ nodeComments HsValArg {} = emptyNodeComments+ nodeComments HsTypeArg {} = emptyNodeComments+ nodeComments HsArgPar {} = emptyNodeComments+#endif #if MIN_VERSION_ghc_lib_parser(9,4,1) instance CommentExtraction (HsQuote GhcPs) where nodeComments ExpBr {} = emptyNodeComments@@ -969,6 +986,12 @@ instance CommentExtraction (HsUntypedSplice GhcPs) where nodeComments (HsUntypedSpliceExpr x _) = nodeComments x nodeComments HsQuasiQuote {} = emptyNodeComments+#endif++#if MIN_VERSION_ghc_lib_parser(9,8,1)+instance CommentExtraction (LHsRecUpdFields GhcPs) where+ nodeComments RegularRecUpdFields {} = emptyNodeComments+ nodeComments OverloadedRecUpdFields {} = emptyNodeComments #endif -- | Marks an AST node as never appearing in the AST. --
src/HIndent/Pretty/Types.hs view
@@ -33,7 +33,6 @@ , pattern FamEqnInsideClassInst , StmtLRInsideVerticalList(..) , ParStmtBlockInsideVerticalList(..)- , DeclSig(..) , TopLevelTyFamInstDecl(..) , Context(..) , HorizontalContext(..)@@ -89,7 +88,6 @@ { lhs :: LHsExpr GhcPs , op :: LHsExpr GhcPs , rhs :: LHsExpr GhcPs- , immediatelyAfterDo :: Bool } -- | `GRHSs` with a label indicating in which context the RHS is located@@ -204,10 +202,6 @@ -- | `ParStmtBlock` inside a vertically printed list. newtype ParStmtBlockInsideVerticalList = ParStmtBlockInsideVerticalList (ParStmtBlock GhcPs GhcPs)---- | A top-level function signature.-newtype DeclSig =- DeclSig (Sig GhcPs) -- | A top-level type family instance declaration. newtype TopLevelTyFamInstDecl =
src/HIndent/Printer.hs view
@@ -8,11 +8,12 @@ module HIndent.Printer ( Printer(..) , PrintState(..)+ , runPrinterStyle ) where import Control.Applicative import Control.Monad-import Control.Monad.State.Strict (MonadState(..), StateT)+import Control.Monad.State.Strict import Data.ByteString.Builder import Data.Int (Int64) import HIndent.Config@@ -48,3 +49,21 @@ -- the maximum column. , psEolComment :: !Bool }++-- | Pretty print the given printable thing.+runPrinterStyle :: Config -> Printer () -> Builder+runPrinterStyle config m =+ maybe (error "Printer failed with mzero call.") psOutput+ $ execStateT (runPrinter m) initState+ where+ initState =+ PrintState+ { psIndentLevel = 0+ , psOutput = mempty+ , psNewline = False+ , psColumn = 0+ , psLine = 1+ , psConfig = config+ , psFitOnOneLine = False+ , psEolComment = False+ }