{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Ormolu.Printer.Combinators
(
R,
runR,
getEnclosingSpan,
getEnclosingSpanWhere,
isExtensionEnabled,
txt,
atom,
space,
newline,
declNewline,
inci,
inciBy,
inciIf,
inciByFrac,
askSourceType,
askModuleFixityMap,
askDebug,
located,
encloseLocated,
located',
switchLayout,
switchLayoutNoLimit,
spansLayout,
Layout (..),
vlayout,
getLayout,
breakpoint,
breakpoint',
getPrinterOpt,
sep,
sepSemi,
canUseBraces,
useBraces,
dontUseBraces,
BracketStyle (..),
sitcc,
backticks,
banana,
braces,
brackets,
parens,
parensHash,
pragmaBraces,
pragma,
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,
SpanMark (..),
spanMarkSpan,
HaddockStyle (..),
setSpanMark,
getSpanMark,
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.Types.SrcLoc hiding (spans)
import Ormolu.Config
import Ormolu.Printer.Comments
import Ormolu.Printer.Internal
import Ormolu.Utils (HasSrcSpan (..), getLoc')
inciIf ::
Bool ->
R () ->
R ()
inciIf :: Bool -> R () -> R ()
inciIf Bool
b R ()
m = if Bool
b then R () -> R ()
inci R ()
m else R ()
m
located ::
(HasSrcSpan l) =>
GenLocated l a ->
(a -> R ()) ->
R ()
located :: forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located (L l
l' a
a) a -> R ()
f = case l -> SrcSpan
forall l. HasSrcSpan l => l -> SrcSpan
loc' 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
encloseLocated ::
(HasSrcSpan l) =>
GenLocated l [a] ->
([a] -> R ()) ->
R ()
encloseLocated :: forall l a.
HasSrcSpan l =>
GenLocated l [a] -> ([a] -> R ()) -> R ()
encloseLocated GenLocated l [a]
la [a] -> R ()
f = GenLocated l [a] -> ([a] -> R ()) -> R ()
forall l a. HasSrcSpan 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. HasSrcSpan 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. HasSrcSpan 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 l a. HasSrcSpan l => GenLocated l a -> SrcSpan
getLoc' 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)
located' ::
(HasSrcSpan l) =>
(a -> R ()) ->
GenLocated l a ->
R ()
located' :: forall l a. HasSrcSpan 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. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located
switchLayout ::
[SrcSpan] ->
R () ->
R ()
switchLayout :: [SrcSpan] -> R () -> R ()
switchLayout [SrcSpan]
spans R ()
r = do
Layout
layout <- [SrcSpan] -> R Layout
spansLayout [SrcSpan]
spans
Layout -> R () -> R ()
enterLayout Layout
layout R ()
r
switchLayoutNoLimit :: [SrcSpan] -> R () -> R ()
switchLayoutNoLimit :: [SrcSpan] -> R () -> R ()
switchLayoutNoLimit [SrcSpan]
spans = Layout -> R () -> R ()
enterLayout (ColumnLimit -> [SrcSpan] -> Layout
spansLayoutWithLimit ColumnLimit
NoLimit [SrcSpan]
spans)
spansLayout :: [SrcSpan] -> R Layout
spansLayout :: [SrcSpan] -> R Layout
spansLayout [SrcSpan]
spans = do
ColumnLimit
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
Layout -> R Layout
forall a. a -> R a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Layout -> R Layout) -> Layout -> R Layout
forall a b. (a -> b) -> a -> b
$ ColumnLimit -> [SrcSpan] -> Layout
spansLayoutWithLimit ColumnLimit
colLimit [SrcSpan]
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
breakpoint :: R ()
breakpoint :: R ()
breakpoint = R () -> R () -> R ()
forall a. R a -> R a -> R a
vlayout R ()
space R ()
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
sep ::
R () ->
(a -> R ()) ->
[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))
sepSemi ::
(a -> R ()) ->
[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
Bool
ub <- R Bool
canUseBraces
case [a]
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
data BracketStyle
=
N
|
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)
backticks :: R () -> R ()
backticks :: R () -> R ()
backticks R ()
m = do
Text -> R ()
txt Text
"`"
R ()
m
Text -> R ()
txt Text
"`"
banana :: BracketStyle -> R () -> R ()
banana :: BracketStyle -> R () -> R ()
banana = Bool -> R () -> R () -> BracketStyle -> R () -> R ()
brackets_ Bool
True R ()
token'oparenbar R ()
token'cparenbar
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
"}")
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
"]")
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
")")
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
"#)")
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
"#-}")
pragma ::
Text ->
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
brackets_ ::
Bool ->
R () ->
R () ->
BracketStyle ->
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
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
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
R ()
newline
Bool -> R () -> R ()
inciIf (BracketStyle
style BracketStyle -> BracketStyle -> Bool
forall a. Eq a => a -> a -> Bool
== BracketStyle
S) R ()
close
comma :: R ()
comma :: R ()
comma = Text -> R ()
txt Text
","
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'
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
equals :: R ()
equals :: R ()
equals = Text -> R ()
interferingTxt Text
"="
token'Larrowtail :: R ()
token'Larrowtail :: R ()
token'Larrowtail = Text
"⤛" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"-<<"
token'Rarrowtail :: R ()
token'Rarrowtail :: R ()
token'Rarrowtail = Text
"⤜" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
">>-"
token'darrow :: R ()
token'darrow :: R ()
token'darrow = Text
"⇒" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"=>"
token'dcolon :: R ()
token'dcolon :: R ()
token'dcolon = Text
"∷" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"::"
token'larrow :: R ()
token'larrow :: R ()
token'larrow = Text
"←" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"<-"
token'larrowtail :: R ()
token'larrowtail :: R ()
token'larrowtail = Text
"⤙" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"-<"
token'rarrow :: R ()
token'rarrow :: R ()
token'rarrow = Text
"→" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"->"
token'rarrowtail :: R ()
token'rarrowtail :: R ()
token'rarrowtail = Text
"⤚" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
">-"
token'star :: R ()
token'star :: R ()
token'star = Text
"★" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"*"
token'forall :: R ()
token'forall :: R ()
token'forall = Text
"∀" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"forall"
token'oparenbar :: R ()
token'oparenbar :: R ()
token'oparenbar = Text
"⦇" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"(|"
token'cparenbar :: R ()
token'cparenbar :: R ()
token'cparenbar = Text
"⦈" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"|)"
token'openExpQuote :: R ()
token'openExpQuote :: R ()
token'openExpQuote = Text
"⟦" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"[|"
token'closeQuote :: R ()
token'closeQuote :: R ()
token'closeQuote = Text
"⟧" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"|]"
token'lolly :: R ()
token'lolly :: R ()
token'lolly = Text
"⊸" Text -> Text -> R ()
`whenUnicodeOtherwise` Text
"%1 ->"
whenUnicodeOtherwise :: Text -> Text -> R ()
Text
unicodeText whenUnicodeOtherwise :: Text -> Text -> R ()
`whenUnicodeOtherwise` Text
asciiText = do
Unicode
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
Bool
unicodeExtensionIsEnabled <- Extension -> R Bool
isExtensionEnabled Extension
UnicodeSyntax
Text -> R ()
txt (Text -> R ()) -> Text -> R ()
forall a b. (a -> b) -> a -> b
$ case Unicode
unicodePrinterOption of
Unicode
UnicodeDetect -> if Bool
unicodeExtensionIsEnabled then Text
unicodeText else Text
asciiText
Unicode
UnicodeAlways -> Text
unicodeText
Unicode
UnicodeNever -> Text
asciiText
data Placement
=
Normal
|
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)
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