Hello community,

here is the log from the commit of package ghc-doclayout for openSUSE:Leap:15.2 
checked in at 2020-03-13 10:56:47
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Leap:15.2/ghc-doclayout (Old)
 and      /work/SRC/openSUSE:Leap:15.2/.ghc-doclayout.new.3160 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Package is "ghc-doclayout"

Fri Mar 13 10:56:47 2020 rev:2 rq:782960 version:0.3

Changes:
--------
--- /work/SRC/openSUSE:Leap:15.2/ghc-doclayout/ghc-doclayout.changes    
2020-02-09 11:26:01.223319493 +0100
+++ /work/SRC/openSUSE:Leap:15.2/.ghc-doclayout.new.3160/ghc-doclayout.changes  
2020-03-13 10:56:47.328409594 +0100
@@ -1,0 +2,17 @@
+Thu Feb 27 16:05:39 UTC 2020 - [email protected]
+
+- Update doclayout to version 0.3.
+  ## 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.
+
+-------------------------------------------------------------------

Old:
----
  doclayout-0.2.0.1.tar.gz

New:
----
  doclayout-0.3.tar.gz

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Other differences:
------------------
++++++ ghc-doclayout.spec ++++++
--- /var/tmp/diff_new_pack.pA81ky/_old  2020-03-13 10:56:47.788409922 +0100
+++ /var/tmp/diff_new_pack.pA81ky/_new  2020-03-13 10:56:47.788409922 +0100
@@ -1,7 +1,7 @@
 #
 # spec file for package ghc-doclayout
 #
-# Copyright (c) 2019 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2020 SUSE LINUX GmbH, Nuernberg, Germany.
 #
 # All modifications and additions to the file contributed by third parties
 # remain the property of their copyright owners, unless otherwise agreed
@@ -19,7 +19,7 @@
 %global pkg_name doclayout
 %bcond_with tests
 Name:           ghc-%{pkg_name}
-Version:        0.2.0.1
+Version:        0.3
 Release:        0
 Summary:        A prettyprinting library for laying out text documents
 License:        BSD-3-Clause

++++++ doclayout-0.2.0.1.tar.gz -> doclayout-0.3.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/doclayout-0.2.0.1/changelog.md 
new/doclayout-0.3/changelog.md
--- old/doclayout-0.2.0.1/changelog.md  2019-10-31 03:12:25.000000000 +0100
+++ new/doclayout-0.3/changelog.md      2020-01-13 08:15:42.000000000 +0100
@@ -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.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/doclayout-0.2.0.1/doclayout.cabal 
new/doclayout-0.3/doclayout.cabal
--- old/doclayout-0.2.0.1/doclayout.cabal       2019-10-31 03:09:35.000000000 
+0100
+++ new/doclayout-0.3/doclayout.cabal   2020-01-13 07:58:19.000000000 +0100
@@ -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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' 
'--exclude=.svnignore' old/doclayout-0.2.0.1/src/Text/DocLayout.hs 
new/doclayout-0.3/src/Text/DocLayout.hs
--- old/doclayout-0.2.0.1/src/Text/DocLayout.hs 2019-10-31 03:03:37.000000000 
+0100
+++ new/doclayout-0.3/src/Text/DocLayout.hs     2020-01-13 07:54:35.000000000 
+0100
@@ -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)


Reply via email to