{-# 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
 { Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
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 :: Plain d -> String
show = d -> String
forall a. Show a => a -> String
show (d -> String) -> (Plain d -> d) -> Plain d -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Plain d -> d
forall d. Spaceable d => Plain d -> d
runPlain

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

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

defPlainState :: PlainState d
defPlainState :: PlainState d
defPlainState = PlainState :: forall d.
[PlainChunk d] -> Column -> Column -> Column -> PlainState d
PlainState
 { plainState_buffer :: [PlainChunk d]
plainState_buffer      = [PlainChunk d]
forall a. Monoid a => a
mempty
 , plainState_bufferStart :: Column
plainState_bufferStart = Column
0
 , plainState_bufferWidth :: Column
plainState_bufferWidth = Column
0
 , plainState_breakIndent :: Column
plainState_breakIndent = Column
0
 }

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

defPlainInh :: Spaceable d => PlainInh d
defPlainInh :: PlainInh d
defPlainInh = PlainInh :: forall d.
Maybe Column -> Bool -> Column -> Plain d -> [SGR] -> PlainInh d
PlainInh
 { plainInh_width :: Maybe Column
plainInh_width     = Maybe Column
forall a. Maybe a
Nothing
 , plainInh_justify :: Bool
plainInh_justify   = Bool
False
 , plainInh_indent :: Column
plainInh_indent    = Column
0
 , plainInh_indenting :: Plain d
plainInh_indenting = Plain d
forall a. Monoid a => a
mempty
 , plainInh_sgr :: [SGR]
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 :: Int -> PlainChunk d -> ShowS
showsPrec Int
p PlainChunk d
x =
		Bool -> ShowS -> ShowS
showParen (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
		case PlainChunk d
x of
		 PlainChunk_Ignored d
d ->
			String -> ShowS
showString String
"Z " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
			Int -> d -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 d
d
		 PlainChunk_Word (Word d
d) ->
			String -> ShowS
showString String
"W " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
			Int -> d -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 d
d
		 PlainChunk_Spaces Column
s ->
			String -> ShowS
showString String
"S " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
			Int -> Column -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Column
s
instance Lengthable d => Lengthable (PlainChunk d) where
	width :: PlainChunk d -> Column
width = \case
	 PlainChunk_Ignored{} -> Column
0
	 PlainChunk_Word Word d
d -> Word d -> Column
forall d. Lengthable d => d -> Column
width Word d
d
	 PlainChunk_Spaces Column
s -> Column
s
	nullWidth :: PlainChunk d -> Bool
nullWidth = \case
	 PlainChunk_Ignored{} -> Bool
True
	 PlainChunk_Word Word d
d -> Word d -> Bool
forall d. Lengthable d => d -> Bool
nullWidth Word d
d
	 PlainChunk_Spaces Column
s -> Column
s Column -> Column -> Bool
forall a. Eq a => a -> a -> Bool
== Column
0
instance From [SGR] d => From [SGR] (PlainChunk d) where
	from :: [SGR] -> PlainChunk d
from [SGR]
sgr = d -> PlainChunk d
forall d. d -> PlainChunk d
PlainChunk_Ignored ([SGR] -> d
forall a d. From a d => a -> d
from [SGR]
sgr)

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

instance Semigroup d => Semigroup (Plain d) where
	Plain PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
x <> :: Plain d -> Plain d -> Plain d
<> Plain PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
y = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh PlainState d
st (d -> d, PlainState d) -> PlainFit d
k ->
		PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
x PlainInh d
inh PlainState d
st (((d -> d, PlainState d) -> PlainFit d) -> PlainFit d)
-> ((d -> d, PlainState d) -> PlainFit d) -> PlainFit d
forall a b. (a -> b) -> a -> b
$ \(d -> d
px,PlainState d
sx) ->
			PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
y PlainInh d
inh PlainState d
sx (((d -> d, PlainState d) -> PlainFit d) -> PlainFit d)
-> ((d -> d, PlainState d) -> PlainFit d) -> PlainFit d
forall a b. (a -> b) -> a -> b
$ \(d -> d
py,PlainState d
sy) ->
				(d -> d, PlainState d) -> PlainFit d
k (d -> d
px(d -> d) -> (d -> d) -> d -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
.d -> d
py,PlainState d
sy)
instance Monoid d => Monoid (Plain d) where
	mempty :: Plain d
mempty = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
_inh PlainState d
st (d -> d, PlainState d) -> PlainFit d
k -> (d -> d, PlainState d) -> PlainFit d
k (d -> d
forall a. a -> a
id,PlainState d
st)
	mappend :: Plain d -> Plain d -> Plain d
mappend = Plain d -> Plain d -> Plain d
forall a. Semigroup a => a -> a -> a
(<>)
instance Spaceable d => Spaceable (Plain d) where
	-- | The default 'newline' does not justify 'plainState_buffer',
	-- for that use 'newlineJustifyingPlain'.
	newline :: Plain d
newline = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh PlainState d
st ->
		Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
forall d.
Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
unPlain
		 (  Plain d
forall d. Spaceable d => Plain d
newlinePlain
		 Plain d -> Plain d -> Plain d
forall a. Semigroup a => a -> a -> a
<> Plain d
forall d. Plain d
indentPlain
		 Plain d -> Plain d -> Plain d
forall a. Semigroup a => a -> a -> a
<> Column -> Plain d
forall d. Column -> Plain d
propagatePlain (PlainState d -> Column
forall d. PlainState d -> Column
plainState_breakIndent PlainState d
st)
		 Plain d -> Plain d -> Plain d
forall a. Semigroup a => a -> a -> a
<> Plain d
forall d. Spaceable d => Plain d
flushlinePlain
		 ) PlainInh d
inh PlainState d
st
		where
		indentPlain :: Plain d
indentPlain = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh ->
			Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
forall d.
Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
unPlain
			 (PlainInh d -> Plain d
forall d. PlainInh d -> Plain d
plainInh_indenting PlainInh d
inh)
			 PlainInh d
inh{plainInh_justify :: Bool
plainInh_justify=Bool
False}
		newlinePlain :: Plain d
newlinePlain = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh PlainState d
st (d -> d, PlainState d) -> PlainFit d
k ->
			(d -> d, PlainState d) -> PlainFit d
k (\d
next ->
				(if PlainInh d -> Bool
forall d. PlainInh d -> Bool
plainInh_justify PlainInh d
inh
					then [PlainChunk d] -> d
forall d. (Monoid d, Spaceable d) => [PlainChunk d] -> d
joinLinePlainChunk ([PlainChunk d] -> d) -> [PlainChunk d] -> d
forall a b. (a -> b) -> a -> b
$ [PlainChunk d] -> [PlainChunk d]
forall a. [a] -> [a]
List.reverse ([PlainChunk d] -> [PlainChunk d])
-> [PlainChunk d] -> [PlainChunk d]
forall a b. (a -> b) -> a -> b
$ PlainState d -> [PlainChunk d]
forall d. PlainState d -> [PlainChunk d]
plainState_buffer PlainState d
st
					else d
forall a. Monoid a => a
mempty
				)d -> d -> d
forall a. Semigroup a => a -> a -> a
<>d
forall d. Spaceable d => d
newlined -> d -> d
forall a. Semigroup a => a -> a -> a
<>d
next
			 , PlainState d
st
			 { plainState_bufferStart :: Column
plainState_bufferStart = Column
0
			 , plainState_bufferWidth :: Column
plainState_bufferWidth = Column
0
			 , plainState_buffer :: [PlainChunk d]
plainState_buffer      = [PlainChunk d]
forall a. Monoid a => a
mempty
			 })
		propagatePlain :: Column -> Plain d
propagatePlain Column
breakIndent = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh PlainState d
st1 (d -> d, PlainState d) -> PlainFit d
k d -> d
fits d -> d
overflow ->
			(d -> d, PlainState d) -> PlainFit d
k (d -> d
forall a. a -> a
id,PlainState d
st1)
			 d -> d
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 Column
breakIndent Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
< PlainInh d -> Column
forall d. PlainInh d -> Column
plainInh_indent PlainInh d
inh
				then d -> d
overflow
				else d -> d
fits
			 )
	space :: Plain d
space = Column -> Plain d
forall d. Spaceable d => Column -> d
spaces Column
1
	spaces :: Column -> Plain d
spaces Column
n = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh st :: PlainState d
st@PlainState{Column
[PlainChunk d]
plainState_breakIndent :: Column
plainState_bufferWidth :: Column
plainState_bufferStart :: Column
plainState_buffer :: [PlainChunk d]
plainState_breakIndent :: forall d. PlainState d -> Column
plainState_bufferWidth :: forall d. PlainState d -> Column
plainState_bufferStart :: forall d. PlainState d -> Column
plainState_buffer :: forall d. PlainState d -> [PlainChunk d]
..} (d -> d, PlainState d) -> PlainFit d
k d -> d
fits d -> d
overflow ->
		let newWidth :: Column
newWidth = Column
plainState_bufferStart Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
plainState_bufferWidth Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
n in
		if PlainInh d -> Bool
forall d. PlainInh d -> Bool
plainInh_justify PlainInh d
inh
		then
			let newState :: PlainState d
newState = PlainState d
st
				 { plainState_buffer :: [PlainChunk d]
plainState_buffer =
					case [PlainChunk d]
plainState_buffer of
					 PlainChunk_Spaces Column
s:[PlainChunk d]
buf -> Column -> PlainChunk d
forall d. Column -> PlainChunk d
PlainChunk_Spaces (Column
sColumn -> Column -> Column
forall a. Num a => a -> a -> a
+Column
n)PlainChunk d -> [PlainChunk d] -> [PlainChunk d]
forall a. a -> [a] -> [a]
:[PlainChunk d]
buf
					 [PlainChunk d]
buf -> Column -> PlainChunk d
forall d. Column -> PlainChunk d
PlainChunk_Spaces Column
nPlainChunk d -> [PlainChunk d] -> [PlainChunk d]
forall a. a -> [a] -> [a]
:[PlainChunk d]
buf
				 , plainState_bufferWidth :: Column
plainState_bufferWidth = Column
plainState_bufferWidth Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
n
				 } in
			case PlainInh d -> Maybe Column
forall d. PlainInh d -> Maybe Column
plainInh_width PlainInh d
inh of
			 Just Column
maxWidth | Column
maxWidth Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
< Column
newWidth ->
				d -> d
overflow (d -> d) -> d -> d
forall a b. (a -> b) -> a -> b
$ (d -> d, PlainState d) -> PlainFit d
k (d -> d
forall a. a -> a
id{-(d<>)-}, PlainState d
newState) d -> d
fits d -> d
overflow
			 Maybe Column
_ -> (d -> d, PlainState d) -> PlainFit d
k (d -> d
forall a. a -> a
id{-(d<>)-}, PlainState d
newState) d -> d
fits d -> d
overflow
		else
			let newState :: PlainState d
newState = PlainState d
st
				 { plainState_bufferWidth :: Column
plainState_bufferWidth = Column
plainState_bufferWidth Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
n
				 } in
			case PlainInh d -> Maybe Column
forall d. PlainInh d -> Maybe Column
plainInh_width PlainInh d
inh of
			 Just Column
maxWidth | Column
maxWidth Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
< Column
newWidth ->
				d -> d
overflow (d -> d) -> d -> d
forall a b. (a -> b) -> a -> b
$ (d -> d, PlainState d) -> PlainFit d
k ((Column -> d
forall d. Spaceable d => Column -> d
spaces Column
n d -> d -> d
forall a. Semigroup a => a -> a -> a
<>), PlainState d
newState) d -> d
fits d -> d
fits
			 Maybe Column
_ -> (d -> d, PlainState d) -> PlainFit d
k ((Column -> d
forall d. Spaceable d => Column -> d
spaces Column
n d -> d -> d
forall a. Semigroup a => a -> a -> a
<>), PlainState d
newState) d -> d
fits d -> d
overflow
instance (From (Word s) d, Semigroup d, Lengthable s) =>
         From (Word s) (Plain d) where
	from :: Word s -> Plain d
from Word s
s = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh st :: PlainState d
st@PlainState{Column
[PlainChunk d]
plainState_breakIndent :: Column
plainState_bufferWidth :: Column
plainState_bufferStart :: Column
plainState_buffer :: [PlainChunk d]
plainState_breakIndent :: forall d. PlainState d -> Column
plainState_bufferWidth :: forall d. PlainState d -> Column
plainState_bufferStart :: forall d. PlainState d -> Column
plainState_buffer :: forall d. PlainState d -> [PlainChunk d]
..} (d -> d, PlainState d) -> PlainFit d
k d -> d
fits d -> d
overflow ->
		let wordWidth :: Column
wordWidth = Word s -> Column
forall d. Lengthable d => d -> Column
width Word s
s in
		if Column
wordWidth Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
<= Column
0
		then (d -> d, PlainState d) -> PlainFit d
k (d -> d
forall a. a -> a
id,PlainState d
st) d -> d
fits d -> d
overflow
		else
			let newBufferWidth :: Column
newBufferWidth = Column
plainState_bufferWidth Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
wordWidth in
			let newWidth :: Column
newWidth = Column
plainState_bufferStart Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
newBufferWidth in
			if PlainInh d -> Bool
forall d. PlainInh d -> Bool
plainInh_justify PlainInh d
inh
			then
				let newState :: PlainState d
newState = PlainState d
st
					 { plainState_buffer :: [PlainChunk d]
plainState_buffer =
						Word d -> PlainChunk d
forall d. Word d -> PlainChunk d
PlainChunk_Word (d -> Word d
forall d. d -> Word d
Word (Word s -> d
forall a d. From a d => a -> d
from Word s
s)) PlainChunk d -> [PlainChunk d] -> [PlainChunk d]
forall a. a -> [a] -> [a]
:
						[PlainChunk d]
plainState_buffer
					 , plainState_bufferWidth :: Column
plainState_bufferWidth = Column
newBufferWidth
					 } in
				case PlainInh d -> Maybe Column
forall d. PlainInh d -> Maybe Column
plainInh_width PlainInh d
inh of
				 Just Column
maxWidth | Column
maxWidth Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
< Column
newWidth ->
					d -> d
overflow (d -> d) -> d -> d
forall a b. (a -> b) -> a -> b
$ (d -> d, PlainState d) -> PlainFit d
k (d -> d
forall a. a -> a
id, PlainState d
newState) d -> d
fits d -> d
overflow
				 Maybe Column
_ -> (d -> d, PlainState d) -> PlainFit d
k (d -> d
forall a. a -> a
id, PlainState d
newState) d -> d
fits d -> d
overflow
			else
				let newState :: PlainState d
newState = PlainState d
st
					 { plainState_bufferWidth :: Column
plainState_bufferWidth = Column
newBufferWidth
					 } in
				case PlainInh d -> Maybe Column
forall d. PlainInh d -> Maybe Column
plainInh_width PlainInh d
inh of
				 Just Column
maxWidth | Column
maxWidth Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
< Column
newWidth ->
					d -> d
overflow (d -> d) -> d -> d
forall a b. (a -> b) -> a -> b
$ (d -> d, PlainState d) -> PlainFit d
k ((Word s -> d
forall a d. From a d => a -> d
from Word s
s d -> d -> d
forall a. Semigroup a => a -> a -> a
<>), PlainState d
newState) d -> d
fits d -> d
fits
				 Maybe Column
_ -> (d -> d, PlainState d) -> PlainFit d
k ((Word s -> d
forall a d. From a d => a -> d
from Word s
s d -> d -> d
forall a. Semigroup a => a -> a -> a
<>), PlainState d
newState) d -> d
fits d -> d
overflow
instance (From (Word s) d, Lengthable s, Spaceable d, Splitable s) =>
         From (Line s) (Plain d) where
	from :: Line s -> Plain d
from =
		[Plain d] -> Plain d
forall a. Monoid a => [a] -> a
mconcat ([Plain d] -> Plain d)
-> (Line s -> [Plain d]) -> Line s -> Plain d
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		Plain d -> [Plain d] -> [Plain d]
forall a. a -> [a] -> [a]
List.intersperse Plain d
forall d. Wrappable d => d
breakspace ([Plain d] -> [Plain d])
-> (Line s -> [Plain d]) -> Line s -> [Plain d]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		(Word s -> Plain d
forall a d. From a d => a -> d
from (Word s -> Plain d) -> [Word s] -> [Plain d]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([Word s] -> [Plain d])
-> (Line s -> [Word s]) -> Line s -> [Plain d]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		s -> [Word s]
forall d. Splitable d => d -> [Word d]
words (s -> [Word s]) -> (Line s -> s) -> Line s -> [Word s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		Line s -> s
forall d. Line d -> d
unLine
instance Spaceable d => Indentable (Plain d) where
	align :: Plain d -> Plain d
align Plain d
p = (Plain d
forall d. Spaceable d => Plain d
flushlinePlain Plain d -> Plain d -> Plain d
forall a. Semigroup a => a -> a -> a
<>) (Plain d -> Plain d) -> Plain d -> Plain d
forall a b. (a -> b) -> a -> b
$ (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh PlainState d
st ->
		let col :: Column
col = PlainState d -> Column
forall d. PlainState d -> Column
plainState_bufferStart PlainState d
st Column -> Column -> Column
forall a. Num a => a -> a -> a
+ PlainState d -> Column
forall d. PlainState d -> Column
plainState_bufferWidth PlainState d
st in
		Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
forall d.
Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
unPlain Plain d
p PlainInh d
inh
		 { plainInh_indent :: Column
plainInh_indent    = Column
col
		 , plainInh_indenting :: Plain d
plainInh_indenting =
			if PlainInh d -> Column
forall d. PlainInh d -> Column
plainInh_indent PlainInh d
inh Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
<= Column
col
			then
				PlainInh d -> Plain d
forall d. PlainInh d -> Plain d
plainInh_indenting PlainInh d
inh Plain d -> Plain d -> Plain d
forall a. Semigroup a => a -> a -> a
<>
				Column -> Plain d
forall d. Spaceable d => Column -> d
spaces (Column
colColumn -> Column -> Column
`minusNatural`PlainInh d -> Column
forall d. PlainInh d -> Column
plainInh_indent PlainInh d
inh)
			else Column -> Plain d
forall d. Spaceable d => Column -> d
spaces Column
col
		 } PlainState d
st
	setIndent :: Plain d -> Column -> Plain d -> Plain d
setIndent Plain d
d Column
i Plain d
p = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh ->
		Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
forall d.
Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
unPlain Plain d
p PlainInh d
inh
		 { plainInh_indent :: Column
plainInh_indent    = Column
i
		 , plainInh_indenting :: Plain d
plainInh_indenting = Plain d
d
		 }
	incrIndent :: Plain d -> Column -> Plain d -> Plain d
incrIndent Plain d
d Column
i Plain d
p = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh ->
		Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
forall d.
Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
unPlain Plain d
p PlainInh d
inh
		 { plainInh_indent :: Column
plainInh_indent    = PlainInh d -> Column
forall d. PlainInh d -> Column
plainInh_indent PlainInh d
inh Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
i
		 , plainInh_indenting :: Plain d
plainInh_indenting = PlainInh d -> Plain d
forall d. PlainInh d -> Plain d
plainInh_indenting PlainInh d
inh Plain d -> Plain d -> Plain d
forall a. Semigroup a => a -> a -> a
<> Plain d
d
		 }
	
	fill :: Column -> Plain d -> Plain d
fill Column
m Plain d
p = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh0 PlainState d
st0 ->
		let maxCol :: Column
maxCol = PlainState d -> Column
forall d. PlainState d -> Column
plainState_bufferStart PlainState d
st0 Column -> Column -> Column
forall a. Num a => a -> a -> a
+ PlainState d -> Column
forall d. PlainState d -> Column
plainState_bufferWidth PlainState d
st0 Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
m in
		let p1 :: Plain d
p1 = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh1 PlainState d
st1 ->
			let col :: Column
col = PlainState d -> Column
forall d. PlainState d -> Column
plainState_bufferStart PlainState d
st1 Column -> Column -> Column
forall a. Num a => a -> a -> a
+ PlainState d -> Column
forall d. PlainState d -> Column
plainState_bufferWidth PlainState d
st1 in
			Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
forall d.
Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
unPlain
			 (if Column
col Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
<= Column
maxCol
				then Column -> Plain d
forall d. Spaceable d => Column -> d
spaces (Column
maxColColumn -> Column -> Column
`minusNatural`Column
col)
				else Plain d
forall a. Monoid a => a
mempty)
			 PlainInh d
inh1 PlainState d
st1
		in
		Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
forall d.
Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
unPlain (Plain d
p Plain d -> Plain d -> Plain d
forall a. Semigroup a => a -> a -> a
<> Plain d
p1) PlainInh d
inh0 PlainState d
st0
	fillOrBreak :: Column -> Plain d -> Plain d
fillOrBreak Column
m Plain d
p = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh0 PlainState d
st0 ->
		let maxCol :: Column
maxCol = PlainState d -> Column
forall d. PlainState d -> Column
plainState_bufferStart PlainState d
st0 Column -> Column -> Column
forall a. Num a => a -> a -> a
+ PlainState d -> Column
forall d. PlainState d -> Column
plainState_bufferWidth PlainState d
st0 Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
m in
		let p1 :: Plain d
p1 = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh1 PlainState d
st1 ->
			let col :: Column
col = PlainState d -> Column
forall d. PlainState d -> Column
plainState_bufferStart PlainState d
st1 Column -> Column -> Column
forall a. Num a => a -> a -> a
+ PlainState d -> Column
forall d. PlainState d -> Column
plainState_bufferWidth PlainState d
st1 in
			Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
forall d.
Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
unPlain
			 (case Column
colColumn -> Column -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare`Column
maxCol of
				 Ordering
LT -> Column -> Plain d
forall d. Spaceable d => Column -> d
spaces (Column
maxColColumn -> Column -> Column
`minusNatural`Column
col)
				 Ordering
EQ -> Plain d
forall a. Monoid a => a
mempty
				 Ordering
GT -> Plain d -> Column -> Plain d -> Plain d
forall d. Indentable d => d -> Column -> d -> d
incrIndent (Column -> Plain d
forall d. Spaceable d => Column -> d
spaces Column
m) Column
m Plain d
forall d. Spaceable d => d
newline
			 ) PlainInh d
inh1 PlainState d
st1
		in
		Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
forall d.
Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
unPlain (Plain d
p Plain d -> Plain d -> Plain d
forall a. Semigroup a => a -> a -> a
<> Plain d
p1) PlainInh d
inh0 PlainState d
st0
instance (Spaceable d, From (Word Char) d, From (Word String) d) => Listable (Plain d) where
	ul :: f (Plain d) -> Plain d
ul f (Plain d)
ds =
		f (Plain d) -> Plain d
forall d (f :: * -> *). (Spaceable d, Foldable f) => f d -> d
catV (f (Plain d) -> Plain d) -> f (Plain d) -> Plain d
forall a b. (a -> b) -> a -> b
$
			((Plain d -> Plain d) -> f (Plain d) -> f (Plain d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Plain d)
ds) ((Plain d -> Plain d) -> f (Plain d))
-> (Plain d -> Plain d) -> f (Plain d)
forall a b. (a -> b) -> a -> b
$ \Plain d
d ->
				Word Char -> Plain d
forall a d. From a d => a -> d
from (Char -> Word Char
forall d. d -> Word d
Word Char
'-')Plain d -> Plain d -> Plain d
forall a. Semigroup a => a -> a -> a
<>Plain d
forall d. Spaceable d => d
spacePlain d -> Plain d -> Plain d
forall a. Semigroup a => a -> a -> a
<>Plain d
forall d. Spaceable d => Plain d
flushlinePlainPlain d -> Plain d -> Plain d
forall a. Semigroup a => a -> a -> a
<>Plain d -> Plain d
forall d. Indentable d => d -> d
align Plain d
d{-<>flushlinePlain-}
	ol :: f (Plain d) -> Plain d
ol f (Plain d)
ds =
		[Plain d] -> Plain d
forall d (f :: * -> *). (Spaceable d, Foldable f) => f d -> d
catV ([Plain d] -> Plain d) -> [Plain d] -> Plain d
forall a b. (a -> b) -> a -> b
$ (Int, [Plain d]) -> [Plain d]
forall a b. (a, b) -> b
snd ((Int, [Plain d]) -> [Plain d]) -> (Int, [Plain d]) -> [Plain d]
forall a b. (a -> b) -> a -> b
$
			(Plain d -> (Int, [Plain d]) -> (Int, [Plain d]))
-> (Int, [Plain d]) -> f (Plain d) -> (Int, [Plain d])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Fold.foldr
			 (\Plain d
d (Int
i, [Plain d]
acc) ->
				(Int -> Int
forall a. Enum a => a -> a
pred Int
i, (Int -> Plain d
forall a d. From a d => a -> d
from Int
iPlain d -> Plain d -> Plain d
forall a. Semigroup a => a -> a -> a
<>Word Char -> Plain d
forall a d. From a d => a -> d
from (Char -> Word Char
forall d. d -> Word d
Word Char
'.')Plain d -> Plain d -> Plain d
forall a. Semigroup a => a -> a -> a
<>Plain d
forall d. Spaceable d => d
spacePlain d -> Plain d -> Plain d
forall a. Semigroup a => a -> a -> a
<>Plain d
forall d. Spaceable d => Plain d
flushlinePlainPlain d -> Plain d -> Plain d
forall a. Semigroup a => a -> a -> a
<>Plain d -> Plain d
forall d. Indentable d => d -> d
align Plain d
d{-<>flushlinePlain-}) Plain d -> [Plain d] -> [Plain d]
forall a. a -> [a] -> [a]
: [Plain d]
acc)
			 ) (f (Plain d) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Fold.length f (Plain d)
ds, []) f (Plain d)
ds
instance Spaceable d => Justifiable (Plain d) where
	justify :: Plain d -> Plain d
justify Plain d
p = (\Plain d
x -> Plain d
forall d. Spaceable d => Plain d
flushlinePlain Plain d -> Plain d -> Plain d
forall a. Semigroup a => a -> a -> a
<> Plain d
x Plain d -> Plain d -> Plain d
forall a. Semigroup a => a -> a -> a
<> Plain d
forall d. Spaceable d => Plain d
flushlinePlain) (Plain d -> Plain d) -> Plain d -> Plain d
forall a b. (a -> b) -> a -> b
$ (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh ->
		Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
forall d.
Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
unPlain Plain d
p PlainInh d
inh{plainInh_justify :: Bool
plainInh_justify=Bool
True}

-- | Commit 'plainState_buffer' upto there, so that it won't be justified.
flushlinePlain :: Spaceable d => Plain d
flushlinePlain :: Plain d
flushlinePlain = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
_inh PlainState d
st (d -> d, PlainState d) -> PlainFit d
k ->
	(d -> d, PlainState d) -> PlainFit d
k( ([PlainChunk d] -> d
forall d. (Monoid d, Spaceable d) => [PlainChunk d] -> d
joinLinePlainChunk (PlainChunk d -> PlainChunk d
forall d. PlainChunk d -> PlainChunk d
collapsePlainChunkSpaces (PlainChunk d -> PlainChunk d) -> [PlainChunk d] -> [PlainChunk d]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PlainChunk d] -> [PlainChunk d]
forall a. [a] -> [a]
List.reverse (PlainState d -> [PlainChunk d]
forall d. PlainState d -> [PlainChunk d]
plainState_buffer PlainState d
st)) d -> d -> d
forall a. Semigroup a => a -> a -> a
<>)
	 , PlainState d
st
		 { plainState_bufferStart :: Column
plainState_bufferStart = PlainState d -> Column
forall d. PlainState d -> Column
plainState_bufferStart PlainState d
st Column -> Column -> Column
forall a. Num a => a -> a -> a
+ PlainState d -> Column
forall d. PlainState d -> Column
plainState_bufferWidth PlainState d
st
		 , plainState_bufferWidth :: Column
plainState_bufferWidth = Column
0
		 , plainState_buffer :: [PlainChunk d]
plainState_buffer      = [PlainChunk d]
forall a. Monoid a => a
mempty
		 }
	 )

collapsePlainChunkSpaces :: PlainChunk d -> PlainChunk d
collapsePlainChunkSpaces :: PlainChunk d -> PlainChunk d
collapsePlainChunkSpaces = \case
 PlainChunk_Spaces Column
s -> Column -> PlainChunk d
forall d. Column -> PlainChunk d
PlainChunk_Spaces (if Column
s Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
> Column
0 then Column
1 else Column
0)
 PlainChunk d
x -> PlainChunk d
x

instance Spaceable d => Wrappable (Plain d) where
	setWidth :: Maybe Column -> Plain d -> Plain d
setWidth Maybe Column
w Plain d
p = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh ->
		Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
forall d.
Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
unPlain Plain d
p PlainInh d
inh{plainInh_width :: Maybe Column
plainInh_width=Maybe Column
w}
	breakpoint :: Plain d
breakpoint = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh PlainState d
st (d -> d, PlainState d) -> PlainFit d
k d -> d
fits d -> d
overflow ->
		(d -> d, PlainState d) -> PlainFit d
k(d -> d
forall a. a -> a
id, PlainState d
st {plainState_breakIndent :: Column
plainState_breakIndent = PlainInh d -> Column
forall d. PlainInh d -> Column
plainInh_indent PlainInh d
inh})
		 d -> d
fits
		 {-overflow-}(\d
_r -> Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
forall d.
Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
unPlain Plain d
forall d. Spaceable d => Plain d
newlineJustifyingPlain PlainInh d
inh PlainState d
st (d -> d, PlainState d) -> PlainFit d
k d -> d
fits d -> d
overflow)
	breakspace :: Plain d
breakspace = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh PlainState d
st (d -> d, PlainState d) -> PlainFit d
k d -> d
fits d -> d
overflow ->
		(d -> d, PlainState d) -> PlainFit d
k( if PlainInh d -> Bool
forall d. PlainInh d -> Bool
plainInh_justify PlainInh d
inh then d -> d
forall a. a -> a
id else (d
forall d. Spaceable d => d
space d -> d -> d
forall a. Semigroup a => a -> a -> a
<>)
		 , PlainState d
st
			 { plainState_buffer :: [PlainChunk d]
plainState_buffer =
				if PlainInh d -> Bool
forall d. PlainInh d -> Bool
plainInh_justify PlainInh d
inh
				then case PlainState d -> [PlainChunk d]
forall d. PlainState d -> [PlainChunk d]
plainState_buffer PlainState d
st of
					 PlainChunk_Spaces Column
s:[PlainChunk d]
bs -> Column -> PlainChunk d
forall d. Column -> PlainChunk d
PlainChunk_Spaces (Column
sColumn -> Column -> Column
forall a. Num a => a -> a -> a
+Column
1)PlainChunk d -> [PlainChunk d] -> [PlainChunk d]
forall a. a -> [a] -> [a]
:[PlainChunk d]
bs
					 [PlainChunk d]
bs -> Column -> PlainChunk d
forall d. Column -> PlainChunk d
PlainChunk_Spaces Column
1PlainChunk d -> [PlainChunk d] -> [PlainChunk d]
forall a. a -> [a] -> [a]
:[PlainChunk d]
bs
				else PlainState d -> [PlainChunk d]
forall d. PlainState d -> [PlainChunk d]
plainState_buffer PlainState d
st
			 , plainState_bufferWidth :: Column
plainState_bufferWidth = PlainState d -> Column
forall d. PlainState d -> Column
plainState_bufferWidth PlainState d
st Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
1
			 , plainState_breakIndent :: Column
plainState_breakIndent = PlainInh d -> Column
forall d. PlainInh d -> Column
plainInh_indent PlainInh d
inh
			 }
		 )
		 d -> d
fits
		 {-overflow-}(\d
_r -> Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
forall d.
Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
unPlain Plain d
forall d. Spaceable d => Plain d
newlineJustifyingPlain PlainInh d
inh PlainState d
st (d -> d, PlainState d) -> PlainFit d
k d -> d
fits d -> d
overflow)
	breakalt :: Plain d -> Plain d -> Plain d
breakalt Plain d
x Plain d
y = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh PlainState d
st (d -> d, PlainState d) -> PlainFit d
k d -> d
fits d -> d
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.
		Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
forall d.
Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
unPlain Plain d
x PlainInh d
inh PlainState d
st (d -> d, PlainState d) -> PlainFit d
forall t t b t p. Monoid t => (t -> t, b) -> (t -> t) -> p -> t
dummyK
		 {-fits-}    (\d
_r -> Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
forall d.
Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
unPlain Plain d
x PlainInh d
inh PlainState d
st (d -> d, PlainState d) -> PlainFit d
k d -> d
fits d -> d
overflow)
		 {-overflow-}(\d
_r -> Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
forall d.
Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
unPlain Plain d
y PlainInh d
inh PlainState d
st (d -> d, PlainState d) -> PlainFit d
k d -> d
fits d -> d
overflow)
		where
		dummyK :: (t -> t, b) -> (t -> t) -> p -> t
dummyK (t -> t
px,b
_sx) t -> t
fits p
_overflow =
			-- NOTE: if px fits, then appending mempty fits
			t -> t
fits (t -> t
px t
forall a. Monoid a => a
mempty)
	endline :: Plain d
endline = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh PlainState d
st (d -> d, PlainState d) -> PlainFit d
k d -> d
fits d -> d
_overflow ->
		let col :: Column
col = PlainState d -> Column
forall d. PlainState d -> Column
plainState_bufferStart PlainState d
st Column -> Column -> Column
forall a. Num a => a -> a -> a
+ PlainState d -> Column
forall d. PlainState d -> Column
plainState_bufferWidth PlainState d
st in
		case PlainInh d -> Maybe Column
forall d. PlainInh d -> Maybe Column
plainInh_width PlainInh d
inh Maybe Column -> (Column -> Maybe Column) -> Maybe Column
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Column -> Column -> Maybe Column
`minusNaturalMaybe` Column
col) of
		 Maybe Column
Nothing -> (d -> d, PlainState d) -> PlainFit d
k (d -> d
forall a. a -> a
id, PlainState d
st) d -> d
fits d -> d
fits
		 Just Column
w ->
			let newState :: PlainState d
newState = PlainState d
st
				 { plainState_bufferWidth :: Column
plainState_bufferWidth = PlainState d -> Column
forall d. PlainState d -> Column
plainState_bufferWidth PlainState d
st Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
w
				 } in
			(d -> d, PlainState d) -> PlainFit d
k (d -> d
forall a. a -> a
id,PlainState d
newState) d -> d
fits d -> d
fits

-- | Like 'newline', but justify 'plainState_buffer' before.
newlineJustifyingPlain :: Spaceable d => Plain d
newlineJustifyingPlain :: Plain d
newlineJustifyingPlain = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh PlainState d
st ->
	Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
forall d.
Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
unPlain
	 (  Plain d
forall d. Spaceable d => Plain d
newlinePlain
	 Plain d -> Plain d -> Plain d
forall a. Semigroup a => a -> a -> a
<> Plain d
forall d. Plain d
indentPlain
	 Plain d -> Plain d -> Plain d
forall a. Semigroup a => a -> a -> a
<> Column -> Plain d
forall d. Column -> Plain d
propagatePlain (PlainState d -> Column
forall d. PlainState d -> Column
plainState_breakIndent PlainState d
st)
	 Plain d -> Plain d -> Plain d
forall a. Semigroup a => a -> a -> a
<> Plain d
forall d. Spaceable d => Plain d
flushlinePlain
	 ) PlainInh d
inh PlainState d
st
	where
	indentPlain :: Plain d
indentPlain = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh ->
		Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
forall d.
Plain d
-> PlainInh d
-> PlainState d
-> ((d -> d, PlainState d) -> PlainFit d)
-> PlainFit d
unPlain
		 (PlainInh d -> Plain d
forall d. PlainInh d -> Plain d
plainInh_indenting PlainInh d
inh)
		 PlainInh d
inh{plainInh_justify :: Bool
plainInh_justify=Bool
False}
	newlinePlain :: Plain d
newlinePlain = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh PlainState d
st (d -> d, PlainState d) -> PlainFit d
k ->
		(d -> d, PlainState d) -> PlainFit d
k (\d
next ->
			(if PlainInh d -> Bool
forall d. PlainInh d -> Bool
plainInh_justify PlainInh d
inh
				then PlainInh d -> PlainState d -> d
forall d. Spaceable d => PlainInh d -> PlainState d -> d
justifyLinePlain PlainInh d
inh PlainState d
st
				else d
forall a. Monoid a => a
mempty
			)d -> d -> d
forall a. Semigroup a => a -> a -> a
<>d
forall d. Spaceable d => d
newlined -> d -> d
forall a. Semigroup a => a -> a -> a
<>d
next
		 , PlainState d
st
		 { plainState_bufferStart :: Column
plainState_bufferStart = Column
0
		 , plainState_bufferWidth :: Column
plainState_bufferWidth = Column
0
		 , plainState_buffer :: [PlainChunk d]
plainState_buffer      = [PlainChunk d]
forall a. Monoid a => a
mempty
		 })
	propagatePlain :: Column -> Plain d
propagatePlain Column
breakIndent = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh PlainState d
st1 (d -> d, PlainState d) -> PlainFit d
k d -> d
fits d -> d
overflow ->
		(d -> d, PlainState d) -> PlainFit d
k (d -> d
forall a. a -> a
id,PlainState d
st1)
		 d -> d
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 Column
breakIndent Column -> Column -> Bool
forall a. Ord a => a -> a -> Bool
< PlainInh d -> Column
forall d. PlainInh d -> Column
plainInh_indent PlainInh d
inh
			then d -> d
overflow
			else d -> d
fits
		 )

-- String
instance (From (Word String) d, Spaceable d) =>
         From String (Plain d) where
	from :: String -> Plain d
from =
		[Plain d] -> Plain d
forall a. Monoid a => [a] -> a
mconcat ([Plain d] -> Plain d)
-> (String -> [Plain d]) -> String -> Plain d
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		Plain d -> [Plain d] -> [Plain d]
forall a. a -> [a] -> [a]
List.intersperse Plain d
forall d. Spaceable d => d
newline ([Plain d] -> [Plain d])
-> (String -> [Plain d]) -> String -> [Plain d]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		(Line String -> Plain d
forall a d. From a d => a -> d
from (Line String -> Plain d) -> [Line String] -> [Plain d]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([Line String] -> [Plain d])
-> (String -> [Line String]) -> String -> [Plain d]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		String -> [Line String]
forall d. Splitable d => d -> [Line d]
lines
instance (From (Word String) d, Spaceable d) =>
         IsString (Plain d) where
	fromString :: String -> Plain d
fromString = String -> Plain d
forall a d. From a d => a -> d
from
-- Text
instance (From (Word Text) d, Spaceable d) =>
         From Text (Plain d) where
	from :: Text -> Plain d
from =
		[Plain d] -> Plain d
forall a. Monoid a => [a] -> a
mconcat ([Plain d] -> Plain d) -> (Text -> [Plain d]) -> Text -> Plain d
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		Plain d -> [Plain d] -> [Plain d]
forall a. a -> [a] -> [a]
List.intersperse Plain d
forall d. Spaceable d => d
newline ([Plain d] -> [Plain d])
-> (Text -> [Plain d]) -> Text -> [Plain d]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		(Line Text -> Plain d
forall a d. From a d => a -> d
from (Line Text -> Plain d) -> [Line Text] -> [Plain d]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([Line Text] -> [Plain d])
-> (Text -> [Line Text]) -> Text -> [Plain d]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		Text -> [Line Text]
forall d. Splitable d => d -> [Line d]
lines
instance (From (Word TL.Text) d, Spaceable d) =>
         From TL.Text (Plain d) where
	from :: Text -> Plain d
from =
		[Plain d] -> Plain d
forall a. Monoid a => [a] -> a
mconcat ([Plain d] -> Plain d) -> (Text -> [Plain d]) -> Text -> Plain d
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		Plain d -> [Plain d] -> [Plain d]
forall a. a -> [a] -> [a]
List.intersperse Plain d
forall d. Spaceable d => d
newline ([Plain d] -> [Plain d])
-> (Text -> [Plain d]) -> Text -> [Plain d]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		(Line Text -> Plain d
forall a d. From a d => a -> d
from (Line Text -> Plain d) -> [Line Text] -> [Plain d]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([Line Text] -> [Plain d])
-> (Text -> [Line Text]) -> Text -> [Plain d]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
		Text -> [Line Text]
forall d. Splitable d => d -> [Line d]
lines
-- Char
instance (From (Word Char) d, Spaceable d) =>
         From Char (Plain d) where
	from :: Char -> Plain d
from Char
' '  = Plain d
forall d. Wrappable d => d
breakspace
	from Char
'\n' = Plain d
forall d. Spaceable d => d
newline
	from Char
c    = Word Char -> Plain d
forall a d. From a d => a -> d
from (Char -> Word Char
forall d. d -> Word d
Word Char
c)

instance (From [SGR] d, Semigroup d) => From [SGR] (Plain d) where
	from :: [SGR] -> Plain d
from [SGR]
sgr = (PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
forall d.
(PlainInh d
 -> PlainState d
 -> ((d -> d, PlainState d) -> PlainFit d)
 -> PlainFit d)
-> Plain d
Plain ((PlainInh d
  -> PlainState d
  -> ((d -> d, PlainState d) -> PlainFit d)
  -> PlainFit d)
 -> Plain d)
-> (PlainInh d
    -> PlainState d
    -> ((d -> d, PlainState d) -> PlainFit d)
    -> PlainFit d)
-> Plain d
forall a b. (a -> b) -> a -> b
$ \PlainInh d
inh PlainState d
st (d -> d, PlainState d) -> PlainFit d
k ->
		if PlainInh d -> Bool
forall d. PlainInh d -> Bool
plainInh_justify PlainInh d
inh
		then (d -> d, PlainState d) -> PlainFit d
k (d -> d
forall a. a -> a
id, PlainState d
st {plainState_buffer :: [PlainChunk d]
plainState_buffer = d -> PlainChunk d
forall d. d -> PlainChunk d
PlainChunk_Ignored ([SGR] -> d
forall a d. From a d => a -> d
from [SGR]
sgr) PlainChunk d -> [PlainChunk d] -> [PlainChunk d]
forall a. a -> [a] -> [a]
: PlainState d -> [PlainChunk d]
forall d. PlainState d -> [PlainChunk d]
plainState_buffer PlainState d
st})
		else (d -> d, PlainState d) -> PlainFit d
k (([SGR] -> d
forall a d. From a d => a -> d
from [SGR]
sgr d -> d -> d
forall a. Semigroup a => a -> a -> a
<>), PlainState d
st)

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

-- | @('countWordsPlain' ps)@ returns the number of words in @(ps)@
-- clearly separated by spaces.
countWordsPlain :: [PlainChunk d] -> Natural
countWordsPlain :: [PlainChunk d] -> Column
countWordsPlain = Bool -> Column -> [PlainChunk d] -> Column
forall a d. Num a => Bool -> a -> [PlainChunk d] -> a
go Bool
False Column
0
 where
	go :: Bool -> a -> [PlainChunk d] -> a
go Bool
inWord a
acc = \case
	 [] -> a
acc
	 PlainChunk_Word{}:[PlainChunk d]
xs ->
		if Bool
inWord
		then Bool -> a -> [PlainChunk d] -> a
go Bool
inWord a
acc [PlainChunk d]
xs
		else Bool -> a -> [PlainChunk d] -> a
go Bool
True (a
acca -> a -> a
forall a. Num a => a -> a -> a
+a
1) [PlainChunk d]
xs
	 PlainChunk_Spaces Column
s:[PlainChunk d]
xs
	  | Column
s Column -> Column -> Bool
forall a. Eq a => a -> a -> Bool
== Column
0    -> Bool -> a -> [PlainChunk d] -> a
go Bool
inWord a
acc [PlainChunk d]
xs
	  | Bool
otherwise -> Bool -> a -> [PlainChunk d] -> a
go Bool
False a
acc [PlainChunk d]
xs
	 PlainChunk_Ignored{}:[PlainChunk d]
xs -> Bool -> a -> [PlainChunk d] -> a
go Bool
inWord a
acc [PlainChunk d]
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 :: Column -> Column -> [Column]
justifyPadding Column
a Column
b = Column -> Column -> [Column]
go Column
r (Column
bColumn -> Column -> Column
forall a. Num a => a -> a -> a
-Column
r) -- NOTE: r >= 0 && b-r >= 0 due to 'divMod'
	where
	(Column
q,Column
r) = Column
aColumn -> Column -> (Column, Column)
`quotRemNatural`Column
b
	
	go :: Column -> Column -> [Column]
go Column
0  Column
bmr = Int -> Column -> [Column]
forall a. Int -> a -> [a]
List.replicate (Column -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Column
bmr) Column
q    -- when min (b-r) r == b-r
	go Column
rr Column
0   = Int -> Column -> [Column]
forall a. Int -> a -> [a]
List.replicate (Column -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Column
rr) (Column
qColumn -> Column -> Column
forall a. Num a => a -> a -> a
+Column
1) -- when min (b-r) r == r
	go Column
rr Column
bmr = Column
qColumn -> [Column] -> [Column]
forall a. a -> [a] -> [a]
:(Column
qColumn -> Column -> Column
forall a. Num a => a -> a -> a
+Column
1) Column -> [Column] -> [Column]
forall a. a -> [a] -> [a]
: Column -> Column -> [Column]
go (Column
rrColumn -> Column -> Column
`minusNatural`Column
1) (Column
bmrColumn -> Column -> Column
`minusNatural`Column
1)

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

-- | Just concat 'PlainChunk's with no justification.
joinLinePlainChunk :: Monoid d => Spaceable d => [PlainChunk d] -> d
joinLinePlainChunk :: [PlainChunk d] -> d
joinLinePlainChunk = [d] -> d
forall a. Monoid a => [a] -> a
mconcat ([d] -> d) -> ([PlainChunk d] -> [d]) -> [PlainChunk d] -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlainChunk d -> d
forall d. Spaceable d => PlainChunk d -> d
runPlainChunk (PlainChunk d -> d) -> [PlainChunk d] -> [d]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)

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

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

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