Plain.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE UndecidableInstances #-}
module Symantic.Document.Plain where

import Control.Monad (Monad(..))
import Data.Bool
import Data.Char (Char)
import Data.Eq (Eq(..))
import Data.Function (($), (.), id)
import Data.Functor ((<$>))
import Data.Maybe (Maybe(..))
import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..), Ordering(..))
import Data.Semigroup (Semigroup(..))
import Data.String (String, IsString(..))
import Data.Text (Text)
import Data.Tuple (snd)
import GHC.Natural (minusNatural,minusNaturalMaybe,quotRemNatural)
import Numeric.Natural (Natural)
import Prelude (fromIntegral, Num(..), pred)
import System.Console.ANSI hiding (SGR)
import Text.Show (Show(..), showString, showParen)
import qualified Data.Foldable as Fold
import qualified Data.List as List
import qualified Data.Text.Lazy as TL

import Symantic.Document.Lang

-- * Type 'Plain'
-- | Church encoded for performance concerns.
-- Kind like 'ParsecT' in @megaparsec@ but a little bit different
-- due to the use of 'PlainFit' for implementing 'breakingSpace' correctly
-- when in the left hand side of ('<>').
-- Prepending is done using continuation, like in a difference list.
newtype Plain d = Plain
 { unPlain ::
     {-curr-}PlainInh d ->
     {-curr-}PlainState d ->
     {-ok-}( ({-prepend-}(d->d), {-new-}PlainState d) -> PlainFit d) ->
     PlainFit d
     -- NOTE: equivalent to:
     -- ReaderT PlainInh (StateT (PlainState d) (Cont (PlainFit d))) (d->d)
 }
instance (Show d, Spaceable d) => Show (Plain d) where
	show = show . runPlain

runPlain :: Spaceable d => Plain d -> d
runPlain x =
	unPlain x
	 defPlainInh
	 defPlainState
	 {-k-}(\(px,_sx) fits _overflow ->
		-- NOTE: if px fits, then appending mempty fits
		fits (px mempty) )
	 {-fits-}id
	 {-overflow-}id

-- ** Type 'PlainState'
data PlainState d = PlainState
 { plainState_buffer          :: ![PlainChunk d]
 , plainState_bufferStart     :: !Column
   -- ^ The 'Column' from which the 'plainState_buffer'
   -- must be written.
 , plainState_bufferWidth     :: !Width
   -- ^ The 'Width' of the 'plainState_buffer' so far.
 , plainState_breakIndent :: !Indent
   -- ^ The amount of 'Indent' added by 'breakspace'
   -- that can be reached by breaking the 'space'
   -- into a 'newlineJustifyingPlain'.
 } deriving (Show)

defPlainState :: PlainState d
defPlainState = PlainState
 { plainState_buffer      = mempty
 , plainState_bufferStart = 0
 , plainState_bufferWidth = 0
 , plainState_breakIndent = 0
 }

-- ** Type 'PlainInh'
data PlainInh d = PlainInh
 { plainInh_width     :: !(Maybe Column)
 , plainInh_justify   :: !Bool
 , plainInh_indent    :: !Indent
 , plainInh_indenting :: !(Plain d)
 , plainInh_sgr       :: ![SGR]
 }

defPlainInh :: Spaceable d => PlainInh d
defPlainInh = PlainInh
 { plainInh_width     = Nothing
 , plainInh_justify   = False
 , plainInh_indent    = 0
 , plainInh_indenting = mempty
 , plainInh_sgr       = []
 }

-- ** Type 'PlainFit'
-- | Double continuation to qualify the returned document
-- as fitting or overflowing the given 'plainInh_width'.
-- It's like @('Bool',d)@ in a normal style
-- (a non continuation-passing-style).
type PlainFit d = {-fits-}(d -> d) ->
                  {-overflow-}(d -> d) ->
                  d

-- ** Type 'PlainChunk'
data PlainChunk d
 =   PlainChunk_Ignored !d
     -- ^ Ignored by the justification but kept in place.
     -- Used for instance to put ANSI sequences.
 |   PlainChunk_Word !(Word d)
 |   PlainChunk_Spaces !Width
     -- ^ 'spaces' preserved to be interleaved
     -- correctly with 'PlainChunk_Ignored'.
