{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Printing combinators. The definitions here are presented in such an
-- order so you can just go through the Haddocks and by the end of the file
-- you should have a pretty good idea how to program rendering logic.
module Ormolu.Printer.Combinators
  ( -- * The 'R' monad
    R,
    runR,
    getEnclosingSpan,
    getEnclosingSpanWhere,
    getEnclosingComments,
    isExtensionEnabled,

    -- * Combinators

    -- ** Basic
    txt,
    txtStripIndent,
    atom,
    space,
    newline,
    declNewline,
    multilineCommentNewline,
    inci,
    inciBy,
    inciIf,
    inciByFrac,
    askSourceType,
    askModuleFixityMap,
    askDebug,
    located,
    encloseLocated,
    located',
    switchLayout,
    switchLayoutNoLimit,
    spansLayout,
    Layout (..),
    vlayout,
    getLayout,
    breakpoint,
    breakpoint',
    getPrinterOpt,
    getLocalModules,

    -- ** Formatting lists
    sep,
    sepSemi,
    canUseBraces,
    useBraces,
    dontUseBraces,

    -- ** Wrapping
    BracketStyle (..),
    sitcc,
    backticks,
    banana,
    braces,
    brackets,
    parens,
    parensHash,
    pragmaBraces,
    pragma,

    -- ** Literals
    comma,
    commaDel,
    commaDelImportExport,
    equals,
    token'Larrowtail,
    token'Rarrowtail,
    token'darrow,
    token'dcolon,
    token'larrow,
    token'larrowtail,
    token'rarrow,
    token'rarrowtail,
    token'star,
    token'forall,
    token'oparenbar,
    token'cparenbar,
    token'openExpQuote,
    token'closeQuote,
    token'lolly,

    -- ** Stateful markers
    SpanMark (..),
    spanMarkSpan,
    HaddockStyle (..),
    setSpanMark,
    getSpanMark,

    -- ** Placement
    Placement (..),
    placeHanging,
  )
where

import Control.Monad
import Data.List (intersperse)
import Data.Text (Text)
import GHC.Data.Strict qualified as Strict
import GHC.LanguageExtensions.Type
import GHC.Parser.Annotation hiding (IsUnicodeSyntax (..))
import GHC.Types.SrcLoc hiding (spans)
import Ormolu.Config
import Ormolu.Printer.Comments
import Ormolu.Printer.Internal

----------------------------------------------------------------------------
-- Basic

-- | Indent the inner expression if the first argument is 'True'.
inciIf ::
  -- | Whether to indent
  Bool ->
  -- | The expression to indent
  R () ->
  R ()
inciIf :: Bool -> R () -> R ()
inciIf Bool
b R ()
m = if Bool
b then R () -> R ()
inci R ()
m else R ()
m

-- | Enter a 'GenLocated' entity. This combinator handles outputting comments
-- and sets layout (single-line vs multi-line) for the inner computation.
-- Roughly, the rule for using 'located' is that every time there is a
-- 'Located' wrapper, it should be “discharged” with a corresponding
-- 'located' invocation.
located ::
  (HasLoc l) =>
  -- | Thing to enter
  GenLocated l a ->
  -- | How to render inner value
  (a -> R ()) ->
  R ()
located :: forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located (L l
l' a
a) a -> R ()
f = case l -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA l
l' of
  UnhelpfulSpan UnhelpfulSpanReason
_ -> a -> R ()
f a
a
  RealSrcSpan RealSrcSpan
l Maybe BufSpan
_ -> do
    RealSrcSpan -> R ()
spitPrecedingComments RealSrcSpan
l
    RealSrcSpan -> R () -> R ()
withEnclosingSpan RealSrcSpan
l (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$
      [SrcSpan] -> R () -> R ()
switchLayout [RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan RealSrcSpan
l Maybe BufSpan
forall a. Maybe a
Strict.Nothing] (a -> R ()
f a
a)
    RealSrcSpan -> R ()
spitFollowingComments RealSrcSpan
l

-- | Similar to 'located', but when the "payload" is an empty list, print
-- virtual elements at the start and end of the source span to prevent comments
-- from "floating out".
encloseLocated ::
  (HasLoc l) =>
  GenLocated l [a] ->
  ([a] -> R ()) ->
  R ()
encloseLocated :: forall l a. HasLoc l => GenLocated l [a] -> ([a] -> R ()) -> R ()
encloseLocated GenLocated l [a]
la [a] -> R ()
f = GenLocated l [a] -> ([a] -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated l [a]
la (([a] -> R ()) -> R ()) -> ([a] -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \[a]
a -> do
  Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
a) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpan () -> (() -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located (SrcSpan -> () -> GenLocated SrcSpan ()
forall l e. l -> e -> GenLocated l e
L SrcSpan
startSpan ()) () -> R ()
forall a. a -> R a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  [a] -> R ()
f [a]
a
  Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
a) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpan () -> (() -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located (SrcSpan -> () -> GenLocated SrcSpan ()
forall l e. l -> e -> GenLocated l e
L SrcSpan
endSpan ()) () -> R ()
forall a. a -> R a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  where
    l :: SrcSpan
l = GenLocated l [a] -> SrcSpan
forall a. HasLoc a => a -> SrcSpan
locA GenLocated l [a]
la
    (SrcLoc
startLoc, SrcLoc
endLoc) = (SrcSpan -> SrcLoc
srcSpanStart SrcSpan
l, SrcSpan -> SrcLoc
srcSpanEnd SrcSpan
l)
    (SrcSpan
startSpan, SrcSpan
endSpan) = (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan SrcLoc
startLoc SrcLoc
startLoc, SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan SrcLoc
endLoc SrcLoc
endLoc)

-- | A version of 'located' with arguments flipped.
located' ::
  (HasLoc l) =>
  -- | How to render inner value
  (a -> R ()) ->
  -- | Thing to enter
  GenLocated l a ->
  R ()
located' :: forall l a. HasLoc l => (a -> R ()) -> GenLocated l a -> R ()
located' = (GenLocated l a -> (a -> R ()) -> R ())
-> (a -> R ()) -> GenLocated l a -> R ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip GenLocated l a -> (a -> R ()) -> R ()
forall l a. HasLoc l => GenLocated l a -> (a -> R ()) -> R ()
located

-- | Set layout according to combination of given 'SrcSpan's for a given.
-- Use this only when you need to set layout based on e.g. combined span of
-- several elements when there is no corresponding 'Located' wrapper
-- provided by GHC AST. It is relatively rare that this one is needed.
--
-- Given empty list this function will set layout to single line.
switchLayout ::
  -- | Span that controls layout
  [SrcSpan] ->
  -- | Computation to run with changed layout
  R () ->
  R ()
switchLayout :: [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
spans R ()
r = do
  layout <- [SrcSpan] -> R Layout
spansLayout [SrcSpan]
spans
  enterLayout layout r

-- | Same as 'switchLayout', except disregards the column limit.
--
-- It should be used for the argument list in function definitions because
-- the column limit can't be enforced there without changing the AST.
switchLayoutNoLimit :: [SrcSpan] -> R () -> R ()
switchLayoutNoLimit :: [SrcSpan] -> R () -> R ()
switchLayoutNoLimit [SrcSpan]
spans = Layout -> R () -> R ()
enterLayout (ColumnLimit -> [SrcSpan] -> Layout
spansLayoutWithLimit ColumnLimit
NoLimit [SrcSpan]
spans)

-- | Which layout combined spans result in?
spansLayout :: [SrcSpan] -> R Layout
spansLayout :: [SrcSpan] -> R Layout
spansLayout [SrcSpan]
spans = do
  colLimit <- (forall (f :: * -> *). PrinterOpts f -> f ColumnLimit)
-> R ColumnLimit
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt PrinterOpts f -> f ColumnLimit
forall (f :: * -> *). PrinterOpts f -> f ColumnLimit
poColumnLimit
  pure $ spansLayoutWithLimit colLimit spans

spansLayoutWithLimit :: ColumnLimit -> [SrcSpan] -> Layout
spansLayoutWithLimit :: ColumnLimit -> [SrcSpan] -> Layout
spansLayoutWithLimit ColumnLimit
colLimit = \case
  [] -> Layout
SingleLine
  (SrcSpan
x : [SrcSpan]
xs) ->
    let combinedSpan :: SrcSpan
combinedSpan = (SrcSpan -> SrcSpan -> SrcSpan) -> SrcSpan -> [SrcSpan] -> SrcSpan
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans SrcSpan
x [SrcSpan]
xs
     in if SrcSpan -> Bool
isOneLineSpan SrcSpan
combinedSpan Bool -> Bool -> Bool
&& Bool -> Bool
not (SrcSpan -> Bool
shouldBreakSingleLine SrcSpan
combinedSpan)
          then Layout
SingleLine
          else Layout
MultiLine
  where
    shouldBreakSingleLine :: SrcSpan -> Bool
shouldBreakSingleLine SrcSpan
srcSpan =
      case (SrcSpan
srcSpan, ColumnLimit
colLimit) of
        (RealSrcSpan RealSrcSpan
rs Maybe BufSpan
_, ColumnLimit Int
maxLineLength) ->
          let spanLineLength :: Int
spanLineLength = RealSrcSpan -> Int
srcSpanEndCol RealSrcSpan
rs Int -> Int -> Int
forall a. Num a => a -> a -> a
- RealSrcSpan -> Int
srcSpanStartCol RealSrcSpan
rs
           in Int
spanLineLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxLineLength
        (SrcSpan, ColumnLimit)
_ -> Bool
False

-- | Insert a space if enclosing layout is single-line, or newline if it's
-- multiline.
--
-- > breakpoint = vlayout space newline
breakpoint :: R ()
breakpoint :: R ()
breakpoint = R () -> R () -> R ()
forall a. R a -> R a -> R a
vlayout R ()
space R ()
newline

-- | Similar to 'breakpoint' but outputs nothing in case of single-line
-- layout.
--
-- > breakpoint' = vlayout (return ()) newline
breakpoint' :: R ()
breakpoint' :: R ()
breakpoint' = R () -> R () -> R ()
forall a. R a -> R a -> R a
vlayout (() -> R ()
forall a. a -> R a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) R ()
newline

----------------------------------------------------------------------------
-- Formatting lists

-- | Render a collection of elements inserting a separator between them.
sep ::
  -- | Separator
  R () ->
  -- | How to render an element
  (a -> R ()) ->
  -- | Elements to render
  [a] ->
  R ()
sep :: forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
s a -> R ()
f [a]
xs = [R ()] -> R ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (R () -> [R ()] -> [R ()]
forall a. a -> [a] -> [a]
intersperse R ()
s (a -> R ()
f (a -> R ()) -> [a] -> [R ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
xs))

-- | Render a collection of elements layout-sensitively using given printer,
-- inserting semicolons if necessary and respecting 'useBraces' and
-- 'dontUseBraces' combinators.
--
-- > useBraces $ sepSemi txt ["foo", "bar"]
-- >   == vlayout (txt "{ foo; bar }") (txt "foo\nbar")
--
-- > dontUseBraces $ sepSemi txt ["foo", "bar"]
-- >   == vlayout (txt "foo; bar") (txt "foo\nbar")
sepSemi ::
  -- | How to render an element
  (a -> R ()) ->
  -- | Elements to render
  [a] ->
  R ()
sepSemi :: forall a. (a -> R ()) -> [a] -> R ()
sepSemi a -> R ()
f [a]
xs = R () -> R () -> R ()
forall a. R a -> R a -> R a
vlayout R ()
singleLine R ()
multiLine
  where
    singleLine :: R ()
singleLine = do
      ub <- R Bool
canUseBraces
      case xs of
        [] -> Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ub (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ Text -> R ()
txt Text
"{}"
        [a]
xs' ->
          if Bool
ub
            then do
              Text -> R ()
txt Text
"{"
              R ()
space
              R () -> (a -> R ()) -> [a] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (Text -> R ()
txt Text
";" R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space) (R () -> R ()
dontUseBraces (R () -> R ()) -> (a -> R ()) -> a -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> R ()
f) [a]
xs'
              R ()
space
              Text -> R ()
txt Text
"}"
            else R () -> (a -> R ()) -> [a] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep (Text -> R ()
txt Text
";" R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space) a -> R ()
f [a]
xs'
    multiLine :: R ()
multiLine =
      R () -> (a -> R ()) -> [a] -> R ()
forall a. R () -> (a -> R ()) -> [a] -> R ()
sep R ()
newline (R () -> R ()
dontUseBraces (R () -> R ()) -> (a -> R ()) -> a -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> R ()
f) [a]
xs

----------------------------------------------------------------------------
-- Wrapping

-- | 'BracketStyle' controlling how closing bracket is rendered.
data BracketStyle
  = -- | Normal
    N
  | -- | Shifted one level
    S
  deriving (BracketStyle -> BracketStyle -> Bool
(BracketStyle -> BracketStyle -> Bool)
-> (BracketStyle -> BracketStyle -> Bool) -> Eq BracketStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BracketStyle -> BracketStyle -> Bool
== :: BracketStyle -> BracketStyle -> Bool
$c/= :: BracketStyle -> BracketStyle -> Bool
/= :: BracketStyle -> BracketStyle -> Bool
Eq, Int -> BracketStyle -> ShowS
[BracketStyle] -> ShowS
BracketStyle -> String
(Int -> BracketStyle -> ShowS)
-> (BracketStyle -> String)
-> ([BracketStyle] -> ShowS)
-> Show BracketStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BracketStyle -> ShowS
showsPrec :: Int -> BracketStyle -> ShowS
$cshow :: BracketStyle -> String
show :: BracketStyle -> String
$cshowList :: [BracketStyle] -> ShowS
showList :: [BracketStyle] -> ShowS
Show)

-- | Surround given entity by backticks.
backticks :: R () -> R ()
backticks :: R () -> R ()
backticks R ()
m = do
  Text -> R ()
txt Text
"`"
  R ()
m
  Text -> R ()
txt Text
"`"

-- | Surround given entity by banana brackets (i.e., from arrow notation.)
banana :: BracketStyle -> R () -> R ()
banana :: BracketStyle -> R () -> R ()
banana = Bool -> R () -> R () -> BracketStyle -> R () -> R ()
brackets_ Bool
True R ()
token'oparenbar R ()
token'cparenbar

-- | Surround given entity by curly braces @{@ and  @}@.
braces :: BracketStyle -> R () -> R ()
braces :: BracketStyle -> R () -> R ()
braces = Bool -> R () -> R () -> BracketStyle -> R () -> R ()
brackets_ Bool
False (Text -> R ()
txt Text
"{") (Text -> R ()
txt Text
"}")

-- | Surround given entity by square brackets @[@ and @]@.
brackets :: BracketStyle -> R () -> R ()
brackets :: BracketStyle -> R () -> R ()
brackets = Bool -> R () -> R () -> BracketStyle -> R () -> R ()
brackets_ Bool
False (Text -> R ()
txt Text
"[") (Text -> R ()
txt Text
"]")

-- | Surround given entity by parentheses @(@ and @)@.
parens :: BracketStyle -> R () -> R ()
parens :: BracketStyle -> R () -> R ()
parens = Bool -> R () -> R () -> BracketStyle -> R () -> R ()
brackets_ Bool
False (Text -> R ()
txt Text
"(") (Text -> R ()
txt Text
")")

-- | Surround given entity by @(# @ and @ #)@.
parensHash :: BracketStyle -> R () -> R ()
parensHash :: BracketStyle -> R () -> R ()
parensHash = Bool -> R () -> R () -> BracketStyle -> R () -> R ()
brackets_ Bool
True (Text -> R ()
txt Text
"(#") (Text -> R ()
txt Text
"#)")

-- | Braces as used for pragmas: @{\-#@ and @#-\}@.
pragmaBraces :: R () -> R ()
pragmaBraces :: R () -> R ()
pragmaBraces R ()
m = R () -> R ()
sitcc (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
  Text -> R ()
txt Text
"{-#"
  R ()
space
  R ()
m
  R ()
breakpoint
  R () -> R ()
inci (Text -> R ()
txt Text
"#-}")

-- | Surround the body with a pragma name and 'pragmaBraces'.
pragma ::
  -- | Pragma text
  Text ->
  -- | Pragma body
  R () ->
  R ()
pragma :: Text -> R () -> R ()
pragma Text
pragmaText R ()
body = R () -> R ()
pragmaBraces (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
  Text -> R ()
txt Text
pragmaText
  R ()
breakpoint
  R ()
body

-- | A helper for defining wrappers like 'parens' and 'braces'.
brackets_ ::
  -- | Insert breakpoints around brackets
  Bool ->
  -- | Opening bracket
  R () ->
  -- | Closing bracket
  R () ->
  -- | Bracket style
  BracketStyle ->
  -- | Inner expression
  R () ->
  R ()
brackets_ :: Bool -> R () -> R () -> BracketStyle -> R () -> R ()
brackets_ Bool
needBreaks R ()
open R ()
close BracketStyle
style R ()
m = R () -> R ()
sitcc (R () -> R () -> R ()
forall a. R a -> R a -> R a
vlayout R ()
singleLine R ()
multiLine)
  where
    singleLine :: R ()
singleLine = do
      R ()
open
      Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needBreaks R ()
space
      R ()
m
      Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
needBreaks R ()
space
      R ()
close
    multiLine :: R ()
multiLine = do
      R ()
open
      commaStyle <- (forall (f :: * -> *). PrinterOpts f -> f CommaStyle)
-> R CommaStyle
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt PrinterOpts f -> f CommaStyle
forall (f :: * -> *). PrinterOpts f -> f CommaStyle
poCommaStyle
      case commaStyle of
        CommaStyle
Leading ->
          if Bool
needBreaks
            then R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
newline R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
m
            else Bool -> R () -> R ()
inciIf (BracketStyle
style BracketStyle -> BracketStyle -> Bool
forall a. Eq a => a -> a -> Bool
== BracketStyle
S) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ R ()
space R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
m
        CommaStyle
Trailing ->
          if Bool
needBreaks
            then R ()
newline R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R () -> R ()
inci R ()
m
            else R ()
space R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R () -> R ()
sitcc R ()
m
      newline
      inciIf (style == S) close

----------------------------------------------------------------------------
-- Literals

-- | Print @,@.
comma :: R ()
comma :: R ()
comma = Text -> R ()
txt Text
","

-- | Delimiting combination with 'comma'. To be used with 'sep'.
commaDel :: R ()
commaDel :: R ()
commaDel = (forall (f :: * -> *). PrinterOpts f -> f CommaStyle)
-> R CommaStyle
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt PrinterOpts f -> f CommaStyle
forall (f :: * -> *). PrinterOpts f -> f CommaStyle
poCommaStyle R CommaStyle -> (CommaStyle -> R ()) -> R ()
forall a b. R a -> (a -> R b) -> R b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CommaStyle -> R ()
commaDel'

-- | Delimiting combination with 'comma' for import-export lists.
-- To be used with `sep`.
commaDelImportExport :: R ()
commaDelImportExport :: R ()
commaDelImportExport =
  (forall (f :: * -> *). PrinterOpts f -> f ImportExportStyle)
-> R ImportExportStyle
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt PrinterOpts f -> f ImportExportStyle
forall (f :: * -> *). PrinterOpts f -> f ImportExportStyle
poImportExportStyle R ImportExportStyle -> (ImportExportStyle -> R ()) -> R ()
forall a b. R a -> (a -> R b) -> R b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    ImportExportStyle
ImportExportLeading -> CommaStyle -> R ()
commaDel' CommaStyle
Leading
    ImportExportStyle
ImportExportTrailing -> CommaStyle -> R ()
commaDel' CommaStyle
Trailing
    ImportExportStyle
ImportExportDiffFriendly -> CommaStyle -> R ()
commaDel' CommaStyle
Trailing

commaDel' :: CommaStyle -> R ()
commaDel' :: CommaStyle -> R ()
commaDel' = \case
  CommaStyle
Leading -> R ()
breakpoint' R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
comma R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
space
  CommaStyle
Trailing -> R ()
comma R () -> R () -> R ()
forall a b. R a -> R b -> R b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> R ()
breakpoint

-- | Print @=@. Do not use @'txt' "="@.
equals :: R ()
equals :: R ()
equals = Text -> R ()
interferingTxt Text
"="

----------------------------------------------------------------------------
-- Token literals
-- The names of the following literals are from GHC's
-- @compiler/GHC/Parser/Lexer.x@.

-- | Print @⤛@ or @-<<@ as appropriate.
token'Larrowtail :: R ()
token'Larrowtail :: R ()
token'Larrowtail = Text
"⤛" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"-<<"

-- | Print @⤜@ or @>>-@ as appropriate.
token'Rarrowtail :: R ()
token'Rarrowtail :: R ()
token'Rarrowtail = Text
"⤜" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
">>-"

-- | Print @⇒@ or @=>@ as appropriate.
token'darrow :: R ()
token'darrow :: R ()
token'darrow = Text
"⇒" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"=>"

-- | Print @∷@ or @::@ as appropriate.
token'dcolon :: R ()
token'dcolon :: R ()
token'dcolon = Text
"∷" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"::"

-- | Print @←@ or @<-@ as appropriate.
token'larrow :: R ()
token'larrow :: R ()
token'larrow = Text
"←" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"<-"

-- | Print @⤙@ or @-<@ as appropriate.
token'larrowtail :: R ()
token'larrowtail :: R ()
token'larrowtail = Text
"⤙" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"-<"

-- | Print @→@ or @->@ as appropriate.
token'rarrow :: R ()
token'rarrow :: R ()
token'rarrow = Text
"→" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"->"

-- | Print @⤚@ or @>-@ as appropriate.
token'rarrowtail :: R ()
token'rarrowtail :: R ()
token'rarrowtail = Text
"⤚" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
">-"

-- | Print @★@ or @*@ as appropriate.
token'star :: R ()
token'star :: R ()
token'star = Text
"★" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"*"

-- | Print @∀@ or @forall@ as appropriate.
token'forall :: R ()
token'forall :: R ()
token'forall = Text
"∀" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"forall"

-- | Print @⦇@ or @(|@ as appropriate.
token'oparenbar :: R ()
token'oparenbar :: R ()
token'oparenbar = Text
"⦇" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"(|"

-- | Print @⦈@ or @|)@ as appropriate.
token'cparenbar :: R ()
token'cparenbar :: R ()
token'cparenbar = Text
"⦈" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"|)"

-- | Print @⟦@ or @[|@ as appropriate.
token'openExpQuote :: R ()
token'openExpQuote :: R ()
token'openExpQuote = Text
"⟦" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"[|"

-- | Print @⟧@ or @|]@ as appropriate.
token'closeQuote :: R ()
token'closeQuote :: R ()
token'closeQuote = Text
"⟧" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"|]"

-- | Print @⊸@ or @%1 ->@ as appropriate.
token'lolly :: R ()
token'lolly :: R ()
token'lolly = Text
"⊸" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"%1 ->"

-- | Write the one text or the other depending on whether Unicode is enabled.
whenUnicodeOtherwise :: Text -> Text -> R ()
Text
unicodeText whenUnicodeOtherwise :: Text -> Text -> R ()
`whenUnicodeOtherwise` Text
asciiText = do
  unicodePrinterOption <- (forall (f :: * -> *). PrinterOpts f -> f Unicode) -> R Unicode
forall a. (forall (f :: * -> *). PrinterOpts f -> f a) -> R a
getPrinterOpt PrinterOpts f -> f Unicode
forall (f :: * -> *). PrinterOpts f -> f Unicode
poUnicode
  unicodeExtensionIsEnabled <- isExtensionEnabled UnicodeSyntax
  txt $ case unicodePrinterOption of
    Unicode
UnicodeDetect -> if Bool
unicodeExtensionIsEnabled then Text
unicodeText else Text
asciiText
    Unicode
UnicodeAlways -> Text
unicodeText
    Unicode
UnicodeNever -> Text
asciiText

----------------------------------------------------------------------------
-- Placement

-- | Expression placement. This marks the places where expressions that
-- implement handing forms may use them.
data Placement
  = -- | Multi-line layout should cause
    -- insertion of a newline and indentation
    -- bump
    Normal
  | -- | Expressions that have hanging form
    -- should use it and avoid bumping one level
    -- of indentation
    Hanging
  deriving (Placement -> Placement -> Bool
(Placement -> Placement -> Bool)
-> (Placement -> Placement -> Bool) -> Eq Placement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Placement -> Placement -> Bool
== :: Placement -> Placement -> Bool
$c/= :: Placement -> Placement -> Bool
/= :: Placement -> Placement -> Bool
Eq, Int -> Placement -> ShowS
[Placement] -> ShowS
Placement -> String
(Int -> Placement -> ShowS)
-> (Placement -> String)
-> ([Placement] -> ShowS)
-> Show Placement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Placement -> ShowS
showsPrec :: Int -> Placement -> ShowS
$cshow :: Placement -> String
show :: Placement -> String
$cshowList :: [Placement] -> ShowS
showList :: [Placement] -> ShowS
Show)

-- | Place a thing that may have a hanging form. This function handles how
-- to separate it from preceding expressions and whether to bump indentation
-- depending on what sort of expression we have.
placeHanging :: Placement -> R () -> R ()
placeHanging :: Placement -> R () -> R ()
placeHanging Placement
placement R ()
m =
  case Placement
placement of
    Placement
Hanging -> do
      R ()
space
      R ()
m
    Placement
Normal -> do
      R ()
breakpoint
      R () -> R ()
inci R ()
m