diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # Pretty library change log +## 1.1.3.6 -- 30th January, 2018 + +* Fix compatability with GHC-8.4/base-4.11 (by Herbert Valerio Riedel). +* Add in benchmarking framework (by Alfredo Di Napoli). + ## 1.1.3.5 -- 1st February, 2017 * Fix documentation formatting bug (by Ivan Lazar Miljenovic) diff --git a/bench/Bench.hs b/bench/Bench.hs new file mode 100644 --- /dev/null +++ b/bench/Bench.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PackageImports #-} +module Main where + +import Criterion.Main +import Data.List +import Text.PrettyPrint.HughesPJ + +-------------------------------------------------------------------------------- +f_left :: Int -> Doc +f_left n = foldl' (<>) empty (map (text . show) [10001..10000+n]) + +-------------------------------------------------------------------------------- +f_right :: Int -> Doc +f_right n = foldr (<>) empty (map (text . show) [10001..10000+n]) + +-------------------------------------------------------------------------------- +stuff :: String -> String -> Double -> Rational -> Int -> Int -> Int -> Doc +stuff s1 s2 d1 r1 i1 i2 i3 = + let a = nest i1 $ text s1 + b = double d1 + c = rational r1 + d = replicate i1 (text s2 <> b <> c <+> a) + e = cat d $+$ cat d $$ (c <> b <+> a) + f = parens e <> brackets c <> hcat d + g = lparen <> f <> rparen + h = text $ s2 ++ s1 + i = map rational ([1..(toRational i2)]::[Rational]) + j = punctuate comma i + k = nest i3 h <> (nest (i1 + i3) $ sep i) $+$ g <> cat j + l = cat $ punctuate (comma <> b <> comma) $ replicate i3 k + in l + +-------------------------------------------------------------------------------- +doc1 :: Doc +doc1 = stuff "Adsas ads" "dassdab weeaa xxxxx" 123.231321 ((-1)/5) 30 300 20 + +-------------------------------------------------------------------------------- +doc2 :: Doc +doc2 = stuff "aDSAS ADS asdasdsa sdsda xx" "SDAB WEEAA" 1333.212 ((-4)/5) 31 301 30 + +-------------------------------------------------------------------------------- +doc3 :: Doc +doc3 = stuff "ADsAs --____ aDS" "DasSdAB weEAA" 2533.21299 ((-4)/999) 39 399 60 + +-------------------------------------------------------------------------------- +processTxt :: TextDetails -> String -> String +processTxt (Chr c) s = c:s +processTxt (Str s1) s2 = s1 ++ s2 +processTxt (PStr s1) s2 = s1 ++ s2 + +-------------------------------------------------------------------------------- +main :: IO () +main = defaultMain $ [ + bgroup "<> associativity" [ bench "left" $ nf (length . render . f_left) 10000 + , bench "right" $ nf (length . render . f_right) 10000 + , bench "left20k" $ nf (length . render . f_left) 20000 + , bench "right20k" $ nf (length . render . f_right) 20000 + , bench "left30k" $ nf (length . render . f_left) 30000 + , bench "right30k" $ nf (length . render . f_right) 30000 + ] + + , bgroup "render" [ bench "doc1" $ nf render doc1 + , bench "doc2" $ nf render doc2 + , bench "doc3" $ nf render doc3 + ] + + , bgroup "fullRender" [ bench "PageMode 1000" $ nf (fullRender PageMode 1000 4 processTxt "") doc2 + , bench "PageMode 100" $ nf (fullRender PageMode 100 1.5 processTxt "") doc2 + , bench "ZigZagMode" $ nf (fullRender ZigZagMode 1000 4 processTxt "") doc2 + , bench "LeftMode" $ nf (fullRender LeftMode 1000 4 processTxt "") doc2 + , bench "OneLineMode" $ nf (fullRender OneLineMode 1000 4 processTxt "") doc3 + ] + ] diff --git a/pretty.cabal b/pretty.cabal --- a/pretty.cabal +++ b/pretty.cabal @@ -1,5 +1,5 @@ name: pretty -version: 1.1.3.5 +version: 1.1.3.6 synopsis: Pretty-printing library description: This package contains a pretty-printing library, a set of API's @@ -55,6 +55,8 @@ QuickCheck >= 2.5 && <3 main-is: Test.hs other-modules: + Text.PrettyPrint.Annotated.HughesPJ + Text.PrettyPrint.HughesPJ PrettyTestVersion TestGenerators TestStructures @@ -67,3 +69,11 @@ include-dirs: src/Text/PrettyPrint/Annotated ghc-options: -rtsopts -with-rtsopts=-K2M +benchmark pretty-bench + type: exitcode-stdio-1.0 + main-is: Bench.hs + hs-source-dirs: bench + ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -O2 -threaded -rtsopts -with-rtsopts=-N1 -with-rtsopts=-s -with-rtsopts=-qg + build-depends: base >= 4.5 && < 5 + , criterion + , pretty diff --git a/src/Text/PrettyPrint.hs b/src/Text/PrettyPrint.hs --- a/src/Text/PrettyPrint.hs +++ b/src/Text/PrettyPrint.hs @@ -41,7 +41,7 @@ -- ** Combining documents empty, - (<>), (<+>), hcat, hsep, + (X.<>), (<+>), hcat, hsep, ($$), ($+$), vcat, sep, cat, fsep, fcat, @@ -67,5 +67,5 @@ ) where -import Text.PrettyPrint.HughesPJ +import Text.PrettyPrint.HughesPJ as X diff --git a/src/Text/PrettyPrint/Annotated.hs b/src/Text/PrettyPrint/Annotated.hs --- a/src/Text/PrettyPrint/Annotated.hs +++ b/src/Text/PrettyPrint/Annotated.hs @@ -41,7 +41,7 @@ -- ** Combining documents empty, - (<>), (<+>), hcat, hsep, + (X.<>), (<+>), hcat, hsep, ($$), ($+$), vcat, sep, cat, fsep, fcat, @@ -74,5 +74,5 @@ ) where -import Text.PrettyPrint.Annotated.HughesPJ +import Text.PrettyPrint.Annotated.HughesPJ as X diff --git a/src/Text/PrettyPrint/Annotated/HughesPJ.hs b/src/Text/PrettyPrint/Annotated/HughesPJ.hs --- a/src/Text/PrettyPrint/Annotated/HughesPJ.hs +++ b/src/Text/PrettyPrint/Annotated/HughesPJ.hs @@ -84,6 +84,9 @@ import Control.DeepSeq ( NFData(rnf) ) import Data.Function ( on ) +#if __GLASGOW_HASKELL__ >= 803 +import Prelude hiding ( (<>) ) +#endif #if __GLASGOW_HASKELL__ >= 800 import qualified Data.Semigroup as Semi ( Semigroup((<>)) ) #elif __GLASGOW_HASKELL__ < 709 diff --git a/src/Text/PrettyPrint/HughesPJ.hs b/src/Text/PrettyPrint/HughesPJ.hs --- a/src/Text/PrettyPrint/HughesPJ.hs +++ b/src/Text/PrettyPrint/HughesPJ.hs @@ -86,6 +86,9 @@ import Control.DeepSeq ( NFData(rnf) ) import Data.Function ( on ) +#if __GLASGOW_HASKELL__ >= 803 +import Prelude hiding ( (<>) ) +#endif #if __GLASGOW_HASKELL__ >= 800 import qualified Data.Semigroup as Semi ( Semigroup((<>)) ) #elif __GLASGOW_HASKELL__ < 709