instance Show d => Show (PlainChunk d) where
	showsPrec p x =
		showParen (p>10) $
		case x of
		 PlainChunk_Ignored d ->
			showString "Z " .
			showsPrec 11 d
		 PlainChunk_Word (Word d) ->
			showString "W " .
			showsPrec 11 d
		 PlainChunk_Spaces s ->
			showString "S " .
			showsPrec 11 s
instance Lengthable d => Lengthable (PlainChunk d) where
	width = \case
	 PlainChunk_Ignored{} -> 0
	 PlainChunk_Word d -> width d
	 PlainChunk_Spaces s -> s
	nullWidth = \case
	 PlainChunk_Ignored{} -> True
	 PlainChunk_Word d -> nullWidth d
	 PlainChunk_Spaces s -> s == 0
instance From [SGR] d => From [SGR] (PlainChunk d) where
	from sgr = PlainChunk_Ignored (from sgr)

runPlainChunk :: Spaceable d => PlainChunk d -> d
runPlainChunk = \case
 PlainChunk_Ignored d -> d
 PlainChunk_Word (Word d) -> d
 PlainChunk_Spaces s -> spaces s

instance Semigroup d => Semigroup (Plain d) where
	Plain x <> Plain y = Plain $ \inh st k ->
		x inh st $ \(px,sx) ->
			y inh sx $ \(py,sy) ->
				k (px.py,sy)
instance Monoid d => Monoid (Plain d) where
	mempty = Plain $ \_inh st k -> k (id,st)
	mappend = (<>)
instance Spaceable d => Spaceable (Plain d) where
	-- | The default 'newline' does not justify 'plainState_buffer',
	-- for that use 'newlineJustifyingPlain'.
	newline = Plain $ \inh st ->
		unPlain
		 (  newlinePlain
		 <> indentPlain
		 <> propagatePlain (plainState_breakIndent st)
		 <> flushlinePlain
		 ) inh st
		where
		indentPlain = Plain $ \inh ->
			unPlain
			 (plainInh_indenting inh)
			 inh{plainInh_justify=False}
		newlinePlain = Plain $ \inh st k ->
			k (\next ->
				(if plainInh_justify inh
					then joinLinePlainChunk $ List.reverse $ plainState_buffer st
					else mempty
				)<>newline<>next
			 , st
			 { plainState_bufferStart = 0
			 , plainState_bufferWidth = 0
			 , plainState_buffer      = mempty
			 })
		propagatePlain breakIndent = Plain $ \inh st1 k fits overflow ->
			k (id,st1)
			 fits
			 {-overflow-}(
				-- NOTE: the text after this newline overflows,
				-- so propagate the overflow before this 'newline',
				-- if and only if there is a 'breakspace' before this 'newline'
				-- whose replacement by a 'newline' indents to a lower indent
				-- than this 'newline''s indent.
				-- Otherwise there is no point in propagating the overflow.
				if breakIndent < plainInh_indent inh
				then overflow
				else fits
			 )
	space = spaces 1
	spaces n = Plain $ \inh st@PlainState{..} k fits overflow ->
		let newWidth = plainState_bufferStart + plainState_bufferWidth + n in
		if plainInh_justify inh
		then
			let newState = st
				 { plainState_buffer =
					case plainState_buffer of
					 PlainChunk_Spaces s:buf -> PlainChunk_Spaces (s+n):buf
					 buf -> PlainChunk_Spaces n:buf
				 , plainState_bufferWidth = plainState_bufferWidth + n
				 } in
			case plainInh_width inh of
			 Just maxWidth | maxWidth < newWidth ->
				overflow $ k (id{-(d<>)-}, newState) fits overflow
			 _ -> k (id{-(d<>)-}, newState) fits overflow
		else
			let newState = st
				 { plainState_bufferWidth = plainState_bufferWidth + n
				 } in
			case plainInh_width inh of
			 Just maxWidth | maxWidth < newWidth ->
				overflow $ k ((spaces n <>), newState) fits fits
			 _ -> k ((spaces n <>), newState) fits overflow
