doclayout 0.2.0.1 → 0.3
raw patch · 3 files changed
+75/−45 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Text.DocLayout: foldlChar :: HasChars a => (b -> Char -> b) -> b -> a -> b
Files
- changelog.md +13/−0
- doclayout.cabal +1/−1
- src/Text/DocLayout.hs +61/−44
changelog.md view
@@ -1,5 +1,18 @@ # doclayout +## 0.3++ * Add foldlChar to signature of HasChars [API change].+ * Use foldlChar in realLength. This avoids a stack overflow+ we were getting with long strings in the previous version+ (with foldrChar). See jgm/pandoc#6031.+ * Replace isBlank with isBreakable and improved startsWithBlank.+ Previously isBlank was used in the layout algorithm where+ what we really wanted was isBreakable.+ * Avoid unnecessary calculation in updateColumns.+ * Replace a right fold with a strict left fold.+ * Add strictness annotations in realLength and updateColumn.+ ## 0.2.0.1 * Made `realLength` smarter about combining characters.
doclayout.cabal view
@@ -1,5 +1,5 @@ name: doclayout-version: 0.2.0.1+version: 0.3 synopsis: A prettyprinting library for laying out text documents. description: doclayout is a prettyprinting library for laying out text documents, with several features not present
src/Text/DocLayout.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-}@@ -75,6 +76,8 @@ where import Prelude+import Data.List (foldl')+import Data.Maybe (fromMaybe) import Safe (lastMay, initSafe) import Control.Monad import Control.Monad.State.Strict@@ -92,10 +95,12 @@ #endif -- | Class abstracting over various string types that--- can fold over characters. Minimal definition is 'foldrChar',--- but defining the other methods can give better performance.+-- can fold over characters. Minimal definition is 'foldrChar'+-- and 'foldlChar', but defining the other methods can give better+-- performance. class (IsString a, Semigroup a, Monoid a, Show a) => HasChars a where foldrChar :: (Char -> b -> b) -> b -> a -> b+ foldlChar :: (b -> Char -> b) -> b -> a -> b replicateChar :: Int -> Char -> a replicateChar n c = fromString (replicate n c) isNull :: a -> Bool@@ -109,18 +114,21 @@ instance HasChars Text where foldrChar = T.foldr+ foldlChar = T.foldl' splitLines = T.splitOn "\n" replicateChar n c = T.replicate n (T.singleton c) isNull = T.null instance HasChars String where foldrChar = foldr+ foldlChar = foldl' splitLines = lines . (++"\n") replicateChar = replicate isNull = null instance HasChars TL.Text where foldrChar = TL.foldr+ foldlChar = TL.foldl' splitLines = TL.splitOn "\n" replicateChar n c = TL.replicate (fromIntegral n) (TL.singleton c) isNull = TL.null@@ -392,9 +400,9 @@ let isBreakingSpace BreakingSpace = True isBreakingSpace _ = False let xs' = dropWhile isBreakingSpace xs- let next = takeWhile (not . isBlank) xs'+ let next = takeWhile (not . isBreakable) xs' st <- get- let off = foldr ((+) . offsetOf) 0 next+ let off = foldl' (\tot t -> tot + offsetOf t) 0 next case lineLength st of Just l | column st + 1 + off > l -> newline _ -> when (column st > 0) $ outp 1 " "@@ -428,27 +436,36 @@ renderList (x:_) = error $ "renderList encountered " ++ show x -isBlank :: HasChars a => Doc a -> Bool-isBlank (Text _ t) = isAllSpace t-isBlank (Block _ ls) = all isAllSpace ls-isBlank (VFill _ t) = isAllSpace t-isBlank (Prefixed _ x) = isBlank x-isBlank (BeforeNonBlank x) = isBlank x-isBlank (Flush x) = isBlank x-isBlank BreakingSpace = True-isBlank (AfterBreak t) = isAllSpace t-isBlank CarriageReturn = True-isBlank NewLine = True-isBlank (BlankLines _) = True-isBlank (Concat x y) = isBlank x && isBlank y-isBlank Empty = True+isBreakable :: HasChars a => Doc a -> Bool+isBreakable BreakingSpace = True+isBreakable CarriageReturn = True+isBreakable NewLine = True+isBreakable (BlankLines _) = True+isBreakable (Concat Empty y) = isBreakable y+isBreakable (Concat x _) = isBreakable x+isBreakable _ = False -startsBlank :: HasChars a => Doc a -> Bool-startsBlank (Text _ t) = foldrChar (const . isSpace) False t-startsBlank x = isBlank x+startsBlank' :: HasChars a => a -> Bool+startsBlank' t = fromMaybe False $ foldlChar go Nothing t+ where+ go Nothing c = Just (isSpace c)+ go (Just b) _ = Just b -isAllSpace :: HasChars a => a -> Bool-isAllSpace = foldrChar ((&&) . isSpace) False+startsBlank :: HasChars a => Doc a -> Bool+startsBlank (Text _ t) = startsBlank' t+startsBlank (Block n ls) = n > 0 && all startsBlank' ls+startsBlank (VFill n t) = n > 0 && startsBlank' t+startsBlank (BeforeNonBlank x) = startsBlank x+startsBlank (Prefixed _ x) = startsBlank x+startsBlank (Flush x) = startsBlank x+startsBlank BreakingSpace = True+startsBlank (AfterBreak t) = startsBlank (Text 0 t)+startsBlank CarriageReturn = True+startsBlank NewLine = True+startsBlank (BlankLines _) = True+startsBlank (Concat Empty y) = startsBlank y+startsBlank (Concat x _) = startsBlank x+startsBlank Empty = True isBlock :: Doc a -> Bool isBlock Block{} = True@@ -564,18 +581,18 @@ -- | Returns the column that would be occupied by the last -- laid out character (assuming no wrapping). updateColumn :: HasChars a => Doc a -> Int -> Int-updateColumn (Text n _) = (+ n)-updateColumn (Block n _) = (+ n)-updateColumn (VFill n _) = (+ n)-updateColumn Empty = const 0-updateColumn CarriageReturn = const 0-updateColumn NewLine = const 0-updateColumn (BlankLines _) = const 0-updateColumn d =- case map realLength (splitLines (render Nothing d)) of- [] -> id- [n] -> (+ n)- xs -> const (last xs)+updateColumn (Text !n _) !k = k + n+updateColumn (Block !n _) !k = k + n+updateColumn (VFill !n _) !k = k + n+updateColumn Empty _ = 0+updateColumn CarriageReturn _ = 0+updateColumn NewLine _ = 0+updateColumn (BlankLines _) _ = 0+updateColumn d !k =+ case splitLines (render Nothing d) of+ [] -> k+ [t] -> k + realLength t+ ts -> realLength $ last ts -- | @lblock n d@ is a block of width @n@ characters, with -- text derived from @d@ and aligned to the left.@@ -703,13 +720,13 @@ -- | Get real length of string, taking into account combining and double-wide -- characters. realLength :: HasChars a => a -> Int-realLength s = case foldrChar go (0, False) s of- (n, True) -> n + 1 -- first char is combining char- -- which we counted as 0 but really takes space- (n, False) -> n+realLength s = fromMaybe 0 $ foldlChar go Nothing s where- go c (tot, _combiningChar) =- case charWidth c of- 0 -> (tot, True)- n -> (tot + n, False)-+ -- Using a Maybe allows us to handle the case where the string+ -- starts with a combining character. Since there is no preceding+ -- character, we count 0 width as 1 in this one case:+ go Nothing !c =+ case charWidth c of+ 0 -> Just 1+ !n -> Just n+ go (Just !tot) !c = Just (tot + charWidth c)