From aaf67f2ec6f9768cb530449c283409eddcbf6806 Mon Sep 17 00:00:00 2001 From: Brandon Chinn Date: Mon, 22 Nov 2021 16:57:56 -0800 Subject: [PATCH 1/4] Add 'haddock-style-module' config option --- README.md | 3 +++ fourmolu.yaml | 1 + src/Ormolu/Config.hs | 22 ++++++++++++++++++++++ src/Ormolu/Config/Types.hs | 8 ++++++++ 4 files changed, 34 insertions(+) diff --git a/README.md b/README.md index 252739ca..b251ae11 100644 --- a/README.md +++ b/README.md @@ -53,6 +53,7 @@ Defaults are in bold. | `record-brace-space` | `true`, **`false`** | `rec {x = 1}` _vs_ `rec{x = 1}` | `newlines-between-decls` | any integer (**`1`**) | Number of newlines between top-level declarations | `haddock-style` | `single-line`, **`multi-line`**, `multi-line-compact` | Use `-- \|`, `{- \|`, or `{-\|` for multiline haddocks (single-line haddocks always use `--`) +| `haddock-style-module` | same as `haddock-style` | `haddock-style`, but specifically for the module docstring (not specifying anything = use the same setting as `haddock-style`) | | `let-style` | `inline`, `newline`, **`auto`**, `mixed` | How to style `let` blocks (`auto` uses `newline` if there's a newline in the input and `inline` otherwise, and `mixed` uses `inline` only when the `let` has exactly one binding) | `in-style` | `left-align`, **`right-align`** | How to align the `in` keyword with respect to `let` | `unicode` | `always`, `detect`, **`never`** | Output Unicode syntax. With `detect` we output Unicode syntax exactly when the extension is seen to be enabled. @@ -76,6 +77,7 @@ indent-wheres: false record-brace-space: false newlines-between-decls: 1 haddock-style: multi-line +haddock-style-module: let-style: auto in-style: right-align respectful: true @@ -94,6 +96,7 @@ indent-wheres: true record-brace-space: true newlines-between-decls: 1 haddock-style: single-line +haddock-style-module: let-style: inline in-style: right-align respectful: false diff --git a/fourmolu.yaml b/fourmolu.yaml index d76eb6e3..c9d3107d 100644 --- a/fourmolu.yaml +++ b/fourmolu.yaml @@ -7,6 +7,7 @@ indent-wheres: true record-brace-space: true newlines-between-decls: 1 haddock-style: single-line +haddock-style-module: let-style: inline in-style: right-align unicode: never diff --git a/src/Ormolu/Config.hs b/src/Ormolu/Config.hs index 3bb1a9ac..223c7fa0 100644 --- a/src/Ormolu/Config.hs +++ b/src/Ormolu/Config.hs @@ -34,6 +34,7 @@ module Ormolu.Config fillMissingPrinterOpts, CommaStyle (..), HaddockPrintStyle (..), + HaddockPrintStyleModule (..), ImportExportStyle (..), LetStyle (..), InStyle (..), @@ -227,6 +228,7 @@ overFieldsM f $(unpackFieldsWithSuffix 'PrinterOpts "0") = do poRecordBraceSpace <- f poRecordBraceSpace0 poNewlinesBetweenDecls <- f poNewlinesBetweenDecls0 poHaddockStyle <- f poHaddockStyle0 + poHaddockStyleModule <- f poHaddockStyleModule0 poLetStyle <- f poLetStyle0 poInStyle <- f poInStyle0 poUnicode <- f poUnicode0 @@ -344,6 +346,14 @@ printerOptsMeta = (showAllValues haddockPrintStyleMap), metaDefault = HaddockMultiLine }, + poHaddockStyleModule = + PrinterOptsFieldMeta + { metaName = "haddock-style-module", + metaGetField = poHaddockStyleModule, + metaPlaceholder = "STYLE", + metaHelp = "How to print module docstring", + metaDefault = PrintStyleInherit + }, poLetStyle = PrinterOptsFieldMeta { metaName = "let-style", @@ -482,6 +492,18 @@ instance PrinterOptsFieldType HaddockPrintStyle where parseText = parseTextWith haddockPrintStyleMap showText = show . showTextWith haddockPrintStyleMap +instance PrinterOptsFieldType HaddockPrintStyleModule where + parseJSON = \case + Aeson.Null -> pure PrintStyleInherit + Aeson.String "" -> pure PrintStyleInherit + v -> PrintStyleOverride <$> parseJSON v + parseText = \case + "" -> pure PrintStyleInherit + s -> PrintStyleOverride <$> parseText s + showText = \case + PrintStyleInherit -> "same as 'haddock-style'" + PrintStyleOverride x -> showText x + instance PrinterOptsFieldType ImportExportStyle where parseJSON = parseJSONWith importExportStyleMap "ImportExportStyle" parseText = parseTextWith importExportStyleMap diff --git a/src/Ormolu/Config/Types.hs b/src/Ormolu/Config/Types.hs index 99d8571b..593323c7 100644 --- a/src/Ormolu/Config/Types.hs +++ b/src/Ormolu/Config/Types.hs @@ -6,6 +6,7 @@ module Ormolu.Config.Types CommaStyle (..), FunctionArrowsStyle (..), HaddockPrintStyle (..), + HaddockPrintStyleModule (..), ImportExportStyle (..), LetStyle (..), InStyle (..), @@ -33,6 +34,8 @@ data PrinterOpts f = PrinterOpts poNewlinesBetweenDecls :: f Int, -- | How to print doc comments poHaddockStyle :: f HaddockPrintStyle, + -- | How to print the module docstring (defaults to poHaddockStyle) + poHaddockStyleModule :: f HaddockPrintStyleModule, -- | Styling of let blocks poLetStyle :: f LetStyle, -- | How to align in keyword @@ -60,6 +63,11 @@ data HaddockPrintStyle | HaddockMultiLineCompact deriving (Eq, Show, Enum, Bounded) +data HaddockPrintStyleModule + = PrintStyleInherit + | PrintStyleOverride HaddockPrintStyle + deriving (Eq, Show) + data ImportExportStyle = ImportExportLeading | ImportExportTrailing From 5e48c05cbc9bbabad34d494302edfba4788c74dc Mon Sep 17 00:00:00 2001 From: Brandon Chinn Date: Mon, 22 Nov 2021 17:07:35 -0800 Subject: [PATCH 2/4] Use haddock-style-module for module docstrings --- src/Ormolu/Printer/Meat/Common.hs | 23 +++++++++++++++++++---- src/Ormolu/Printer/Meat/Module.hs | 6 +++++- 2 files changed, 24 insertions(+), 5 deletions(-) diff --git a/src/Ormolu/Printer/Meat/Common.hs b/src/Ormolu/Printer/Meat/Common.hs index 5108ee21..cde103d8 100644 --- a/src/Ormolu/Printer/Meat/Common.hs +++ b/src/Ormolu/Printer/Meat/Common.hs @@ -11,6 +11,7 @@ module Ormolu.Printer.Meat.Common p_qualName, p_infixDefHelper, p_hsDocString, + p_hsDocString', p_sourceText, ) where @@ -140,7 +141,22 @@ p_hsDocString :: -- | The doc string to render LHsDocString -> R () -p_hsDocString hstyle needsNewline (L l str) = do +p_hsDocString hstyle needsNewline lstr = do + poHStyle <- getPrinterOpt poHaddockStyle + p_hsDocString' poHStyle hstyle needsNewline lstr + +-- | Print a Haddock. +p_hsDocString' :: + -- | 'haddock-style' configuration option + HaddockPrintStyle -> + -- | Haddock style + HaddockStyle -> + -- | Finish the doc string with a newline + Bool -> + -- | The doc string to render + LHsDocString -> + R () +p_hsDocString' poHStyle hstyle needsNewline (L l str) = do let isCommentSpan = \case HaddockSpan _ _ -> True CommentSpan _ -> True @@ -151,10 +167,9 @@ p_hsDocString hstyle needsNewline (L l str) = do mSrcSpan <- getSrcSpan l - printStyle <- getPrinterOpt poHaddockStyle let useSingleLineComments = or - [ printStyle == HaddockSingleLine, + [ poHStyle == HaddockSingleLine, length docLines <= 1, -- Use multiple single-line comments when the whole comment is indented maybe False ((> 1) . srcSpanStartCol) mSrcSpan @@ -170,7 +185,7 @@ p_hsDocString hstyle needsNewline (L l str) = do else do txt . T.concat $ [ "{-", - case (hstyle, printStyle) of + case (hstyle, poHStyle) of (Pipe, HaddockMultiLineCompact) -> "" _ -> " ", haddockDelim diff --git a/src/Ormolu/Printer/Meat/Module.hs b/src/Ormolu/Printer/Meat/Module.hs index 10c76ad5..82d10cad 100644 --- a/src/Ormolu/Printer/Meat/Module.hs +++ b/src/Ormolu/Printer/Meat/Module.hs @@ -61,7 +61,11 @@ p_hsModule mstackHeader pragmas hsmod@HsModule {..} = do p_hsModuleHeader :: HsModule -> LocatedA ModuleName -> R () p_hsModuleHeader HsModule {..} moduleName = do located moduleName $ \name -> do - forM_ hsmodHaddockModHeader (p_hsDocString Pipe True) + poHStyle <- + getPrinterOpt poHaddockStyleModule >>= \case + PrintStyleInherit -> getPrinterOpt poHaddockStyle + PrintStyleOverride style -> pure style + forM_ hsmodHaddockModHeader (p_hsDocString' poHStyle Pipe True) p_hsmodName name forM_ hsmodDeprecMessage $ \w -> do From 88e96f6d3358055ad9ef0a7cd5918e12aabd239f Mon Sep 17 00:00:00 2001 From: Brandon Chinn Date: Tue, 31 May 2022 01:23:13 -0700 Subject: [PATCH 3/4] Add tests --- ...addockMultiLine-module=HaddockMultiLine.hs | 31 +++++++++++++++++++ ...ultiLine-module=HaddockMultiLineCompact.hs | 31 +++++++++++++++++++ ...ddockMultiLine-module=HaddockSingleLine.hs | 30 ++++++++++++++++++ ...ultiLineCompact-module=HaddockMultiLine.hs | 31 +++++++++++++++++++ ...eCompact-module=HaddockMultiLineCompact.hs | 31 +++++++++++++++++++ ...ltiLineCompact-module=HaddockSingleLine.hs | 30 ++++++++++++++++++ ...ddockSingleLine-module=HaddockMultiLine.hs | 28 +++++++++++++++++ ...ngleLine-module=HaddockMultiLineCompact.hs | 28 +++++++++++++++++ ...dockSingleLine-module=HaddockSingleLine.hs | 27 ++++++++++++++++ tests/Ormolu/Config/PrinterOptsSpec.hs | 23 +++++++++++--- 10 files changed, 286 insertions(+), 4 deletions(-) create mode 100644 data/fourmolu/haddock-style/output-HaddockMultiLine-module=HaddockMultiLine.hs create mode 100644 data/fourmolu/haddock-style/output-HaddockMultiLine-module=HaddockMultiLineCompact.hs create mode 100644 data/fourmolu/haddock-style/output-HaddockMultiLine-module=HaddockSingleLine.hs create mode 100644 data/fourmolu/haddock-style/output-HaddockMultiLineCompact-module=HaddockMultiLine.hs create mode 100644 data/fourmolu/haddock-style/output-HaddockMultiLineCompact-module=HaddockMultiLineCompact.hs create mode 100644 data/fourmolu/haddock-style/output-HaddockMultiLineCompact-module=HaddockSingleLine.hs create mode 100644 data/fourmolu/haddock-style/output-HaddockSingleLine-module=HaddockMultiLine.hs create mode 100644 data/fourmolu/haddock-style/output-HaddockSingleLine-module=HaddockMultiLineCompact.hs create mode 100644 data/fourmolu/haddock-style/output-HaddockSingleLine-module=HaddockSingleLine.hs diff --git a/data/fourmolu/haddock-style/output-HaddockMultiLine-module=HaddockMultiLine.hs b/data/fourmolu/haddock-style/output-HaddockMultiLine-module=HaddockMultiLine.hs new file mode 100644 index 00000000..37d5919e --- /dev/null +++ b/data/fourmolu/haddock-style/output-HaddockMultiLine-module=HaddockMultiLine.hs @@ -0,0 +1,31 @@ +{- | This is a test multiline + module haddock +-} +module Foo where + +-- | This is a singleline function haddock +single1 :: Int + +-- | This is a singleline function haddock +single2 :: Int + +{- | This is a multiline + function haddock +-} +multi1 :: Int + +{- | +This is a multiline +function haddock +-} +multi2 :: Int + +{- | This is a haddock + + with two consecutive newlines + + + https://github.com/fourmolu/fourmolu/issues/172 +-} +foo :: Int +foo = 42 diff --git a/data/fourmolu/haddock-style/output-HaddockMultiLine-module=HaddockMultiLineCompact.hs b/data/fourmolu/haddock-style/output-HaddockMultiLine-module=HaddockMultiLineCompact.hs new file mode 100644 index 00000000..6b68714d --- /dev/null +++ b/data/fourmolu/haddock-style/output-HaddockMultiLine-module=HaddockMultiLineCompact.hs @@ -0,0 +1,31 @@ +{-| This is a test multiline + module haddock +-} +module Foo where + +-- | This is a singleline function haddock +single1 :: Int + +-- | This is a singleline function haddock +single2 :: Int + +{- | This is a multiline + function haddock +-} +multi1 :: Int + +{- | +This is a multiline +function haddock +-} +multi2 :: Int + +{- | This is a haddock + + with two consecutive newlines + + + https://github.com/fourmolu/fourmolu/issues/172 +-} +foo :: Int +foo = 42 diff --git a/data/fourmolu/haddock-style/output-HaddockMultiLine-module=HaddockSingleLine.hs b/data/fourmolu/haddock-style/output-HaddockMultiLine-module=HaddockSingleLine.hs new file mode 100644 index 00000000..5110614c --- /dev/null +++ b/data/fourmolu/haddock-style/output-HaddockMultiLine-module=HaddockSingleLine.hs @@ -0,0 +1,30 @@ +-- | This is a test multiline +-- module haddock +module Foo where + +-- | This is a singleline function haddock +single1 :: Int + +-- | This is a singleline function haddock +single2 :: Int + +{- | This is a multiline + function haddock +-} +multi1 :: Int + +{- | +This is a multiline +function haddock +-} +multi2 :: Int + +{- | This is a haddock + + with two consecutive newlines + + + https://github.com/fourmolu/fourmolu/issues/172 +-} +foo :: Int +foo = 42 diff --git a/data/fourmolu/haddock-style/output-HaddockMultiLineCompact-module=HaddockMultiLine.hs b/data/fourmolu/haddock-style/output-HaddockMultiLineCompact-module=HaddockMultiLine.hs new file mode 100644 index 00000000..deaab4a7 --- /dev/null +++ b/data/fourmolu/haddock-style/output-HaddockMultiLineCompact-module=HaddockMultiLine.hs @@ -0,0 +1,31 @@ +{- | This is a test multiline + module haddock +-} +module Foo where + +-- | This is a singleline function haddock +single1 :: Int + +-- | This is a singleline function haddock +single2 :: Int + +{-| This is a multiline + function haddock +-} +multi1 :: Int + +{-| +This is a multiline +function haddock +-} +multi2 :: Int + +{-| This is a haddock + + with two consecutive newlines + + + https://github.com/fourmolu/fourmolu/issues/172 +-} +foo :: Int +foo = 42 diff --git a/data/fourmolu/haddock-style/output-HaddockMultiLineCompact-module=HaddockMultiLineCompact.hs b/data/fourmolu/haddock-style/output-HaddockMultiLineCompact-module=HaddockMultiLineCompact.hs new file mode 100644 index 00000000..7bc1ef3b --- /dev/null +++ b/data/fourmolu/haddock-style/output-HaddockMultiLineCompact-module=HaddockMultiLineCompact.hs @@ -0,0 +1,31 @@ +{-| This is a test multiline + module haddock +-} +module Foo where + +-- | This is a singleline function haddock +single1 :: Int + +-- | This is a singleline function haddock +single2 :: Int + +{-| This is a multiline + function haddock +-} +multi1 :: Int + +{-| +This is a multiline +function haddock +-} +multi2 :: Int + +{-| This is a haddock + + with two consecutive newlines + + + https://github.com/fourmolu/fourmolu/issues/172 +-} +foo :: Int +foo = 42 diff --git a/data/fourmolu/haddock-style/output-HaddockMultiLineCompact-module=HaddockSingleLine.hs b/data/fourmolu/haddock-style/output-HaddockMultiLineCompact-module=HaddockSingleLine.hs new file mode 100644 index 00000000..8578180a --- /dev/null +++ b/data/fourmolu/haddock-style/output-HaddockMultiLineCompact-module=HaddockSingleLine.hs @@ -0,0 +1,30 @@ +-- | This is a test multiline +-- module haddock +module Foo where + +-- | This is a singleline function haddock +single1 :: Int + +-- | This is a singleline function haddock +single2 :: Int + +{-| This is a multiline + function haddock +-} +multi1 :: Int + +{-| +This is a multiline +function haddock +-} +multi2 :: Int + +{-| This is a haddock + + with two consecutive newlines + + + https://github.com/fourmolu/fourmolu/issues/172 +-} +foo :: Int +foo = 42 diff --git a/data/fourmolu/haddock-style/output-HaddockSingleLine-module=HaddockMultiLine.hs b/data/fourmolu/haddock-style/output-HaddockSingleLine-module=HaddockMultiLine.hs new file mode 100644 index 00000000..147710e0 --- /dev/null +++ b/data/fourmolu/haddock-style/output-HaddockSingleLine-module=HaddockMultiLine.hs @@ -0,0 +1,28 @@ +{- | This is a test multiline + module haddock +-} +module Foo where + +-- | This is a singleline function haddock +single1 :: Int + +-- | This is a singleline function haddock +single2 :: Int + +-- | This is a multiline +-- function haddock +multi1 :: Int + +-- | +--This is a multiline +--function haddock +multi2 :: Int + +-- | This is a haddock +-- +-- with two consecutive newlines +-- +-- +-- https://github.com/fourmolu/fourmolu/issues/172 +foo :: Int +foo = 42 diff --git a/data/fourmolu/haddock-style/output-HaddockSingleLine-module=HaddockMultiLineCompact.hs b/data/fourmolu/haddock-style/output-HaddockSingleLine-module=HaddockMultiLineCompact.hs new file mode 100644 index 00000000..c184733b --- /dev/null +++ b/data/fourmolu/haddock-style/output-HaddockSingleLine-module=HaddockMultiLineCompact.hs @@ -0,0 +1,28 @@ +{-| This is a test multiline + module haddock +-} +module Foo where + +-- | This is a singleline function haddock +single1 :: Int + +-- | This is a singleline function haddock +single2 :: Int + +-- | This is a multiline +-- function haddock +multi1 :: Int + +-- | +--This is a multiline +--function haddock +multi2 :: Int + +-- | This is a haddock +-- +-- with two consecutive newlines +-- +-- +-- https://github.com/fourmolu/fourmolu/issues/172 +foo :: Int +foo = 42 diff --git a/data/fourmolu/haddock-style/output-HaddockSingleLine-module=HaddockSingleLine.hs b/data/fourmolu/haddock-style/output-HaddockSingleLine-module=HaddockSingleLine.hs new file mode 100644 index 00000000..93673337 --- /dev/null +++ b/data/fourmolu/haddock-style/output-HaddockSingleLine-module=HaddockSingleLine.hs @@ -0,0 +1,27 @@ +-- | This is a test multiline +-- module haddock +module Foo where + +-- | This is a singleline function haddock +single1 :: Int + +-- | This is a singleline function haddock +single2 :: Int + +-- | This is a multiline +-- function haddock +multi1 :: Int + +-- | +--This is a multiline +--function haddock +multi2 :: Int + +-- | This is a haddock +-- +-- with two consecutive newlines +-- +-- +-- https://github.com/fourmolu/fourmolu/issues/172 +foo :: Int +foo = 42 diff --git a/tests/Ormolu/Config/PrinterOptsSpec.hs b/tests/Ormolu/Config/PrinterOptsSpec.hs index 2947e004..8ff36026 100644 --- a/tests/Ormolu/Config/PrinterOptsSpec.hs +++ b/tests/Ormolu/Config/PrinterOptsSpec.hs @@ -28,6 +28,7 @@ import Ormolu detectSourceType, ormolu, ) +import Ormolu.Config (HaddockPrintStyleModule (..)) import Ormolu.Exception (OrmoluException, printOrmoluException) import Ormolu.Terminal (ColorMode (..), runTerm) import Ormolu.Utils.IO (readFileUtf8, writeFileUtf8) @@ -130,10 +131,24 @@ singleTests = }, TestGroup { label = "haddock-style", - testCases = allOptions, - updateConfig = \haddockStyle opts -> opts {poHaddockStyle = pure haddockStyle}, - showTestCase = show, - testCaseSuffix = suffix1 + testCases = (,) <$> allOptions <*> (PrintStyleInherit : map PrintStyleOverride allOptions), + updateConfig = \(haddockStyle, haddockStyleModule) opts -> + opts + { poHaddockStyle = pure haddockStyle, + poHaddockStyleModule = pure haddockStyleModule + }, + showTestCase = \(haddockStyle, haddockStyleModule) -> + show haddockStyle + ++ case haddockStyleModule of + PrintStyleInherit -> "" + PrintStyleOverride style -> " + module=" ++ show style, + testCaseSuffix = \(haddockStyle, haddockStyleModule) -> + suffixWith + [ show haddockStyle, + case haddockStyleModule of + PrintStyleInherit -> "" + PrintStyleOverride style -> "module=" ++ show style + ] }, TestGroup { label = "let-style", From ef458224ecddddc23c22e5bc4ac6b31a0a0cdd2b Mon Sep 17 00:00:00 2001 From: Brandon Chinn Date: Mon, 22 Nov 2021 17:10:53 -0800 Subject: [PATCH 4/4] Update CHANGELOG --- changelog.d/haddock-style-module.md | 1 + 1 file changed, 1 insertion(+) create mode 100644 changelog.d/haddock-style-module.md diff --git a/changelog.d/haddock-style-module.md b/changelog.d/haddock-style-module.md new file mode 100644 index 00000000..4d88efad --- /dev/null +++ b/changelog.d/haddock-style-module.md @@ -0,0 +1 @@ +Add `haddock-style-module` option ([#135](https://github.com/fourmolu/fourmolu/pull/135))