instance (From (Word s) d, Semigroup d, Lengthable s) =>
         From (Word s) (Plain d) where
	from s = Plain $ \inh st@PlainState{..} k fits overflow ->
		let wordWidth = width s in
		if wordWidth <= 0
		then k (id,st) fits overflow
		else
			let newBufferWidth = plainState_bufferWidth + wordWidth in
			let newWidth = plainState_bufferStart + newBufferWidth in
			if plainInh_justify inh
			then
				let newState = st
					 { plainState_buffer =
						PlainChunk_Word (Word (from s)) :
						plainState_buffer
					 , plainState_bufferWidth = newBufferWidth
					 } in
				case plainInh_width inh of
				 Just maxWidth | maxWidth < newWidth ->
					overflow $ k (id, newState) fits overflow
				 _ -> k (id, newState) fits overflow
			else
				let newState = st
					 { plainState_bufferWidth = newBufferWidth
					 } in
				case plainInh_width inh of
				 Just maxWidth | maxWidth < newWidth ->
					overflow $ k ((from s <>), newState) fits fits
				 _ -> k ((from s <>), newState) fits overflow
instance (From (Word s) d, Lengthable s, Spaceable d, Splitable s) =>
         From (Line s) (Plain d) where
	from =
		mconcat .
		List.intersperse breakspace .
		(from <$>) .
		words .
		unLine
instance Spaceable d => Indentable (Plain d) where
	align p = (flushlinePlain <>) $ Plain $ \inh st ->
		let col = plainState_bufferStart st + plainState_bufferWidth st in
		unPlain p inh
		 { plainInh_indent    = col
		 , plainInh_indenting =
			if plainInh_indent inh <= col
			then
				plainInh_indenting inh <>
				spaces (col`minusNatural`plainInh_indent inh)
			else spaces col
		 } st
	setIndent d i p = Plain $ \inh ->
		unPlain p inh
		 { plainInh_indent    = i
		 , plainInh_indenting = d
		 }
	incrIndent d i p = Plain $ \inh ->
		unPlain p inh
		 { plainInh_indent    = plainInh_indent inh + i
		 , plainInh_indenting = plainInh_indenting inh <> d
		 }
	
	fill m p = Plain $ \inh0 st0 ->
		let maxCol = plainState_bufferStart st0 + plainState_bufferWidth st0 + m in
		let p1 = Plain $ \inh1 st1 ->
			let col = plainState_bufferStart st1 + plainState_bufferWidth st1 in
			unPlain
			 (if col <= maxCol
				then spaces (maxCol`minusNatural`col)
				else mempty)
			 inh1 st1
		in
		unPlain (p <> p1) inh0 st0
	fillOrBreak m p = Plain $ \inh0 st0 ->
		let maxCol = plainState_bufferStart st0 + plainState_bufferWidth st0 + m in
		let p1 = Plain $ \inh1 st1 ->
			let col = plainState_bufferStart st1 + plainState_bufferWidth st1 in
			unPlain
			 (case col`compare`maxCol of
				 LT -> spaces (maxCol`minusNatural`col)
				 EQ -> mempty
				 GT -> incrIndent (spaces m) m newline
			 ) inh1 st1
		in
		unPlain (p <> p1) inh0 st0
instance (Spaceable d, From (Word Char) d, From (Word String) d) => Listable (Plain d) where
	ul ds =
		catV $
			(<$> ds) $ \d ->
				from (Word '-')<>space<>flushlinePlain<>align d{-<>flushlinePlain-}
	ol ds =
		catV $ snd $
			Fold.foldr
			 (\d (i, acc) ->
				(pred i, (from i<>from (Word '.')<>space<>flushlinePlain<>align d{-<>flushlinePlain-}) : acc)
			 ) (Fold.length ds, []) ds
instance Spaceable d => Justifiable (Plain d) where
	justify p = (\x -> flushlinePlain <> x <> flushlinePlain) $ Plain $ \inh ->
		unPlain p inh{plainInh_justify=True}

-- | Commit 'plainState_buffer' upto there, so that it won't be justified.
flushlinePlain :: Spaceable d => Plain d
flushlinePlain = Plain $ \_inh st k ->
	k( (joinLinePlainChunk (collapsePlainChunkSpaces <$> List.reverse (plainState_buffer st)) <>)
	 , st
		 { plainState_bufferStart = plainState_bufferStart st + plainState_bufferWidth st
		 , plainState_bufferWidth = 0
		 , plainState_buffer      = mempty
		 }
	 )

collapsePlainChunkSpaces :: PlainChunk d -> PlainChunk d
collapsePlainChunkSpaces = \case
 PlainChunk_Spaces s -> PlainChunk_Spaces (if s > 0 then 1 else 0)
 x -> x

