1 {-# LANGUAGE NoMonomorphismRestriction #-}
2 {-# LANGUAGE OverloadedStrings #-}
3 {-# LANGUAGE UndecidableInstances #-}
4 module Symantic.Document.Plain where
6 import Control.Monad (Monad(..))
8 import Data.Char (Char)
9 import Data.Eq (Eq(..))
10 import Data.Function (($), (.), id)
11 import Data.Functor ((<$>))
13 import Data.Kind (Type)
14 import Data.Maybe (Maybe(..))
15 import Data.Monoid (Monoid(..))
16 import Data.Ord (Ord(..), Ordering(..))
17 import Data.Semigroup (Semigroup(..))
18 import Data.String (IsString(..), String)
19 import GHC.Natural (minusNatural,minusNaturalMaybe,quotRemNatural)
20 import Numeric.Natural (Natural)
21 import Prelude (fromIntegral, Num(..), pred, error)
22 import System.Console.ANSI hiding (SGR)
23 import Text.Show (Show(..), showString, showParen)
24 import qualified Data.Foldable as Fold
25 import qualified Data.List as List
26 import qualified Data.Tuple as Tuple
27 import qualified Data.Text as T
28 import qualified Data.Text.Lazy as TL
29 --import qualified Data.Text.Lazy.Builder as TLB
34 import Symantic.Document.Class
35 import Symantic.Document.Utils
38 -- | Church encoded for performance concerns.
39 -- Kind like 'ParsecT' in @megaparsec@ but a little bit different
40 -- due to the use of 'PlainFit' for implementing 'breakingSpace' correctly
41 -- when in the left hand side of ('<.>').
42 -- Prepending is done using continuation, like in a difference list.
43 newtype Plain (o::Type) a = Plain
46 {-curr-}PlainState o ->
47 {-ok-}( ({-prepend-}(o->o), {-new-}PlainState o) -> PlainFit o) ->
49 -- NOTE: equivalent to:
50 -- ReaderT PlainInh (StateT (PlainState o) (Cont (PlainFit o))) (o->o)
53 instance Semigroup o => ProductFunctor (Plain o) where
54 x <.> y = Plain $ \(a,b) inh st k ->
55 unPlain x a inh st $ \(px,sx) ->
56 unPlain y b inh sx $ \(py,sy) ->
58 x .> y = Plain $ \b inh st k ->
59 unPlain x () inh st $ \(px,sx) ->
60 unPlain y b inh sx $ \(py,sy) ->
62 x <. y = Plain $ \a inh st k ->
63 unPlain x a inh st $ \(px,sx) ->
64 unPlain y () inh sx $ \(py,sy) ->
66 instance Emptyable (Plain o) where
67 empty = Plain $ \_a _inh st k -> k (id,st)
68 instance Outputable o => Repeatable (Plain o) where
69 many0 item = Plain $ \as ->
70 unPlain (concat ((`void` item) <$> as)) ()
71 many1 item = Plain $ \case
73 as -> unPlain (concat ((`void` item) <$> as)) ()
76 instance (Convertible String o, Outputable o) => IsString (Plain o ()) where
78 instance (Convertible String o, Outputable o) => Convertible String (Plain o ()) where
81 List.intersperse newline .
84 List.intersperse breakspace .
88 instance (Convertible T.Text o, Convertible Char o, Outputable o) => Convertible T.Text (Plain o ()) where
91 List.intersperse newline .
94 List.intersperse breakspace .
98 instance (Convertible TL.Text o, Convertible Char o, Outputable o) => Convertible TL.Text (Plain o ()) where
101 List.intersperse newline .
104 List.intersperse breakspace .
108 --intersperse sep = concat . List.intersperse sep
109 instance (Convertible String o, Outputable o) => Inferable Int (Plain o) where
110 infer = showWordPlain
111 instance (Convertible String o, Outputable o) => Inferable Natural (Plain o) where
112 infer = showWordPlain
113 instance (Convertible String o, Outputable o) => Inferable (Word String) (Plain o) where
114 infer = Plain $ ($ ()) . unPlain . wordPlain
115 instance (Convertible String o, Outputable o) => Inferable String (Plain o) where
116 infer = Plain $ ($ ()) . unPlain . fromString
117 instance (Convertible T.Text o, Convertible Char o, Outputable o) => Inferable T.Text (Plain o) where
118 infer = Plain $ ($ ()) . unPlain . convert
119 instance (Convertible TL.Text o, Convertible Char o, Outputable o) => Inferable TL.Text (Plain o) where
120 infer = Plain $ ($ ()) . unPlain . convert
121 instance Outputable o => Inferable Char (Plain o) where
122 infer = Plain $ \o _inh st k -> k ((char o<>),st)
125 Convertible String o =>
127 Inferable a (Plain o) => Plain o a
128 showWordPlain = Plain $
129 ($ ()) . unPlain . wordPlain .
132 runPlain :: Monoid o => Plain o a -> a -> o
137 {-k-}(\(px,_sx) fits _overflow ->
138 -- NOTE: if px fits, then appending mempty fits
143 -- ** Type 'PlainState'
144 data PlainState o = PlainState
145 { plainState_buffer :: ![PlainChunk o]
146 , plainState_bufferStart :: !Column
147 -- ^ The 'Column' from which the 'plainState_buffer'
149 , plainState_bufferWidth :: !Width
150 -- ^ The 'Width' of the 'plainState_buffer' so far.
151 , plainState_breakIndent :: !Indent
152 -- ^ The amount of 'Indent' added by 'breakspace'
153 -- that can be reached by breaking the 'space'
154 -- into a 'newlineJustifyingPlain'.
157 defPlainState :: PlainState o
158 defPlainState = PlainState
159 { plainState_buffer = mempty
160 , plainState_bufferStart = 0
161 , plainState_bufferWidth = 0
162 , plainState_breakIndent = 0
165 -- ** Type 'PlainInh'
166 data PlainInh o = PlainInh
167 { plainInh_width :: !(Maybe Column)
168 , plainInh_justify :: !Bool
169 , plainInh_indent :: !Indent
170 , plainInh_indenting :: !(Plain o ())
171 , plainInh_sgr :: ![SGR]
174 defPlainInh :: Monoid o => PlainInh o
175 defPlainInh = PlainInh
176 { plainInh_width = Nothing
177 , plainInh_justify = False
178 , plainInh_indent = 0
179 , plainInh_indenting = empty
183 -- ** Type 'PlainFit'
184 -- | Double continuation to qualify the returned document
185 -- as fitting or overflowing the given 'plainInh_width'.
186 -- It's like @('Bool',o)@ in a normal style
187 -- (a non continuation-passing-style).
190 {-overflow-}(o -> o) ->
193 -- ** Type 'PlainChunk'
195 = PlainChunk_Ignored !o
196 -- ^ Ignored by the justification but kept in place.
197 -- Used for instance to put ANSI sequences.
198 | PlainChunk_Word !(Word o)
199 | PlainChunk_Spaces !Width
200 -- ^ 'spaces' preserved to be interleaved
201 -- correctly with 'PlainChunk_Ignored'.
202 instance Show o => Show (PlainChunk o) where
206 PlainChunk_Ignored o ->
209 PlainChunk_Word (Word o) ->
212 PlainChunk_Spaces s ->
215 instance Lengthable o => Lengthable (PlainChunk o) where
217 PlainChunk_Ignored{} -> 0
218 PlainChunk_Word o -> length o
219 PlainChunk_Spaces s -> s
221 PlainChunk_Ignored{} -> True
222 PlainChunk_Word o -> isEmpty o
223 PlainChunk_Spaces s -> s == 0
224 --instance From [SGR] o => From [SGR] (PlainChunk o) where
225 -- from sgr = PlainChunk_Ignored (from sgr)
227 runPlainChunk :: Outputable o => PlainChunk o -> o
228 runPlainChunk = \case
229 PlainChunk_Ignored o -> o
230 PlainChunk_Word (Word o) -> o
231 PlainChunk_Spaces s -> repeatedChar s ' '
233 instance Voidable (Plain o) where
234 void a p = Plain $ \() -> unPlain p a
235 instance (Convertible Char o, Outputable o) => Spaceable (Plain o) where
237 spaces n = Plain $ \() inh st@PlainState{..} k fits overflow ->
238 let newWidth = plainState_bufferStart + plainState_bufferWidth + n in
239 if plainInh_justify inh
242 { plainState_buffer =
243 case plainState_buffer of
244 PlainChunk_Spaces s:buf -> PlainChunk_Spaces (s+n):buf
245 buf -> PlainChunk_Spaces n:buf
246 , plainState_bufferWidth = plainState_bufferWidth + n
248 case plainInh_width inh of
249 Just maxWidth | maxWidth < newWidth ->
250 overflow $ k (id{-(o<>)-}, newState) fits overflow
251 _ -> k (id{-(o<>)-}, newState) fits overflow
254 { plainState_bufferWidth = plainState_bufferWidth + n
256 case plainInh_width inh of
257 Just maxWidth | maxWidth < newWidth ->
258 overflow $ k ((repeatedChar n ' ' <>), newState) fits fits
259 _ -> k ((repeatedChar n ' ' <>), newState) fits overflow
260 instance (Outputable o) => Newlineable (Plain o) where
261 -- | The default 'newline' does not justify 'plainState_buffer',
262 -- for that use 'newlineJustifyingPlain'.
263 newline = Plain $ \() inh st ->
267 <. propagatePlain (plainState_breakIndent st)
271 indentPlain = Plain $ \() inh ->
273 (plainInh_indenting inh)
274 () inh{plainInh_justify=False}
275 newlinePlain = Plain $ \() inh st k ->
277 (if plainInh_justify inh
278 then joinLinePlainChunk $ List.reverse $ plainState_buffer st
282 { plainState_bufferStart = 0
283 , plainState_bufferWidth = 0
284 , plainState_buffer = mempty
286 propagatePlain breakIndent = Plain $ \() inh st1 k fits overflow ->
290 -- NOTE: the text after this newline overflows,
291 -- so propagate the overflow before this 'newline',
292 -- if and only if there is a 'breakspace' before this 'newline'
293 -- whose replacement by a 'newline' indents to a lower indent
294 -- than this 'newline''s indent.
295 -- Otherwise there is no point in propagating the overflow.
296 if breakIndent < plainInh_indent inh
301 -- | Commit 'plainState_buffer' upto there, so that it won'o be justified.
302 flushlinePlain :: Outputable o => Plain o ()
303 flushlinePlain = Plain $ \() _inh st k ->
304 k( (joinLinePlainChunk (collapsePlainChunkSpaces <$> List.reverse (plainState_buffer st)) <>)
306 { plainState_bufferStart = plainState_bufferStart st + plainState_bufferWidth st
307 , plainState_bufferWidth = 0
308 , plainState_buffer = mempty
312 -- | Just concat 'PlainChunk's with no justification.
313 joinLinePlainChunk :: Outputable o => [PlainChunk o] -> o
314 joinLinePlainChunk = mconcat . (runPlainChunk <$>)
316 collapsePlainChunkSpaces :: PlainChunk o -> PlainChunk o
317 collapsePlainChunkSpaces = \case
318 PlainChunk_Spaces s -> PlainChunk_Spaces (if s > 0 then 1 else 0)
322 Lengthable i => Convertible i o => Outputable o =>
324 wordPlain inp = Plain $ \() inh st@PlainState{..} k fits overflow ->
325 let wordWidth = length inp in
326 let out = convert inp in
328 then k (id,st) fits overflow
330 let newBufferWidth = plainState_bufferWidth + wordWidth in
331 let newWidth = plainState_bufferStart + newBufferWidth in
332 if plainInh_justify inh
335 { plainState_buffer = PlainChunk_Word out : plainState_buffer
336 , plainState_bufferWidth = newBufferWidth
338 case plainInh_width inh of
339 Just maxWidth | maxWidth < newWidth ->
340 overflow $ k (id, newState) fits overflow
341 _ -> k (id, newState) fits overflow
344 { plainState_bufferWidth = newBufferWidth
346 case plainInh_width inh of
347 Just maxWidth | maxWidth < newWidth ->
348 overflow $ k ((unWord out <>), newState) fits fits
349 _ -> k ((unWord out <>), newState) fits overflow
351 instance (Convertible Char o, Outputable o) => Indentable (Plain o) where
352 align p = (flushlinePlain .>) $ Plain $ \a inh st ->
353 let col = plainState_bufferStart st + plainState_bufferWidth st in
355 { plainInh_indent = col
356 , plainInh_indenting =
357 if plainInh_indent inh <= col
359 plainInh_indenting inh .>
360 spaces (col`minusNatural`plainInh_indent inh)
363 setIndent o i p = Plain $ \a inh ->
365 { plainInh_indent = i
366 , plainInh_indenting = o
368 incrIndent o i p = Plain $ \a inh ->
370 { plainInh_indent = plainInh_indent inh + i
371 , plainInh_indenting = plainInh_indenting inh .> o
373 fill m p = Plain $ \a inh0 st0 ->
374 let maxCol = plainState_bufferStart st0 + plainState_bufferWidth st0 + m in
375 let p1 = Plain $ \() inh1 st1 ->
376 let col = plainState_bufferStart st1 + plainState_bufferWidth st1 in
379 then spaces (maxCol`minusNatural`col)
383 unPlain (p <. p1) a inh0 st0
384 fillOrBreak m p = Plain $ \a inh0 st0 ->
385 let maxCol = plainState_bufferStart st0 + plainState_bufferWidth st0 + m in
386 let p1 = Plain $ \() inh1 st1 ->
387 let col = plainState_bufferStart st1 + plainState_bufferWidth st1 in
389 (case col`compare`maxCol of
390 LT -> spaces (maxCol`minusNatural`col)
392 GT -> incrIndent (spaces m) m newline
395 unPlain (p <. p1) a inh0 st0
396 instance (Convertible Char o, Convertible String o, Outputable o) => Listable (Plain o) where
400 wordPlain (Word '-').>space.>flushlinePlain
408 , ( wordPlain (Word (show n))
409 .> wordPlain (Word '.') .> space
415 ) (Fold.length is, []) is
416 unorderedList li = intercalate_ newline $
417 wordPlain (Word '-') .> space .> flushlinePlain .> align li
418 orderedList li = Plain $ \as ->
419 unPlain (intercalate_ newline item)
422 item = Plain $ \(i::Natural, a) ->
425 .> wordPlain (Word '.') .> space
428 intercalate_ sep li = Plain $ \as ->
429 unPlain (concat (List.intersperse sep ((`void` li) <$> as))) ()
430 list_ opn sep cls li =
432 (opn .> intercalate_ (sep .> space) li <. cls)
433 (align $ opn .> space
434 .> intercalate_ (newline .> sep .> space) li
436 instance Outputable o => Justifiable (Plain o) where
437 justify p = (\x -> flushlinePlain .> x <. flushlinePlain) $ Plain $ \a inh ->
438 unPlain p a inh{plainInh_justify=True}
439 instance Outputable o => Wrappable (Plain o) where
440 setWidth w p = Plain $ \a inh ->
441 unPlain p a inh{plainInh_width=w}
442 breakpoint = Plain $ \() inh st k fits overflow ->
443 k(id, st{plainState_breakIndent = plainInh_indent inh})
445 {-overflow-}(\_r -> unPlain newlineJustifyingPlain () inh st k fits overflow)
446 breakspace = Plain $ \() inh st k fits overflow ->
447 k( if plainInh_justify inh then id else (char ' ' <>)
449 { plainState_buffer =
450 if plainInh_justify inh
451 then case plainState_buffer st of
452 PlainChunk_Spaces s:bs -> PlainChunk_Spaces (s+1):bs
453 bs -> PlainChunk_Spaces 1:bs
454 else plainState_buffer st
455 , plainState_bufferWidth = plainState_bufferWidth st + 1
456 , plainState_breakIndent = plainInh_indent inh
460 {-overflow-}(\_r -> unPlain newlineJustifyingPlain () inh st k fits overflow)
461 breakalt x y = Plain $ \a inh st k fits overflow ->
462 -- NOTE: breakalt must be y if and only if x does not fit,
463 -- hence the use of dummyK to limit the test
464 -- to overflows raised within x, and drop those raised after x.
465 unPlain x a inh st dummyK
466 {-fits-} (\_r -> unPlain x a inh st k fits overflow)
467 {-overflow-}(\_r -> unPlain y a inh st k fits overflow)
469 dummyK (px,_sx) fits _overflow =
470 -- NOTE: if px fits, then appending mempty fits
472 endline = Plain $ \() inh st k fits _overflow ->
473 let col = plainState_bufferStart st + plainState_bufferWidth st in
474 case plainInh_width inh >>= (`minusNaturalMaybe` col) of
475 Nothing -> k (id, st) fits fits
478 { plainState_bufferWidth = plainState_bufferWidth st + w
480 k (id,newState) fits fits
482 -- | Like 'newline', but justify 'plainState_buffer' before.
483 newlineJustifyingPlain :: Outputable o => Plain o ()
484 newlineJustifyingPlain = Plain $ \() inh st ->
488 .> propagatePlain (plainState_breakIndent st)
492 indentPlain = Plain $ \a inh ->
494 (plainInh_indenting inh) a
495 inh{plainInh_justify=False}
496 newlinePlain = Plain $ \() inh st k ->
498 (if plainInh_justify inh
499 then justifyLinePlain inh st
503 { plainState_bufferStart = 0
504 , plainState_bufferWidth = 0
505 , plainState_buffer = mempty
507 propagatePlain breakIndent = Plain $ \() inh st1 k fits overflow ->
511 -- NOTE: the text after this newline overflows,
512 -- so propagate the overflow before this 'newline',
513 -- if and only if there is a 'breakspace' before this 'newline'
514 -- whose replacement by a 'newline' indents to a lower indent
515 -- than this 'newline''s indent.
516 -- Otherwise there is no point in propagating the overflow.
517 if breakIndent < plainInh_indent inh
525 PlainInh o -> PlainState o -> o
526 justifyLinePlain inh PlainState{..} =
527 case plainInh_width inh of
528 Nothing -> joinLinePlainChunk $ List.reverse plainState_buffer
530 if maxWidth < plainState_bufferStart
531 || maxWidth < plainInh_indent inh
532 then joinLinePlainChunk $ List.reverse plainState_buffer
534 let superfluousSpaces = Fold.foldr
537 PlainChunk_Ignored{} -> 0
538 PlainChunk_Word{} -> 0
539 PlainChunk_Spaces s -> s`minusNatural`(min 1 s))
540 0 plainState_buffer in
542 -- NOTE: cap the spaces at 1,
543 -- to let justifyWidth decide where to add spaces.
544 plainState_bufferWidth`minusNatural`superfluousSpaces in
546 -- NOTE: when minBufferWidth is not breakable,
547 -- the length of justification can be wider than
548 -- what remains to reach maxWidth.
550 maxWidth`minusNatural`plainState_bufferStart
552 let wordCount = countWordsPlain plainState_buffer in
553 unLine $ padLinePlainChunkInits justifyWidth $
554 (minBufferWidth,wordCount,List.reverse plainState_buffer)
556 -- | @('countWordsPlain' ps)@ returns the number of words in @(ps)@
557 -- clearly separated by spaces.
558 countWordsPlain :: [PlainChunk o] -> Natural
559 countWordsPlain = go False 0
561 go inWord acc = \case
563 PlainChunk_Word{}:xs ->
565 then go inWord acc xs
566 else go True (acc+1) xs
567 PlainChunk_Spaces s:xs
568 | s == 0 -> go inWord acc xs
569 | otherwise -> go False acc xs
570 PlainChunk_Ignored{}:xs -> go inWord acc xs
572 -- | @('justifyPadding' a b)@ returns the padding lengths
573 -- to reach @(a)@ in @(b)@ pads,
574 -- using the formula: @(a '==' m'*'(q '+' q'+'1) '+' ('r'-'m)'*'(q'+'1) '+' (b'-'r'-'m)'*'q)@
575 -- where @(q+1)@ and @(q)@ are the two padding lengths used and @(m = min (b-r) r)@.
577 -- A simple implementation of 'justifyPadding' could be:
579 -- 'justifyPadding' a b =
580 -- 'join' ('List.replicate' m [q,q'+'1])
581 -- <> ('List.replicate' (r'-'m) (q'+'1)
582 -- <> ('List.replicate' ((b'-'r)'-'m) q
584 -- (q,r) = a`divMod`b
587 justifyPadding :: Natural -> Natural -> [Natural]
588 justifyPadding a b = go r (b-r) -- NOTE: r >= 0 && b-r >= 0 due to 'divMod'
590 (q,r) = a`quotRemNatural`b
592 go 0 bmr = List.replicate (fromIntegral bmr) q -- when min (b-r) r == b-r
593 go rr 0 = List.replicate (fromIntegral rr) (q+1) -- when min (b-r) r == r
594 go rr bmr = q:(q+1) : go (rr`minusNatural`1) (bmr`minusNatural`1)
596 padLinePlainChunkInits ::
598 Width -> (Natural, Natural, [PlainChunk o]) -> Line o
599 padLinePlainChunkInits maxWidth (lineWidth,wordCount,line) = Line $
600 if maxWidth <= lineWidth
601 -- The gathered line reached or overreached the maxWidth,
602 -- hence no padding id needed.
604 -- The case maxWidth <= lineWidth && wordCount == 1
605 -- can happen if first word's length is < maxWidth
606 -- but second word's len is >= maxWidth.
607 then joinLinePlainChunk line
609 -- Share the missing spaces as evenly as possible
610 -- between the words of the line.
611 padLinePlainChunk line $ justifyPadding (maxWidth-lineWidth) (wordCount-1)
613 -- | Interleave 'PlainChunk's with 'Width's from 'justifyPadding'.
614 padLinePlainChunk :: Outputable o => [PlainChunk o] -> [Width] -> o
615 padLinePlainChunk = go
617 go (w:ws) lls@(l:ls) =
619 PlainChunk_Spaces _s -> repeatedChar (fromIntegral (l+1)) ' ' <> go ws ls
620 _ -> runPlainChunk w <> go ws lls
621 go (w:ws) [] = runPlainChunk w <> go ws []
625 sgrPlain :: Outputable o => [SGR] -> Plain o ()
626 sgrPlain sgr = Plain $ \() inh st k ->
627 if plainInh_justify inh
628 then k (id, st {plainState_buffer =
629 PlainChunk_Ignored (fromString (setSGRCode sgr)) :
632 else k ((fromString (setSGRCode sgr) <>), st)
634 instance Outputable o => Colorable16 (Plain o) where
635 reverse = plainSGR $ SetSwapForegroundBackground True
636 black = plainSGR $ SetColor Foreground Dull Black
637 red = plainSGR $ SetColor Foreground Dull Red
638 green = plainSGR $ SetColor Foreground Dull Green
639 yellow = plainSGR $ SetColor Foreground Dull Yellow
640 blue = plainSGR $ SetColor Foreground Dull Blue
641 magenta = plainSGR $ SetColor Foreground Dull Magenta
642 cyan = plainSGR $ SetColor Foreground Dull Cyan
643 white = plainSGR $ SetColor Foreground Dull White
644 blacker = plainSGR $ SetColor Foreground Vivid Black
645 redder = plainSGR $ SetColor Foreground Vivid Red
646 greener = plainSGR $ SetColor Foreground Vivid Green
647 yellower = plainSGR $ SetColor Foreground Vivid Yellow
648 bluer = plainSGR $ SetColor Foreground Vivid Blue
649 magentaer = plainSGR $ SetColor Foreground Vivid Magenta
650 cyaner = plainSGR $ SetColor Foreground Vivid Cyan
651 whiter = plainSGR $ SetColor Foreground Vivid White
652 onBlack = plainSGR $ SetColor Background Dull Black
653 onRed = plainSGR $ SetColor Background Dull Red
654 onGreen = plainSGR $ SetColor Background Dull Green
655 onYellow = plainSGR $ SetColor Background Dull Yellow
656 onBlue = plainSGR $ SetColor Background Dull Blue
657 onMagenta = plainSGR $ SetColor Background Dull Magenta
658 onCyan = plainSGR $ SetColor Background Dull Cyan
659 onWhite = plainSGR $ SetColor Background Dull White
660 onBlacker = plainSGR $ SetColor Background Vivid Black
661 onRedder = plainSGR $ SetColor Background Vivid Red
662 onGreener = plainSGR $ SetColor Background Vivid Green
663 onYellower = plainSGR $ SetColor Background Vivid Yellow
664 onBluer = plainSGR $ SetColor Background Vivid Blue
665 onMagentaer = plainSGR $ SetColor Background Vivid Magenta
666 onCyaner = plainSGR $ SetColor Background Vivid Cyan
667 onWhiter = plainSGR $ SetColor Background Vivid White
668 instance Outputable o => Decorable (Plain o) where
669 bold = plainSGR $ SetConsoleIntensity BoldIntensity
670 underline = plainSGR $ SetUnderlining SingleUnderline
671 italic = plainSGR $ SetItalicized True
673 plainSGR :: Outputable o => SGR -> Plain o a -> Plain o a
674 plainSGR newSGR p = before .> middle <. after
676 before = Plain $ \() inh st k ->
677 let o = fromString $ setSGRCode [newSGR] in
678 if plainInh_justify inh
680 { plainState_buffer =
681 PlainChunk_Ignored o :
685 middle = Plain $ \a inh ->
686 unPlain p a inh{plainInh_sgr=newSGR:plainInh_sgr inh}
687 after = Plain $ \() inh st k ->
688 let o = fromString $ setSGRCode $ Reset : List.reverse (plainInh_sgr inh) in
689 if plainInh_justify inh
691 { plainState_buffer =
692 PlainChunk_Ignored o :