Use Choice for p_hsDoc

src/Ormolu/Printer/Meat/Common.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ViewPatterns #-}
@@ -18,6 +19,8 @@ module Ormolu.Printer.Meat.Common
 where
 
 import Control.Monad
+import Data.Choice (Choice)
+import Data.Choice qualified as Choice
 import Data.Text qualified as T
 import GHC.Data.FastString
 import GHC.Hs.Binds
@@ -152,7 +155,7 @@ p_hsDoc ::
   -- | Haddock style
   HaddockStyle ->
   -- | Finish the doc string with a newline
-  Bool ->
+  Choice "endNewline" ->
   -- | The 'LHsDoc' to render
   LHsDoc GhcPs ->
   R ()
@@ -175,7 +178,7 @@ p_hsDoc hstyle needsNewline (L l str) = do
       else newline >> txt "--"
     space
     unless (T.null x) (txt x)
-  when needsNewline newline
+  when (Choice.toBool needsNewline) newline
   case l of
     UnhelpfulSpan _ ->
       -- It's often the case that the comment itself doesn't have a span

src/Ormolu/Printer/Meat/Declaration.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ViewPatterns #-}
@@ -10,6 +11,7 @@ module Ormolu.Printer.Meat.Declaration
   )
 where
 
+import Data.Choice (pattern Without)
 import Data.List (sort)
 import Data.List.NonEmpty (NonEmpty (..), (<|))
 import Data.List.NonEmpty qualified as NE
@@ -124,10 +126,10 @@ p_hsDecl style = \case
   SpliceD _ x -> p_spliceDecl x
   DocD _ docDecl ->
     case docDecl of
-      DocCommentNext str -> p_hsDoc Pipe False str
-      DocCommentPrev str -> p_hsDoc Caret False str
-      DocCommentNamed name str -> p_hsDoc (Named name) False str
-      DocGroup n str -> p_hsDoc (Asterisk n) False str
+      DocCommentNext str -> p_hsDoc Pipe (Without #endNewline) str
+      DocCommentPrev str -> p_hsDoc Caret (Without #endNewline) str
+      DocCommentNamed name str -> p_hsDoc (Named name) (Without #endNewline) str
+      DocGroup n str -> p_hsDoc (Asterisk n) (Without #endNewline) str
   RoleAnnotD _ x -> p_roleAnnot x
   KindSigD _ s -> p_standaloneKindSig s
 

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

@@ -14,7 +14,7 @@ module Ormolu.Printer.Meat.Declaration.Data
 where
 
 import Control.Monad
-import Data.Choice (Choice, pattern Is, pattern Isn't)
+import Data.Choice (Choice, pattern Is, pattern Isn't, pattern With)
 import Data.Choice qualified as Choice
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.List.NonEmpty qualified as NE
@@ -136,7 +136,7 @@ p_dataDecl style name tyVars getTyVarLoc p_tyVar fixity HsDataDefn {..} = do
 p_conDecl :: Choice "singleRecCon" -> ConDecl GhcPs -> R ()
 p_conDecl singleRecCon = \case
   ConDeclGADT {..} -> do
-    mapM_ (p_hsDoc Pipe True) con_doc
+    mapM_ (p_hsDoc Pipe (With #endNewline)) con_doc
     let conDeclSpn =
           fmap getLocA (NE.toList con_names)
             <> [getLocA con_bndrs]
@@ -180,7 +180,7 @@ p_conDecl singleRecCon = \case
           else breakpoint
         located quantifiedTy p_hsType
   ConDeclH98 {..} -> do
-    mapM_ (p_hsDoc Pipe True) con_doc
+    mapM_ (p_hsDoc Pipe (With #endNewline)) con_doc
     let conNameSpn = getLocA con_name
         conNameWithContextSpn =
           [ RealSrcSpan real Strict.Nothing

src/Ormolu/Printer/Meat/ImportExport.hs

@@ -1,5 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RecordWildCards #-}
 
 -- | Rendering of import and export lists.
@@ -10,6 +12,7 @@ module Ormolu.Printer.Meat.ImportExport
 where
 
 import Control.Monad
+import Data.Choice (pattern Without)
 import Data.Foldable (for_, traverse_)
 import GHC.Hs
 import GHC.LanguageExtensions.Type
@@ -122,9 +125,9 @@ p_lie encLayout relativePos = \case
       FirstPos -> return ()
       MiddlePos -> newline
       LastPos -> newline
-    p_hsDoc (Asterisk n) False str
+    p_hsDoc (Asterisk n) (Without #endNewline) str
   IEDoc NoExtField str ->
-    p_hsDoc Pipe False str
+    p_hsDoc Pipe (Without #endNewline) str
   IEDocNamed NoExtField str -> p_hsDocName str
   where
     p_comma =
@@ -144,7 +147,7 @@ p_lie encLayout relativePos = \case
     p_exportDoc :: Maybe (ExportDoc GhcPs) -> R ()
     p_exportDoc = traverse_ $ \exportDoc -> do
       breakpoint
-      p_hsDoc Caret False exportDoc
+      p_hsDoc Caret (Without #endNewline) exportDoc
 
 ieExportDoc :: IE GhcPs -> Maybe (ExportDoc GhcPs)
 ieExportDoc = \case

src/Ormolu/Printer/Meat/Module.hs

@@ -1,4 +1,6 @@
+{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RecordWildCards #-}
 
 -- | Rendering of modules.
@@ -8,6 +10,7 @@ module Ormolu.Printer.Meat.Module
 where
 
 import Control.Monad
+import Data.Choice (pattern With)
 import GHC.Hs hiding (comment)
 import GHC.Types.SrcLoc
 import Ormolu.Parser.CommentStream
@@ -45,7 +48,7 @@ p_hsModule mstackHeader pragmas HsModule {..} = do
       Nothing -> return ()
       Just hsmodName' -> do
         located hsmodName' $ \name -> do
-          forM_ hsmodHaddockModHeader (p_hsDoc Pipe True)
+          forM_ hsmodHaddockModHeader (p_hsDoc Pipe (With #endNewline))
           p_hsmodName name
         breakpoint
         forM_ hsmodDeprecMessage $ \w -> do

src/Ormolu/Printer/Meat/Type.hs

@@ -1,5 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeFamilies #-}
 
@@ -19,6 +21,7 @@ module Ormolu.Printer.Meat.Type
   )
 where
 
+import Data.Choice (pattern With)
 import GHC.Hs hiding (isPromoted)
 import GHC.Types.SourceText
 import GHC.Types.SrcLoc
@@ -131,7 +134,7 @@ p_hsType' multilineArgs = \case
     inci (located k p_hsType)
   HsSpliceTy _ splice -> p_hsUntypedSplice DollarSplice splice
   HsDocTy _ t str -> do
-    p_hsDoc Pipe True str
+    p_hsDoc Pipe (With #endNewline) str
     located t p_hsType
   HsBangTy _ (HsSrcBang _ u s) t -> do
     case u of
@@ -259,7 +262,7 @@ p_conDeclFields xs =
 
 p_conDeclField :: ConDeclField GhcPs -> R ()
 p_conDeclField ConDeclField {..} = do
-  mapM_ (p_hsDoc Pipe True) cd_fld_doc
+  mapM_ (p_hsDoc Pipe (With #endNewline)) cd_fld_doc
   sitcc $
     sep
       commaDel