instance Spaceable d => Wrappable (Plain d) where
	setWidth w p = Plain $ \inh ->
		unPlain p inh{plainInh_width=w}
	breakpoint = Plain $ \inh st k fits overflow ->
		k(id, st {plainState_breakIndent = plainInh_indent inh})
		 fits
		 {-overflow-}(\_r -> unPlain newlineJustifyingPlain inh st k fits overflow)
	breakspace = Plain $ \inh st k fits overflow ->
		k( if plainInh_justify inh then id else (space <>)
		 , st
			 { plainState_buffer =
				if plainInh_justify inh
				then case plainState_buffer st of
					 PlainChunk_Spaces s:bs -> PlainChunk_Spaces (s+1):bs
					 bs -> PlainChunk_Spaces 1:bs
				else plainState_buffer st
			 , plainState_bufferWidth = plainState_bufferWidth st + 1
			 , plainState_breakIndent = plainInh_indent inh
			 }
		 )
		 fits
		 {-overflow-}(\_r -> unPlain newlineJustifyingPlain inh st k fits overflow)
	breakalt x y = Plain $ \inh st k fits overflow ->
		-- NOTE: breakalt must be y if and only if x does not fit,
		-- hence the use of dummyK to limit the test
		-- to overflows raised within x, and drop those raised after x.
		unPlain x inh st dummyK
		 {-fits-}    (\_r -> unPlain x inh st k fits overflow)
		 {-overflow-}(\_r -> unPlain y inh st k fits overflow)
		where
		dummyK (px,_sx) fits _overflow =
			-- NOTE: if px fits, then appending mempty fits
			fits (px mempty)
	endline = Plain $ \inh st k fits _overflow ->
		let col = plainState_bufferStart st + plainState_bufferWidth st in
		case plainInh_width inh >>= (`minusNaturalMaybe` col) of
		 Nothing -> k (id, st) fits fits
		 Just w ->
			let newState = st
				 { plainState_bufferWidth = plainState_bufferWidth st + w
				 } in
			k (id,newState) fits fits

-- | Like 'newline', but justify 'plainState_buffer' before.
newlineJustifyingPlain :: Spaceable d => Plain d
newlineJustifyingPlain = Plain $ \inh st ->
	unPlain
	 (  newlinePlain
	 <> indentPlain
	 <> propagatePlain (plainState_breakIndent st)
	 <> flushlinePlain
	 ) inh st
	where
	indentPlain = Plain $ \inh ->
		unPlain
		 (plainInh_indenting inh)
		 inh{plainInh_justify=False}
	newlinePlain = Plain $ \inh st k ->
		k (\next ->
			(if plainInh_justify inh
				then justifyLinePlain inh st
				else mempty
			)<>newline<>next
		 , st
		 { plainState_bufferStart = 0
		 , plainState_bufferWidth = 0
		 , plainState_buffer      = mempty
		 })
	propagatePlain breakIndent = Plain $ \inh st1 k fits overflow ->
		k (id,st1)
		 fits
		 {-overflow-}(
			-- NOTE: the text after this newline overflows,
			-- so propagate the overflow before this 'newline',
			-- if and only if there is a 'breakspace' before this 'newline'
			-- whose replacement by a 'newline' indents to a lower indent
			-- than this 'newline''s indent.
			-- Otherwise there is no point in propagating the overflow.
			if breakIndent < plainInh_indent inh
			then overflow
			else fits
		 )

-- String
instance (From (Word String) d, Spaceable d) =>
         From String (Plain d) where
	from =
		mconcat .
		List.intersperse newline .
		(from <$>) .
		lines
instance (From (Word String) d, Spaceable d) =>
         IsString (Plain d) where
	fromString = from
-- Text
instance (From (Word Text) d, Spaceable d) =>
         From Text (Plain d) where
	from =
		mconcat .
		List.intersperse newline .
		(from <$>) .
		lines
instance (From (Word TL.Text) d, Spaceable d) =>
         From TL.Text (Plain d) where
	from =
		mconcat .
		List.intersperse newline .
		(from <$>) .
		lines
-- Char
instance (From (Word Char) d, Spaceable d) =>
         From Char (Plain d) where
	from ' '  = breakspace
	from '\n' = newline
	from c    = from (Word c)

