Safe Haskell | None |
---|---|
Language | Haskell2010 |
Symantic.Document.Plain
Synopsis
- newtype Plain d = Plain {
- unPlain :: PlainInh d -> PlainState d -> ((d -> d, PlainState d) -> PlainFit d) -> PlainFit d
- runPlain :: Spaceable d => Plain d -> d
- data PlainState d = PlainState {}
- defPlainState :: PlainState d
- 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
- type PlainFit d = (d -> d) -> (d -> d) -> d
- data PlainChunk d
- = PlainChunk_Ignored !d
- | PlainChunk_Word !(Word d)
- | PlainChunk_Spaces !Width
- runPlainChunk :: Spaceable d => PlainChunk d -> d
- flushlinePlain :: Spaceable d => Plain d
- collapsePlainChunkSpaces :: PlainChunk d -> PlainChunk d
- newlineJustifyingPlain :: Spaceable d => Plain d
- justifyLinePlain :: Spaceable d => PlainInh d -> PlainState d -> d
- countWordsPlain :: [PlainChunk d] -> Natural
- justifyPadding :: Natural -> Natural -> [Natural]
- padLinePlainChunkInits :: Spaceable d => Width -> (Natural, Natural, [PlainChunk d]) -> Line d
- joinLinePlainChunk :: Monoid d => Spaceable d => [PlainChunk d] -> d
- padLinePlainChunk :: Spaceable d => [PlainChunk d] -> [Width] -> d
- plainSGR :: Semigroup d => From [SGR] d => SGR -> Plain d -> Plain d
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.
Constructors
Plain | |
Fields
|
Instances
Type PlainState
data PlainState d Source #
Constructors
PlainState | |
Fields
|
Instances
Show d => Show (PlainState d) Source # | |
Defined in Symantic.Document.Plain Methods showsPrec :: Int -> PlainState d -> ShowS # show :: PlainState d -> String # showList :: [PlainState d] -> ShowS # |
defPlainState :: PlainState d Source #
Type PlainInh
Constructors
PlainInh | |
Fields
|
defPlainInh :: Spaceable d => PlainInh d Source #
Type PlainFit
type PlainFit d = (d -> d) -> (d -> d) -> d Source #
Double continuation to qualify the returned document
as fitting or overflowing the given plainInh_width
.
It's like (
in a normal style
(a non continuation-passing-style).Bool
,d)
Type PlainChunk
data PlainChunk d Source #
Constructors
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 |
|
Instances
Show d => Show (PlainChunk d) Source # | |
Defined in Symantic.Document.Plain Methods showsPrec :: Int -> PlainChunk d -> ShowS # show :: PlainChunk d -> String # showList :: [PlainChunk d] -> ShowS # | |
Lengthable d => Lengthable (PlainChunk d) Source # | |
Defined in Symantic.Document.Plain | |
From [SGR] d => From [SGR] (PlainChunk d) Source # | |
Defined in Symantic.Document.Plain Methods from :: [SGR] -> PlainChunk d Source # |
runPlainChunk :: Spaceable d => PlainChunk d -> d Source #
flushlinePlain :: Spaceable d => Plain d Source #
Commit plainState_buffer
upto there, so that it won't be justified.
collapsePlainChunkSpaces :: PlainChunk d -> PlainChunk d Source #
newlineJustifyingPlain :: Spaceable d => Plain d Source #
Like newline
, but justify plainState_buffer
before.
Justifying
justifyLinePlain :: Spaceable d => PlainInh d -> PlainState d -> d Source #
countWordsPlain :: [PlainChunk d] -> Natural Source #
(
returns the number of words in countWordsPlain
ps)(ps)
clearly separated by spaces.
justifyPadding :: Natural -> Natural -> [Natural] Source #
(
returns the padding lengths
to reach justifyPadding
a b)(a)
in (b)
pads,
using the formula: (a
where ==
m*
(q +
q+
1) +
(r
-'m)*
(q+
1) +
(b-
r-
m)*
q)(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
(replicate
m [q,q+
1])
<> (replicate
(r-
m) (q+
1)
<> (replicate
((b-
r)-
m) q
where
(q,r) = adivMod
b
m = min
(b-r) r
padLinePlainChunkInits :: Spaceable d => Width -> (Natural, Natural, [PlainChunk d]) -> Line d Source #
joinLinePlainChunk :: Monoid d => Spaceable d => [PlainChunk d] -> d Source #
Just concat PlainChunk
s with no justification.
padLinePlainChunk :: Spaceable d => [PlainChunk d] -> [Width] -> d Source #
Interleave PlainChunk
s with Width
s from justifyPadding
.