diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,11 +1,19 @@ -# 0.1.0 +# 0.2.1 (2022-09-24) -Initial version. +* Update to `portray-0.3.0`. +* Fix an alignment bug in list/tuple elements. +* Support flexible configuration of floating-point literals. +* Support configuration of numeric place separators. +* Use lazy Text internally in `pp` and `ppd` to support large/infinite values. -# 0.2.0 +# 0.2.0 (2021-09-17) -* Update to portray-0.2.0. +* Update to `portray-0.2.0`. * Add colorized pretty-printing for `pp` and `ppd`. * Fix records/lists/tuples putting initial elements on their own lines. * Flow string literals onto multiple lines, preferring to break after `\n`s. * Support configurable string escaping, to allow printing Unicode in strings. + +# 0.1.0 (2021-09-14) + +Initial version. diff --git a/portray-prettyprinter.cabal b/portray-prettyprinter.cabal --- a/portray-prettyprinter.cabal +++ b/portray-prettyprinter.cabal @@ -1,38 +1,34 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0. +-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack --- --- hash: 9a1c9decccd042e10d029755324f91da86d55e74574de17e95f313f00dd9a59b name: portray-prettyprinter -version: 0.2.0 -synopsis: A portray backend using the prettyprinter package. +version: 0.2.1 +synopsis: Portray backend for prettyprinter description: This provides a backend for along with derivable 'Pretty' instances for types with 'Portray' instances. . - This started out as a fork of - , and is - still very similar. However, @prettyprinter@ gives more flexibility to - documents at the cost of requiring more behavior to be specified explicitly. - As such, some formats are nicer with the @prettyprinter@ backend, - configurable syntax highlighting is supported, and unicode escaping is - configurable. However, this backend is less mature and hasn't been used as - much in practice, so there are likely more formatting bugs than in - @portray-pretty@. Please do file bugs on the GitHub issue tracker if you - find anything that seems obviously wrong! + This backend has largely superseded the original + . Because + @prettyprinter@ gives more flexibility to documents at the cost of requiring + more behavior to be specified explicitly, some formats are nicer with this + backend, configurable syntax highlighting is supported, and unicode escaping + is configurable. However, as this backend is still newer, there are + potentially more unnoticed formatting bugs. Please do file bugs on the + GitHub issue tracker if you find anything that seems obviously wrong! . Try using 'pp' as the print function in GHCi: @:set -interactive-print=Data.Portray.Prettyprinter.pp@! category: Text -homepage: https://github.com/google/hs-portray#readme -bug-reports: https://github.com/google/hs-portray/issues -author: Andrew Pritchard -maintainer: Andrew Pritchard -copyright: 2021 Google LLC +homepage: https://github.com/awpr/portray#readme +bug-reports: https://github.com/awpr/portray/issues +author: Andrew Pritchard +maintainer: Andrew Pritchard +copyright: 2021 Google LLC; 2022 Andrew Pritchard license: Apache-2.0 license-file: LICENSE build-type: Simple @@ -41,43 +37,39 @@ source-repository head type: git - location: https://github.com/google/hs-portray + location: https://github.com/awpr/portray subdir: portray-prettyprinter library exposed-modules: Data.Portray.Prettyprinter - other-modules: - Paths_portray_prettyprinter hs-source-dirs: src build-depends: - base >=4.12 && <4.16 - , portray >=0.2 && <0.3 - , portray-diff >=0.1 && <0.2 - , prettyprinter >=1.7 && <1.8 - , prettyprinter-ansi-terminal >=1.1.2 && <1.2 - , text >=0.1 && <1.3 + base >=4.12 && <4.17 + , portray ==0.3.* + , portray-diff ==0.1.* + , prettyprinter >=1.2 && <1.8 + , prettyprinter-ansi-terminal >=1.1.1 && <1.2 + , text >=0.1 && <2.1 default-language: Haskell2010 test-suite PortrayPrettyprinter-test type: exitcode-stdio-1.0 main-is: Main.hs - other-modules: - Paths_portray_prettyprinter hs-source-dirs: test build-depends: HUnit , QuickCheck - , base >=4.12 && <4.16 + , base >=4.12 && <4.17 , portray - , portray-diff >=0.1 && <0.2 + , portray-diff ==0.1.* , portray-prettyprinter - , prettyprinter >=1.7 && <1.8 - , prettyprinter-ansi-terminal >=1.1.2 && <1.2 + , prettyprinter >=1.2 && <1.8 + , prettyprinter-ansi-terminal >=1.1.1 && <1.2 , test-framework , test-framework-hunit , test-framework-quickcheck2 - , text >=0.1 && <1.3 + , text >=0.1 && <2.1 default-language: Haskell2010 diff --git a/src/Data/Portray/Prettyprinter.hs b/src/Data/Portray/Prettyprinter.hs --- a/src/Data/Portray/Prettyprinter.hs +++ b/src/Data/Portray/Prettyprinter.hs @@ -1,4 +1,5 @@ -- Copyright 2021 Google LLC +-- Copyright 2022 Andrew Pritchard -- -- Licensed under the Apache License, Version 2.0 (the "License"); -- you may not use this file except in compliance with the License. @@ -81,6 +82,7 @@ -- This module also exports the underlying rendering functionality in a variety -- of forms for more esoteric uses. +{-# LANGUAGE CPP #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -96,9 +98,12 @@ , WrappedPortray(..) -- * Rendering -- ** Configuration - , Config, defaultConfig + , Config, defaultConfig, prettyConfig -- *** Escape Sequences , setShouldEscapeChar, escapeNonASCII, escapeSpecialOnly + -- *** Numeric Literals + , setTrimTrailingFloatZeros, setScientificNotationThreshold + , setSeparatorGroupSizes -- ** Colorization , SyntaxClass(..), LitKind(..) , defaultStyling, subtleStyling, noStyling @@ -106,7 +111,9 @@ , DocAssocPrec, toDocAssocPrecF, toDocAssocPrec -- ** Convenience Functions , portrayalToDoc - , styleShowPortrayal, prettyShowPortrayal, basicShowPortrayal + , styleShowPortrayal, styleShowPortrayalLazy + , prettyShowPortrayal, prettyShowPortrayalLazy + , basicShowPortrayal ) where import Data.Char (isAscii, isDigit, isPrint) @@ -114,18 +121,28 @@ import Data.Functor ((<&>)) import Data.Text (Text) import qualified Data.Text as T -import qualified Data.Text.IO as T (putStrLn) +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.IO as T (putStrLn) import GHC.Show (showLitChar) -import Prettyprinter (Doc, Pretty(..)) -import qualified Prettyprinter.Render.Terminal as A -- for ANSI -import qualified Prettyprinter as P +#if MIN_VERSION_prettyprinter(1, 7, 0) +#define Prettyprinter_ Prettyprinter +#else +#define Prettyprinter_ Data.Text.Prettyprint.Doc +#endif +import Prettyprinter_ (Doc, Pretty(..)) +import qualified Prettyprinter_.Render.Terminal as A -- for ANSI +import qualified Prettyprinter_ as P + import Data.Portray ( Assoc(..), Infixity(..), FactorPortrayal(..) , Ident(..), IdentKind(..) , Portray, Portrayal(..), PortrayalF(..) , cata, portray + , Base(..), FloatLiteral(..) + , formatIntLit, formatFloatLit, formatSpecialFloat + , normalizeFloatLit, trimFloatLit ) import Data.Portray.Diff (Diff(..)) @@ -134,7 +151,7 @@ -- This uses ANSI color codes, so take care not to use it in contexts where it -- might output to something other than a terminal. pp :: Portray a => a -> IO () -pp = T.putStrLn . prettyShowPortrayal . portray +pp = T.putStrLn . prettyShowPortrayalLazy . portray -- | Pretty-print a value using its 'Portray' instance. -- @@ -147,7 +164,7 @@ -- This uses ANSI color codes, so take care not to use it in contexts where it -- might output to something other than a terminal. ppd :: Diff a => a -> a -> IO () -ppd x = T.putStrLn . maybe "_" prettyShowPortrayal . diff x +ppd x = T.putStrLn . maybe "_" prettyShowPortrayalLazy . diff x -- | Pretty-print a diff between two values using a 'Diff' instance. -- @@ -244,6 +261,16 @@ -- are always escaped, and anything that wouldn't be escaped by 'Show' is never -- escaped. -- +-- * 'setTrimTrailingFloatZeros', whether to trim trailing zeros in +-- floating-point literals. +-- +-- * 'setScientificNotationThreshold', a limit on the number of padding +-- (non-precision) zeros in floating-point literals before switching to +-- scientific notation. +-- +-- * 'setSeparatorGroupSizes', configuration of where to place underscores in +-- the whole-number part of integral and fractional literals. +-- -- For forwards-compatibility reasons, the field selectors and constructor of -- this type are hidden; use the provided setters to build a config. For -- example: @@ -252,21 +279,120 @@ -- config = -- defaultConfig -- & setShouldEscapeChar (const True) -- Escape everything we can. +-- & setTrimTrailingFloatZeros True -- @ data Config = Config { _shouldEscapeChar :: Char -> Bool + , _scientificNotationThreshold :: Int + , _trimTrailingFloatZeros :: Bool + , _separatorGroupSizes :: Base -> [Int] } -- | Set the predicate for whether to escape a given character; see 'Config'. setShouldEscapeChar :: (Char -> Bool) -> Config -> Config -setShouldEscapeChar f _ = Config f +setShouldEscapeChar f c = c { _shouldEscapeChar = f } --- | A sensible default configuration to build on. +-- | Configure trimming of trailing zeros from floating-point literals. -- --- Uses 'escapeNonASCII'. +-- @since 0.2.1 +setTrimTrailingFloatZeros :: Bool -> Config -> Config +setTrimTrailingFloatZeros b c = c { _trimTrailingFloatZeros = b } + +-- | Configure the number of zeros to pad with before using scientific notation. +-- +-- If the radix point is within or adjaecent to the specified digits in a float +-- literal, it's considered to need no padding zeros. If the radix point is +-- outside the specified digits, we can either materialize extra zeros to cover +-- the gap between the specified digits and the radix point, or use scientific +-- notation to move the radix point into the specified digits. A single +-- placeholder zero to the left of the radix point is not considered to be a +-- padding zero. +-- +-- @ +-- FloatLiteral False "1234" (-4) = _.____1 234 +-- = 0.00001 234 -- 4 padding 0s +-- = 1.234e-5 +-- @ +-- +-- @ +-- FloatLiteral False "1234" 8 = 1 234____._ +-- = 1 2340000 -- 4 padding 0s +-- = 1.234e7 +-- @ +-- +-- Trailing that are part of the specified digits are not considered to be +-- padding (if not trimmed by 'setTrimTrailingFloatZeros'): +-- +-- @ +-- FloatLiteral False "100" 4 = 1 00_._ +-- = 1 000 -- 1 padding 0 +-- = 1.000e3 +-- @ +-- +-- This threshold determines how many padding zeros to tolerate before +-- switching over to scientific notation. Choosing a very high threshold +-- naturally means scientific notation will ~never be used. Choosing a +-- negative threshold naturally means scientific notation will always be used. +-- +-- Deciding based on the number of padding zeros rather than the absolute +-- magnitude of the number means we won't needlessly format @1234567@ as +-- @1.234567e6@ when doing so doesn't actually make the representation more +-- compact. +-- +-- @since 0.2.1 +setScientificNotationThreshold :: Int -> Config -> Config +setScientificNotationThreshold n c = c { _scientificNotationThreshold = n } + +-- | Set the separator spacing for NumericUnderscores, or disable underscores. +-- +-- The list of group sizes is used working leftwards from the radix point. If +-- the list runs out, no further separators will be inserted. +-- +-- @ +-- [4, 3, 2, 2] : 123456000000 => 1_23_45_600_0000 +-- repeat 3 : 123456000000 => 123_456_000_000 +-- [1] : 123456000000 => 12345600000_0 +-- @ +-- +-- This allows both the conventional US separator placement of every three +-- digits by providing @cycle 3@, as well as more complex spacings such as +-- @3 : repeat 2@ reportedly used in India. +-- +-- Backends should not cache these lists, and should attempt to use them in a +-- single-use, streaming manner, so that large portions of infinite lists are +-- not held in memory. Clients should assume returning infinite lists is fine. +-- +-- @since 0.2.1 +setSeparatorGroupSizes :: (Base -> [Int]) -> Config -> Config +setSeparatorGroupSizes f c = c { _separatorGroupSizes = f } + +-- | A sensible, conservative default configuration to build on. +-- +-- * Uses 'escapeNonASCII' to escape everything but printable ASCII characters. +-- * Preserves any trailing zeros in float literals. +-- * Uses scientific notation when any padding zeros would be needed. +-- * Does not use numeric underscores. defaultConfig :: Config -defaultConfig = Config escapeNonASCII +defaultConfig = Config escapeNonASCII 0 False (const []) +-- | A default "pretty" config with more opinionated choices. +-- +-- This using numeric underscores, slightly less scientific notation, and less +-- escaping compared to 'defaultConfig'. +-- +-- @since 0.2.1 +prettyConfig :: Config +prettyConfig = + defaultConfig + & setShouldEscapeChar escapeSpecialOnly + & setScientificNotationThreshold 2 + & setSeparatorGroupSizes + (\case + Decimal -> repeat 3 -- Conventional US spacing: powers of 1,000. + Binary -> repeat 8 -- 8-bit groups. + Octal -> [] -- /shrug/ doesn't divide bytes evenly. + Hex -> repeat 8) -- 32-bit groups. + -- | Convert a 'Portrayal' to a 'Doc'. portrayalToDoc :: Config -> Portrayal -> Doc SyntaxClass portrayalToDoc cfg t = toDocAssocPrec cfg t AssocNope (-1) @@ -330,12 +456,10 @@ [] -> opener <> closer (doc:docs) -> P.group $ - foldl01 - (\x y -> x <> P.group (P.line' <> y)) - id - mempty - (opener <> P.flatAlt " " "" <> doc : - zipWith (P.<+>) (repeat separator) docs) <> + opener <> P.flatAlt " " "" <> P.align doc <> + foldMap + (\x -> P.group (P.line' <> x)) + (map (\x -> separator P.<+> P.align x) docs) <> P.line' <> closer where opener = P.annotate Bracket o @@ -469,6 +593,26 @@ backslashBreak = P.annotate EscapeSequence $ "\\" <> P.line' <> "\\" +ppIntLit :: Base -> [Int] -> Integer -> Doc SyntaxClass +ppIntLit b seps = P.annotate (Literal IntLit) . text . formatIntLit b seps + +paddingZeros :: FloatLiteral -> Int +paddingZeros (FloatLiteral _ d e) + | e < 0 = negate e + | e > T.length d = e - T.length d + | otherwise = 0 + +ppFloatLit :: Config -> FloatLiteral -> Doc SyntaxClass +ppFloatLit cfg lit = + P.annotate (Literal RatLit) $ text $ + formatFloatLit + (paddingZeros lit' > _scientificNotationThreshold cfg) + (_separatorGroupSizes cfg Decimal) lit' + where + lit' = + (if _trimTrailingFloatZeros cfg then trimFloatLit else id) $ + normalizeFloatLit lit + -- | Render one layer of 'PortrayalF' to 'DocAssocPrec'. toDocAssocPrecF :: Config @@ -476,27 +620,36 @@ -> DocAssocPrec SyntaxClass toDocAssocPrecF cfg = \case NameF nm -> \_ _ -> ppPrefix nm - LitIntF x -> \_ _ -> P.annotate (Literal IntLit) $ pretty x - LitRatF x -> \_ _ -> - P.annotate (Literal RatLit) $ pretty (fromRational x :: Double) + LitIntBaseF base x -> \_ _ -> ppIntLit base (_separatorGroupSizes cfg base) x + LitFloatF x -> \_ _ -> ppFloatLit cfg x + + SpecialFloatF x -> \_ _ -> + P.annotate Structural $ text $ -- Different color from numeric float lits. + formatSpecialFloat x + LitStrF x -> \_ _ -> ppStrLit cfg x + LitCharF x -> \_ _ -> -- Likewise Char P.annotate (Literal CharLit) $ P.enclose "'" "'" $ (if litCharIsEscaped cfg x then P.annotate EscapeSequence else id) $ text $ escapeLitChar cfg x + OpaqueF txt -> \_ _ -> text txt ApplyF fn [] -> \_ _ -> fn AssocL 10 + ApplyF fn xs -> \lr p -> maybeParens (not $ fixityCompatible (Infixity AssocL 10) lr p) $ P.nest 2 $ P.sep [ fn AssocL 10 , P.sep $ xs <&> \docprec -> docprec AssocR 10 ] + BinopF nm fx x y -> ppBinop nm fx x y TupleF xs -> \_ _ -> ppBulletList "(" "," ")" $ xs <&> \x -> x AssocNope (-1) ListF xs -> \_ _ -> ppBulletList "[" "," "]" $ xs <&> \x -> x AssocNope (-1) + LambdaCaseF xs -> \_ p -> maybeParens (p >= 10) $ P.nest 2 $ P.sep @@ -509,28 +662,32 @@ | (pat, val) <- xs ] ] + RecordF con sels -> \_ _ -> case sels of [] -> con AssocNope (-1) _ -> P.nest 2 $ P.sep [ con AssocNope 10 , ppBulletList "{" "," "}" - [ P.nest 4 $ P.sep + [ P.nest 2 $ P.sep [ ppPrefix sel P.<+> P.annotate Structural "=" , val AssocNope 0 ] | FactorPortrayal sel val <- sels ] ] + TyAppF val ty -> \_ _ -> P.nest 2 $ P.sep [ val AssocNope 10 , P.annotate Structural "@" <> ty AssocNope 10 ] + TySigF val ty -> \_ p -> maybeParens (p >= 0) $ P.nest 2 $ P.sep [ val AssocNope 0 , P.annotate Structural "::" P.<+> ty AssocNope 0 ] + QuotF nm content -> \_ _ -> P.nest 2 $ P.sep [ P.annotate Structural "[" <> @@ -539,6 +696,7 @@ , content AssocNope (-1) , P.annotate Structural "|]" ] + UnlinesF ls -> \_ _ -> P.vcat (ls <&> \l -> l AssocNope (-1)) NestF n x -> \_ _ -> P.nest n (x AssocNope (-1)) @@ -553,15 +711,27 @@ -- | Convenience function for rendering a 'Portrayal' to colorized 'Text'. prettyShowPortrayal :: Portrayal -> Text prettyShowPortrayal = - styleShowPortrayal - (defaultConfig & setShouldEscapeChar escapeSpecialOnly) - defaultStyling + styleShowPortrayal prettyConfig defaultStyling +-- | A lazy 'TL.Text' variant of 'prettyShowPortrayal'. +-- +-- @since 0.2.1 +prettyShowPortrayalLazy :: Portrayal -> TL.Text +prettyShowPortrayalLazy = + styleShowPortrayalLazy prettyConfig defaultStyling + -- | Convenience function for rendering a 'Portrayal' to stylized 'Text'. styleShowPortrayal :: Config -> (SyntaxClass -> Maybe A.AnsiStyle) -> Portrayal -> Text -styleShowPortrayal cfg style p = - A.renderStrict $ P.alterAnnotationsS style $ +styleShowPortrayal cfg style = TL.toStrict . styleShowPortrayalLazy cfg style + +-- | A lazy 'TL.Text' variant of 'styleShowPortrayal'. +-- +-- @since 0.2.1 +styleShowPortrayalLazy + :: Config -> (SyntaxClass -> Maybe A.AnsiStyle) -> Portrayal -> TL.Text +styleShowPortrayalLazy cfg style p = + A.renderLazy $ P.alterAnnotationsS style $ P.layoutPretty P.defaultLayoutOptions $ toDocAssocPrec cfg p AssocNope (-1) diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,4 +1,5 @@ -- Copyright 2021 Google LLC +-- Copyright 2022 Andrew Pritchard -- -- Licensed under the Apache License, Version 2.0 (the "License"); -- you may not use this file except in compliance with the License. @@ -12,6 +13,7 @@ -- See the License for the specific language governing permissions and -- limitations under the License. +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingVia #-} @@ -21,14 +23,21 @@ module Main where +import Data.Fixed (Fixed, E3) import Data.Function ((&)) import Data.Text (Text) import qualified Data.Text as T import GHC.Read (readLitChar) import GHC.Show (showLitChar) -import qualified Prettyprinter as P -import qualified Prettyprinter.Render.Text as R +#if MIN_VERSION_prettyprinter(1, 7, 0) +#define Prettyprinter_ Prettyprinter +#else +#define Prettyprinter_ Data.Text.Prettyprint.Doc +#endif + +import qualified Prettyprinter_ as P +import qualified Prettyprinter_.Render.Text as R import Test.Framework (defaultMain, testGroup) import Test.Framework.Providers.HUnit (testCase) import Test.Framework.Providers.QuickCheck2 (testProperty) @@ -69,13 +78,93 @@ propCharRoundTrips :: Config -> Char -> Property propCharRoundTrips cfg c = c === read (T.unpack $ showPortrayalCfg cfg c) +altShowPortrayal :: Portrayal -> Text +altShowPortrayal = + styleShowPortrayal + (prettyConfig & setTrimTrailingFloatZeros True) + (const mempty) + main :: IO () main = defaultMain - [ testGroup "Atom" - [ testCase "()" $ basicShowPortrayal (Tuple []) @?= "()" - , testCase "2" $ basicShowPortrayal (LitInt 2) @?= "2" + [ testGroup "LitInt" + [ testCase "2" $ basicShowPortrayal (LitInt 2) @?= "2" + , testCase "1000" $ basicShowPortrayal (LitInt 1000) @?= "1000" + + , testCase "0o123" $ + basicShowPortrayal (LitIntBase Octal 0o123) @?= "0o123" + + , testCase "0b10000000" $ + basicShowPortrayal (LitIntBase Binary 128) @?= "0b10000000" + + , testCase "0xdeadbeef" $ + basicShowPortrayal (LitIntBase Hex 0xdeadbeef) @?= + "0xdeadbeef" + + , testCase "2_" $ altShowPortrayal (LitInt 2) @?= "2" + , testCase "1_000" $ altShowPortrayal (LitInt 1000) @?= "1_000" + , testCase "1_000_000" $ altShowPortrayal (LitInt 1000000) @?= "1_000_000" + + , testCase "0o123456" $ + altShowPortrayal (LitIntBase Octal 0o123456) @?= "0o123456" + + , testCase "0b1_00001000" $ + altShowPortrayal (LitIntBase Binary 0x0108) @?= "0b1_00001000" + + , testCase "0xfeedface_deadbeef" $ + altShowPortrayal (LitIntBase Hex 0xfeedfacedeadbeef) @?= + "0xfeedface_deadbeef" ] + , testGroup "LitFloat" + [ testCase "2" $ + basicShowPortrayal (LitFloat (floatToLiteral (2 :: Float))) @?= "2" + + , testCase "1e6" $ + basicShowPortrayal (LitFloat (floatToLiteral (1e6 :: Float))) @?= + "1e6" + + , testCase "1.02e-4" $ + basicShowPortrayal (LitFloat (floatToLiteral (1.02e-4 :: Float))) @?= + "1.02e-4" + + , testCase "5/3" $ + basicShowPortrayal (LitFloat (floatToLiteral (5/3 :: Float))) @?= + "1.6666666" + + , testCase "2.000" $ + basicShowPortrayal (LitFloat (fixedToLiteral (2 :: Fixed E3))) @?= + "2.000" + + , testCase "2000.000" $ + basicShowPortrayal (LitFloat (fixedToLiteral (2000 :: Fixed E3))) @?= + "2000.000" + + , testCase "5/3 :: Double" $ + basicShowPortrayal (LitFloat (floatToLiteral (5/3 :: Double))) @?= + "1.6666666666666667" + + , testCase "5000/3" $ + basicShowPortrayal (LitFloat (floatToLiteral (5000/3 :: Float))) @?= + "1666.6666" + + , testCase "5_000/3" $ + altShowPortrayal (LitFloat (floatToLiteral (5000/3 :: Float))) @?= + "1_666.6666" + + , testCase "2 :: Fixed E3" $ + altShowPortrayal (LitFloat (fixedToLiteral (2 :: Fixed E3))) @?= "2" + + , testCase "2e3 :: Fixed E3" $ + altShowPortrayal (LitFloat (fixedToLiteral (2000 :: Fixed E3))) @?= + "2e3" + + , testCase "NaN" $ basicShowPortrayal (SpecialFloat NaN) @?= "NaN" + , testCase "Infinity" $ + basicShowPortrayal (SpecialFloat $ Infinity False) @?= "Infinity" + , testCase "-Infinity" $ + basicShowPortrayal (SpecialFloat $ Infinity True) @?= "-Infinity" + ] + , testGroup "Apply" [ testCase "nullary" $ basicShowPortrayal (Apply (Name "Nothing") []) @?= "Nothing" @@ -151,7 +240,8 @@ ] , testGroup "Tuple" - [ testCase "pair" $ + [ testCase "nullary" $ basicShowPortrayal (Tuple []) @?= "()" + , testCase "pair" $ basicShowPortrayal (Tuple [LitInt 2, LitInt 4]) @?= "(2, 4)" , testCase "triple" $ basicShowPortrayal (Tuple [LitInt 2, LitInt 4, LitInt 6]) @?= @@ -159,9 +249,9 @@ , testCase "line-break" $ basicShowPortrayal (Tuple [strAtom "222", strAtom (replicate 80 '2')]) @?= - "( 222\n\ - \, 2222222222222222222222222222222222222222222222222222222222222\ - \2222222222222222222\n\ + "( 222\n\\ + \, 2222222222222222222222222222222222222222222222222222222222222\\ + \2222222222222222222\n\\ \)" ] @@ -169,6 +259,14 @@ [ testCase "empty" $ basicShowPortrayal (List []) @?= "[]" , testCase "singleton" $ basicShowPortrayal (List [LitInt 2]) @?= "[2]" + , testCase "nested" $ + basicShowPortrayal + (portray [[1..25 :: Int]]) @?= + "[ [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17\\ + \, 18, 19, 20, 21\n\\ + \ , 22, 23, 24, 25\n\\ + \ ]\n\\ + \]" ] , testGroup "LambdaCase" @@ -187,9 +285,9 @@ [ (Name "True", strAtom (replicate 40 '2')) , (Name "False", strAtom (replicate 40 '4')) ]) @?= - "\\case\n\ - \ { True -> 2222222222222222222222222222222222222222\n\ - \ ; False -> 4444444444444444444444444444444444444444\n\ + "\\case\n\\ + \ { True -> 2222222222222222222222222222222222222222\n\\ + \ ; False -> 4444444444444444444444444444444444444444\n\\ \ }" , testCase "no-parens" $ basicShowPortrayal @@ -222,9 +320,9 @@ [ FactorPortrayal "l" (portray @[Int] [0..10]) , FactorPortrayal "r" (portray @[Int] [0..10]) ]) @?= - "These\n\ - \ { l = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10]\n\ - \ , r = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10]\n\ + "These\n\\ + \ { l = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10]\n\\ + \ , r = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10]\n\\ \ }" , testCase "break-equals" $ basicShowPortrayal @@ -233,9 +331,9 @@ "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" (Name "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa") ]) @?= - "These\n\ - \ { aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa =\n\ - \ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n\ + "These\n\\ + \ { aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa =\n\\ + \ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n\\ \ }" ] @@ -252,7 +350,7 @@ (TyApp (strAtom $ replicate 50 'a') (strAtom $ replicate 50 'a')) @?= - "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n\ + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n\\ \ @aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" ] @@ -270,7 +368,7 @@ (TySig (strAtom $ replicate 50 'a') (strAtom $ replicate 50 'a')) @?= - "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n\ + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n\\ \ :: aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" , testCase "parens" $ basicShowPortrayal