instance (From [SGR] d, Semigroup d) => From [SGR] (Plain d) where
	from sgr = Plain $ \inh st k ->
		if plainInh_justify inh
		then k (id, st {plainState_buffer = PlainChunk_Ignored (from sgr) : plainState_buffer st})
		else k ((from sgr <>), st)

-- * Justifying
justifyLinePlain ::
 Spaceable d =>
 PlainInh d -> PlainState d -> d
justifyLinePlain inh PlainState{..} =
	case plainInh_width inh of
	 Nothing -> joinLinePlainChunk $ List.reverse plainState_buffer
	 Just maxWidth ->
		if maxWidth < plainState_bufferStart
		|| maxWidth < plainInh_indent inh
		then joinLinePlainChunk $ List.reverse plainState_buffer
		else
			let superfluousSpaces = Fold.foldr
				 (\c acc ->
					acc + case c of
					 PlainChunk_Ignored{} -> 0
					 PlainChunk_Word{} -> 0
					 PlainChunk_Spaces s -> s`minusNatural`(min 1 s))
				 0 plainState_buffer in
			let minBufferWidth =
				-- NOTE: cap the spaces at 1,
				-- to let justifyWidth decide where to add spaces.
				plainState_bufferWidth`minusNatural`superfluousSpaces in
			let justifyWidth =
				-- NOTE: when minBufferWidth is not breakable,
				-- the width of justification can be wider than
				-- what remains to reach maxWidth.
				max minBufferWidth $
					maxWidth`minusNatural`plainState_bufferStart
			in
			let wordCount = countWordsPlain plainState_buffer in
			unLine $ padLinePlainChunkInits justifyWidth $
			 (minBufferWidth,wordCount,List.reverse plainState_buffer)

-- | @('countWordsPlain' ps)@ returns the number of words in @(ps)@
-- clearly separated by spaces.
countWordsPlain :: [PlainChunk d] -> Natural
countWordsPlain = go False 0
 where
	go inWord acc = \case
	 [] -> acc
	 PlainChunk_Word{}:xs ->
		if inWord
		then go inWord acc xs
		else go True (acc+1) xs
	 PlainChunk_Spaces s:xs
	  | s == 0    -> go inWord acc xs
	  | otherwise -> go False acc xs
	 PlainChunk_Ignored{}:xs -> go inWord acc xs

