pragmatic-show 0.1.2.1 → 0.2.0.0

raw patch · 3 files changed

+175/−41 lines, 3 filesdep ~containersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: containers

API changes (from Hackage documentation)

Files

• Text/Show/Pragmatic.hs +151/−36
• pragmatic-show.cabal +8/−5
• test/tasty/test.hs +16/−0

@@ -12,6 +12,12 @@ {-# LANGUAGE FlexibleInstances    #-} {-# LANGUAGE FlexibleContexts     #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE UnicodeSyntax        #-}+{-# LANGUAGE GADTs                #-}+{-# LANGUAGE DeriveFunctor        #-}+{-# LANGUAGE DeriveFoldable       #-}+{-# LANGUAGE DeriveTraversable    #-}  #include "HsBaseConfig.h" @@ -22,6 +28,7 @@        , ltdPrecShowsPrec        , showsPrecWithSharedPrecision        , ShowMagnitudeRangeLimited(..)+       , PaddingMode(..)        ) where  import Prelude hiding (Show(..), shows, print)@@ -161,8 +168,13 @@ import qualified Data.IntMap as ℤMap import qualified Data.Sequence as Seq import qualified Data.Tree as Tree+import Data.Functor.Identity (Identity(..))  +data PaddingMode = NoPadding+                 | PadLeftToAlign+                 | PadRightToAlign+                 | PadToConstantWidth  -- | A drop-in replacement for 'Prelude.Show'. The behaviour is mostly the same: --   the result of 'show' should be valid Haskell code, and 'read'ing back such a@@ -178,20 +190,37 @@ --   it depends on the type and the order of magnitude which amount of rounding is --   appropriate. See <https://github.com/leftaroundabout/pragmatic-show/blob/master/test/tasty/test.hs the test suite> for some examples. class Show a where-  {-# MINIMAL showsPrec | show #-}+  {-# MINIMAL showsPrec | show | showEach #-}   showsPrec :: Int -> a -> ShowS   showsPrec _ x = (show x++)   show :: a -> String   show = (`shows`"")+  showEach :: Traversable t+                => PaddingMode -- ^ Whether / how to ensure that e.g. decimal points line up.+                -> Int         -- ^ Precedence to use for showing each individual element+                -> t a         -- ^ List or other container of elements+                -> t ShowS     -- ^ Every element in the container shown, possibly with+                               --   shared processing like trimmed insignificant decimals+  showEach = defaultShowEach   showList :: [a] -> ShowS   showList = defaultShowList +defaultAssembleListShow :: [ShowS] -> ShowS+defaultAssembleListShow [] = ("[]"++)+defaultAssembleListShow (x:xs) = ('[':) . x . flip (foldr (\y -> (',':) . y)) xs . (']':)+ defaultShowList :: Show a => [a] -> ShowS-defaultShowList [] = ("[]"++)-defaultShowList (x:xs) = ('[':) . shows x . flip (foldr (\y -> (',':) . shows y)) xs . (']':)+defaultShowList = defaultAssembleListShow . showEach NoPadding 0 +defaultShowEach :: (Show a, Traversable t) => PaddingMode -> Int -> t a -> t ShowS+defaultShowEach PadToConstantWidth p l+          = fmap (\r c -> r <> replicate (totalWidth - length r) ' ' <> c) shown+ where totalWidth = maximum $ length<$>shown+       shown = fmap (($ "") . showsPrec p) l+defaultShowEach _ p l = fmap (showsPrec p) l+ shows :: Show a => a -> ShowS-shows = showsPrec 0+shows = runIdentity . showEach NoPadding 0 . Identity  #define StdShow(A)             \ instance Show (A) where {       \@@ -487,66 +516,97 @@   class Show a => ShowMagnitudeRangeLimited a where-  showsPrecMagnitudeRangeLimited :: Int -> Int -> a -> ShowS+  showsPrecMagnitudeRangeLimited+          :: Int     -- ^ Precision of the data type+          -> Int     -- ^ Precedence of the showing context+          -> a       -- ^ Numerical value to show+          -> ShowS  instance Show Float where   showsPrec = ltdPrecShowsPrec 7-  showList = ltdPrecShowList id 7+  showEach = showsPrecWithSharedPrecision id 7 instance ShowMagnitudeRangeLimited Float where   showsPrecMagnitudeRangeLimited = ltdPrecShowsPrec  instance Show Double where   showsPrec = ltdPrecShowsPrec 10-  showList = ltdPrecShowList id 10+  showEach = showsPrecWithSharedPrecision id 10 instance ShowMagnitudeRangeLimited Double where   showsPrecMagnitudeRangeLimited = ltdPrecShowsPrec  instance Show CFloat where   showsPrec = ltdPrecShowsPrec 5-  showList = ltdPrecShowList id 5+  showEach = showsPrecWithSharedPrecision id 5 instance ShowMagnitudeRangeLimited CFloat where   showsPrecMagnitudeRangeLimited = ltdPrecShowsPrec  instance Show CDouble where   showsPrec = ltdPrecShowsPrec 10-  showList = ltdPrecShowList id 10+  showEach = showsPrecWithSharedPrecision id 10 instance ShowMagnitudeRangeLimited CDouble where   showsPrecMagnitudeRangeLimited = ltdPrecShowsPrec -ltdPrecShowList :: (ShowMagnitudeRangeLimited n, RealFloat sn)-                   => (n -> sn) -> Int -> [n] -> ShowS-ltdPrecShowList realise precision vals-          = ('[':) . flip (foldr id)-                          (intersperse (',':)-                             $ showsPrecWithSharedPrecision realise precision 0 vals)-                   . (']':)--showsPrecWithSharedPrecision :: (ShowMagnitudeRangeLimited n, RealFloat sn, Traversable list)+showsPrecWithSharedPrecision :: ∀ n list sn . (ShowMagnitudeRangeLimited n, RealFloat sn, Traversable list)               => (n -> sn)   -- ^ Magnitude-function. Should be a norm.               -> Int         -- ^ Precision of the type, in significant decimals. This will                              --   be used to trim the length of all entries to match the                              --   expected numerical uncertainty of the biggest one.+              -> PaddingMode -- ^ What to do to align decimal points               -> Int         -- ^ Precedence of the enclosing context in which the values                              --   are to be shown.               -> list n      -- ^ Values to show               -> list ShowS  -- ^ Individual values' string representation.-showsPrecWithSharedPrecision realise precision p vals-     = fmap (\val ->-              let uMagn = usableMagnitude $ realise val-              in showsPrecMagnitudeRangeLimited-                   (max 0 $ precision - floor (maxUMag - uMagn)) p val+showsPrecWithSharedPrecision magnitudeFn precision padMode p vals+        = (case padMode of+            PadToConstantWidth -> \strn -> +                  let lenStrn = length strn+                  in (replicate (longestPaddedValLength - lenStrn) ' '++) . (strn++)+            _ -> (++)+           ) <$> paddedShownVals+ where shownVals :: list (n, String)+       shownVals = fmap (\val ->+              let uMagn = usableMagnitude $ magnitudeFn val+              in (val, showsPrecMagnitudeRangeLimited+                   (max 0 $ precision - floor (maxUMag - uMagn)) p val "")             ) vals- where usableMagnitude n+       usableMagnitude n         | n<0            = usableMagnitude (-n)         | n==n, 2*n>n    = logBase 10 n-        | otherwise      = -1/0-       maxUMag = maximum $ usableMagnitude . realise <$> vals+        | otherwise      = -1/0    -- NaN or infinite values are disregarded+       maxUMag = maximum $ usableMagnitude . magnitudeFn <$> vals+       leftmostCharacterMagnitude :: (n, String) -> Int+       leftmostCharacterMagnitude (_, "0") = 0+       leftmostCharacterMagnitude (n, ('-':strn))+                     = 1 + leftmostCharacterMagnitude (n, dropWhile (=='-') strn)+       leftmostCharacterMagnitude (n, '.':strn)+                     = leftmostCharacterMagnitude (n, strn)+       leftmostCharacterMagnitude (n, '0':strn)+                     = 1 + leftmostCharacterMagnitude (n, strn)+       leftmostCharacterMagnitude (n, strn) = floor (usableMagnitude $ magnitudeFn n)+       leftmostColumnMagnitude, rightmostColumnMagnitude :: Int+       leftmostColumnMagnitude = maximum $ leftmostCharacterMagnitude <$> shownVals+       rightmostColumnMagnitude = leftmostColumnMagnitude - maximum (length . snd <$> shownVals)+       administerPadding :: (n, String) -> String+       administerPadding (n,strn) = case padMode of+          NoPadding -> strn+          PadLeftToAlign -> replicate (leftmostColumnMagnitude - lchm) ' ' ++ strn+          _ -> strn ++ replicate (rchm - rightmostColumnMagnitude) ' '+        where lchm, rchm :: Int+              lchm = leftmostCharacterMagnitude (n, strn)+              rchm = lchm - length strn+       paddedShownVals :: list String+       paddedShownVals = administerPadding <$> shownVals+       longestPaddedValLength = maximum $ length <$>paddedShownVals  -- | @'ltdPrecShowsPrec' prcn@ displays floating-point values with a precision --   of at least @prcn@ digits. That does not mean it will necessarily display --   that many digits, rather it tries to always choose the shortest representation --   with the required precision.-ltdPrecShowsPrec :: (RealFloat n) => Int -> Int -> n -> ShowS+ltdPrecShowsPrec :: (RealFloat n)+          => Int     -- ^ Precision of the data type+          -> Int     -- ^ Precedence of the showing context+          -> n       -- ^ Numerical value to show+          -> ShowS ltdPrecShowsPrec precision p n cont     = minimumBy (comparing length)         [ postProc $ ltdPrecShowsPrecDecimal precision p' (preProc n) ""@@ -581,7 +641,7 @@                       $ ('-':) . ltdPrecShowsPrecDecimal precision 0 (negate n)     | n==n*2      = ("Infinity"++)     | e₁₀<7 && lrDigs <= e₁₀-                  = (rDigits++) . (replicate (e₁₀-lrDigs) '0' ++)+                  = shows (round n :: Int)     | e₁₀>0 && e₁₀<3                   = (take e₁₀ rDigits++) . ('.':) . (drop e₁₀ rDigits++)     | e₁₀> -2 && e₁₀<=0@@ -599,6 +659,13 @@          rDigits = reverse rDigits'          lrDigs = length rDigits +instance (Show a) => Show (Identity a) where+  showsPrec p (Identity x) = showParen (p>9) $ ("Identity "++) . showsPrec 11 x++instance (Show a) => Show (Maybe a) where+  showsPrec _ Nothing = ("Nothing"++)+  showsPrec p (Just x) = showParen (p>9) $ ("Just "++) . showsPrec 11 x+ instance (Show a) => Show [a] where   showsPrec _ = showList @@ -616,14 +683,62 @@   showsPrec p (Tree.Node a st) = showParen (p>9)                 $ ("Node "++) . showsPrec 11 a . (' ':) . shows st +data TraverseFirst t b a where+  TraverseFirst :: { firstTraversed :: t (a,b) } -> TraverseFirst t b a+ deriving (Functor, Foldable, Traversable)++data TraverseSecond t a b where+  TraverseSecond :: { secondTraversed :: t (a,b) } -> TraverseSecond t a b+ deriving (Functor, Foldable, Traversable)+ instance (Show a, Show b) => Show (a,b) where-  showsPrec _ (a,b) = ('(':) . shows a . (',':) . shows b . (')':)+  showEach padMode _+         = fmap (\(sa,sb) -> ('(':) . sa . (',':) . sb . (')':))+             .  firstTraversed . showEach padMode 0 . TraverseFirst+             . secondTraversed . showEach padMode 0 . TraverseSecond++data TraverseFirstOf3 t b c a where+  TraverseFirstOf3 :: { firstOf3Traversed :: t (a,b,c) } -> TraverseFirstOf3 t b c a+ deriving (Functor, Foldable, Traversable)++data TraverseSecondOf3 t a c b where+  TraverseSecondOf3 :: { secondOf3Traversed :: t (a,b,c) } -> TraverseSecondOf3 t a c b+ deriving (Functor, Foldable, Traversable)++data TraverseThird t a b c where+  TraverseThird :: { thirdTraversed :: t (a,b,c) } -> TraverseThird t a b c+ deriving (Functor, Foldable, Traversable)+ instance (Show a, Show b, Show c) => Show (a,b,c) where-  showsPrec _ (a,b,c) = ('(':) . shows a . (',':) . shows b . (',':) . shows c . (')':)+  showEach padMode _+       = fmap (\(sa,sb,sc) -> ('(':) . sa . (',':) . sb . (',':) . sc . (')':))+             .  firstOf3Traversed . showEach padMode 0 . TraverseFirstOf3+             . secondOf3Traversed . showEach padMode 0 . TraverseSecondOf3+             .     thirdTraversed . showEach padMode 0 . TraverseThird++data TraverseFirstOf4 t b c d a where+  TraverseFirstOf4 :: { firstOf4Traversed :: t (a,b,c,d) } -> TraverseFirstOf4 t b c d a+ deriving (Functor, Foldable, Traversable)++data TraverseSecondOf4 t a c d b where+  TraverseSecondOf4 :: { secondOf4Traversed :: t (a,b,c,d) } -> TraverseSecondOf4 t a c d b+ deriving (Functor, Foldable, Traversable)++data TraverseThirdOf4 t a b d c where+  TraverseThirdOf4 :: { thirdOf4Traversed :: t (a,b,c,d) } -> TraverseThirdOf4 t a b d c+ deriving (Functor, Foldable, Traversable)++data TraverseFourth t a b c d where+  TraverseFourth :: { fourthTraversed :: t (a,b,c,d) } -> TraverseFourth t a b c d+ deriving (Functor, Foldable, Traversable)+ instance (Show a, Show b, Show c, Show d) => Show (a,b,c,d) where-  showsPrec _ (a,b,c,d) = ('(':)-           . shows a . (',':) . shows b . (',':) . shows c . (',':) . shows d-                        . (')':)+  showEach padMode _+       = fmap (\(sa,sb,sc,sd) -> ('(':).sa.(',':).sb.(',':).sc.(',':).sd.(')':))+             .  firstOf4Traversed . showEach padMode 0 . TraverseFirstOf4+             . secondOf4Traversed . showEach padMode 0 . TraverseSecondOf4+             .  thirdOf4Traversed . showEach padMode 0 . TraverseThirdOf4+             .    fourthTraversed . showEach padMode 0 . TraverseFourth  instance (Integral i, Show i) => Show (Ratio i) where   showsPrec p n@@ -634,10 +749,10 @@  instance Show (Complex Double) where   showsPrec = ltdPrecShowsPrecComplex 10-  showList = ltdPrecShowList magnitude 10+  showEach = showsPrecWithSharedPrecision magnitude 10 instance Show (Complex Float) where   showsPrec = ltdPrecShowsPrecComplex 7-  showList = ltdPrecShowList magnitude 7+  showEach = showsPrecWithSharedPrecision magnitude 7 instance (RealFloat a, Show (Complex a), ShowMagnitudeRangeLimited a)     => ShowMagnitudeRangeLimited (Complex a) where   showsPrecMagnitudeRangeLimited = ltdPrecShowsPrecComplex@@ -648,7 +763,7 @@  | abs r > abs i * 10^precision     = ltdPrecShowsPrec precision p r  | otherwise-    = case ($"")<$>showsPrecWithSharedPrecision id precision 6 [r,i] of+    = case ($ "")<$>showsPrecWithSharedPrecision id precision NoPadding 6 [r,i] of            [sr,"0"] -> showParen (p>7) $ (sr++)            [sr,si] -> showParen (p>6) $ (sr++) . (":+"++) . (si++) 

@@ -2,18 +2,21 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                pragmatic-show-version:             0.1.2.1+version:             0.2.0.0 synopsis:            Alternative Show class that gives shorter view if possible. description:         The standard 'Show' class is handy for quickly viewing any Haskell                      values without having to think about formatting. However, it often                      produces needlessly clunky string representations, which are difficult                      to parse by eye. This package offers a drop-in replacement which-                     attempts to keep the representation as short as possible.+                     attempts to keep the representation as readable as possible.+                     It does this through more graphical layout, omission of redundant+                     information, and (still quite conservative) trimming of low-significance+                     digits. license:             GPL-3 license-file:        LICENSE author:              Justus Sagemüller homepage:            https://github.com/leftaroundabout/pragmatic-show-maintainer:          (@) jsag $ hvl.no+maintainer:          (@) jsag $ kth.se -- copyright:            category:            Text build-type:          Simple@@ -25,11 +28,11 @@   -- other-modules:          other-extensions:    FlexibleInstances   build-depends:       base >=4.8 && <5-                       , containers >=0.5 && <0.7+                       , containers >=0.5 && <0.9   -- hs-source-dirs:         default-language:    Haskell2010 -test-suite test+test-suite pragmatic-show-test   default-language:     Haskell2010   type:

@@ -39,6 +39,9 @@    , testProperty "(Int,Integer)" $ readBackEq ([]::[(Int,Integer)])    , testProperty "(Int,Integer,(Char,[Int]),String)"          $ readBackEq ([]::[(Int,Integer,(Char,[Int]),String)])+   , testProperty "[(Int,Bool)]" $ readBackEq ([]::[ [(Int,Bool)] ])+   , testProperty "([(Char,Int,Char)],[(Int,Char,Int,Char)])"+         $ readBackEq ([]::[ ([(Char,Int,Char)],[(Int,Char,Int,Char)]) ])    ]   , testGroup "Showing double-precision floats"    [ floatTest 1 "1"@@ -68,6 +71,8 @@    , floatsTest (take 10 $ iterate (/16) 1)        "[1,0.0625,3.90625e-3,2.44140625e-4,1.5258789e-5,9.53674e-7,5.9605e-8,3.725e-9,2.33e-10,1.5e-11]"    , floatsTest [1, -sqrt 2, sqrt (-2)] "[1,-sqrt 2,NaN]"+   , floatsTest [pi**k | k <- [1, 4 .. 30]]+       "[pi,97,3020,93648,2.904e6,9.0032e7,2.791564e9,8.6556004e10,2.683779414e12,8.3214007069e13,2.58015652686e15]"    ]   , testGroup "Showing rational numbers"    [ rationalTest 0 "0"@@ -84,6 +89,11 @@    , complexTest (exp $ 0:+pi/4) "sqrt 2/2:+sqrt 2/2"    , complexTest (exp $ 0:+5*pi/4) "(-sqrt 2/2):+(-sqrt 2/2)"    ]+  , testGroup "Showing tuples and lists of tuples"+   [ floatTupleTest (1.001e-3, 1e40) "(1.001e-3,1e40)"+   , floatTuplesTest [ (1.001e-3,1e40),(3e-3,1.001) ]+                     "[(1.001e-3,1e40),(3e-3,1)]"+   ]   ]  -- | Check that showing and reading again yields the original value.@@ -110,6 +120,12 @@  floatsTest :: [Double] -> String -> TestTree floatsTest n s = testCase s $ show n @?= s++floatTupleTest :: (Double,Double) -> String -> TestTree+floatTupleTest n s = testCase s $ show n @?= s++floatTuplesTest :: [(Double,Double)] -> String -> TestTree+floatTuplesTest n s = testCase s $ show n @?= s  rationalTest :: Rational -> String -> TestTree rationalTest n s = testCase s $ show n @?= s