pragmatic-show 0.1.1.0 → 0.1.2.0

raw patch · 3 files changed

+160/−18 lines, 3 filesdep +containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: containers

API changes (from Hackage documentation)

Files

• Text/Show/Pragmatic.hs +138/−8
• pragmatic-show.cabal +2/−1
• test/tasty/test.hs +20/−9

@@ -8,16 +8,30 @@ -- Portability : portable --  -{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP                  #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE UndecidableInstances #-} -module Text.Show.Pragmatic where+module Text.Show.Pragmatic (+       -- * Replacement for the standard class+         Show(..), print+       -- * Utility (unstable)+       , ltdPrecShowsPrec+       , showsPrecWithSharedPrecision+       , ShowMagnitudeRangeLimited(..)+       ) where -import Prelude hiding (Show(..), shows)+import Prelude hiding (Show(..), shows, print) import qualified Prelude+import Data.Foldable (toList)+import Data.List (intersperse, minimumBy)+import Data.Ord (comparing)  import Data.Int (Int8, Int16, Int32, Int64) import Data.Word (Word8, Word16, Word32, Word64) import Data.Ratio+import Data.Complex (Complex((:+)), magnitude) #if MIN_VERSION_base(4,8,0) import Numeric.Natural (Natural) #endif@@ -133,8 +147,15 @@ import Data.Void #endif +import qualified Data.Set as Set+import qualified Data.IntSet as ℤSet+import qualified Data.Map as Map+import qualified Data.IntMap as ℤMap+import qualified Data.Sequence as Seq+import qualified Data.Tree as Tree  + -- | 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 --   value should give the original value – but, unlike in 'Prelude.Show', we don't@@ -155,9 +176,12 @@   show :: a -> String   show = (`shows`"")   showList :: [a] -> ShowS-  showList [] = ("[]"++)-  showList (x:xs) = ('[':) . shows x . flip (foldr (\y -> (',':) . shows y)) xs . (']':)+  showList = defaultShowList +defaultShowList :: Show a => [a] -> ShowS+defaultShowList [] = ("[]"++)+defaultShowList (x:xs) = ('[':) . shows x . flip (foldr (\y -> (',':) . shows y)) xs . (']':)+ shows :: Show a => a -> ShowS shows = showsPrec 0 @@ -450,27 +474,99 @@                        (r,"'") -> (r++)  +class Show a => ShowMagnitudeRangeLimited a where+  showsPrecMagnitudeRangeLimited :: Int -> Int -> a -> ShowS+ instance Show Float where   showsPrec = ltdPrecShowsPrec 7+  showList = ltdPrecShowList id 7+instance ShowMagnitudeRangeLimited Float where+  showsPrecMagnitudeRangeLimited = ltdPrecShowsPrec  instance Show Double where   showsPrec = ltdPrecShowsPrec 10+  showList = ltdPrecShowList id 10+instance ShowMagnitudeRangeLimited Double where+  showsPrecMagnitudeRangeLimited = ltdPrecShowsPrec  instance Show CFloat where   showsPrec = ltdPrecShowsPrec 5+  showList = ltdPrecShowList id 5+instance ShowMagnitudeRangeLimited CFloat where+  showsPrecMagnitudeRangeLimited = ltdPrecShowsPrec  instance Show CDouble where   showsPrec = ltdPrecShowsPrec 10+  showList = ltdPrecShowList 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)+              => (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.+              -> 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+            ) vals+ where usableMagnitude n+        | n<0            = usableMagnitude (-n)+        | n==n, 2*n>n    = logBase 10 n+        | otherwise      = -1/0+       maxUMag = maximum $ usableMagnitude . realise <$> vals+ -- | @'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 _ _ 0 = ("0"++)-ltdPrecShowsPrec precision p n+ltdPrecShowsPrec precision p n cont+    = minimumBy (comparing length)+        [ postProc $ ltdPrecShowsPrecDecimal precision p' (preProc n) ""+        | (preProc, p', postProc)+            <- [ (id, p, id) ]+             ++[ ( (/μ)+                 , 7, \s -> case s of+                        "1"   -> sμ ""+                        "(-1)"-> showParen (p>=6) (('-':) . sμ) ""+                        _     -> showParen (p>7) ((s++) . ('*':) . sμ) ""+                 )+               | (μ,sμ) <- (pi, ("pi"++))+                          :[ (pi / fromIntegral m, ("pi/"++) . shows m)+                           | m<-[2,3,4 :: Int] ]+                         ++[ (sqrt $ fromIntegral n, ("sqrt "++) . shows n)+                           | n<-[2,3,5 :: Int] ]+                         ++[ ( sqrt (fromIntegral n)/fromIntegral m+                             , ("sqrt "++) . shows n . ('/':) . shows m)+                           | n<-[2,3 :: Int]+                           , m<-[2,3 :: Int] ]+               ]+             ++[ ( (*fromIntegral n)+                 , 7, \s -> showParen (p>7) ((s++) . ('/':) . shows n) "" )+               | n<-[3,7,9 :: Int] ]+        ] ++ cont++ltdPrecShowsPrecDecimal :: (RealFloat n) => Int -> Int -> n -> ShowS+ltdPrecShowsPrecDecimal _ _ 0 = ("0"++)+ltdPrecShowsPrecDecimal precision p n     | not (n==n)  = ("NaN"++)-    | n<0         = showParen (p>5) $ ('-':) . ltdPrecShowsPrec precision 0 (negate n)+    | n<0         = showParen (p>5)+                      $ ('-':) . ltdPrecShowsPrecDecimal precision 0 (negate n)     | n==n*2      = ("Infinity"++)     | e₁₀<7 && lrDigs <= e₁₀                   = (rDigits++) . (replicate (e₁₀-lrDigs) '0' ++)@@ -494,6 +590,20 @@ instance (Show a) => Show [a] where   showsPrec _ = showList +instance (Show a, Ord a) => Show (Seq.Seq a) where+  showsPrec _ = defaultShowList . toList+instance (Show a, Ord a) => Show (Set.Set a) where+  showsPrec _ = defaultShowList . Set.toList+instance Show ℤSet.IntSet where+  showsPrec _ = defaultShowList . ℤSet.toList+instance (Show a, Ord a, Show b) => Show (Map.Map a b) where+  showsPrec _ = defaultShowList . Map.toList+instance (Show b) => Show (ℤMap.IntMap b) where+  showsPrec _ = defaultShowList . ℤMap.toList+instance (Show a) => Show (Tree.Tree a) where+  showsPrec p (Tree.Node a st) = showParen (p>9)+                $ ("Node "++) . showsPrec 11 a . (' ':) . shows st+ instance (Show a, Show b) => Show (a,b) where   showsPrec _ (a,b) = ('(':) . shows a . (',':) . shows b . (')':) instance (Show a, Show b, Show c) => Show (a,b,c) where@@ -509,6 +619,26 @@    | denominator n == 1  = shows $ numerator n    | otherwise           = showParen (p>6) $ shows (numerator n)                                               . ('/':) . shows (denominator n)++instance Show (Complex Double) where+  showsPrec = ltdPrecShowsPrecComplex 10+  showList = ltdPrecShowList magnitude 10+instance Show (Complex Float) where+  showsPrec = ltdPrecShowsPrecComplex 7+  showList = ltdPrecShowList magnitude 7+instance (RealFloat a, Show (Complex a), ShowMagnitudeRangeLimited a)+    => ShowMagnitudeRangeLimited (Complex a) where+  showsPrecMagnitudeRangeLimited = ltdPrecShowsPrecComplex++ltdPrecShowsPrecComplex :: (RealFloat r, ShowMagnitudeRangeLimited r)+                           => Int -> Int -> Complex r -> ShowS+ltdPrecShowsPrecComplex precision p (r:+i)+ | abs r > abs i * 10^precision+    = ltdPrecShowsPrec precision p r+ | otherwise+    = case ($"")<$>showsPrecWithSharedPrecision id precision 6 [r,i] of+           [sr,"0"] -> showParen (p>7) $ (sr++)+           [sr,si] -> showParen (p>6) $ (sr++) . (":+"++) . (si++)  -- | Drop-in for the standard screen-displaying function. This is useful as a GHCi --   evaluation action; invoke with

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                pragmatic-show-version:             0.1.1.0+version:             0.1.2.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@@ -25,6 +25,7 @@   -- other-modules:          other-extensions:    FlexibleInstances   build-depends:       base >=4.8 && <5+                       , containers >=0.5 && <0.6   -- hs-source-dirs:         default-language:    Haskell2010 

@@ -20,6 +20,7 @@ import Prelude hiding (Show(..)) import Text.Show.Pragmatic +import Data.Complex (Complex((:+))) import Data.VectorSpace  @@ -43,9 +44,10 @@    [ floatTest 1 "1"    , floatTest 10 "10"    , floatTest 0.1 "0.1"+   , floatTest (1/3) "1/3"    , floatTest 1e9 "1e9"    , floatTest 1e90 "1e90"-   , floatTest pi "3.14159265359"+   , floatTest pi "pi"    , floatTest 32 "32"    , floatTest (89.524 - 9.004) "80.52"    , floatTest (0.3 + 0.3 + 0.3) "0.9"@@ -62,14 +64,10 @@    , floatTest 7e35 "7e35"    , floatTest (1/0) "Infinity"    , floatTest (sqrt $ -1) "NaN"-   ]-  , testGroup "Re-Reading of approximate types"-   [ testProperty "Double" $ readBackApproxEq ([]::[Double]) 1e-10-   , testProperty "Double with higher-than-supported precision"-          . QC.expectFailure-           $ readBackApproxEq ([]::[Double]) 1e-14-   , testProperty "Double²" $ readBackApproxEq ([]::[(Double,Double)]) 1e-10-   , testProperty "Float" $ readBackApproxEq ([]::[Float]) 1e-5+   , floatsTest [1,2,3] "[1,2,3]"+   , 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]"    ]   , testGroup "Showing rational numbers"    [ rationalTest 0 "0"@@ -79,6 +77,13 @@    , rationalTest (-268/19) "-268/19"    , rationalTest (3/3) "1"    ]+  , testGroup "Showing complex numbers"+   [ complexTest 1 "1"+   , complexTest (sqrt $ -1) "0:+1"+   , complexTest (exp $ 0:+pi) "-1"+   , complexTest (exp $ 0:+pi/4) "sqrt 2/2:+sqrt 2/2"+   , complexTest (exp $ 0:+5*pi/4) "(-sqrt 2/2):+(-sqrt 2/2)"+   ]   ]  -- | Check that showing and reading again yields the original value.@@ -99,6 +104,12 @@  floatTest :: Double -> String -> TestTree floatTest n s = testCase s $ show n @?= s++complexTest :: Complex Double -> String -> TestTree+complexTest n s = testCase s $ show n @?= s++floatsTest :: [Double] -> String -> TestTree+floatsTest n s = testCase s $ show n @?= s  rationalTest :: Rational -> String -> TestTree rationalTest n s = testCase s $ show n @?= s