-- | @('justifyPadding' a b)@ returns the padding lengths
-- to reach @(a)@ in @(b)@ pads,
-- using the formula: @(a '==' m'*'(q '+' q'+'1) '+' ('r'-'m)'*'(q'+'1) '+' (b'-'r'-'m)'*'q)@
-- where @(q+1)@ and @(q)@ are the two padding lengths used and @(m = min (b-r) r)@.
--
-- A simple implementation of 'justifyPadding' could be:
-- @
-- 'justifyPadding' a b =
--   'join' ('List.replicate' m [q,q'+'1])
--   <> ('List.replicate' (r'-'m) (q'+'1)
--   <> ('List.replicate' ((b'-'r)'-'m) q
--   where
--   (q,r) = a`divMod`b
--   m = 'min' (b-r) r
-- @
justifyPadding :: Natural -> Natural -> [Natural]
justifyPadding a b = go r (b-r) -- NOTE: r >= 0 && b-r >= 0 due to 'divMod'
	where
	(q,r) = a`quotRemNatural`b
	
	go 0  bmr = List.replicate (fromIntegral bmr) q    -- when min (b-r) r == b-r
	go rr 0   = List.replicate (fromIntegral rr) (q+1) -- when min (b-r) r == r
	go rr bmr = q:(q+1) : go (rr`minusNatural`1) (bmr`minusNatural`1)

padLinePlainChunkInits ::
 Spaceable d =>
 Width -> (Natural, Natural, [PlainChunk d]) -> Line d
padLinePlainChunkInits maxWidth (lineWidth,wordCount,line) = Line $
	if maxWidth <= lineWidth
		-- The gathered line reached or overreached the maxWidth,
		-- hence no padding id needed.
	|| wordCount <= 1
		-- The case maxWidth <= lineWidth && wordCount == 1
		-- can happen if first word's length is < maxWidth
		-- but second word's len is >= maxWidth.
	then joinLinePlainChunk line
	else
		-- Share the missing spaces as evenly as possible
		-- between the words of the line.
		padLinePlainChunk line $ justifyPadding (maxWidth-lineWidth) (wordCount-1)

-- | Just concat 'PlainChunk's with no justification.
joinLinePlainChunk :: Monoid d => Spaceable d => [PlainChunk d] -> d
joinLinePlainChunk = mconcat . (runPlainChunk <$>)

-- | Interleave 'PlainChunk's with 'Width's from 'justifyPadding'.
padLinePlainChunk :: Spaceable d => [PlainChunk d] -> [Width] -> d
padLinePlainChunk = go
	where
	go (w:ws) lls@(l:ls) =
		case w of
		 PlainChunk_Spaces _s -> spaces (fromIntegral (l+1)) <> go ws ls
		 _ -> runPlainChunk w <> go ws lls
	go (w:ws) [] = runPlainChunk w <> go ws []
	go [] _ls = mempty

-- * Escaping
instance (Semigroup d, From [SGR] d) => Colorable16 (Plain d) where
	reverse     = plainSGR $ SetSwapForegroundBackground True
	black       = plainSGR $ SetColor Foreground Dull  Black
	red         = plainSGR $ SetColor Foreground Dull  Red
	green       = plainSGR $ SetColor Foreground Dull  Green
	yellow      = plainSGR $ SetColor Foreground Dull  Yellow
	blue        = plainSGR $ SetColor Foreground Dull  Blue
	magenta     = plainSGR $ SetColor Foreground Dull  Magenta
	cyan        = plainSGR $ SetColor Foreground Dull  Cyan
	white       = plainSGR $ SetColor Foreground Dull  White
	blacker     = plainSGR $ SetColor Foreground Vivid Black
	redder      = plainSGR $ SetColor Foreground Vivid Red
	greener     = plainSGR $ SetColor Foreground Vivid Green
	yellower    = plainSGR $ SetColor Foreground Vivid Yellow
	bluer       = plainSGR $ SetColor Foreground Vivid Blue
	magentaer   = plainSGR $ SetColor Foreground Vivid Magenta
	cyaner      = plainSGR $ SetColor Foreground Vivid Cyan
	whiter      = plainSGR $ SetColor Foreground Vivid White
	onBlack     = plainSGR $ SetColor Background Dull  Black
	onRed       = plainSGR $ SetColor Background Dull  Red
	onGreen     = plainSGR $ SetColor Background Dull  Green
	onYellow    = plainSGR $ SetColor Background Dull  Yellow
	onBlue      = plainSGR $ SetColor Background Dull  Blue
	onMagenta   = plainSGR $ SetColor Background Dull  Magenta
	onCyan      = plainSGR $ SetColor Background Dull  Cyan
	onWhite     = plainSGR $ SetColor Background Dull  White
	onBlacker   = plainSGR $ SetColor Background Vivid Black
	onRedder    = plainSGR $ SetColor Background Vivid Red
	onGreener   = plainSGR $ SetColor Background Vivid Green
	onYellower  = plainSGR $ SetColor Background Vivid Yellow
	onBluer     = plainSGR $ SetColor Background Vivid Blue
	onMagentaer = plainSGR $ SetColor Background Vivid Magenta
	onCyaner    = plainSGR $ SetColor Background Vivid Cyan
	onWhiter    = plainSGR $ SetColor Background Vivid White
instance (Semigroup d, From [SGR] d) => Decorable (Plain d) where
	bold      = plainSGR $ SetConsoleIntensity BoldIntensity
	underline = plainSGR $ SetUnderlining SingleUnderline
	italic    = plainSGR $ SetItalicized True

plainSGR ::
 Semigroup d =>
 From [SGR] d =>
 SGR -> Plain d -> Plain d
plainSGR newSGR p = before <> middle <> after
	where
	before = Plain $ \inh st k ->
		let d = from [newSGR] in
		if plainInh_justify inh
		then k (id, st
		 { plainState_buffer =
			PlainChunk_Ignored d :
			plainState_buffer st
		 })
		else k ((d <>), st)
	middle = Plain $ \inh ->
		unPlain p inh{plainInh_sgr=newSGR:plainInh_sgr inh}
	after = Plain $ \inh st k ->
		let d = from $ Reset : List.reverse (plainInh_sgr inh) in
		if plainInh_justify inh
		then k (id, st
		 { plainState_buffer =
			PlainChunk_Ignored d :
			plainState_buffer st
		 })
		else k ((d <>), st)