diff options
author | defanor <defanor@uberspace.net> | 2017-10-28 03:16:26 +0300 |
---|---|---|
committer | defanor <defanor@uberspace.net> | 2017-10-28 03:16:26 +0300 |
commit | d2da10d36b857e399e10388ddc6f66850211ec77 (patch) | |
tree | 40e98bcc17276200f98c5af7c0de2b64263b9bc9 | |
parent | b52d2a395814158319a781d38a49bb0f132c221d (diff) |
Improve plaintext rendering
Reuse lineToInlines previously used for Gopher, and adjust fitLines.
-rw-r--r-- | Pancake.hs | 17 | ||||
-rw-r--r-- | Text/Pandoc/Readers/Gopher.hs | 8 | ||||
-rw-r--r-- | Text/Pandoc/Readers/Plain.hs | 17 |
3 files changed, 25 insertions, 17 deletions
@@ -237,12 +237,17 @@ fitLines maxLen inlineBits = map mconcat $ map reverse $ fitWords [] 0 inlineBit -- a new line fitWords _ 0 (w:ws) = fitWords [w] (length $ asString w) ws -- add a word to a line - fitWords curLine curLen (w:ws) = let wLen = length (asString w) in - if curLen + wLen <= maxLen - then fitWords (w:curLine) (curLen + wLen) ws - else curLine : fitWords [] 0 (case w of - " " -> ws - _ -> (w:ws)) + fitWords curLine curLen (w:ws) = let wLen = length (asString w) + spaceAhead = case ws of + (" " : _) -> True + _ -> False + in if curLen + wLen <= maxLen + then fitWords (w:curLine) (curLen + wLen) $ + -- if there's an unnecessary space ahead, skip it + if (curLen + wLen + 1 > maxLen && spaceAhead) + then tail ws + else ws + else curLine : fitWords [] 0 (w:ws) -- end, no words pending fitWords _ 0 [] = [] -- end, with words pending diff --git a/Text/Pandoc/Readers/Gopher.hs b/Text/Pandoc/Readers/Gopher.hs index 33dec3e..694720d 100644 --- a/Text/Pandoc/Readers/Gopher.hs +++ b/Text/Pandoc/Readers/Gopher.hs @@ -16,14 +16,8 @@ import Text.Pandoc.Definition import Text.Pandoc.Error import Text.Parsec import Text.Parsec.String +import Text.Pandoc.Readers.Plain --- | Translates a text line into a list of 'Inline' elements suitable --- for further processing. -lineToInlines :: String -> [Inline] -lineToInlines [] = [] -lineToInlines (' ':rest) = Space : lineToInlines rest -lineToInlines s = let (cur, next) = break (== ' ') s - in Str cur : lineToInlines next -- | UNASCII ::= ASCII - [Tab CR-LF NUL]. unascii :: Parser Char diff --git a/Text/Pandoc/Readers/Plain.hs b/Text/Pandoc/Readers/Plain.hs index 600e5f8..cb8fb9b 100644 --- a/Text/Pandoc/Readers/Plain.hs +++ b/Text/Pandoc/Readers/Plain.hs @@ -6,15 +6,24 @@ Portability : portable -} {-# LANGUAGE OverloadedStrings #-} -module Text.Pandoc.Readers.Plain ( readPlain ) where +module Text.Pandoc.Readers.Plain ( readPlain + , lineToInlines + ) where import Text.Pandoc.Definition import Text.Pandoc.Error -import Data.List + + +-- | Translates a text line into a list of 'Inline' elements suitable +-- for further processing. +lineToInlines :: String -> [Inline] +lineToInlines [] = [] +lineToInlines (' ':rest) = Space : lineToInlines rest +lineToInlines s = let (cur, next) = break (== ' ') s + in Str cur : lineToInlines next -- | Reads plain text, always succeeding and producing a single -- 'Plain' block. readPlain :: String -> Either PandocError Pandoc readPlain = Right . Pandoc mempty . pure . Plain . - concatMap (\l -> (intersperse Space $ map Str $ words l) ++ [LineBreak]) . lines - -- or Right . Pandoc mempty . pure . RawBlock "plain" + concatMap (\l -> (lineToInlines l) ++ [LineBreak]) . lines |