text-show 0.2.0.0 → 0.3.0.0
raw patch · 56 files changed
+5486/−550 lines, 56 filesdep +bytestringdep +ghc-primdep +tastydep ~arraydep ~basedep ~containers
Dependencies added: bytestring, ghc-prim, tasty, tasty-quickcheck, template-haskell, time
Dependency ranges changed: array, base, containers, quickcheck-instances, text-show
Files
- CHANGELOG.md +7/−0
- README.md +1/−1
- src/Text/Show/Text.hs +16/−475
- src/Text/Show/Text/Class.hs +136/−0
- src/Text/Show/Text/Control.hs +17/−0
- src/Text/Show/Text/Control/Applicative.hs +38/−0
- src/Text/Show/Text/Control/Concurrent.hs +65/−0
- src/Text/Show/Text/Control/Exception.hs +240/−0
- src/Text/Show/Text/Control/Monad/ST.hs +28/−0
- src/Text/Show/Text/Data.hs +38/−0
- src/Text/Show/Text/Data/Array.hs +40/−0
- src/Text/Show/Text/Data/Bool.hs +30/−0
- src/Text/Show/Text/Data/ByteString.hs +99/−0
- src/Text/Show/Text/Data/Char.hs +122/−0
- src/Text/Show/Text/Data/Containers.hs +110/−0
- src/Text/Show/Text/Data/Data.hs +96/−0
- src/Text/Show/Text/Data/Dynamic.hs +32/−0
- src/Text/Show/Text/Data/Either.hs +33/−0
- src/Text/Show/Text/Data/Fixed.hs +81/−0
- src/Text/Show/Text/Data/Floating.hs +370/−0
- src/Text/Show/Text/Data/Integral.hs +221/−0
- src/Text/Show/Text/Data/List.hs +27/−0
- src/Text/Show/Text/Data/Maybe.hs +33/−0
- src/Text/Show/Text/Data/Monoid.hs +119/−0
- src/Text/Show/Text/Data/Ord.hs +52/−0
- src/Text/Show/Text/Data/Text.hs +49/−0
- src/Text/Show/Text/Data/Time.hs +111/−0
- src/Text/Show/Text/Data/Tuple.hs +333/−0
- src/Text/Show/Text/Data/Type/Coercion.hs +30/−0
- src/Text/Show/Text/Data/Type/Equality.hs +30/−0
- src/Text/Show/Text/Data/Typeable.hs +148/−0
- src/Text/Show/Text/Data/Version.hs +55/−0
- src/Text/Show/Text/Foreign.hs +15/−0
- src/Text/Show/Text/Foreign/C/Types.hs +202/−0
- src/Text/Show/Text/Foreign/Ptr.hs +89/−0
- src/Text/Show/Text/Functions.hs +27/−0
- src/Text/Show/Text/GHC.hs +21/−0
- src/Text/Show/Text/GHC/Event.hs +41/−0
- src/Text/Show/Text/GHC/Generics.hs +156/−0
- src/Text/Show/Text/GHC/Stats.hs +77/−0
- src/Text/Show/Text/Instances.hs +19/−0
- src/Text/Show/Text/System.hs +16/−0
- src/Text/Show/Text/System/Exit.hs +37/−0
- src/Text/Show/Text/System/IO.hs +176/−0
- src/Text/Show/Text/System/Posix/Types.hs +124/−0
- src/Text/Show/Text/TH.hs +204/−0
- src/Text/Show/Text/Text.hs +14/−0
- src/Text/Show/Text/Text/Read.hs +71/−0
- src/Text/Show/Text/Utils.hs +66/−0
- tests/Instances/BaseAndFriends.hs +507/−0
- tests/Instances/Derived.hs +171/−0
- tests/Properties.hs +19/−57
- tests/Properties/BaseAndFriends.hs +411/−0
- tests/Properties/Derived.hs +66/−0
- tests/Properties/Utils.hs +28/−0
- text-show.cabal +122/−17
CHANGELOG.md view
@@ -1,3 +1,10 @@+# 0.3.0.0+* Lots of bugfixes+* Show instances for many other data types in `base`, `containers` and `time`+* Expose internal modules with monomorphic functions+* `Text.Show.Text` now exports `Data.Text.Lazy.Builder` for convenience+* Add `showLazy`, `showPrec`, `showPrecLazy`, `printLazy`, `hPrint`, `hPrintLazy`, `lengthB`, and `replicateB`+ # 0.2.0.0 * Add `Show` instances for strict and lazy `Text`
README.md view
@@ -1,3 +1,3 @@-# `text-show` [](https://travis-ci.org/RyanGlScott/text-show)+# `text-show` [](http://hackage.haskell.org/package/text-show) [](https://travis-ci.org/RyanGlScott/text-show) Efficient conversion of values into [`Text`](https://github.com/bos/text), in the spirit of [`bytestring-show`](http://hackage.haskell.org/package/bytestring-show).
src/Text/Show/Text.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-} ----------------------------------------------------------------------------- -- | -- Module : Text.Show.Text@@ -14,486 +14,27 @@ -- * The 'Show' class Show (..) , show- -- * 'Builder' construction+ , showLazy+ , showPrec+ , showPrecLazy , showbParen- , showbLitChar+ -- * 'Builder's+ , module Data.Text.Lazy.Builder+ , lengthB+ , replicateB , unlinesB , unwordsB -- * Printing values , print+ , printLazy+ , hPrint+ , hPrintLazy ) where -import Data.Array (Array, (!), assocs, bounds, listArray)-import Data.Char (ord)-import Data.Int (Int8, Int16, Int32, Int64)-import Data.Ix (Ix)-import Data.Complex (Complex(..))-import qualified Data.Map as M-import Data.Map (Map)-import Data.Monoid (Monoid(mempty), (<>))-import Data.Ratio (Ratio, numerator, denominator)-import qualified Data.Set as S-import Data.Set (Set)-import Data.Text (Text)-import Data.Text.Buildable (build)-import Data.Text.IO (putStrLn)-import qualified Data.Text.Lazy as LT-import Data.Text.Lazy (toStrict)-import Data.Text.Lazy.Builder (Builder, singleton, toLazyText)-import Data.Text.Lazy.Builder.RealFloat (realFloat)-import Data.Word (Word, Word8, Word16, Word32, Word64)--import Foreign.Ptr (Ptr, IntPtr, WordPtr)--import Prelude hiding (Show(..), print, putStrLn)---- | Conversion of values to 'Text'.-class Show a where- -- |- -- Constructs a 'Text' via an efficient 'Builder'. The precedence is used to - -- determine where to put parentheses in a shown expression involving operators.- -- - -- 'Builder's can be efficiently combined, so the @showb@ functions are available- -- for showing multiple values before producing an output 'Text'.- showbPrec :: Int -> a -> Builder- - -- |- -- Constructs a 'Text' via an efficient 'Builder'. 'Builder's can be efficiently- -- combined, so this is available building a 'Text' from multiple values.- showb :: a -> Builder- - -- |- -- Allows for specialized display of lists. This is used, for example, when- -- showing lists of 'Char's.- showbList :: [a] -> Builder- - showbPrec _ = showb- - showb = showbPrec 0- - showbList [] = "[]"- showbList (x:xs) = s '[' <> showb x <> go xs -- "[..- where- go (y:ys) = s ',' <> showb y <> go ys -- ..,..- go [] = s ']' -- ..]"- {-# MINIMAL showbPrec | showb #-}---- | Constructs a 'Text' from a single value.-show :: Show a => a -> Text-show = toStrict . toLazyText . showb-{-# INLINE show #-}---- | Surrounds 'Builder' output with parentheses if the 'Bool' parameter is 'True'.-showbParen :: Bool -> Builder -> Builder-showbParen p builder | p = s '(' <> builder <> s ')'- | otherwise = builder-{-# INLINE showbParen #-}---- | Prints a value's 'Text' representation to the standard output.-print :: Show a => a -> IO ()-print = putStrLn . show-{-# INLINE print #-}---- | Merges several 'Builder's, separating them by newlines.-unlinesB :: [Builder] -> Builder-unlinesB (b:bs) = b <> s '\n' <> unlinesB bs-unlinesB [] = mempty---- | Merges several 'Builder's, separating them by spaces.-unwordsB :: [Builder] -> Builder-unwordsB (b:bs@(_:_)) = b <> s ' ' <> unwordsB bs-unwordsB [b] = b-unwordsB [] = mempty---- | A table of ASCII control characters that needs to be escaped with a backslash.-asciiTabB :: Array Int Builder-asciiTabB = listArray (0, 32) ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",- "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI",- "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",- "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US",- "SP"]---- | Constructs a 'Builder' with one character (without single quotes).-showbLitChar :: Char -> Builder-showbLitChar c | c > '\DEL' = s '\\' <> showb (ord c)-showbLitChar '\DEL' = "\\DEL"-showbLitChar '\\' = "\\\\"-showbLitChar c | c >= ' ' = s c-showbLitChar '\a' = "\\a"-showbLitChar '\b' = "\\b"-showbLitChar '\f' = "\\f"-showbLitChar '\n' = "\\n"-showbLitChar '\r' = "\\r"-showbLitChar '\t' = "\\t"-showbLitChar '\v' = "\\v"-showbLitChar '\SO' = "\\S0"-showbLitChar c = s '\\' <> (asciiTabB ! ord c)-{-# INLINE showbLitChar #-}---- |--- A shorter name for 'singleton' for convenience's sake (since it tends to be used--- pretty often in @text-show@).-s :: Char -> Builder-s = singleton-{-# INLINE s #-}--instance Show Builder where- showb = id--instance Show () where- showb () = "()"--instance Show Char where- showb '\'' = "'\\''"- showb c = s '\'' <> showbLitChar c <> s '\''- {-# INLINE showb #-}- - showbList = build- {-# INLINE showbList #-}---- Strict variant-instance Show Text where- showb = build- {-# INLINE showb #-}--instance Show LT.Text where- showb = build- {-# INLINE showb #-}--instance Show Bool where- showb True = "True"- showb False = "False"--instance Show a => Show [a] where- showb = showbList- {-# INLINE showb #-}--instance Show Int where- showb = build- {-# INLINE showb #-}- - showbPrec k i = showbParen (i < 0 && k > 0) $ build i- {-# INLINE showbPrec #-}--instance Show Int8 where- showb = build- {-# INLINE showb #-}- - showbPrec k i = showbParen (i < 0 && k > 0) $ build i- {-# INLINE showbPrec #-}--instance Show Int16 where- showb = build- {-# INLINE showb #-}- - showbPrec k i = showbParen (i < 0 && k > 0) $ build i- {-# INLINE showbPrec #-}--instance Show Int32 where- showb = build- {-# INLINE showb #-}- - showbPrec k i = showbParen (i < 0 && k > 0) $ build i- {-# INLINE showbPrec #-}--instance Show Int64 where- showb = build- {-# INLINE showb #-}- - showbPrec k i = showbParen (i < 0 && k > 0) $ build i- {-# INLINE showbPrec #-}--instance Show Integer where- showb = build- {-# INLINE showb #-}- - showbPrec k i = showbParen (i < 0 && k > 0) $ build i- {-# INLINE showbPrec #-}--instance Show Word where- showb = build- {-# INLINE showb #-}--instance Show Word8 where- showb = build- {-# INLINE showb #-}--instance Show Word16 where- showb = build- {-# INLINE showb #-}--instance Show Word32 where- showb = build- {-# INLINE showb #-}--instance Show Word64 where- showb = build- {-# INLINE showb #-}--instance Show Float where- showb = realFloat- {-# INLINE showb #-}- - showbPrec k f = showbParen (f < 0 && k > 0) $ realFloat f- {-# INLINE showbPrec #-}--instance Show Double where- showb = realFloat- {-# INLINE showb #-}- - showbPrec k f = showbParen (f < 0 && k > 0) $ realFloat f- {-# INLINE showbPrec #-}--instance (Show a, Integral a) => Show (Ratio a) where- {-# SPECIALIZE instance Show Rational #-}- showbPrec k q = showbParen (k > 7) $ showbPrec 8 (numerator q) <>- s '%' <> showb (denominator q)--instance (Show a, RealFloat a) => Show (Complex a) where- {-# SPECIALIZE instance Show (Complex Float) #-}- {-# SPECIALIZE instance Show (Complex Double) #-}- showbPrec k (a :+ b) = showbParen (k > 6) $ showbPrec 7 a <> " :+ " <> showbPrec 7 b--instance Show a => Show (Maybe a) where- showbPrec _ Nothing = "Nothing"- showbPrec k (Just a) = showbParen (k > 10) $ "Just " <> showbPrec 11 a- {-# INLINE showbPrec #-}--instance (Show a, Show b) => Show (Either a b) where- showbPrec k (Left a) = showbParen (k > 10) $ "Left " <> showbPrec 11 a- showbPrec k (Right b) = showbParen (k > 10) $ "Right " <> showbPrec 11 b--instance Show Ordering where- showb LT = "LT"- showb EQ = "EQ"- showb GT = "GT"--instance (Show a, Show b) => Show (a, b) where- showb (a, b) =- s '(' <> showb a <>- s ',' <> showb b <>- s ')'- {-# INLINE showb #-}--instance (Show a, Show b, Show c) => Show (a, b, c) where- showb (a, b, c) =- s '(' <> showb a <>- s ',' <> showb b <>- s ',' <> showb c <>- s ')'- {-# INLINE showb #-}--instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where- showb (a, b, c, d) =- s '(' <> showb a <>- s ',' <> showb b <>- s ',' <> showb c <>- s ',' <> showb d <>- s ')'- {-# INLINE showb #-}--instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where- showb (a, b, c, d, e) =- s '(' <> showb a <>- s ',' <> showb b <>- s ',' <> showb c <>- s ',' <> showb d <>- s ',' <> showb e <>- s ')'- {-# INLINE showb #-}--instance (Show a, Show b, Show c, Show d, Show e, Show f) => Show (a, b, c, d, e, f) where- showb (a, b, c, d, e, f) =- s '(' <> showb a <>- s ',' <> showb b <>- s ',' <> showb c <>- s ',' <> showb d <>- s ',' <> showb e <>- s ',' <> showb f <>- s ')'- {-# INLINE showb #-}--instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g) =>- Show (a, b, c, d, e, f, g) where- showb (a, b, c, d, e, f, g) =- s '(' <> showb a <>- s ',' <> showb b <>- s ',' <> showb c <>- s ',' <> showb d <>- s ',' <> showb e <>- s ',' <> showb f <>- s ',' <> showb g <>- s ')'- {-# INLINE showb #-}--instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h) =>- Show (a, b, c, d, e, f, g, h) where- showb (a, b, c, d, e, f, g, h) =- s '(' <> showb a <>- s ',' <> showb b <>- s ',' <> showb c <>- s ',' <> showb d <>- s ',' <> showb e <>- s ',' <> showb f <>- s ',' <> showb g <>- s ',' <> showb h <>- s ')'- {-# INLINE showb #-}--instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i) =>- Show (a, b, c, d, e, f, g, h, i) where- showb (a, b, c, d, e, f, g, h, i) =- s '(' <> showb a <>- s ',' <> showb b <>- s ',' <> showb c <>- s ',' <> showb d <>- s ',' <> showb e <>- s ',' <> showb f <>- s ',' <> showb g <>- s ',' <> showb h <>- s ',' <> showb i <>- s ')'- {-# INLINE showb #-}--instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j) =>- Show (a, b, c, d, e, f, g, h, i, j) where- showb (a, b, c, d, e, f, g, h, i, j) =- s '(' <> showb a <>- s ',' <> showb b <>- s ',' <> showb c <>- s ',' <> showb d <>- s ',' <> showb e <>- s ',' <> showb f <>- s ',' <> showb g <>- s ',' <> showb h <>- s ',' <> showb i <>- s ',' <> showb j <>- s ')'- {-# INLINE showb #-}--instance (Show a, Show b, Show c, Show d, Show e, Show f,- Show g, Show h, Show i, Show j, Show k) =>- Show (a, b, c, d, e, f, g, h, i, j, k) where- showb (a, b, c, d, e, f, g, h, i, j, k) =- s '(' <> showb a <>- s ',' <> showb b <>- s ',' <> showb c <>- s ',' <> showb d <>- s ',' <> showb e <>- s ',' <> showb f <>- s ',' <> showb g <>- s ',' <> showb h <>- s ',' <> showb i <>- s ',' <> showb j <>- s ',' <> showb k <>- s ')'- {-# INLINE showb #-}--instance (Show a, Show b, Show c, Show d, Show e, Show f,- Show g, Show h, Show i, Show j, Show k, Show l) =>- Show (a, b, c, d, e, f, g, h, i, j, k, l) where- showb (a, b, c, d, e, f, g, h, i, j, k, l) =- s '(' <> showb a <>- s ',' <> showb b <>- s ',' <> showb c <>- s ',' <> showb d <>- s ',' <> showb e <>- s ',' <> showb f <>- s ',' <> showb g <>- s ',' <> showb h <>- s ',' <> showb i <>- s ',' <> showb j <>- s ',' <> showb k <>- s ',' <> showb l <>- s ')'- {-# INLINE showb #-}--instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g,- Show h, Show i, Show j, Show k, Show l, Show m) =>- Show (a, b, c, d, e, f, g, h, i, j, k, l, m) where- showb (a, b, c, d, e, f, g, h, i, j, k, l, m) =- s '(' <> showb a <>- s ',' <> showb b <>- s ',' <> showb c <>- s ',' <> showb d <>- s ',' <> showb e <>- s ',' <> showb f <>- s ',' <> showb g <>- s ',' <> showb h <>- s ',' <> showb i <>- s ',' <> showb j <>- s ',' <> showb k <>- s ',' <> showb l <>- s ',' <> showb m <>- s ')'- {-# INLINE showb #-}--instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g,- Show h, Show i, Show j, Show k, Show l, Show m, Show n) =>- Show (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where- showb (a, b, c, d, e, f, g, h, i, j, k, l, m, n) =- s '(' <> showb a <>- s ',' <> showb b <>- s ',' <> showb c <>- s ',' <> showb d <>- s ',' <> showb e <>- s ',' <> showb f <>- s ',' <> showb g <>- s ',' <> showb h <>- s ',' <> showb i <>- s ',' <> showb j <>- s ',' <> showb k <>- s ',' <> showb l <>- s ',' <> showb m <>- s ',' <> showb n <>- s ')'- {-# INLINE showb #-}--instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h,- Show i, Show j, Show k, Show l, Show m, Show n, Show o) =>- Show (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where- showb (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) =- s '(' <> showb a <>- s ',' <> showb b <>- s ',' <> showb c <>- s ',' <> showb d <>- s ',' <> showb e <>- s ',' <> showb f <>- s ',' <> showb g <>- s ',' <> showb h <>- s ',' <> showb i <>- s ',' <> showb j <>- s ',' <> showb k <>- s ',' <> showb l <>- s ',' <> showb m <>- s ',' <> showb n <>- s ',' <> showb o <>- s ')'- {-# INLINE showb #-}--instance (Show i, Show e, Ix i) => Show (Array i e) where- showbPrec k a = showbParen (k > 10) $ "array " <>- showb (bounds a) <> s ' ' <> showb (assocs a)- {-# INLINE showb #-}--instance (Show k, Show v) => Show (Map k v) where- showbPrec k m = showbParen (k > 10) $ "fromList " <>- showb (M.toList m)- {-# INLINE showb #-}--instance Show e => Show (Set e) where- showbPrec k set = showbParen (k > 10) $ "fromList " <>- showb (S.toList set)- {-# INLINE showb #-}--instance Show IntPtr where- showb = build- {-# INLINE showb #-}+import Data.Text.Lazy.Builder -instance Show WordPtr where- showb = build- {-# INLINE showb #-}+import Prelude hiding (Show(show), print) -instance Show (Ptr a) where- showb = build- {-# INLINE showb #-}+import Text.Show.Text.Class+import Text.Show.Text.Instances ()+import Text.Show.Text.Utils (lengthB, replicateB, unlinesB, unwordsB)
+ src/Text/Show/Text/Class.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE CPP, NoImplicitPrelude, OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Class+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- The 'Show' type class.+----------------------------------------------------------------------------+module Text.Show.Text.Class where++import Data.Text as TS (Text)+import qualified Data.Text.IO as TS (putStrLn, hPutStrLn)+import qualified Data.Text.Lazy as TL (Text)+import qualified Data.Text.Lazy.IO as TL (putStrLn, hPutStrLn)+import Data.Text.Lazy (toStrict)+import Data.Text.Lazy.Builder (Builder, toLazyText)++import Prelude hiding (Show(show))++import System.IO (Handle)++import Text.Show.Text.Utils ((<>), s)++-- | +-- Conversion of values to 'Text'. Because there are both strict and lazy 'Text'+-- variants, the 'Show' class deliberately avoids using 'Text' in its functions.+-- Instead, 'showbPrec', 'showb', and 'showbList' all return 'Builder's, an+-- efficient intermediate form that can be converted to either kind of 'Text'.+-- +-- 'Builder' is a 'Monoid', so it is useful to use the 'mappend' (or '<>') function+-- to combine 'Builder's when deriving 'Show' instances. As an example:+-- +-- @+-- import Text.Show.Text+-- +-- data Example = Example Int Int+-- instance Show Example where+-- showb (Example i1 i2) = showb i1 <> singleton ' ' <> showb i2+-- @+-- +-- If you do not want to derive 'Show' instances manually, you can alternatively+-- use the "Text.Show.Text.TH" module to automatically generate default 'Show'+-- instances using Template Haskell.+class Show a where+ -- |+ -- Constructs a 'Text' via an efficient 'Builder'. The precedence is used to + -- determine where to put parentheses in a shown expression involving operators.+ -- + -- 'Builder's can be efficiently combined, so the @showb@ functions are available+ -- for showing multiple values before producing an output 'Text'.+ showbPrec :: Int -> a -> Builder+ + -- |+ -- Constructs a 'Text' via an efficient 'Builder'. 'Builder's can be efficiently+ -- combined, so this is available building a 'Text' from multiple values.+ showb :: a -> Builder+ + -- |+ -- Allows for specialized display of lists. This is used, for example, when+ -- showing lists of 'Char's.+ showbList :: [a] -> Builder+ + showbPrec _ = showb+ + showb = showbPrec 0+ + showbList = showbListDefault+#if __GLASGOW_HASKELL__ >= 708+ {-# MINIMAL showbPrec | showb #-}+#endif++-- | Constructs a strict 'Text' from a single value.+show :: Show a => a -> TS.Text+show = toStrict . showLazy+{-# INLINE show #-}++-- | Constructs a lazy 'Text' from a single value.+showLazy :: Show a => a -> TL.Text+showLazy = toLazyText . showb+{-# INLINE showLazy #-}++-- | Constructs a strict 'Text' from a single value with the given precedence.+showPrec :: Show a => Int -> a -> TS.Text+showPrec p = toStrict . showPrecLazy p+{-# INLINE showPrec #-}++-- | Constructs a lazy 'Text' from a single value with the given precedence.+showPrecLazy :: Show a => Int -> a -> TL.Text+showPrecLazy p = toLazyText . showbPrec p+{-# INLINE showPrecLazy #-}++-- |+-- Converts a list of 'Show' values into a 'Builder' in which the values are surrounded+-- by square brackets and each value is separated by a comma. This is the default+-- implementation of 'showbList' save for a few special cases (e.g., 'String').+showbListDefault :: Show a => [a] -> Builder+showbListDefault [] = "[]"+showbListDefault (x:xs) = s '[' <> showb x <> go xs -- "[..+ where+ go (y:ys) = s ',' <> showb y <> go ys -- ..,..+ go [] = s ']' -- ..]"+{-# INLINE showbListDefault #-}++-- | Surrounds 'Builder' output with parentheses if the 'Bool' parameter is 'True'.+showbParen :: Bool -> Builder -> Builder+showbParen p builder | p = s '(' <> builder <> s ')'+ | otherwise = builder+{-# INLINE showbParen #-}++-- | Writes a value's strict 'Text' representation to the standard output, followed+-- by a newline.+print :: Show a => a -> IO ()+print = TS.putStrLn . show+{-# INLINE print #-}++-- | Writes a value's lazy 'Text' representation to the standard output, followed+-- by a newline.+printLazy :: Show a => a -> IO ()+printLazy = TL.putStrLn . showLazy+{-# INLINE printLazy #-}++-- | Writes a value's strict 'Text' representation to a file handle, followed+-- by a newline.+hPrint :: Show a => Handle -> a -> IO ()+hPrint h = TS.hPutStrLn h . show+{-# INLINE hPrint #-}++-- | Writes a value's lazy 'Text' representation to a file handle, followed+-- by a newline.+hPrintLazy :: Show a => Handle -> a -> IO ()+hPrintLazy h = TL.hPutStrLn h . showLazy+{-# INLINE hPrintLazy #-}
+ src/Text/Show/Text/Control.hs view
@@ -0,0 +1,17 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Control+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Imports 'Show' instances for @Control@ modules.+----------------------------------------------------------------------------+module Text.Show.Text.Control () where ++import Text.Show.Text.Control.Applicative ()+import Text.Show.Text.Control.Concurrent ()+import Text.Show.Text.Control.Exception ()+import Text.Show.Text.Control.Monad.ST ()
+ src/Text/Show/Text/Control/Applicative.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Control.Applicative+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' function for 'ZipList'.+----------------------------------------------------------------------------+module Text.Show.Text.Control.Applicative (showbZipListPrec) where++import Control.Applicative (ZipList(..))++import Data.Text.Lazy.Builder (Builder)++import GHC.Show (appPrec)++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showb, showbPrec), showbParen)+import Text.Show.Text.Data.List ()+import Text.Show.Text.Utils ((<>), s)++-- | Convert a 'ZipList' to a 'Builder' with the given precedence.+showbZipListPrec :: Show a => Int -> ZipList a -> Builder+showbZipListPrec p (ZipList zl) = showbParen (p > appPrec) $+ "ZipList {getZipList = "+ <> showb zl+ <> s '}'+{-# INLINE showbZipListPrec #-}++instance Show a => Show (ZipList a) where+ showbPrec = showbZipListPrec+ {-# INLINE showbPrec #-}
+ src/Text/Show/Text/Control/Concurrent.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Control.Concurrent+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' functions for concurrency-related data types.+----------------------------------------------------------------------------+module Text.Show.Text.Control.Concurrent (+ showbThreadIdPrec+ , showbThreadStatusPrec+ , showbBlockReason+ ) where++import Data.Text.Lazy.Builder (Builder, fromString)++import GHC.Conc (BlockReason(..), ThreadId, ThreadStatus(..))+import GHC.Show (appPrec)++import qualified Prelude as P+import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showb, showbPrec), showbParen)+import Text.Show.Text.Utils ((<>))++-- | Convert a 'ThreadId' to a 'Builder' with the given precedence.+showbThreadIdPrec :: Int -> ThreadId -> Builder+showbThreadIdPrec p ti = fromString $ P.showsPrec p ti ""+{-# INLINE showbThreadIdPrec #-}++-- | Convert a 'ThreadStatus' to a 'Builder' with the given precedence.+showbThreadStatusPrec :: Int -> ThreadStatus -> Builder+showbThreadStatusPrec _ ThreadRunning = "ThreadRunning"+showbThreadStatusPrec _ ThreadFinished = "ThreadFinished"+showbThreadStatusPrec p (ThreadBlocked br)+ = showbParen (p > appPrec) $ "ThreadBlocked " <> showbBlockReason br+showbThreadStatusPrec _ ThreadDied = "ThreadDied"+{-# INLINE showbThreadStatusPrec #-}++-- | Convert a 'BlockReason' to a 'Builder'.+showbBlockReason :: BlockReason -> Builder+showbBlockReason BlockedOnMVar = "BlockedOnMVar"+showbBlockReason BlockedOnBlackHole = "BlockedOnBlackHole"+showbBlockReason BlockedOnException = "BlockedOnException"+showbBlockReason BlockedOnSTM = "BlockedOnSTM"+showbBlockReason BlockedOnForeignCall = "BlockedOnForeignCall"+showbBlockReason BlockedOnOther = "BlockedOnOther"+{-# INLINE showbBlockReason #-}++instance Show ThreadId where+ showbPrec = showbThreadIdPrec+ {-# INLINE showbPrec #-}++instance Show ThreadStatus where+ showbPrec = showbThreadStatusPrec+ {-# INLINE showbPrec #-}++instance Show BlockReason where+ showb = showbBlockReason+ {-# INLINE showb #-}
+ src/Text/Show/Text/Control/Exception.hs view
@@ -0,0 +1,240 @@+{-# LANGUAGE CPP, NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Data.Monoid+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' functions for 'Exception's.+----------------------------------------------------------------------------+module Text.Show.Text.Control.Exception (+ showbSomeExceptionPrec+ , showbIOException+ , showbArithException+ , showbArrayException+ , showbAssertionFailed+#if MIN_VERSION_base(4,7,0)+ , showbSomeAsyncException+#endif+ , showbAsyncException+ , showbNonTermination+ , showbNestedAtomically+ , showbBlockedIndefinitelyOnMVar+ , showbBlockedIndefinitelyOnSTM+ , showbDeadlock+ , showbNoMethodError+ , showbPatternMatchFail+ , showbRecConError+ , showbRecSelError+ , showbRecUpdError+ , showbErrorCall+ ) where++import Control.Exception.Base++import Data.Monoid (mempty)+import Data.Text.Lazy.Builder (Builder, fromString)++import qualified Prelude as P+import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showb, showbPrec))+import Text.Show.Text.Utils ((<>))++-- | Convert a 'SomeException' value to a 'Builder' with the given precedence.+showbSomeExceptionPrec :: Int -> SomeException -> Builder+showbSomeExceptionPrec p (SomeException e) = fromString $ P.showsPrec p e ""+{-# INLINE showbSomeExceptionPrec #-}++-- | Convert an 'IOException' to a 'Builder'.+showbIOException :: IOException -> Builder+showbIOException = fromString . show+{-# INLINE showbIOException #-}++-- | Convert an 'ArithException' to a 'Builder'.+showbArithException :: ArithException -> Builder+showbArithException Overflow = "arithmetic overflow"+showbArithException Underflow = "arithmetic underflow"+showbArithException LossOfPrecision = "loss of precision"+showbArithException DivideByZero = "divide by zero"+showbArithException Denormal = "denormal"+#if MIN_VERSION_base(4,6,0)+showbArithException RatioZeroDenominator = "Ratio has zero denominator"+#endif+{-# INLINE showbArithException #-}++-- | Convert an 'ArrayException' to a 'Builder'.+showbArrayException :: ArrayException -> Builder+showbArrayException (IndexOutOfBounds s)+ = "array index out of range"+ <> (if not $ null s then ": " <> fromString s+ else mempty)+showbArrayException (UndefinedElement s)+ = "undefined array element"+ <> (if not $ null s then ": " <> fromString s+ else mempty)+{-# INLINE showbArrayException #-}++-- | Convert an 'AssertionFailed' exception to a 'Builder'.+showbAssertionFailed :: AssertionFailed -> Builder+showbAssertionFailed (AssertionFailed err) = fromString err+{-# INLINE showbAssertionFailed #-}++#if MIN_VERSION_base(4,7,0)+-- | Convert a 'SomeAsyncException' value to a 'Builder'.+showbSomeAsyncException :: SomeAsyncException -> Builder+showbSomeAsyncException (SomeAsyncException e) = fromString $ P.show e+{-# INLINE showbSomeAsyncException #-}+#endif++-- | Convert an 'AsyncException' to a 'Builder'.+showbAsyncException :: AsyncException -> Builder+showbAsyncException StackOverflow = "stack overflow"+showbAsyncException HeapOverflow = "heap overflow"+showbAsyncException ThreadKilled = "thread killed"+showbAsyncException UserInterrupt = "user interrupt"+{-# INLINE showbAsyncException #-}++-- | Convert a 'NonTermination' exception to a 'Builder'.+showbNonTermination :: NonTermination -> Builder+showbNonTermination NonTermination = "<<loop>>"+{-# INLINE showbNonTermination #-}++-- | Convert a 'NestedAtomically' exception to a 'Builder'.+showbNestedAtomically :: NestedAtomically -> Builder+showbNestedAtomically NestedAtomically = "Control.Concurrent.STM.atomically was nested"+{-# INLINE showbNestedAtomically #-}++-- | Convert a 'BlockedIndefinitelyOnMVar' exception to a 'Builder'.+showbBlockedIndefinitelyOnMVar :: BlockedIndefinitelyOnMVar -> Builder+showbBlockedIndefinitelyOnMVar BlockedIndefinitelyOnMVar = "thread blocked indefinitely in an MVar operation"+{-# INLINE showbBlockedIndefinitelyOnMVar #-}++-- | Convert a 'BlockedIndefinitelyOnSTM' exception to a 'Builder'.+showbBlockedIndefinitelyOnSTM :: BlockedIndefinitelyOnSTM -> Builder+showbBlockedIndefinitelyOnSTM BlockedIndefinitelyOnSTM = "thread blocked indefinitely in an STM transaction"+{-# INLINE showbBlockedIndefinitelyOnSTM #-}++-- | Convert a 'Deadlock' exception to a 'Builder'.+showbDeadlock :: Deadlock -> Builder+showbDeadlock Deadlock = "<<deadlock>>"+{-# INLINE showbDeadlock #-}++-- | Convert a 'NoMethodError' to a 'Builder'.+showbNoMethodError :: NoMethodError -> Builder+showbNoMethodError (NoMethodError err) = fromString err+{-# INLINE showbNoMethodError #-}++-- | Convert a 'PatternMatchFail' to a 'Builder'.+showbPatternMatchFail :: PatternMatchFail -> Builder+showbPatternMatchFail (PatternMatchFail err) = fromString err+{-# INLINE showbPatternMatchFail #-}++-- | Convert a 'RecConError' to a 'Builder'.+showbRecConError :: RecConError -> Builder+showbRecConError (RecConError err) = fromString err+{-# INLINE showbRecConError #-}++-- | Convert a 'RecSelError' to a 'Builder'.+showbRecSelError :: RecSelError -> Builder+showbRecSelError (RecSelError err) = fromString err+{-# INLINE showbRecSelError #-}++-- | Convert a 'RecUpdError' to a 'Builder'.+showbRecUpdError :: RecUpdError -> Builder+showbRecUpdError (RecUpdError err) = fromString err+{-# INLINE showbRecUpdError #-}++-- | Convert an 'ErrorCall' to a 'Builder'.+showbErrorCall :: ErrorCall -> Builder+showbErrorCall (ErrorCall err) = fromString err+{-# INLINE showbErrorCall #-}++-- | Convert a 'MaskingState' to a 'Builder'.+showbMaskingState :: MaskingState -> Builder+showbMaskingState Unmasked = "Unmasked"+showbMaskingState MaskedInterruptible = "MaskedInterruptible"+showbMaskingState MaskedUninterruptible = "MaskedUninterruptible"+{-# INLINE showbMaskingState #-}++instance Show SomeException where+ showbPrec = showbSomeExceptionPrec+ {-# INLINE showbPrec #-}++instance Show IOException where+ showb = showbIOException+ {-# INLINE showb #-}++instance Show ArithException where+ showb = showbArithException+ {-# INLINE showb #-}++instance Show ArrayException where+ showb = showbArrayException+ {-# INLINE showb #-}++instance Show AssertionFailed where+ showb = showbAssertionFailed+ {-# INLINE showb #-}++#if MIN_VERSION_base(4,7,0)+instance Show SomeAsyncException where+ showb = showbSomeAsyncException+ {-# INLINE showb #-}+#endif++instance Show AsyncException where+ showb = showbAsyncException+ {-# INLINE showb #-}++instance Show NonTermination where+ showb = showbNonTermination+ {-# INLINE showb #-}++instance Show NestedAtomically where+ showb = showbNestedAtomically+ {-# INLINE showb #-}++instance Show BlockedIndefinitelyOnMVar where+ showb = showbBlockedIndefinitelyOnMVar+ {-# INLINE showb #-}++instance Show BlockedIndefinitelyOnSTM where+ showb = showbBlockedIndefinitelyOnSTM+ {-# INLINE showb #-}++instance Show Deadlock where+ showb = showbDeadlock+ {-# INLINE showb #-}++instance Show NoMethodError where+ showb = showbNoMethodError+ {-# INLINE showb #-}++instance Show PatternMatchFail where+ showb = showbPatternMatchFail+ {-# INLINE showb #-}++instance Show RecConError where+ showb = showbRecConError+ {-# INLINE showb #-}++instance Show RecSelError where+ showb = showbRecSelError+ {-# INLINE showb #-}++instance Show RecUpdError where+ showb = showbRecUpdError+ {-# INLINE showb #-}++instance Show ErrorCall where+ showb = showbErrorCall+ {-# INLINE showb #-}++instance Show MaskingState where+ showb = showbMaskingState+ {-# INLINE showb #-}
+ src/Text/Show/Text/Control/Monad/ST.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Control.Monad.ST+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' functions for strict 'ST' values.+----------------------------------------------------------------------------+module Text.Show.Text.Control.Monad.ST (showbST) where++import Control.Monad.ST (ST)+import Data.Text.Lazy.Builder (Builder)+import Prelude hiding (Show)+import Text.Show.Text.Class (Show(showb))++-- | Convert a strict 'ST' value to a 'Builder'.+showbST :: ST s a -> Builder+showbST _ = "<<ST action>>"+{-# INLINE showbST #-}++instance Show (ST s a) where+ showb = showbST+ {-# INLINE showb #-}
+ src/Text/Show/Text/Data.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Data+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Imports 'Show' instances for @Data@ modules.+----------------------------------------------------------------------------+module Text.Show.Text.Data () where++import Text.Show.Text.Data.Array ()+import Text.Show.Text.Data.Bool ()+import Text.Show.Text.Data.ByteString ()+import Text.Show.Text.Data.Char ()+import Text.Show.Text.Data.Containers ()+import Text.Show.Text.Data.Data ()+import Text.Show.Text.Data.Dynamic ()+import Text.Show.Text.Data.Either ()+import Text.Show.Text.Data.Fixed ()+import Text.Show.Text.Data.Floating ()+import Text.Show.Text.Data.Integral ()+import Text.Show.Text.Data.List ()+import Text.Show.Text.Data.Maybe ()+import Text.Show.Text.Data.Monoid ()+import Text.Show.Text.Data.Ord ()+import Text.Show.Text.Data.Text ()+import Text.Show.Text.Data.Time ()+import Text.Show.Text.Data.Tuple ()+#if MIN_VERSION_base(4,7,0)+import Text.Show.Text.Data.Type.Coercion ()+import Text.Show.Text.Data.Type.Equality ()+#endif+import Text.Show.Text.Data.Typeable ()+import Text.Show.Text.Data.Version ()
+ src/Text/Show/Text/Data/Array.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Data.Array+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' function for 'Array' values.+----------------------------------------------------------------------------+module Text.Show.Text.Data.Array (showbArrayPrec) where++import Data.Array (Array, assocs, bounds)+import Data.Ix (Ix)+import Data.Text.Lazy.Builder (Builder)++import GHC.Show (appPrec, appPrec1)++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showbPrec), showbParen)+import Text.Show.Text.Data.List ()+import Text.Show.Text.Data.Tuple ()+import Text.Show.Text.Utils ((<>), s)++-- | Convert a 'Array' value to a 'Builder' with the given precedence.+showbArrayPrec :: (Show i, Show e, Ix i) => Int -> Array i e -> Builder+showbArrayPrec p a = showbParen (p > appPrec) $+ "array "+ <> showbPrec appPrec1 (bounds a)+ <> s ' '+ <> showbPrec appPrec1 (assocs a)+{-# INLINE showbArrayPrec #-}++instance (Show i, Show e, Ix i) => Show (Array i e) where+ showbPrec = showbArrayPrec+ {-# INLINE showbPrec #-}
+ src/Text/Show/Text/Data/Bool.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Data.Bool+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' functions for 'Bool' values.+----------------------------------------------------------------------------+module Text.Show.Text.Data.Bool (showbBool) where++import Data.Text.Buildable (build)+import Data.Text.Lazy.Builder (Builder)++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showb))++-- | Convert a 'Bool' to a 'Builder'.+showbBool :: Bool -> Builder+showbBool = build+{-# INLINE showbBool #-}++instance Show Bool where+ showb = showbBool+ {-# INLINE showb #-}
+ src/Text/Show/Text/Data/ByteString.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE CPP, NoImplicitPrelude #-}+#if !(MIN_VERSION_bytestring(0,10,0))+{-# LANGUAGE OverloadedStrings #-}+#endif+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Foreign.Data.ByteString+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' functions for data types in the @bytestring@ library.+-- These are included for convenience (and because @bytestring@ is a+-- dependency of this library).+----------------------------------------------------------------------------+module Text.Show.Text.Data.ByteString (+ showbByteStringStrict+ , showbByteStringLazy+ , showbByteStringLazyPrec+#if MIN_VERSION_bytestring(0,10,4)+ , showbShortByteString+#endif+ ) where++import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+#if MIN_VERSION_bytestring(0,10,4)+import Data.ByteString.Short (ShortByteString)+#endif+import Data.Text.Lazy.Builder (Builder, fromString)++import qualified Prelude as P+import Prelude hiding (Show(show))++import Text.Show.Text.Class (Show(showb, showbPrec))++-- Imports needed for older versions of bytestring+#if !(MIN_VERSION_bytestring(0,10,0))+import qualified Data.ByteString.Lazy.Internal as BL++import GHC.Show (appPrec, appPrec1)++import Text.Show.Text.Class (showbParen)+import Text.Show.Text.Utils ((<>), s)+#endif++-- | Convert a strict 'ByteString' to a 'Builder'.+showbByteStringStrict :: BS.ByteString -> Builder+showbByteStringStrict = fromString . P.show+{-# INLINE showbByteStringStrict #-}++-- | Convert a lazy 'ByteString' to a 'Builder'.+showbByteStringLazy :: BL.ByteString -> Builder+showbByteStringLazy = showbByteStringLazyPrec 0+{-# INLINE showbByteStringLazy #-}++-- | Convert a lazy 'ByteString' to a 'Builder' with the given precedence.+-- +-- With @bytestring-0.10.0.0@ or later, this function ignores the precedence+-- argument, since lazy 'ByteString's are printed out identically to 'String's.+-- On earlier versions of @bytestring@, however, lazy 'ByteString's can be printed+-- with parentheses (e.g., @Chunk "example" Empty@ vs. @(Chunk "example" Empty)@)+-- depending on the precedence.+showbByteStringLazyPrec :: Int -> BL.ByteString -> Builder+#if MIN_VERSION_bytestring(0,10,0)+showbByteStringLazyPrec _ = fromString . P.show+#else+showbByteStringLazyPrec _ BL.Empty = "Empty"+showbByteStringLazyPrec p (BL.Chunk bs bl) = showbParen (p > appPrec) $+ "Chunk "+ <> showbPrec appPrec1 bs+ <> s ' '+ <> showbPrec appPrec1 bl+#endif+{-# INLINE showbByteStringLazyPrec #-}++#if MIN_VERSION_bytestring(0,10,4)+-- | Convert a 'ShortByteString' to a 'Builder'.+showbShortByteString :: ShortByteString -> Builder+showbShortByteString = fromString . P.show+{-# INLINE showbShortByteString #-}+#endif++instance Show BS.ByteString where+ showb = showbByteStringStrict+ {-# INLINE showb #-}++instance Show BL.ByteString where+ showbPrec = showbByteStringLazyPrec+ {-# INLINE showbPrec #-}++#if MIN_VERSION_bytestring(0,10,4)+instance Show ShortByteString where+ showb = showbShortByteString+ {-# INLINE showb #-}+#endif
+ src/Text/Show/Text/Data/Char.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Data.Char+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' functions for 'Char' and 'String'.+----------------------------------------------------------------------------+module Text.Show.Text.Data.Char (+ showbChar+ , showbLitChar+ , showbString+ , showbLitString+ , showbGeneralCategory+ ) where++import Data.Array (Array, (!), listArray)+import Data.Char (GeneralCategory(..), isDigit, ord)+import Data.Monoid (mempty)+import Data.Text.Buildable (build)+import Data.Text.Lazy.Builder (Builder)++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(..))+import Text.Show.Text.Utils ((<>), s)++-- | A table of ASCII control characters that needs to be escaped with a backslash.+asciiTabB :: Array Int Builder+asciiTabB = listArray (0, 32) ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL",+ "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI",+ "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB",+ "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US",+ "SP"]++-- | Convert a 'Char' to a 'Builder' (surrounded by single quotes).+showbChar :: Char -> Builder+showbChar '\'' = "'\\''"+showbChar c = s '\'' <> showbLitChar c <> s '\''+{-# INLINE showbChar #-}++-- | Convert a 'Char' to a 'Builder' (without single quotes).+showbLitChar :: Char -> Builder+showbLitChar c | c > '\DEL' = s '\\' <> build (ord c)+showbLitChar '\DEL' = "\\DEL"+showbLitChar '\\' = "\\\\"+showbLitChar c | c >= ' ' = s c+showbLitChar '\a' = "\\a"+showbLitChar '\b' = "\\b"+showbLitChar '\f' = "\\f"+showbLitChar '\n' = "\\n"+showbLitChar '\r' = "\\r"+showbLitChar '\t' = "\\t"+showbLitChar '\v' = "\\v"+showbLitChar '\SO' = "\\SO"+showbLitChar c = s '\\' <> (asciiTabB ! ord c)+{-# INLINE showbLitChar #-}++-- | Convert a 'String' to a 'Builder' (surrounded by double quotes).+showbString :: String -> Builder+showbString cs = s '"' <> showbLitString cs <> s '"'+{-# INLINE showbString #-}++-- | Convert a 'String' to a 'Builder' (without double quotes).+showbLitString :: String -> Builder+showbLitString [] = mempty+showbLitString ('\SO':'H':cs) = "\\SO\\&H" <> showbLitString cs+showbLitString ('"':cs) = "\\\"" <> showbLitString cs+showbLitString (c:d:cs)+ | c > '\DEL' && isDigit d = s '\\' <> build (ord c) <> "\\&" <> s d <> showbLitString cs+showbLitString (c:cs) = showbLitChar c <> showbLitString cs+{-# INLINE showbLitString #-}++-- | Convert a 'GeneralCategory' to a 'Builder'.+showbGeneralCategory :: GeneralCategory -> Builder+showbGeneralCategory UppercaseLetter = "UppercaseLetter"+showbGeneralCategory LowercaseLetter = "LowercaseLetter"+showbGeneralCategory TitlecaseLetter = "TitlecaseLetter"+showbGeneralCategory ModifierLetter = "ModifierLetter"+showbGeneralCategory OtherLetter = "OtherLetter"+showbGeneralCategory NonSpacingMark = "NonSpacingMark"+showbGeneralCategory SpacingCombiningMark = "SpacingCombiningMark"+showbGeneralCategory EnclosingMark = "EnclosingMark"+showbGeneralCategory DecimalNumber = "DecimalNumber"+showbGeneralCategory LetterNumber = "LetterNumber"+showbGeneralCategory OtherNumber = "OtherNumber"+showbGeneralCategory ConnectorPunctuation = "ConnectorPunctuation"+showbGeneralCategory DashPunctuation = "DashPunctuation"+showbGeneralCategory OpenPunctuation = "OpenPunctuation"+showbGeneralCategory ClosePunctuation = "ClosePunctuation"+showbGeneralCategory InitialQuote = "InitialQuote"+showbGeneralCategory FinalQuote = "FinalQuote"+showbGeneralCategory OtherPunctuation = "OtherPunctuation"+showbGeneralCategory MathSymbol = "MathSymbol"+showbGeneralCategory CurrencySymbol = "CurrencySymbol" +showbGeneralCategory ModifierSymbol = "ModifierSymbol"+showbGeneralCategory OtherSymbol = "OtherSymbol"+showbGeneralCategory Space = "Space"+showbGeneralCategory LineSeparator = "LineSeparator"+showbGeneralCategory ParagraphSeparator = "ParagraphSeparator"+showbGeneralCategory Control = "Control"+showbGeneralCategory Format = "Format"+showbGeneralCategory Surrogate = "Surrogate"+showbGeneralCategory PrivateUse = "PrivateUse"+showbGeneralCategory NotAssigned = "NotAssigned"+{-# INLINE showbGeneralCategory #-}++instance Show Char where+ showb = showbChar+ {-# INLINE showb #-}+ + showbList = showbString+ {-# INLINE showbList #-}++instance Show GeneralCategory where+ showb = showbGeneralCategory+ {-# INLINE showb #-}
+ src/Text/Show/Text/Data/Containers.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Data.Containers+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' functions for data types in the @containers@ library.+-- These are included for convenience (and because @containers@ is a+-- dependency of this library).+----------------------------------------------------------------------------+module Text.Show.Text.Data.Containers (+ showbIntMapPrec+ , showbIntSetPrec+ , showbMapPrec+ , showbSequencePrec+ , showbSetPrec+ , showbTreePrec+ ) where++import qualified Data.Foldable as F+import Data.Text.Lazy.Builder (Builder)++import qualified Data.IntMap as IM+import Data.IntMap (IntMap)+import qualified Data.IntSet as IS+import Data.IntSet (IntSet)+import qualified Data.Map as M+import Data.Map (Map)+import Data.Sequence (Seq)+import qualified Data.Set as Set+import Data.Set (Set)+import Data.Tree (Tree(..))++import GHC.Show (appPrec)++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showb, showbPrec), showbParen, showbListDefault)+import Text.Show.Text.Data.Integral ()+import Text.Show.Text.Data.Tuple ()+import Text.Show.Text.Utils ((<>), s)++-- | Convert an 'IntMap' into a 'Builder' with the given precedence.+showbIntMapPrec :: Show v => Int -> IntMap v -> Builder+showbIntMapPrec p im+ = showbParen (p > appPrec) $ "fromList " <> showbListDefault (IM.toList im)+{-# INLINE showbIntMapPrec #-}++-- | Convert an 'IntSet' into a 'Builder' with the given precedence.+showbIntSetPrec :: Int -> IntSet -> Builder+showbIntSetPrec p is+ = showbParen (p > appPrec) $ "fromList " <> showbListDefault (IS.toList is)+{-# INLINE showbIntSetPrec #-}++-- | Convert a 'Map' into a 'Builder' with the given precedence.+showbMapPrec :: (Show k, Show v) => Int -> Map k v -> Builder+showbMapPrec p m+ = showbParen (p > appPrec) $ "fromList " <> showbListDefault (M.toList m)+{-# INLINE showbMapPrec #-}++-- | Convert a 'Sequence' into a 'Builder' with the given precedence.+showbSequencePrec :: Show a => Int -> Seq a -> Builder+showbSequencePrec p s'+ = showbParen (p > appPrec) $ "fromList " <> showbListDefault (F.toList s')+{-# INLINE showbSequencePrec #-}++-- | Convert a 'Set' into a 'Builder' with the given precedence.+showbSetPrec :: Show a => Int -> Set a -> Builder+showbSetPrec p s'+ = showbParen (p > appPrec) $ "fromList " <> showbListDefault (Set.toList s')+{-# INLINE showbSetPrec #-}++-- | Convert a 'Tree' into a 'Builder' with the given precedence.+showbTreePrec :: Show a => Int -> Tree a -> Builder+showbTreePrec p (Node rl sf) = showbParen (p > appPrec) $+ "Node {rootLabel = "+ <> showb rl+ <> ", subForest = "+ <> showbListDefault sf+ <> s '}'+{-# INLINE showbTreePrec #-}++instance Show v => Show (IntMap v) where+ showbPrec = showbIntMapPrec+ {-# INLINE showbPrec #-}++instance Show IntSet where+ showbPrec = showbIntSetPrec+ {-# INLINE showbPrec #-}++instance (Show k, Show v) => Show (Map k v) where+ showbPrec = showbMapPrec+ {-# INLINE showbPrec #-}++instance Show a => Show (Seq a) where+ showbPrec = showbSequencePrec+ {-# INLINE showbPrec #-}++instance Show a => Show (Set a) where+ showbPrec = showbSetPrec+ {-# INLINE showbPrec #-}++instance Show a => Show (Tree a) where+ showbPrec = showbTreePrec+ {-# INLINE showbPrec #-}
+ src/Text/Show/Text/Data/Data.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Data.Data+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' functions for data types in the @Data@ module.+----------------------------------------------------------------------------+module Text.Show.Text.Data.Data (+ showbConstr+ , showbConstrRepPrec+ , showbDataRepPrec+ , showbDataTypePrec+ , showbFixity+ ) where++import Data.Data (Constr, ConstrRep(..), DataRep(..), DataType, Fixity(..),+ dataTypeName, dataTypeRep, showConstr)+import Data.Text.Lazy.Builder (Builder, fromString)++import GHC.Show (appPrec, appPrec1)++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showb, showbPrec), showbParen)+import Text.Show.Text.Data.Char (showbChar)+import Text.Show.Text.Data.Integral (showbIntPrec, showbIntegerPrec, showbRatioPrec)+import Text.Show.Text.Data.List ()+import Text.Show.Text.Utils ((<>), s)++-- | Convert a 'DataType' to a 'Builder' with the given precedence.+showbDataTypePrec :: Int -> DataType -> Builder+showbDataTypePrec p dt = showbParen (p > appPrec) $+ "DataType {tycon = "+ <> showb (dataTypeName dt)+ <> ", datarep = "+ <> showb (dataTypeRep dt)+ <> s '}'+{-# INLINE showbDataTypePrec #-}++-- | Convert a 'DataRep' to a 'Builder' with the given precedence.+showbDataRepPrec :: Int -> DataRep -> Builder+showbDataRepPrec p (AlgRep cs) = showbParen (p > appPrec) $ "AlgRep " <> showb cs+showbDataRepPrec _ IntRep = "IntRep"+showbDataRepPrec _ FloatRep = "FloatRep"+showbDataRepPrec _ CharRep = "CharRep"+showbDataRepPrec _ NoRep = "NoRep"+{-# INLINE showbDataRepPrec #-}++-- | Convert a 'Constr' to a 'Builder'.+showbConstr :: Constr -> Builder+showbConstr = fromString . showConstr+{-# INLINE showbConstr #-}++-- | Convert a 'Fixity' value to a 'Builder'.+showbFixity :: Fixity -> Builder+showbFixity Prefix = "Prefix"+showbFixity Infix = "Infix"+{-# INLINE showbFixity #-}++-- | Convert a 'ConstrRep' to a 'Builder' with the given precedence.+showbConstrRepPrec :: Int -> ConstrRep -> Builder+showbConstrRepPrec p (AlgConstr ci)+ = showbParen (p > appPrec) $ "AlgConstr " <> showbIntPrec appPrec1 ci+showbConstrRepPrec p (IntConstr i)+ = showbParen (p > appPrec) $ "IntConstr " <> showbIntegerPrec appPrec1 i+showbConstrRepPrec p (FloatConstr r)+ = showbParen (p > appPrec) $ "FloatConstr " <> showbRatioPrec appPrec1 r+showbConstrRepPrec p (CharConstr c)+ = showbParen (p > appPrec) $ "CharConstr " <> showbChar c+{-# INLINE showbConstrRepPrec #-}++instance Show DataType where+ showbPrec = showbDataTypePrec+ {-# INLINE showbPrec #-}++instance Show DataRep where+ showbPrec = showbDataRepPrec+ {-# INLINE showbPrec #-}++instance Show Constr where+ showb = showbConstr+ {-# INLINE showb #-}++instance Show ConstrRep where+ showbPrec = showbConstrRepPrec+ {-# INLINE showbPrec #-}++instance Show Fixity where+ showb = showbFixity+ {-# INLINE showb #-}
+ src/Text/Show/Text/Data/Dynamic.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Data.Dynamic+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' function for 'Dynamic'.+----------------------------------------------------------------------------+module Text.Show.Text.Data.Dynamic (showbDynamic) where++import Data.Dynamic (Dynamic, dynTypeRep)+import Data.Text.Lazy.Builder (Builder)++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showb))+import Text.Show.Text.Data.Typeable (showbTypeRepPrec)+import Text.Show.Text.Utils ((<>))++-- | Convert a 'Dynamic' value to a 'Builder'.+showbDynamic :: Dynamic -> Builder+showbDynamic dyn = "<<" <> showbTypeRepPrec 0 (dynTypeRep dyn) <> ">>"+{-# INLINE showbDynamic #-}++instance Show Dynamic where+ showb = showbDynamic+ {-# INLINE showb #-}
+ src/Text/Show/Text/Data/Either.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Data.Either+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' function for 'Either' values.+----------------------------------------------------------------------------+module Text.Show.Text.Data.Either (showbEitherPrec) where++import Data.Text.Lazy.Builder (Builder)++import GHC.Show (appPrec, appPrec1)++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showbPrec), showbParen)+import Text.Show.Text.Utils ((<>))++-- | Convert a 'Either' value to a 'Builder' with the given precedence.+showbEitherPrec :: (Show a, Show b) => Int -> Either a b -> Builder+showbEitherPrec p (Left a) = showbParen (p > appPrec) $ "Left " <> showbPrec appPrec1 a+showbEitherPrec p (Right b) = showbParen (p > appPrec) $ "Right " <> showbPrec appPrec1 b+{-# INLINE showbEitherPrec #-}++instance (Show a, Show b) => Show (Either a b) where+ showbPrec = showbEitherPrec+ {-# INLINE showbPrec #-}
+ src/Text/Show/Text/Data/Fixed.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE CPP, NoImplicitPrelude #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Data.Fixed+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' function for 'Fixed' values.+----------------------------------------------------------------------------+module Text.Show.Text.Data.Fixed (showbFixed) where++import Data.Fixed (HasResolution(..))+import Data.Text.Lazy.Builder (Builder)++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showb))++#if MIN_VERSION_base(4,7,0)+import Data.Fixed (Fixed(..))+import Data.Int (Int64)+import Data.Monoid (mempty)++import Text.Show.Text.Data.Integral ()+import Text.Show.Text.Utils ((<>), lengthB, replicateB, s)+#else+import Data.Fixed (Fixed, showFixed)+import Data.Text.Lazy.Builder (fromString)+#endif++-- | Convert a 'Fixed' value to a 'Builder', where the first argument indicates+-- whether to chop off trailing zeroes.+showbFixed :: HasResolution a => Bool -> Fixed a -> Builder+#if MIN_VERSION_base(4,7,0)+showbFixed chopTrailingZeroes fa@(MkFixed a) | a < 0+ = s '-' <> showbFixed chopTrailingZeroes (asTypeOf (MkFixed (negate a)) fa)+showbFixed chopTrailingZeroes fa@(MkFixed a)+ = showb i <> withDotB (showbIntegerZeroes chopTrailingZeroes digits fracNum)+ where+ res = fromInteger $ resolution fa+ (i, d) = divMod (fromInteger a) res+ digits = ceiling (logBase 10 (fromInteger $ resolution fa) :: Double)+ maxnum = 10 ^ digits+ fracNum = div (d * maxnum) res+#else+showbFixed chopTrailingZeroes = fromString . showFixed chopTrailingZeroes+#endif+{-# INLINE showbFixed #-}++#if MIN_VERSION_base(4,7,0)+-- | Only works for positive 'Integer's.+showbIntegerZeroes :: Bool -> Int64 -> Integer -> Builder+showbIntegerZeroes True _ 0 = mempty+showbIntegerZeroes chopTrailingZeroes digits a = replicateB (digits - lengthB sh) (s '0') <> sh'+ where+ sh, sh' :: Builder+ sh = showb a+ sh' = if chopTrailingZeroes then chopZeroesB a else sh+{-# INLINE showbIntegerZeroes #-}++-- | Chops off the trailing zeroes of an 'Integer'.+chopZeroesB :: Integer -> Builder+chopZeroesB 0 = mempty+chopZeroesB a | mod a 10 == 0 = chopZeroesB (div a 10)+chopZeroesB a = showb a+{-# INLINE chopZeroesB #-}++-- | Prepends a dot to a non-empty 'Builder'.+withDotB :: Builder -> Builder+withDotB b | b == mempty = mempty+ | otherwise = s '.' <> b+{-# INLINE withDotB #-}+#endif++instance HasResolution a => Show (Fixed a) where+ showb = showbFixed False+ {-# INLINE showb #-}
+ src/Text/Show/Text/Data/Floating.hs view
@@ -0,0 +1,370 @@+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Data.Floating+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' functions for floating-point types.+----------------------------------------------------------------------------+module Text.Show.Text.Data.Floating (+ showbRealFloatPrec+ , showbFloatPrec+ , showbDoublePrec+ , showbComplexPrec+ , showbEFloat+ , showbFFloat+ , showbGFloat+ , showbFFloatAlt+ , showbGFloatAlt+ ) where++import Data.Array.Base (unsafeAt)+import Data.Array.IArray (Array, array)+import Data.Complex (Complex(..))+import qualified Data.Text as T (replicate)+import Data.Text.Lazy.Builder (Builder, fromString, fromText)+import Data.Text.Lazy.Builder.Int (decimal)+import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showbPrec), showbParen)+import Text.Show.Text.Utils ((<>), i2d, s)++-- | Convert a 'RealFloat' value to a 'Builder' with the given precedence.+showbRealFloatPrec :: RealFloat a => Int -> a -> Builder+showbRealFloatPrec p x+ | x < 0 || isNegativeZero x = showbParen (p > 6) $ s '-' <> showbGFloat Nothing (-x)+ | otherwise = showbGFloat Nothing x+{-# INLINE showbRealFloatPrec #-}++-- | Convert a 'Float' to a 'Builder' with the given precedence.+showbFloatPrec :: Int -> Float -> Builder+showbFloatPrec = showbRealFloatPrec+{-# INLINE showbFloatPrec #-}++-- | Convert a 'Double' to a 'Builder' with the given precedence.+showbDoublePrec :: Int -> Double -> Builder+showbDoublePrec = showbRealFloatPrec+{-# INLINE showbDoublePrec #-}++-- | Convert a 'Complex' value to a 'Builder' with the given precedence.+showbComplexPrec :: (RealFloat a, Show a) => Int -> Complex a -> Builder+showbComplexPrec p (a :+ b) = showbParen (p > complexPrec) $+ showbPrec (complexPrec+1) a+ <> " :+ "+ <> showbPrec (complexPrec+1) b+ where complexPrec = 6+{-# INLINE showbComplexPrec #-}++-- | Show a signed 'RealFloat' value+-- using scientific (exponential) notation (e.g. @2.45e2@, @1.5e-3@).+--+-- In the call @'showbEFloat' digs val@, if @digs@ is 'Nothing',+-- the value is shown to full precision; if @digs@ is @'Just' d@,+-- then at most @d@ digits after the decimal point are shown.+showbEFloat :: RealFloat a => Maybe Int -> a -> Builder+showbEFloat = formatRealFloat Exponent+{-# INLINE showbEFloat #-}++-- | Show a signed 'RealFloat' value+-- using standard decimal notation (e.g. @245000@, @0.0015@).+--+-- In the call @'showbFFloat' digs val@, if @digs@ is 'Nothing',+-- the value is shown to full precision; if @digs@ is @'Just' d@,+-- then at most @d@ digits after the decimal point are shown.+showbFFloat :: RealFloat a => Maybe Int -> a -> Builder+showbFFloat = formatRealFloat Fixed+{-# INLINE showbFFloat #-}++-- | Show a signed 'RealFloat' value+-- using standard decimal notation for arguments whose absolute value lies+-- between @0.1@ and @9,999,999@, and scientific notation otherwise.+--+-- In the call @'showbGFloat' digs val@, if @digs@ is 'Nothing',+-- the value is shown to full precision; if @digs@ is @'Just' d@,+-- then at most @d@ digits after the decimal point are shown.+showbGFloat :: RealFloat a => Maybe Int -> a -> Builder+showbGFloat = formatRealFloat Generic+{-# INLINE showbGFloat #-}++-- | Show a signed 'RealFloat' value+-- using standard decimal notation (e.g. @245000@, @0.0015@).+--+-- This behaves as 'showFFloat', except that a decimal point+-- is always guaranteed, even if not needed.+showbFFloatAlt :: RealFloat a => Maybe Int -> a -> Builder+showbFFloatAlt d x = formatRealFloatAlt Fixed d True x+{-# INLINE showbFFloatAlt #-}++-- | Show a signed 'RealFloat' value+-- using standard decimal notation for arguments whose absolute value lies+-- between @0.1@ and @9,999,999@, and scientific notation otherwise.+--+-- This behaves as 'showFFloat', except that a decimal point+-- is always guaranteed, even if not needed.+showbGFloatAlt :: RealFloat a => Maybe Int -> a -> Builder+showbGFloatAlt d x = formatRealFloatAlt Generic d True x+{-# INLINE showbGFloatAlt #-}++instance Show Float where+ showbPrec = showbFloatPrec+ {-# INLINE showbPrec #-}++instance Show Double where+ showbPrec = showbDoublePrec+ {-# INLINE showbPrec #-}++instance (RealFloat a, Show a) => Show (Complex a) where+ {-# SPECIALIZE instance Show (Complex Float) #-}+ {-# SPECIALIZE instance Show (Complex Double) #-}+ showbPrec = showbComplexPrec+ {-# INLINE showbPrec #-}++-------------------------------------------------------------------------------+-- GHC.Float internal functions, adapted for Builders+-------------------------------------------------------------------------------++-- | Like 'formatRealFloatAlt', except that the decimal is only shown for arguments+-- whose absolute value is between @0.1@ and @9,999,999@.+formatRealFloat :: RealFloat a+ => FPFormat -- ^ What notation to use.+ -> Maybe Int -- ^ Number of decimal places to render.+ -> a+ -> Builder+formatRealFloat fmt decs = formatRealFloatAlt fmt decs False+{-# INLINE formatRealFloat #-}++-- | Converts a 'RealFloat' value to a Builder. Super-configurable.+formatRealFloatAlt :: RealFloat a+ => FPFormat -- ^ What notation to use.+ -> Maybe Int -- ^ Number of decimal places to render.+ -> Bool -- ^ Should a decimal point always be shown?+ -> a+ -> Builder+{-# SPECIALIZE formatRealFloatAlt :: FPFormat -> Maybe Int -> Bool -> Float -> Builder #-}+{-# SPECIALIZE formatRealFloatAlt :: FPFormat -> Maybe Int -> Bool -> Double -> Builder #-}+formatRealFloatAlt fmt decs alt x+ | isNaN x = "NaN"+ | isInfinite x = if x < 0 then "-Infinity" else "Infinity"+ | x < 0 || isNegativeZero x = s '-' <> doFmt fmt (floatToDigits (-x))+ | otherwise = doFmt fmt (floatToDigits x)+ where+ doFmt format (is, e) =+ let ds = map i2d is in+ case format of+ Generic ->+ doFmt (if e < 0 || e > 7 then Exponent else Fixed)+ (is,e)+ Exponent ->+ case decs of+ Nothing ->+ let show_e' = decimal (e-1) in+ case ds of+ "0" -> "0.0e0"+ [d] -> s d <> ".0e" <> show_e'+ (d:ds') -> s d <> s '.' <> fromString ds' <> s 'e' <> show_e'+ [] -> error "formatRealFloat/doFmt/Exponent: []"+ Just dec ->+ let dec' = max dec 1 in+ case is of+ [0] -> "0." <> fromText (T.replicate dec' "0") <> "e0"+ _ ->+ let+ (ei,is') = roundTo (dec'+1) is+ (d:ds') = map i2d (if ei > 0 then init is' else is')+ in+ s d <> s '.' <> fromString ds' <> s 'e' <> decimal (e-1+ei)+ Fixed ->+ let+ mk0 ls = case ls of { "" -> "0" ; _ -> fromString ls}+ in+ case decs of+ Nothing+ | e <= 0 -> "0." <> fromText (T.replicate (-e) "0") <> fromString ds+ | otherwise ->+ let+ f 0 str rs = mk0 (reverse str) <> s '.' <> mk0 rs+ f n str "" = f (n-1) ('0':str) ""+ f n str (r:rs) = f (n-1) (r:str) rs+ in+ f e "" ds+ Just dec ->+ let dec' = max dec 0 in+ if e >= 0 then+ let+ (ei,is') = roundTo (dec' + e) is+ (ls,rs) = splitAt (e+ei) (map i2d is')+ in+ mk0 ls <> (if null rs && not alt then "" else s '.' <> fromString rs)+ else+ let+ (ei,is') = roundTo dec' (replicate (-e) 0 ++ is)+ d:ds' = map i2d (if ei > 0 then is' else 0:is')+ in+ s d <> (if null ds' && not alt then "" else s '.' <> fromString ds')++-- Based on "Printing Floating-Point Numbers Quickly and Accurately"+-- by R.G. Burger and R.K. Dybvig in PLDI 96.+-- This version uses a much slower logarithm estimator. It should be improved.++-- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number,+-- and returns a list of digits and an exponent.+-- In particular, if @x>=0@, and+--+-- > floatToDigits base x = ([d1,d2,...,dn], e)+--+-- then+--+-- (1) @n >= 1@+--+-- (2) @x = 0.d1d2...dn * (base**e)@+--+-- (3) @0 <= di <= base-1@+floatToDigits :: (RealFloat a) => a -> ([Int], Int)+{-# SPECIALIZE floatToDigits :: Float -> ([Int], Int) #-}+{-# SPECIALIZE floatToDigits :: Double -> ([Int], Int) #-}+floatToDigits 0 = ([0], 0)+floatToDigits x =+ let+ (f0, e0) = decodeFloat x+ (minExp0, _) = floatRange x+ p = floatDigits x+ b = floatRadix x+ minExp = minExp0 - p -- the real minimum exponent+ -- Haskell requires that f be adjusted so denormalized numbers+ -- will have an impossibly low exponent. Adjust for this.+ (f, e) =+ let n = minExp - e0 in+ if n > 0 then (f0 `quot` (expt b n), e0+n) else (f0, e0)+ (r, s', mUp, mDn) =+ if e >= 0 then+ let be = expt b e in+ if f == expt b (p-1) then+ (f*be*b*2, 2*b, be*b, be) -- according to Burger and Dybvig+ else+ (f*be*2, 2, be, be)+ else+ if e > minExp && f == expt b (p-1) then+ (f*b*2, expt b (-e+1)*2, b, 1)+ else+ (f*2, expt b (-e)*2, 1, 1)+ k :: Int+ k =+ let+ k0 :: Int+ k0 =+ if b == 2 then+ -- logBase 10 2 is very slightly larger than 8651/28738+ -- (about 5.3558e-10), so if log x >= 0, the approximation+ -- k1 is too small, hence we add one and need one fixup step less.+ -- If log x < 0, the approximation errs rather on the high side.+ -- That is usually more than compensated for by ignoring the+ -- fractional part of logBase 2 x, but when x is a power of 1/2+ -- or slightly larger and the exponent is a multiple of the+ -- denominator of the rational approximation to logBase 10 2,+ -- k1 is larger than logBase 10 x. If k1 > 1 + logBase 10 x,+ -- we get a leading zero-digit we don't want.+ -- With the approximation 3/10, this happened for+ -- 0.5^1030, 0.5^1040, ..., 0.5^1070 and values close above.+ -- The approximation 8651/28738 guarantees k1 < 1 + logBase 10 x+ -- for IEEE-ish floating point types with exponent fields+ -- <= 17 bits and mantissae of several thousand bits, earlier+ -- convergents to logBase 10 2 would fail for long double.+ -- Using quot instead of div is a little faster and requires+ -- fewer fixup steps for negative lx.+ let lx = p - 1 + e0+ k1 = (lx * 8651) `quot` 28738+ in if lx >= 0 then k1 + 1 else k1+ else+ -- f :: Integer, log :: Float -> Float,+ -- ceiling :: Float -> Int+ ceiling ((log (fromInteger (f+1) :: Float) ++ fromIntegral e * log (fromInteger b)) /+ log 10)+--WAS: fromInt e * log (fromInteger b))++ fixup n =+ if n >= 0 then+ if r + mUp <= expt 10 n * s' then n else fixup (n+1)+ else+ if expt 10 (-n) * (r + mUp) <= s' then n else fixup (n+1)+ in+ fixup k0++ gen ds rn sN mUpN mDnN =+ let+ (dn, rn') = (rn * 10) `quotRem` sN+ mUpN' = mUpN * 10+ mDnN' = mDnN * 10+ in+ case (rn' < mDnN', rn' + mUpN' > sN) of+ (True, False) -> dn : ds+ (False, True) -> dn+1 : ds+ (True, True) -> if rn' * 2 < sN then dn : ds else dn+1 : ds+ (False, False) -> gen (dn:ds) rn' sN mUpN' mDnN'++ rds =+ if k >= 0 then+ gen [] r (s' * expt 10 k) mUp mDn+ else+ let bk = expt 10 (-k) in+ gen [] (r * bk) s' (mUp * bk) (mDn * bk)+ in+ (map fromIntegral (reverse rds), k)++-- |+roundTo :: Int -> [Int] -> (Int,[Int])+roundTo d is =+ case f d True is of+ x@(0,_) -> x+ (1,xs) -> (1, 1:xs)+ _ -> error "roundTo: bad Value"+ where+ f n _ [] = (0, replicate n 0)+ f 0 e (x:xs) | x == 5 && e && all (== 0) xs = (0, []) -- Round to even when at exactly half the base+ | otherwise = (if x >= 5 then 1 else 0, [])+ f n _ (i:xs)+ | i' == 10 = (1,0:ds)+ | otherwise = (0,i':ds)+ where+ (c,ds) = f (n-1) (even i) xs+ i' = c + i++-- Exponentiation with a cache for the most common numbers.++-- | The minimum exponent in the cache.+minExpt :: Int+minExpt = 0+{-# INLINE minExpt #-}++-- | The maximum exponent (of 2) in the cache.+maxExpt :: Int+maxExpt = 1100+{-# INLINE maxExpt #-}++-- | Exponentiate an 'Integer', using a cache if possible.+expt :: Integer -> Int -> Integer+expt base n+ | base == 2 && n >= minExpt && n <= maxExpt = expts `unsafeAt` n+ | base == 10 && n <= maxExpt10 = expts10 `unsafeAt` n+ | otherwise = base^n+{-# INLINE expt #-}++-- | Cached powers of two.+expts :: Array Int Integer+expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]++-- | The maximum exponent (of 10) in the cache.+maxExpt10 :: Int+maxExpt10 = 324+{-# INLINE maxExpt10 #-}++-- | Cached powers of 10.+expts10 :: Array Int Integer+expts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]]
+ src/Text/Show/Text/Data/Integral.hs view
@@ -0,0 +1,221 @@+{-# LANGUAGE CPP, MagicHash, NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Data.Integral+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' functions for integral types.+----------------------------------------------------------------------------+module Text.Show.Text.Data.Integral (+ showbIntPrec+ , showbInt8Prec+ , showbInt16Prec+ , showbInt32Prec+ , showbInt64Prec+ , showbIntegerPrec+ , showbIntegralPrec+ , showbIntAtBase+ , showbBin+ , showbHex+ , showbOct+ , showbRatioPrec+ , showbWord+ , showbWord8+ , showbWord16+ , showbWord32+ , showbWord64+ ) where++import Data.Char (intToDigit)+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Monoid (mempty)+import Data.Ratio (Ratio, numerator, denominator)+import Data.Text.Buildable (build)+import Data.Text.Lazy.Builder (Builder)+import Data.Word (Word, Word8, Word16, Word32, Word64)++import GHC.Exts (Int(I#))+#if __GLASGOW_HASKELL__ >= 708+import GHC.Exts (isTrue#)+import GHC.Prim (Int#)+#endif+import GHC.Prim ((<#), (>#))+import GHC.Real (ratioPrec, ratioPrec1)++import qualified Prelude as P (show)+import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showb, showbPrec), showbParen)+import Text.Show.Text.Utils ((<>), s)++-- | Convert an 'Int' to a 'Builder' with the given precedence.+showbIntPrec :: Int -> Int -> Builder+showbIntPrec (I# p) n'@(I# n)+ | isTrue (n <# 0#) && isTrue (p ># 6#) = s '(' <> build n' <> s ')'+ | otherwise = build n'+ where+#if __GLASGOW_HASKELL__ >= 708+ isTrue :: Int# -> Bool+ isTrue b = isTrue# b+#else+ isTrue :: Bool -> Bool+ isTrue = id+#endif++-- | Convert an 'Int8' to a 'Builder' with the given precedence.+showbInt8Prec :: Int -> Int8 -> Builder+showbInt8Prec p = showbIntPrec p . fromIntegral+{-# INLINE showbInt8Prec #-}++-- | Convert an 'Int16' to a 'Builder' with the given precedence.+showbInt16Prec :: Int -> Int16 -> Builder+showbInt16Prec p = showbIntPrec p . fromIntegral+{-# INLINE showbInt16Prec #-}++-- | Convert an 'Int32' to a 'Builder' with the given precedence.+showbInt32Prec :: Int -> Int32 -> Builder+showbInt32Prec p = showbIntPrec p . fromIntegral+{-# INLINE showbInt32Prec #-}++-- | Convert an 'Int64' to a 'Builder' with the given precedence.+showbInt64Prec :: Int -> Int64 -> Builder+#if WORD_SIZE_IN_BITS < 64+showbInt64Prec p = showbIntegerPrec p . toInteger+#else+showbInt64Prec p = showbIntPrec p . fromIntegral+#endif+{-# INLINE showbInt64Prec #-}++-- | Convert an 'Integer' to a 'Builder' with the given precedence.+showbIntegerPrec :: Int -> Integer -> Builder+showbIntegerPrec p n+ | p > 6 && n < 0 = s '(' <> build n <> s ')'+ | otherwise = build n+{-# INLINE showbIntegerPrec #-}++-- | Convert an 'Integral' type to a 'Builder' with the given precedence.+showbIntegralPrec :: Integral a => Int -> a -> Builder+showbIntegralPrec p = showbIntegerPrec p . toInteger+{-# INLINE showbIntegralPrec #-}++-- | Shows a /non-negative/ 'Integral' number using the base specified by the+-- first argument, and the character representation specified by the second.+showbIntAtBase :: (Integral a, Show a) => a -> (Int -> Char) -> a -> Builder+showbIntAtBase base toChr n0+ | base <= 1 = error . P.show $ "Text.Show.Text.Int.showbIntAtBase: applied to unsupported base" <> showb base+ | n0 < 0 = error . P.show $ "Text.Show.Text.Int.showbIntAtBase: applied to negative number " <> showb n0+ | otherwise = showbIt (quotRem n0 base) mempty+ where+ showbIt (n, d) b = seq c $ -- stricter than necessary+ case n of+ 0 -> b'+ _ -> showbIt (quotRem n base) b'+ where+ c :: Char+ c = toChr $ fromIntegral d+ + b' :: Builder+ b' = s c <> b+{-# INLINE showbIntAtBase #-}++-- | Show /non-negative/ 'Integral' numbers in base 2.+showbBin :: (Integral a, Show a) => a -> Builder+showbBin = showbIntAtBase 2 intToDigit+{-# INLINE showbBin #-}++-- | Show /non-negative/ 'Integral' numbers in base 16.+showbHex :: (Integral a, Show a) => a -> Builder+showbHex = showbIntAtBase 16 intToDigit+{-# INLINE showbHex #-}++-- | Show /non-negative/ 'Integral' numbers in base 8.+showbOct :: (Integral a, Show a) => a -> Builder+showbOct = showbIntAtBase 8 intToDigit+{-# INLINE showbOct #-}++-- | Convert a 'Ratio' to a 'Builder' with the given precedence.+showbRatioPrec :: (Show a, Integral a) => Int -> Ratio a -> Builder+showbRatioPrec p q = showbParen (p > ratioPrec) $+ showbPrec ratioPrec1 (numerator q)+ <> " % "+ <> showbPrec ratioPrec1 (denominator q)+{-# INLINE showbRatioPrec #-}++-- | Convert a 'Word' to a 'Builder' with the given precedence.+showbWord :: Word -> Builder+showbWord = build+{-# INLINE showbWord #-}++-- | Convert a 'Word8' to a 'Builder' with the given precedence.+showbWord8 :: Word8 -> Builder+showbWord8 = build+{-# INLINE showbWord8 #-}++-- | Convert a 'Word16' to a 'Builder' with the given precedence.+showbWord16 :: Word16 -> Builder+showbWord16 = build+{-# INLINE showbWord16 #-}++-- | Convert a 'Word32' to a 'Builder' with the given precedence.+showbWord32 :: Word32 -> Builder+showbWord32 = build+{-# INLINE showbWord32 #-}++-- | Convert a 'Word64' to a 'Builder' with the given precedence.+showbWord64 :: Word64 -> Builder+showbWord64 = build+{-# INLINE showbWord64 #-}++instance Show Int where+ showbPrec = showbIntPrec+ {-# INLINE showbPrec #-}++instance Show Int8 where+ showbPrec = showbInt8Prec+ {-# INLINE showbPrec #-}++instance Show Int16 where+ showbPrec = showbInt16Prec+ {-# INLINE showbPrec #-}++instance Show Int32 where+ showbPrec = showbInt32Prec+ {-# INLINE showbPrec #-}++instance Show Int64 where+ showbPrec = showbInt64Prec+ {-# INLINE showbPrec #-}++instance Show Integer where+ showbPrec = showbIntegerPrec+ {-# INLINE showbPrec #-}++instance (Show a, Integral a) => Show (Ratio a) where+ {-# SPECIALIZE instance Show Rational #-}+ showbPrec = showbRatioPrec+ {-# INLINE showbPrec #-}++instance Show Word where+ showb = showbWord+ {-# INLINE showb #-}++instance Show Word8 where+ showb = showbWord8+ {-# INLINE showb #-}++instance Show Word16 where+ showb = showbWord16+ {-# INLINE showb #-}++instance Show Word32 where+ showb = showbWord32+ {-# INLINE showb #-}++instance Show Word64 where+ showb = showbWord64+ {-# INLINE showb #-}
+ src/Text/Show/Text/Data/List.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Data.List+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Exports 'showbListDefault'.+----------------------------------------------------------------------------+module Text.Show.Text.Data.List (showbListDefault) where++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showb, showbList), showbListDefault)+import Text.Show.Text.Data.Char ()+import Text.Show.Text.Data.Integral ()++instance Show a => Show [a] where+ {-# SPECIALIZE instance Show [String] #-}+ {-# SPECIALIZE instance Show [Char] #-}+ {-# SPECIALIZE instance Show [Int] #-}+ showb = showbList+ {-# INLINE showb #-}
+ src/Text/Show/Text/Data/Maybe.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Data.Maybe+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' function for 'Maybe' values.+----------------------------------------------------------------------------+module Text.Show.Text.Data.Maybe (showbMaybePrec) where++import Data.Text.Lazy.Builder (Builder)++import GHC.Show (appPrec, appPrec1)++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showbPrec), showbParen)+import Text.Show.Text.Utils ((<>))++-- | Convert a 'Maybe' value to a 'Builder' with the given precedence.+showbMaybePrec :: Show a => Int -> Maybe a -> Builder+showbMaybePrec _ Nothing = "Nothing"+showbMaybePrec p (Just a) = showbParen (p > appPrec) $ "Just " <> showbPrec appPrec1 a+{-# INLINE showbMaybePrec #-}++instance Show a => Show (Maybe a) where+ showbPrec = showbMaybePrec+ {-# INLINE showbPrec #-}
+ src/Text/Show/Text/Data/Monoid.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Data.Monoid+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' functions for 'Monoid'-related newtypes.+----------------------------------------------------------------------------+module Text.Show.Text.Data.Monoid (+ showbAllPrec+ , showbAnyPrec+ , showbDualPrec+ , showbFirstPrec+ , showbLastPrec+ , showbProductPrec+ , showbSumPrec+ ) where++import Data.Monoid (All(..), Any(..), Dual(..), First(..),+ Last(..), Product(..), Sum(..))+import Data.Text.Lazy.Builder (Builder)++import GHC.Show (appPrec)++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showb, showbPrec), showbParen)+import Text.Show.Text.Data.Bool (showbBool)+import Text.Show.Text.Data.Maybe (showbMaybePrec)+import Text.Show.Text.Utils ((<>), s)++-- | Convert an 'All' value to a 'Builder' with the given precedence.+showbAllPrec :: Int -> All -> Builder+showbAllPrec p (All a) = showbParen (p > appPrec) $+ "All {getAll = "+ <> showbBool a+ <> s '}'+{-# INLINE showbAllPrec #-}++-- | Convert an 'Any' value to a 'Builder' with the given precedence.+showbAnyPrec :: Int -> Any -> Builder+showbAnyPrec p (Any a) = showbParen (p > appPrec) $+ "Any {getAny = "+ <> showbBool a+ <> s '}'+{-# INLINE showbAnyPrec #-}++-- | Convert a 'Dual' value to a 'Builder' with the given precedence.+showbDualPrec :: Show a => Int -> Dual a -> Builder+showbDualPrec p (Dual d) = showbParen (p > appPrec) $+ "Dual {getDual = "+ <> showb d+ <> s '}'+{-# INLINE showbDualPrec #-}++-- | Convert a 'First' value to a 'Builder' with the given precedence.+showbFirstPrec :: Show a => Int -> First a -> Builder+showbFirstPrec p (First f) = showbParen (p > appPrec) $+ "First {getFirst = "+ <> showbMaybePrec 0 f+ <> s '}'+{-# INLINE showbFirstPrec #-}++-- | Convert a 'Last' value to a 'Builder' with the given precedence.+showbLastPrec :: Show a => Int -> Last a -> Builder+showbLastPrec p (Last l) = showbParen (p > appPrec) $+ "Last {getLast = "+ <> showbMaybePrec 0 l+ <> s '}'+{-# INLINE showbLastPrec #-}++-- | Convert a 'Product' value to a 'Builder' with the given precedence.+showbProductPrec :: Show a => Int -> Product a -> Builder+showbProductPrec p (Product prod) = showbParen (p > appPrec) $+ "Product {getProduct = "+ <> showb prod+ <> s '}'+{-# INLINE showbProductPrec #-}++-- | Convert a 'Sum' value to a 'Builder' with the given precedence.+showbSumPrec :: Show a => Int -> Sum a -> Builder+showbSumPrec p (Sum sum') = showbParen (p > appPrec) $+ "Sum {getSum = "+ <> showb sum'+ <> s '}'+{-# INLINE showbSumPrec #-}++instance Show All where+ showbPrec = showbAllPrec+ {-# INLINE showbPrec #-}++instance Show Any where+ showbPrec = showbAnyPrec+ {-# INLINE showbPrec #-}++instance Show a => Show (Dual a) where+ showbPrec = showbDualPrec+ {-# INLINE showbPrec #-}++instance Show a => Show (First a) where+ showbPrec = showbFirstPrec+ {-# INLINE showbPrec #-}++instance Show a => Show (Last a) where+ showbPrec = showbLastPrec+ {-# INLINE showbPrec #-}++instance Show a => Show (Product a) where+ showbPrec = showbProductPrec+ {-# INLINE showbPrec #-}++instance Show a => Show (Sum a) where+ showbPrec = showbSumPrec+ {-# INLINE showbPrec #-}
+ src/Text/Show/Text/Data/Ord.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE CPP, NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Data.Ord+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' functions for 'Ordering' and 'Down'.+----------------------------------------------------------------------------+module Text.Show.Text.Data.Ord (+ showbOrdering+#if MIN_VERSION_base(4,6,0)+ , showbDownPrec+#endif+ ) where++import Data.Text.Lazy.Builder (Builder)+import Prelude hiding (Show)+import Text.Show.Text.Class (Show(showb))++#if MIN_VERSION_base(4,6,0)+import Data.Ord (Down(..))+import GHC.Show (appPrec, appPrec1)+import Text.Show.Text.Class (showbPrec, showbParen)+import Text.Show.Text.Utils ((<>))+#endif++-- | Convert a 'Ordering' to a 'Builder'.+showbOrdering :: Ordering -> Builder+showbOrdering LT = "LT"+showbOrdering EQ = "EQ"+showbOrdering GT = "GT"+{-# INLINE showbOrdering #-}++instance Show Ordering where+ showb = showbOrdering+ {-# INLINE showb #-}++#if MIN_VERSION_base(4,6,0)+-- | Convert a 'Down' value to a 'Builder' with the given precedence.+showbDownPrec :: Show a => Int -> Down a -> Builder+showbDownPrec p (Down d) = showbParen (p > appPrec) $ "Down " <> showbPrec appPrec1 d+{-# INLINE showbDownPrec #-}++instance Show a => Show (Down a) where+ showbPrec = showbDownPrec+ {-# INLINE showbPrec #-}+#endif
+ src/Text/Show/Text/Data/Text.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Data.Text+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' functions for 'Text' types.+----------------------------------------------------------------------------+module Text.Show.Text.Data.Text (+ showbTextStrict+ , showbTextLazy+ ) where++import Data.Text as TS+import Data.Text.Lazy as TL+import Data.Text.Lazy.Builder (Builder, toLazyText)++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showb))+import Text.Show.Text.Data.Char ()+import Text.Show.Text.Data.List ()++-- | Convert a strict 'Text' into a 'Builder'.+showbTextStrict :: TS.Text -> Builder+showbTextStrict = showb . TS.unpack++-- | Convert a lazy 'Text' into a 'Builder'.+showbTextLazy :: TL.Text -> Builder+showbTextLazy = showb . TL.unpack++instance Show Builder where+ showb = showb . toLazyText+ {-# INLINE showb #-}++-- Strict variant+instance Show TS.Text where+ showb = showbTextStrict+ {-# INLINE showb #-}++-- Lazy variant+instance Show TL.Text where+ showb = showbTextLazy+ {-# INLINE showb #-}
+ src/Text/Show/Text/Data/Time.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Foreign.Data.Time+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' functions for data types in the @time@ library. These+-- are included for convenience (and because @time@ is a dependency of this+-- library).+----------------------------------------------------------------------------+module Text.Show.Text.Data.Time (+ showbDay+ , showbDiffTime+ , showbUTCTime+ , showbNominalDiffTime+ , showbAbsoluteTime+ , showbTimeZone+ , showbTimeOfDay+ , showbLocalTime+ ) where++import Data.Text.Buildable (build)+import Data.Text.Lazy.Builder (Builder)+import Data.Time.Calendar (Day)+import Data.Time.Clock (DiffTime, UTCTime, NominalDiffTime)+import Data.Time.Clock.TAI (AbsoluteTime, taiToUTCTime)+import Data.Time.LocalTime (TimeZone, TimeOfDay, LocalTime,+ utc, utcToLocalTime)++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showb))+import Text.Show.Text.Utils ((<>))++-- | Convert a 'Day' into a 'Builder'.+showbDay :: Day -> Builder+showbDay = build+{-# INLINE showbDay #-}++-- | Convert a 'DiffTime' into a 'Builder'.+showbDiffTime :: DiffTime -> Builder+showbDiffTime = build+{-# INLINE showbDiffTime #-}++-- | Convert a 'UTCTime' into a 'Builder'.+showbUTCTime :: UTCTime -> Builder+showbUTCTime = build+{-# INLINE showbUTCTime #-}++-- | Convert a 'NominalDiffTime' into a 'Builder'.+showbNominalDiffTime :: NominalDiffTime -> Builder+showbNominalDiffTime = build+{-# INLINE showbNominalDiffTime #-}++-- | Convert a 'AbsoluteTime' into a 'Builder'.+showbAbsoluteTime :: AbsoluteTime -> Builder+showbAbsoluteTime t = showbLocalTime (utcToLocalTime utc $ taiToUTCTime (const 0) t)+ <> " TAI" -- ugly, but standard apparently+{-# INLINE showbAbsoluteTime #-}++-- | Convert a 'TimeZone' into a 'Builder'.+showbTimeZone :: TimeZone -> Builder+showbTimeZone = build+{-# INLINE showbTimeZone #-}++-- | Convert a 'TimeOfDay' into a 'Builder'.+showbTimeOfDay :: TimeOfDay -> Builder+showbTimeOfDay = build+{-# INLINE showbTimeOfDay #-}++-- | Convert a 'LocalTime' into a 'Builder'.+showbLocalTime :: LocalTime -> Builder+showbLocalTime = build+{-# INLINE showbLocalTime #-}++instance Show Day where+ showb = showbDay+ {-# INLINE showb #-}++instance Show DiffTime where+ showb = showbDiffTime+ {-# INLINE showb #-}++instance Show UTCTime where+ showb = showbUTCTime+ {-# INLINE showb #-}++instance Show NominalDiffTime where+ showb = showbNominalDiffTime+ {-# INLINE showb #-}++instance Show AbsoluteTime where+ showb = showbAbsoluteTime+ {-# INLINE showb #-}++instance Show TimeZone where+ showb = showbTimeZone+ {-# INLINE showb #-}++instance Show TimeOfDay where+ showb = showbTimeOfDay+ {-# INLINE showb #-}++instance Show LocalTime where+ showb = showbLocalTime+ {-# INLINE showb #-}
+ src/Text/Show/Text/Data/Tuple.hs view
@@ -0,0 +1,333 @@+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Data.Tuple+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' functions for tuple types.+----------------------------------------------------------------------------+module Text.Show.Text.Data.Tuple (+ showbUnit+ , showb2Tuple+ , showb3Tuple+ , showb4Tuple+ , showb5Tuple+ , showb6Tuple+ , showb7Tuple+ , showb8Tuple+ , showb9Tuple+ , showb10Tuple+ , showb11Tuple+ , showb12Tuple+ , showb13Tuple+ , showb14Tuple+ , showb15Tuple+ ) where++import Data.Text.Lazy.Builder (Builder)++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showb))+import Text.Show.Text.Utils ((<>), s)++-- | Converts @()@ into a 'Builder'.+showbUnit :: () -> Builder+showbUnit () = "()"+{-# INLINE showbUnit #-}++-- | Converts a 2-tuple into a 'Builder'.+showb2Tuple :: (Show a, Show b) => (a, b) -> Builder+showb2Tuple (a, b) =+ s '(' <> showb a <>+ s ',' <> showb b <>+ s ')'+{-# INLINE showb2Tuple #-}++-- | Converts a 3-tuple into a 'Builder'.+showb3Tuple :: (Show a, Show b, Show c) => (a, b, c) -> Builder+showb3Tuple (a, b, c) =+ s '(' <> showb a <>+ s ',' <> showb b <>+ s ',' <> showb c <>+ s ')'+{-# INLINE showb3Tuple #-}++-- | Converts a 4-tuple into a 'Builder'.+showb4Tuple :: (Show a, Show b, Show c, Show d) => (a, b, c, d) -> Builder+showb4Tuple (a, b, c, d) =+ s '(' <> showb a <>+ s ',' <> showb b <>+ s ',' <> showb c <>+ s ',' <> showb d <>+ s ')'+{-# INLINE showb4Tuple #-}++-- | Converts a 5-tuple into a 'Builder'.+showb5Tuple :: (Show a, Show b, Show c, Show d, Show e) => (a, b, c, d, e) -> Builder+showb5Tuple (a, b, c, d, e) =+ s '(' <> showb a <>+ s ',' <> showb b <>+ s ',' <> showb c <>+ s ',' <> showb d <>+ s ',' <> showb e <>+ s ')'+{-# INLINE showb5Tuple #-}++-- | Converts a 6-tuple into a 'Builder'.+showb6Tuple :: (Show a, Show b, Show c, Show d, Show e, Show f) => (a, b, c, d, e, f) -> Builder+showb6Tuple (a, b, c, d, e, f) =+ s '(' <> showb a <>+ s ',' <> showb b <>+ s ',' <> showb c <>+ s ',' <> showb d <>+ s ',' <> showb e <>+ s ',' <> showb f <>+ s ')'+{-# INLINE showb6Tuple #-}++-- | Converts a 7-tuple into a 'Builder'.+showb7Tuple :: (Show a, Show b, Show c, Show d, Show e, Show f, Show g)+ => (a, b, c, d, e, f, g) -> Builder+showb7Tuple (a, b, c, d, e, f, g) =+ s '(' <> showb a <>+ s ',' <> showb b <>+ s ',' <> showb c <>+ s ',' <> showb d <>+ s ',' <> showb e <>+ s ',' <> showb f <>+ s ',' <> showb g <>+ s ')'+{-# INLINE showb7Tuple #-}++-- | Converts an 8-tuple into a 'Builder'.+showb8Tuple :: (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h)+ => (a, b, c, d, e, f, g, h) -> Builder+showb8Tuple (a, b, c, d, e, f, g, h) =+ s '(' <> showb a <>+ s ',' <> showb b <>+ s ',' <> showb c <>+ s ',' <> showb d <>+ s ',' <> showb e <>+ s ',' <> showb f <>+ s ',' <> showb g <>+ s ',' <> showb h <>+ s ')'+{-# INLINE showb8Tuple #-}++-- | Converts a 9-tuple into a 'Builder'.+showb9Tuple :: (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i)+ => (a, b, c, d, e, f, g, h, i) -> Builder+showb9Tuple (a, b, c, d, e, f, g, h, i) =+ s '(' <> showb a <>+ s ',' <> showb b <>+ s ',' <> showb c <>+ s ',' <> showb d <>+ s ',' <> showb e <>+ s ',' <> showb f <>+ s ',' <> showb g <>+ s ',' <> showb h <>+ s ',' <> showb i <>+ s ')'+{-# INLINE showb9Tuple #-}++-- | Converts a 10-tuple into a 'Builder'.+showb10Tuple :: (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j)+ => (a, b, c, d, e, f, g, h, i, j) -> Builder+showb10Tuple (a, b, c, d, e, f, g, h, i, j) =+ s '(' <> showb a <>+ s ',' <> showb b <>+ s ',' <> showb c <>+ s ',' <> showb d <>+ s ',' <> showb e <>+ s ',' <> showb f <>+ s ',' <> showb g <>+ s ',' <> showb h <>+ s ',' <> showb i <>+ s ',' <> showb j <>+ s ')'+{-# INLINE showb10Tuple #-}++-- | Converts an 11-tuple into a 'Builder'.+showb11Tuple :: (Show a, Show b, Show c, Show d, Show e, Show f,+ Show g, Show h, Show i, Show j, Show k)+ => (a, b, c, d, e, f, g, h, i, j, k) -> Builder+showb11Tuple (a, b, c, d, e, f, g, h, i, j, k) =+ s '(' <> showb a <>+ s ',' <> showb b <>+ s ',' <> showb c <>+ s ',' <> showb d <>+ s ',' <> showb e <>+ s ',' <> showb f <>+ s ',' <> showb g <>+ s ',' <> showb h <>+ s ',' <> showb i <>+ s ',' <> showb j <>+ s ',' <> showb k <>+ s ')'+{-# INLINE showb11Tuple #-}++-- | Converts a 12-tuple into a 'Builder'.+showb12Tuple :: (Show a, Show b, Show c, Show d, Show e, Show f,+ Show g, Show h, Show i, Show j, Show k, Show l)+ => (a, b, c, d, e, f, g, h, i, j, k, l) -> Builder+showb12Tuple (a, b, c, d, e, f, g, h, i, j, k, l) =+ s '(' <> showb a <>+ s ',' <> showb b <>+ s ',' <> showb c <>+ s ',' <> showb d <>+ s ',' <> showb e <>+ s ',' <> showb f <>+ s ',' <> showb g <>+ s ',' <> showb h <>+ s ',' <> showb i <>+ s ',' <> showb j <>+ s ',' <> showb k <>+ s ',' <> showb l <>+ s ')'+{-# INLINE showb12Tuple #-}++-- | Converts a 13-tuple into a 'Builder'.+showb13Tuple :: (Show a, Show b, Show c, Show d, Show e, Show f, Show g,+ Show h, Show i, Show j, Show k, Show l, Show m)+ => (a, b, c, d, e, f, g, h, i, j, k, l, m) -> Builder+showb13Tuple (a, b, c, d, e, f, g, h, i, j, k, l, m) =+ s '(' <> showb a <>+ s ',' <> showb b <>+ s ',' <> showb c <>+ s ',' <> showb d <>+ s ',' <> showb e <>+ s ',' <> showb f <>+ s ',' <> showb g <>+ s ',' <> showb h <>+ s ',' <> showb i <>+ s ',' <> showb j <>+ s ',' <> showb k <>+ s ',' <> showb l <>+ s ',' <> showb m <>+ s ')'+{-# INLINE showb13Tuple #-}++-- | Converts a 14-tuple into a 'Builder'.+showb14Tuple :: (Show a, Show b, Show c, Show d, Show e, Show f, Show g,+ Show h, Show i, Show j, Show k, Show l, Show m, Show n)+ => (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -> Builder+showb14Tuple (a, b, c, d, e, f, g, h, i, j, k, l, m, n) =+ s '(' <> showb a <>+ s ',' <> showb b <>+ s ',' <> showb c <>+ s ',' <> showb d <>+ s ',' <> showb e <>+ s ',' <> showb f <>+ s ',' <> showb g <>+ s ',' <> showb h <>+ s ',' <> showb i <>+ s ',' <> showb j <>+ s ',' <> showb k <>+ s ',' <> showb l <>+ s ',' <> showb m <>+ s ',' <> showb n <>+ s ')'+{-# INLINE showb14Tuple #-}++-- | Converts a 15-tuple into a 'Builder'.+showb15Tuple :: (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h,+ Show i, Show j, Show k, Show l, Show m, Show n, Show o)+ => (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -> Builder+showb15Tuple (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) =+ s '(' <> showb a <>+ s ',' <> showb b <>+ s ',' <> showb c <>+ s ',' <> showb d <>+ s ',' <> showb e <>+ s ',' <> showb f <>+ s ',' <> showb g <>+ s ',' <> showb h <>+ s ',' <> showb i <>+ s ',' <> showb j <>+ s ',' <> showb k <>+ s ',' <> showb l <>+ s ',' <> showb m <>+ s ',' <> showb n <>+ s ',' <> showb o <>+ s ')'+{-# INLINE showb15Tuple #-}++instance Show () where+ showb = showbUnit+ {-# INLINE showb #-}++instance (Show a, Show b) => Show (a, b) where+ showb = showb2Tuple+ {-# INLINE showb #-}++instance (Show a, Show b, Show c) => Show (a, b, c) where+ showb = showb3Tuple+ {-# INLINE showb #-}++instance (Show a, Show b, Show c, Show d) => Show (a, b, c, d) where+ showb = showb4Tuple+ {-# INLINE showb #-}++instance (Show a, Show b, Show c, Show d, Show e) => Show (a, b, c, d, e) where+ showb = showb5Tuple+ {-# INLINE showb #-}++instance (Show a, Show b, Show c, Show d, Show e, Show f) => Show (a, b, c, d, e, f) where+ showb = showb6Tuple+ {-# INLINE showb #-}++instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g) =>+ Show (a, b, c, d, e, f, g) where+ showb = showb7Tuple+ {-# INLINE showb #-}++instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h) =>+ Show (a, b, c, d, e, f, g, h) where+ showb = showb8Tuple+ {-# INLINE showb #-}++instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i) =>+ Show (a, b, c, d, e, f, g, h, i) where+ showb = showb9Tuple+ {-# INLINE showb #-}++instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j) =>+ Show (a, b, c, d, e, f, g, h, i, j) where+ showb = showb10Tuple+ {-# INLINE showb #-}++instance (Show a, Show b, Show c, Show d, Show e, Show f,+ Show g, Show h, Show i, Show j, Show k) =>+ Show (a, b, c, d, e, f, g, h, i, j, k) where+ showb = showb11Tuple+ {-# INLINE showb #-}++instance (Show a, Show b, Show c, Show d, Show e, Show f,+ Show g, Show h, Show i, Show j, Show k, Show l) =>+ Show (a, b, c, d, e, f, g, h, i, j, k, l) where+ showb = showb12Tuple+ {-# INLINE showb #-}++instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g,+ Show h, Show i, Show j, Show k, Show l, Show m) =>+ Show (a, b, c, d, e, f, g, h, i, j, k, l, m) where+ showb = showb13Tuple+ {-# INLINE showb #-}++instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g,+ Show h, Show i, Show j, Show k, Show l, Show m, Show n) =>+ Show (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where+ showb = showb14Tuple+ {-# INLINE showb #-}++instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h,+ Show i, Show j, Show k, Show l, Show m, Show n, Show o) =>+ Show (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where+ showb = showb15Tuple+ {-# INLINE showb #-}
+ src/Text/Show/Text/Data/Type/Coercion.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE GADTs, NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Data.Type.Coercion+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' function for representational equality.+----------------------------------------------------------------------------+module Text.Show.Text.Data.Type.Coercion (showbCoercion) where++import Data.Text.Lazy.Builder (Builder)+import Data.Type.Coercion (Coercion(..))++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showb))++-- | Convert a representational equality value to a 'Builder'.+showbCoercion :: Coercion a b -> Builder+showbCoercion Coercion = "Coercion"+{-# INLINE showbCoercion #-}++instance Show (Coercion a b) where+ showb = showbCoercion+ {-# INLINE showb #-}
+ src/Text/Show/Text/Data/Type/Equality.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE GADTs, NoImplicitPrelude, OverloadedStrings, TypeOperators #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Data.Type.Equality+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' function for propositional equality.+----------------------------------------------------------------------------+module Text.Show.Text.Data.Type.Equality (showbPropEquality) where++import Data.Text.Lazy.Builder (Builder)+import Data.Type.Equality ((:~:)(..))++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showb))++-- | Convert a propositional equality value to a 'Builder'.+showbPropEquality :: (a :~: b) -> Builder+showbPropEquality Refl = "Refl"+{-# INLINE showbPropEquality #-}++instance Show (a :~: b) where+ showb = showbPropEquality+ {-# INLINE showb #-}
+ src/Text/Show/Text/Data/Typeable.hs view
@@ -0,0 +1,148 @@+{-# LANGUAGE CPP, NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Data.Typeable+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' functions for data types in the @Typeable@ module.+----------------------------------------------------------------------------+module Text.Show.Text.Data.Typeable (+ showbTypeRepPrec+ , showbTyCon+#if MIN_VERSION_base(4,4,0)+ , showbFingerprint+#endif+#if MIN_VERSION_base(4,7,0)+ , showbProxy+#endif+ ) where++import Data.Monoid (mempty)+#if MIN_VERSION_base(4,7,0)+import Data.Proxy (Proxy(..))+#endif+import Data.Text.Lazy.Builder (Builder, fromString)+import Data.Typeable (TypeRep, typeRepArgs, typeRepTyCon)+#if MIN_VERSION_base(4,4,0)+import Data.Typeable.Internal (TyCon(..), funTc, listTc)+import GHC.Fingerprint.Type (Fingerprint(..))+#else+import Data.Typeable (TyCon, mkTyCon, tyConString, typeOf)+#endif+import Data.Word (Word64)++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showb, showbPrec), showbParen)+import Text.Show.Text.Data.Integral (showbHex)+import Text.Show.Text.Data.List ()+import Text.Show.Text.Utils ((<>), lengthB, replicateB, s)++-- | Convert a 'TypeRep' to a 'Builder' with the given precedence.+showbTypeRepPrec :: Int -> TypeRep -> Builder+showbTypeRepPrec p tyrep =+ case tys of+ [] -> showbTyCon tycon+ [x] | tycon == listTc -> s '[' <> showb x <> s ']'+ [a,r] | tycon == funTc -> showbParen (p > 8) $+ showbPrec 9 a+ <> " -> "+ <> showbPrec 8 r+ xs | isTupleTyCon tycon -> showbTuple xs+ | otherwise -> showbParen (p > 9) $+ showbPrec p tycon+ <> s ' '+ <> showbArgs (s ' ') tys+ where+ tycon = typeRepTyCon tyrep+ tys = typeRepArgs tyrep+{-# INLINE showbTypeRepPrec #-}++#if !(MIN_VERSION_base(4,4,0))+-- | The list 'TyCon'.+listTc :: TyCon+listTc = typeRepTyCon $ typeOf [()]+{-# INLINE listTc #-}++-- | The function (@->@) 'TyCon'.+funTc :: TyCon+funTc = mkTyCon "->"+#endif++-- | Does the 'TyCon' represent a tuple type constructor?+isTupleTyCon :: TyCon -> Bool+isTupleTyCon tycon = case tyconStr of+ ('(':',':_) -> True+ _ -> False+ where+ tyconStr = tyConString tycon+{-# INLINE isTupleTyCon #-}++-- | Helper function for showing a list of arguments, each separated by the given+-- 'Builder'.+showbArgs :: Show a => Builder -> [a] -> Builder+showbArgs _ [] = mempty+showbArgs _ [a] = showbPrec 10 a+showbArgs sep (a:as) = showbPrec 10 a <> sep <> showbArgs sep as+{-# INLINE showbArgs #-}++-- | Helper function for showing a list of 'TypeRep's in a tuple.+showbTuple :: [TypeRep] -> Builder+showbTuple args = s '(' <> showbArgs (s ',') args <> s ')'+{-# INLINE showbTuple #-}++-- | Convert a 'TyCon' to a 'Builder'.+showbTyCon :: TyCon -> Builder+showbTyCon = fromString . tyConString+{-# INLINE showbTyCon #-}++#if MIN_VERSION_base(4,7,0)+-- | Convert a 'Proxy' type to a 'Builder'.+showbProxy :: Proxy s -> Builder+showbProxy _ = "Proxy"+{-# INLINE showbProxy #-}+#endif++#if MIN_VERSION_base(4,4,0)+-- | Convert a 'Fingerprint' to a 'Builder'.+showbFingerprint :: Fingerprint -> Builder+showbFingerprint (Fingerprint w1 w2) = hex16 w1 <> hex16 w2+ where+ hex16 :: Word64 -> Builder+ hex16 i = let hex = showbHex i+ in replicateB (16 - lengthB hex) (s '0') <> hex+{-# INLINE showbFingerprint #-}+#endif++#if MIN_VERSION_base(4,4,0)+-- | Identical to 'tyConName'. Defined to avoid using excessive amounts of pragmas+-- with base-4.3 and earlier, which use 'tyConString'.+tyConString :: TyCon -> String+tyConString = tyConName+{-# INLINE tyConString #-}+#endif++instance Show TypeRep where+ showbPrec = showbTypeRepPrec+ {-# INLINE showbPrec #-}++instance Show TyCon where+ showb = showbTyCon+ {-# INLINE showb #-}++#if MIN_VERSION_base(4,4,0)+instance Show Fingerprint where+ showb = showbFingerprint+ {-# INLINE showb #-}+#endif++#if MIN_VERSION_base(4,7,0)+instance Show (Proxy s) where+ showb = showbProxy+ {-# INLINE showb #-}+#endif
+ src/Text/Show/Text/Data/Version.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Data.Version+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' function for 'Version'.+----------------------------------------------------------------------------+module Text.Show.Text.Data.Version (+ showbVersionPrec+ , showbVersionConcrete+ ) where++import Data.List (intersperse)+import Data.Monoid (mconcat)+import Data.Text.Lazy.Builder (Builder, fromString)+import Data.Version (Version(..))++import GHC.Show (appPrec)++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showb, showbPrec), showbParen)+import Text.Show.Text.Data.Char ()+import Text.Show.Text.Data.Integral ()+import Text.Show.Text.Data.List ()+import Text.Show.Text.Utils ((<>), s)++-- | Convert a 'Version' to a 'Builder' with the given precedence.+showbVersionPrec :: Int -> Version -> Builder+showbVersionPrec p (Version b t) = showbParen (p > appPrec) $+ "Version {versionBranch = "+ <> showb b+ <> ", versionTags = "+ <> showb t+ <> s '}'+{-# INLINE showbVersionPrec #-}++-- | Provides one possible concrete representation for 'Version'. For+-- a version with 'versionBranch' @= [1,2,3]@ and 'versionTags' +-- @= [\"tag1\",\"tag2\"]@, the output will be @1.2.3-tag1-tag2@.+showbVersionConcrete :: Version -> Builder+showbVersionConcrete (Version branch tags)+ = mconcat (intersperse (s '.') $ map showb branch) <>+ mconcat (map ((s '-' <>) . fromString) tags)+{-# INLINE showbVersionConcrete #-}++instance Show Version where+ showbPrec = showbVersionPrec+ {-# INLINE showbPrec #-}
+ src/Text/Show/Text/Foreign.hs view
@@ -0,0 +1,15 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Foreign+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Imports 'Show' instances for @Foreign@ modules.+----------------------------------------------------------------------------+module Text.Show.Text.Foreign () where++import Text.Show.Text.Foreign.C.Types ()+import Text.Show.Text.Foreign.Ptr ()
+ src/Text/Show/Text/Foreign/C/Types.hs view
@@ -0,0 +1,202 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, NoImplicitPrelude, StandaloneDeriving #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Foreign.C.Types+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' functions for Haskell newtypes corresponding to C+-- types in the Foreign Function Interface (FFI).+----------------------------------------------------------------------------+module Text.Show.Text.Foreign.C.Types (+ showbCCharPrec+ , showbCSCharPrec+ , showbCUChar+ , showbCShortPrec+ , showbCUShort+ , showbCIntPrec+ , showbCUInt+ , showbCLongPrec+ , showbCULong+ , showbCPtrdiffPrec+ , showbCSize+ , showbCWcharPrec+ , showbCSigAtomicPrec+ , showbCLLongPrec+ , showbCULLong+ , showbCIntPtrPrec+ , showbCUIntPtr+ , showbCIntMaxPrec+ , showbCUIntMax+ , showbCClockPrec+ , showbCTimePrec+ , showbCUSeconds+ , showbCSUSecondsPrec+ , showbCFloatPrec+ , showbCDoublePrec+ ) where++import Data.Text.Lazy.Builder (Builder)++import Foreign.C.Types++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showb, showbPrec))+import Text.Show.Text.Data.Integral ()+import Text.Show.Text.Data.Floating ()++-- | Convert a 'CChar' to a 'Builder' with the given precedence.+showbCCharPrec :: Int -> CChar -> Builder+showbCCharPrec = showbPrec+{-# INLINE showbCCharPrec #-}++-- | Convert a 'CSChar' to a 'Builder' with the given precedence.+showbCSCharPrec :: Int -> CSChar -> Builder+showbCSCharPrec = showbPrec+{-# INLINE showbCSCharPrec #-}++-- | Convert a 'CUChar' to a 'Builder'.+showbCUChar :: CUChar -> Builder+showbCUChar = showb+{-# INLINE showbCUChar #-}++-- | Convert a 'CShort' to a 'Builder' with the given precedence.+showbCShortPrec :: Int -> CShort -> Builder+showbCShortPrec = showbPrec+{-# INLINE showbCShortPrec #-}++-- | Convert a 'CUShort' to a 'Builder'.+showbCUShort :: CUShort -> Builder+showbCUShort = showb+{-# INLINE showbCUShort #-}++-- | Convert a 'CInt' to a 'Builder' with the given precedence.+showbCIntPrec :: Int -> CInt -> Builder+showbCIntPrec = showbPrec+{-# INLINE showbCIntPrec #-}++-- | Convert a 'CUInt' to a 'Builder'.+showbCUInt :: CUInt -> Builder+showbCUInt = showb+{-# INLINE showbCUInt #-}++-- | Convert a 'CLong' to a 'Builder' with the given precedence.+showbCLongPrec :: Int -> CLong -> Builder+showbCLongPrec = showbPrec+{-# INLINE showbCLongPrec #-}++-- | Convert a 'CULong' to a 'Builder'.+showbCULong :: CULong -> Builder+showbCULong = showb+{-# INLINE showbCULong #-}++-- | Convert a 'CPtrdiff' to a 'Builder' with the given precedence.+showbCPtrdiffPrec :: Int -> CPtrdiff -> Builder+showbCPtrdiffPrec = showbPrec+{-# INLINE showbCPtrdiffPrec #-}++-- | Convert a 'CSize' to a 'Builder'.+showbCSize :: CSize -> Builder+showbCSize = showb+{-# INLINE showbCSize #-}++-- | Convert a 'CWchar' to a 'Builder' with the given precedence.+showbCWcharPrec :: Int -> CWchar -> Builder+showbCWcharPrec = showbPrec+{-# INLINE showbCWcharPrec #-}++-- | Convert a 'CSigAtomic' to a 'Builder' with the given precedence.+showbCSigAtomicPrec :: Int -> CSigAtomic -> Builder+showbCSigAtomicPrec = showbPrec+{-# INLINE showbCSigAtomicPrec #-}++-- | Convert a 'CLLong' to a 'Builder' with the given precedence.+showbCLLongPrec :: Int -> CLLong -> Builder+showbCLLongPrec = showbPrec+{-# INLINE showbCLLongPrec #-}++-- | Convert a 'CULLong' to a 'Builder'.+showbCULLong :: CULLong -> Builder+showbCULLong = showb+{-# INLINE showbCULLong #-}++-- | Convert a 'CIntPtr' to a 'Builder' with the given precedence.+showbCIntPtrPrec :: Int -> CIntPtr -> Builder+showbCIntPtrPrec = showbPrec+{-# INLINE showbCIntPtrPrec #-}++-- | Convert a 'CUIntPtr' to a 'Builder'.+showbCUIntPtr :: CUIntPtr -> Builder+showbCUIntPtr = showb+{-# INLINE showbCUIntPtr #-}++-- | Convert a 'CIntMax' to a 'Builder' with the given precedence.+showbCIntMaxPrec :: Int -> CIntMax -> Builder+showbCIntMaxPrec = showbPrec+{-# INLINE showbCIntMaxPrec #-}++-- | Convert a 'CUIntMax' to a 'Builder'.+showbCUIntMax :: CUIntMax -> Builder+showbCUIntMax = showb+{-# INLINE showbCUIntMax #-}++-- | Convert a 'CClock' to a 'Builder' with the given precedence.+showbCClockPrec :: Int -> CClock -> Builder+showbCClockPrec = showbPrec+{-# INLINE showbCClockPrec #-}++-- | Convert a 'CTime' to a 'Builder' with the given precedence.+showbCTimePrec :: Int -> CTime -> Builder+showbCTimePrec = showbPrec+{-# INLINE showbCTimePrec #-}++-- | Convert a 'CUSeconds' value to a 'Builder'.+showbCUSeconds :: CUSeconds -> Builder+showbCUSeconds = showb+{-# INLINE showbCUSeconds #-}++-- | Convert a 'CSUSeconds' value to a 'Builder' with the given precedence.+showbCSUSecondsPrec :: Int -> CSUSeconds -> Builder+showbCSUSecondsPrec = showbPrec+{-# INLINE showbCSUSecondsPrec #-}++-- | Convert a 'CFloat' to a 'Builder' with the given precedence.+showbCFloatPrec :: Int -> CFloat -> Builder+showbCFloatPrec = showbPrec+{-# INLINE showbCFloatPrec #-}++-- | Convert a 'CDouble' to a 'Builder' with the given precedence.+showbCDoublePrec :: Int -> CDouble -> Builder+showbCDoublePrec = showbPrec+{-# INLINE showbCDoublePrec #-}++deriving instance Show CChar+deriving instance Show CSChar+deriving instance Show CUChar+deriving instance Show CShort+deriving instance Show CUShort+deriving instance Show CInt+deriving instance Show CUInt+deriving instance Show CLong+deriving instance Show CULong+deriving instance Show CPtrdiff+deriving instance Show CSize+deriving instance Show CWchar+deriving instance Show CSigAtomic+deriving instance Show CLLong+deriving instance Show CULLong+deriving instance Show CIntPtr+deriving instance Show CUIntPtr+deriving instance Show CIntMax+deriving instance Show CUIntMax+deriving instance Show CClock+deriving instance Show CTime+deriving instance Show CUSeconds+deriving instance Show CSUSeconds+deriving instance Show CFloat+deriving instance Show CDouble
+ src/Text/Show/Text/Foreign/Ptr.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE CPP, MagicHash, NoImplicitPrelude #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Foreign.Ptr+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' functions for pointer types used in the Haskell+-- Foreign Function Interface (FFI).+----------------------------------------------------------------------------+module Text.Show.Text.Foreign.Ptr (+ showbPtr+ , showbFunPtr+ , showbIntPtrPrec+ , showbWordPtr+ , showbForeignPtr+ ) where++import Data.Text.Lazy.Builder (Builder)++import Foreign.ForeignPtr (ForeignPtr)+import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)+import Foreign.Ptr (FunPtr, IntPtr, WordPtr, castFunPtrToPtr)++import GHC.Num (wordToInteger)+import GHC.Ptr (Ptr(..))+import GHC.Prim (addr2Int#, int2Word#, unsafeCoerce#)++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showb, showbPrec))+import Text.Show.Text.Data.Integral (showbHex, showbIntPrec, showbWord)+import Text.Show.Text.Utils ((<>), lengthB, replicateB, s)++#include "MachDeps.h"++-- | Convert a 'Ptr' to a 'Builder'. Note that this does not require the parameterized+-- type to be an instance of 'Show' itself.+showbPtr :: Ptr a -> Builder+showbPtr (Ptr a) = padOut . showbHex $ wordToInteger (int2Word# (addr2Int# a))+ where+ padOut :: Builder -> Builder+ padOut ls = s '0' <> s 'x'+ <> replicateB (2*SIZEOF_HSPTR - lengthB ls) (s '0')+ <> ls++-- | Convert a 'FunPtr' to a 'Builder'. Note that this does not require the+-- parameterized type to be an instance of 'Show' itself.+showbFunPtr :: FunPtr a -> Builder+showbFunPtr = showb . castFunPtrToPtr+{-# INLINE showbFunPtr #-}++-- | Convert an 'IntPtr' to a 'Builder' with the given precedence.+showbIntPtrPrec :: Int -> IntPtr -> Builder+showbIntPtrPrec k ip = showbIntPrec k $ unsafeCoerce# ip++-- | Convert a 'WordPtr' to a 'Builder'.+showbWordPtr :: WordPtr -> Builder+showbWordPtr wp = showbWord $ unsafeCoerce# wp++-- | Convert a 'ForeignPtr' to a 'Builder'. Note that this does not require the+-- parameterized type to be an instance of 'Show' itself.+showbForeignPtr :: ForeignPtr a -> Builder+showbForeignPtr = showb . unsafeForeignPtrToPtr+{-# INLINE showbForeignPtr #-}++instance Show (Ptr a) where+ showb = showbPtr+ {-# INLINE showb #-}++instance Show (FunPtr a) where+ showb = showbFunPtr+ {-# INLINE showb #-}++instance Show IntPtr where+ showbPrec = showbIntPtrPrec+ {-# INLINE showbPrec #-}++instance Show WordPtr where+ showb = showbWordPtr+ {-# INLINE showb #-}++instance Show (ForeignPtr a) where+ showb = showbForeignPtr+ {-# INLINE showb #-}
+ src/Text/Show/Text/Functions.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Functions+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Optional 'Show' instance for functions.+----------------------------------------------------------------------------+module Text.Show.Text.Functions (showbFunction) where++import Data.Text.Lazy.Builder (Builder)+import Prelude hiding (Show)+import Text.Show.Text.Class (Show(showb))++-- | Convert a function to a 'Builder'.+showbFunction :: (a -> b) -> Builder+showbFunction = const "<function>"+{-# INLINE showbFunction #-}++instance Show (a -> b) where+ showb = showbFunction+ {-# INLINE showb #-}
+ src/Text/Show/Text/GHC.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.GHC+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Imports 'Show' instances for @GHC@ modules.+----------------------------------------------------------------------------+module Text.Show.Text.GHC () where ++#if MIN_VERSION_base(4,4,0)+import Text.Show.Text.GHC.Event ()+import Text.Show.Text.GHC.Generics ()+#endif+#if MIN_VERSION_base(4,5,0)+import Text.Show.Text.GHC.Stats ()+#endif
+ src/Text/Show/Text/GHC/Event.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.GHC.Stats+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' functions for data types in the @Event@ module.+----------------------------------------------------------------------------+module Text.Show.Text.GHC.Event (showbEvent, showbFdKeyPrec) where ++import Data.Text.Lazy.Builder (Builder, fromString)++import GHC.Event (Event, FdKey)++import qualified Prelude as P+import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showb, showbPrec))++-- | Convert an 'Event' to a 'Builder'.+showbEvent :: Event -> Builder+showbEvent = fromString . P.show+{-# INLINE showbEvent #-}++-- | Convert an 'FdKey' to a 'Builder' with the given precedence.+showbFdKeyPrec :: Int -> FdKey -> Builder+showbFdKeyPrec p fdKey = fromString $ P.showsPrec p fdKey ""+{-# INLINE showbFdKeyPrec #-}++instance Show Event where+ showb = showbEvent+ {-# INLINE showb #-}++instance Show FdKey where+ showbPrec = showbFdKeyPrec+ {-# INLINE showbPrec #-}
+ src/Text/Show/Text/GHC/Generics.hs view
@@ -0,0 +1,156 @@+{-# LANGUAGE FlexibleContexts, NoImplicitPrelude, OverloadedStrings, TypeOperators #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.GHC.Generics+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' functions for generics-related data types.+----------------------------------------------------------------------------+module Text.Show.Text.GHC.Generics (+ showbU1+ , showbPar1Prec+ , showbRec1Prec+ , showbK1Prec+ , showbM1Prec+ , showbSumTypePrec+ , showbProductTypePrec+ , showbCompFunctorsPrec+ , showbFixityPrec+ , showbAssociativity+ , showbArityPrec+ ) where++import Data.Text.Lazy.Builder (Builder)++import GHC.Generics (U1(..), Par1(..), Rec1(..), K1(..),+ M1(..), (:+:)(..), (:*:)(..), (:.:)(..),+ Fixity(..), Associativity(..), Arity(..))+import GHC.Show (appPrec, appPrec1)++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showb, showbPrec), showbParen)+import Text.Show.Text.Data.Integral (showbIntPrec)+import Text.Show.Text.Utils ((<>), s)++-- | Convert a 'U1' value to a 'Builder'.+showbU1 :: U1 p -> Builder+showbU1 U1 = "U1"+{-# INLINE showbU1 #-}++-- | Convert a 'Par1' value to a 'Builder' with the given precedence.+showbPar1Prec :: Show p => Int -> Par1 p -> Builder+showbPar1Prec p (Par1 up) = showbParen (p > appPrec) $+ "Par1 {unPar1 = " <> showb up <> s '}'+{-# INLINE showbPar1Prec #-}++-- | Convert a 'Rec1' value to a 'Builder' with the given precedence.+showbRec1Prec :: Show (f p) => Int -> Rec1 f p -> Builder+showbRec1Prec p (Rec1 ur) = showbParen (p > appPrec) $+ "Rec1 {unRec1 = " <> showb ur <> s '}'+{-# INLINE showbRec1Prec #-}++-- | Convert a 'K1' value to a 'Builder' with the given precedence.+showbK1Prec :: Show c => Int -> K1 i c p -> Builder+showbK1Prec p (K1 uk) = showbParen (p > appPrec) $+ "K1 {unK1 = " <> showb uk <> s '}'+{-# INLINE showbK1Prec #-}++-- | Convert an 'M1' value to a 'Builder' with the given precedence.+showbM1Prec :: Show (f p) => Int -> M1 i c f p -> Builder+showbM1Prec p (M1 um) = showbParen (p > appPrec) $+ "M1 {unM1 = " <> showb um <> s '}'+{-# INLINE showbM1Prec #-}++-- | Convert a '(:+:)' value to a 'Builder' with the given precedence.+showbSumTypePrec :: (Show (f p), Show (g p)) => Int -> (f :+: g) p -> Builder+showbSumTypePrec p (L1 l) = showbParen (p > appPrec) $ "L1 " <> showbPrec appPrec1 l+showbSumTypePrec p (R1 r) = showbParen (p > appPrec) $ "R1 " <> showbPrec appPrec1 r+{-# INLINE showbSumTypePrec #-}++-- | Convert an '(:*:)' value to a 'Builder' with the given precedence.+showbProductTypePrec :: (Show (f p), Show (g p)) => Int -> (f :*: g) p -> Builder+showbProductTypePrec p (l :*: r) = showbParen (p > prec) $+ showbPrec (prec + 1) l+ <> " :*: "+ <> showbPrec (prec + 1) r+ where+ prec :: Int+ prec = 6+{-# INLINE showbProductTypePrec #-}++-- | Convert an '(:.:)' value to a 'Builder' with the given precedence.+showbCompFunctorsPrec :: Show (f (g p)) => Int -> (f :.: g) p -> Builder+showbCompFunctorsPrec p (Comp1 uc) = showbParen (p > appPrec) $+ "Comp1 {unComp1 = " <> showb uc <> s '}'+{-# INLINE showbCompFunctorsPrec #-}++-- | Convert a 'Fixity' value to a 'Builder' with the given precedence.+showbFixityPrec :: Int -> Fixity -> Builder+showbFixityPrec _ Prefix = "Prefix"+showbFixityPrec p (Infix a i) = showbParen (p > appPrec) $+ "Infix " <> showbAssociativity a <> s ' ' <> showbIntPrec appPrec1 i+{-# INLINE showbFixityPrec #-}++-- | Convert an 'Associativity' value to a 'Builder'.+showbAssociativity :: Associativity -> Builder+showbAssociativity LeftAssociative = "LeftAssociative"+showbAssociativity RightAssociative = "RightAssociative"+showbAssociativity NotAssociative = "NotAssociative"+{-# INLINE showbAssociativity #-}++-- | Convert an 'Arity' value to a 'Builder' with the given precedence.+showbArityPrec :: Int -> Arity -> Builder+showbArityPrec _ NoArity = "NoArity"+showbArityPrec p (Arity i) = showbParen (p > appPrec) $+ "Arity " <> showbIntPrec appPrec1 i+{-# INLINE showbArityPrec #-}++instance Show (U1 p) where+ showb = showbU1+ {-# INLINE showb #-}++instance Show p => Show (Par1 p) where+ showbPrec = showbPar1Prec+ {-# INLINE showbPrec #-}++instance Show (f p) => Show (Rec1 f p) where+ showbPrec = showbRec1Prec+ {-# INLINE showbPrec #-}++instance Show c => Show (K1 i c p) where+ showbPrec = showbK1Prec+ {-# INLINE showbPrec #-}++instance Show (f p) => Show (M1 i c f p) where+ showbPrec = showbM1Prec+ {-# INLINE showbPrec #-}++instance (Show (f p), Show (g p)) => Show ((f :+: g) p) where+ showbPrec = showbSumTypePrec+ {-# INLINE showbPrec #-}++instance (Show (f p), Show (g p)) => Show ((f :*: g) p) where+ showbPrec = showbProductTypePrec+ {-# INLINE showbPrec #-}++instance Show (f (g p)) => Show ((f :.: g) p) where+ showbPrec = showbCompFunctorsPrec+ {-# INLINE showbPrec #-}++instance Show Fixity where+ showbPrec = showbFixityPrec+ {-# INLINE showbPrec #-}++instance Show Associativity where+ showb = showbAssociativity+ {-# INLINE showb #-}++instance Show Arity where+ showbPrec = showbArityPrec+ {-# INLINE showbPrec #-}
+ src/Text/Show/Text/GHC/Stats.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE CPP, NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.GHC.Stats+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' function for 'GCStats'.+----------------------------------------------------------------------------+module Text.Show.Text.GHC.Stats (showbGCStatsPrec) where ++import Data.Text.Lazy.Builder (Builder)++import GHC.Show (appPrec)+import GHC.Stats (GCStats(..))++import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showbPrec), showbParen)+import Text.Show.Text.Data.Integral (showbInt64Prec)+import Text.Show.Text.Data.Floating (showbDoublePrec)+import Text.Show.Text.Utils ((<>), s)++-- | Convert a 'GCStats' value to a 'Builder' with the given precedence.+showbGCStatsPrec :: Int -> GCStats -> Builder+showbGCStatsPrec p gcStats = showbParen (p > appPrec) $+ "GCStats {bytesAllocated = "+ <> showbInt64Prec 0 (bytesAllocated gcStats)+ <> ", numGcs = "+ <> showbInt64Prec 0 (numGcs gcStats)+ <> ", maxBytesUsed = "+ <> showbInt64Prec 0 (maxBytesUsed gcStats)+ <> ", numByteUsageSamples = "+ <> showbInt64Prec 0 (numByteUsageSamples gcStats)+ <> ", cumulativeBytesUsed = "+ <> showbInt64Prec 0 (cumulativeBytesUsed gcStats)+ <> ", bytesCopied = "+ <> showbInt64Prec 0 (bytesCopied gcStats)+ <> ", currentBytesUsed = "+ <> showbInt64Prec 0 (currentBytesUsed gcStats)+ <> ", currentBytesSlop = "+ <> showbInt64Prec 0 (currentBytesSlop gcStats)+ <> ", maxBytesSlop = "+ <> showbInt64Prec 0 (maxBytesSlop gcStats)+ <> ", peakMegabytesAllocated = "+ <> showbInt64Prec 0 (peakMegabytesAllocated gcStats)+ <> ", mutatorCpuSeconds = "+ <> showbDoublePrec 0 (mutatorCpuSeconds gcStats)+ <> ", mutatorWallSeconds = "+ <> showbDoublePrec 0 (mutatorWallSeconds gcStats)+ <> ", gcCpuSeconds = "+ <> showbDoublePrec 0 (gcCpuSeconds gcStats)+ <> ", gcWallSeconds = "+ <> showbDoublePrec 0 (gcWallSeconds gcStats)+ <> ", cpuSeconds = "+ <> showbDoublePrec 0 (cpuSeconds gcStats)+ <> ", wallSeconds = "+ <> showbDoublePrec 0 (wallSeconds gcStats)+#if MIN_VERSION_base(4,6,0)+ <> ", parTotBytesCopied = "+ <> showbInt64Prec 0 (parTotBytesCopied gcStats)+#else+ <> ", parAvgBytesCopied = "+ <> showbInt64Prec 0 (parAvgBytesCopied gcStats)+#endif+ <> ", parMaxBytesCopied = "+ <> showbInt64Prec 0 (parMaxBytesCopied gcStats)+ <> s '}'+{-# INLINE showbGCStatsPrec #-}++instance Show GCStats where+ showbPrec = showbGCStatsPrec+ {-# INLINE showbPrec #-}
+ src/Text/Show/Text/Instances.hs view
@@ -0,0 +1,19 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Instances+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Imports 'Show' instances for all data types covered by @text-show@.+---------------------------------------------------------------------------- +module Text.Show.Text.Instances () where++import Text.Show.Text.Control ()+import Text.Show.Text.Data ()+import Text.Show.Text.Foreign ()+import Text.Show.Text.GHC ()+import Text.Show.Text.System ()+import Text.Show.Text.Text ()
+ src/Text/Show/Text/System.hs view
@@ -0,0 +1,16 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.System+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Imports 'Show' functions for @System@ modules.+----------------------------------------------------------------------------+module Text.Show.Text.System () where ++import Text.Show.Text.System.Exit ()+import Text.Show.Text.System.IO ()+import Text.Show.Text.System.Posix.Types ()
+ src/Text/Show/Text/System/Exit.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Data.Monoid+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' function for 'ExitCode'.+----------------------------------------------------------------------------+module Text.Show.Text.System.Exit (showbExitCodePrec) where++import Data.Text.Lazy.Builder (Builder)++import GHC.Show (appPrec, appPrec1)++import Prelude hiding (Show)++import System.Exit (ExitCode(..))++import Text.Show.Text.Class (Show(showbPrec), showbParen)+import Text.Show.Text.Data.Integral (showbIntPrec)+import Text.Show.Text.Utils ((<>))++-- | Convert an 'ExitCode' to a 'Builder' with the given precedence.+showbExitCodePrec :: Int -> ExitCode -> Builder+showbExitCodePrec _ ExitSuccess = "ExitSuccess"+showbExitCodePrec p (ExitFailure c) = showbParen (p > appPrec) $+ "ExitFailure " <> showbIntPrec appPrec1 c+{-# INLINE showbExitCodePrec #-}++instance Show ExitCode where+ showbPrec = showbExitCodePrec+ {-# INLINE showbPrec #-}
+ src/Text/Show/Text/System/IO.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE CPP, NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.System.IO+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' functions for 'IO'-related data types.+---------------------------------------------------------------------------- +module Text.Show.Text.System.IO (+ showbHandle+ , showbIOMode+ , showbBufferModePrec+ , showbHandlePosn+ , showbSeekMode+#if MIN_VERSION_base(4,3,0)+ , showbTextEncoding+#endif+#if MIN_VERSION_base(4,4,0)+ , showbCodingProgress+ , showbCodingFailureMode+#endif+ , showbNewline+ , showbNewlineModePrec+ ) where++import Data.Text.Lazy.Builder (Builder, fromString)++#if MIN_VERSION_base(4,3,0)+import GHC.IO.Encoding.Types (TextEncoding(..))+#endif+#if MIN_VERSION_base(4,4,0)+import GHC.IO.Encoding.Failure (CodingFailureMode(..))+import GHC.IO.Encoding.Types (CodingProgress(..))+#endif+import GHC.IO.Handle (HandlePosn(..))+import GHC.IO.Handle.Types (Handle(..))+import GHC.Show (appPrec, appPrec1)++import Prelude hiding (Show)++import System.IO (BufferMode(..), IOMode(..), Newline(..),+ NewlineMode(..), SeekMode(..))++import Text.Show.Text.Class (Show(showb, showbPrec), showbParen)+import Text.Show.Text.Data.Integral (showbIntegerPrec)+import Text.Show.Text.Data.Maybe (showbMaybePrec)+import Text.Show.Text.Utils ((<>), s)++-- | Convert a 'Handle' to a 'Builder'.+showbHandle :: Handle -> Builder+showbHandle (FileHandle file _) = showbHandleFilePath file+showbHandle (DuplexHandle file _ _) = showbHandleFilePath file+{-# INLINE showbHandle #-}++-- | Convert a 'Handle`'s 'FilePath' to a 'Builder'.+showbHandleFilePath :: FilePath -> Builder+showbHandleFilePath file = "{handle: " <> fromString file <> s '}'+{-# INLINE showbHandleFilePath #-}++-- | Convert an 'IOMode' to a 'Builder'.+showbIOMode :: IOMode -> Builder+showbIOMode ReadMode = "ReadMode"+showbIOMode WriteMode = "WriteMode"+showbIOMode AppendMode = "AppendMode"+showbIOMode ReadWriteMode = "ReadWriteMode"+{-# INLINE showbIOMode #-}++-- | Convert a 'BufferMode' to a 'Builder' with the given precedence.+showbBufferModePrec :: Int -> BufferMode -> Builder+showbBufferModePrec _ NoBuffering = "NoBuffering"+showbBufferModePrec _ LineBuffering = "LineBuffering"+showbBufferModePrec p (BlockBuffering size)+ = showbParen (p > appPrec) $ "BlockBuffering " <> showbMaybePrec appPrec1 size+{-# INLINE showbBufferModePrec #-}++-- | Convert a 'HandlePosn' to a 'Builder'.+showbHandlePosn :: HandlePosn -> Builder+showbHandlePosn (HandlePosn h pos)+ = showbHandle h <> " at position " <> showbIntegerPrec 0 pos+{-# INLINE showbHandlePosn #-}++-- | Convert a 'SeekMode' to a 'Builder'.+showbSeekMode :: SeekMode -> Builder+showbSeekMode AbsoluteSeek = "AbsoluteSeek"+showbSeekMode RelativeSeek = "RelativeSeek"+showbSeekMode SeekFromEnd = "SeekFromEnd"+{-# INLINE showbSeekMode #-}++#if MIN_VERSION_base(4,3,0)+-- | Convert a 'TextEncoding' to a 'Builder'.+showbTextEncoding :: TextEncoding -> Builder+showbTextEncoding = fromString . textEncodingName+{-# INLINE showbTextEncoding #-}+#endif++#if MIN_VERSION_base(4,4,0)+-- | Convert a 'CodingProgress' to a 'Builder'.+showbCodingProgress :: CodingProgress -> Builder+showbCodingProgress InputUnderflow = "InputUnderflow"+showbCodingProgress OutputUnderflow = "OutputUnderflow"+showbCodingProgress InvalidSequence = "InvalidSequence"+{-# INLINE showbCodingProgress #-}++-- | Convert a 'CodingFailureMode' value to a 'Builder'.+showbCodingFailureMode :: CodingFailureMode -> Builder+showbCodingFailureMode ErrorOnCodingFailure = "ErrorOnCodingFailure"+showbCodingFailureMode IgnoreCodingFailure = "IgnoreCodingFailure"+showbCodingFailureMode TransliterateCodingFailure = "TransliterateCodingFailure"+showbCodingFailureMode RoundtripFailure = "RoundtripFailure"+{-# INLINE showbCodingFailureMode #-}+#endif++-- | Convert a 'Newline' to a 'Builder'.+showbNewline :: Newline -> Builder+showbNewline LF = "LF"+showbNewline CRLF = "CRLF"+{-# INLINE showbNewline #-}++-- | Convert a 'NewlineMode' to a 'Builder' with the given precedence.+showbNewlineModePrec :: Int -> NewlineMode -> Builder+showbNewlineModePrec p (NewlineMode inl onl) = showbParen (p > appPrec) $+ "NewlineMode {inputNL = "+ <> showbNewline inl+ <> ", outputNL = "+ <> showbNewline onl+ <> s '}'+{-# INLINE showbNewlineModePrec #-}++instance Show Handle where+ showb = showbHandle+ {-# INLINE showb #-}++instance Show IOMode where+ showb = showbIOMode+ {-# INLINE showb #-}++instance Show BufferMode where+ showbPrec = showbBufferModePrec+ {-# INLINE showbPrec #-}++instance Show HandlePosn where+ showb = showbHandlePosn+ {-# INLINE showb #-}++instance Show SeekMode where+ showb = showbSeekMode+ {-# INLINE showb #-}++#if MIN_VERSION_base(4,3,0)+instance Show TextEncoding where+ showb = showbTextEncoding+ {-# INLINE showb #-}+#endif++#if MIN_VERSION_base(4,4,0)+instance Show CodingProgress where+ showb = showbCodingProgress+ {-# INLINE showb #-}++instance Show CodingFailureMode where+ showb = showbCodingFailureMode+ {-# INLINE showb #-}+#endif++instance Show Newline where+ showb = showbNewline+ {-# INLINE showb #-}++instance Show NewlineMode where+ showbPrec = showbNewlineModePrec+ {-# INLINE showbPrec #-}
+ src/Text/Show/Text/System/Posix/Types.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, NoImplicitPrelude, StandaloneDeriving #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.System.Posix.Types+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' functions for Haskell equivalents of POSIX data types.+----------------------------------------------------------------------------+module Text.Show.Text.System.Posix.Types (+ showbCDev+ , showbCIno+ , showbCMode+ , showbCOffPrec+ , showbCPidPrec+ , showbCSsizePrec+ , showbCGid+ , showbCNlink+ , showbCUid+ , showbCCc+ , showbCSpeed+ , showbCTcflag+ , showbCRLim+ , showbFdPrec+ ) where++import Data.Text.Lazy.Builder (Builder)++import Prelude hiding (Show)++import System.Posix.Types++import Text.Show.Text.Class (Show(showb, showbPrec))+import Text.Show.Text.Data.Integral ()+import Text.Show.Text.Foreign.C.Types ()++-- | Convert a 'CDev' to a 'Builder'.+showbCDev :: CDev -> Builder+showbCDev = showb+{-# INLINE showbCDev #-}++-- | Convert a 'CIno' to a 'Builder'.+showbCIno :: CIno -> Builder+showbCIno = showb+{-# INLINE showbCIno #-}++-- | Convert a 'CMode' to a 'Builder'.+showbCMode :: CMode -> Builder+showbCMode = showb+{-# INLINE showbCMode #-}++-- | Convert a 'COff' to a 'Builder' with the given precedence.+showbCOffPrec :: Int -> COff -> Builder+showbCOffPrec = showbPrec+{-# INLINE showbCOffPrec #-}++-- | Convert a 'CPid' to a 'Builder' with the given precedence.+showbCPidPrec :: Int -> CPid -> Builder+showbCPidPrec = showbPrec+{-# INLINE showbCPidPrec #-}++-- | Convert a 'CSsize' to a 'Builder' with the given precedence.+showbCSsizePrec :: Int -> CSsize -> Builder+showbCSsizePrec = showbPrec+{-# INLINE showbCSsizePrec #-}++-- | Convert a 'CGid' to a 'Builder'.+showbCGid :: CGid -> Builder+showbCGid = showb+{-# INLINE showbCGid #-}++-- | Convert a 'CNlink' to a 'Builder'.+showbCNlink :: CNlink -> Builder+showbCNlink = showb+{-# INLINE showbCNlink #-}++-- | Convert a 'CUid' to a 'Builder'.+showbCUid :: CUid -> Builder+showbCUid = showb+{-# INLINE showbCUid #-}++-- | Convert a 'CCc' to a 'Builder'.+showbCCc :: CCc -> Builder+showbCCc = showb+{-# INLINE showbCCc #-}++-- | Convert a 'CSpeed' to a 'Builder'.+showbCSpeed :: CSpeed -> Builder+showbCSpeed = showb+{-# INLINE showbCSpeed #-}++-- | Convert a 'CTcflag' to a 'Builder'.+showbCTcflag :: CTcflag -> Builder+showbCTcflag = showb+{-# INLINE showbCTcflag #-}++-- | Convert a 'CRLim' to a 'Builder'.+showbCRLim :: CRLim -> Builder+showbCRLim = showb+{-# INLINE showbCRLim #-}++-- | Convert an 'Fd' to a 'Builder' with the given precedence.+showbFdPrec :: Int -> Fd -> Builder+showbFdPrec = showbPrec+{-# INLINE showbFdPrec #-}++deriving instance Show CDev+deriving instance Show CIno+deriving instance Show CMode+deriving instance Show COff+deriving instance Show CPid+deriving instance Show CSsize+deriving instance Show CGid+deriving instance Show CNlink+deriving instance Show CUid+deriving instance Show CCc+deriving instance Show CSpeed+deriving instance Show CTcflag+deriving instance Show CRLim+deriving instance Show Fd
+ src/Text/Show/Text/TH.hs view
@@ -0,0 +1,204 @@+{-# LANGUAGE CPP, NoImplicitPrelude, TemplateHaskell #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.TH+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Exports 'deriveShow', which automatically derives a 'Show' instance for a+-- @data@ type or @newtype@. You need to enable the @TemplateHaskell@+-- language extension in order to use 'deriveShow'.+-- +-- As an example:+-- +-- @+-- {-# LANGUAGE TemplateHaskell #-}+-- import Text.Show.Text.TH (deriveShow)+-- +-- data D a = Nullary+-- | Unary Int+-- | Product String Char a+-- | Record { testOne :: Double+-- , testTwo :: Bool+-- , testThree :: D a+-- }+-- $(deriveShow ''D)+-- @+-- +-- @D@ now has a 'Show' instance equivalent to that which would be generated+-- by a @deriving Show@ clause. +-- +-- Note that at the moment, 'deriveShow' does not support data families,+-- so it is impossible to use 'deriveShow' with @data instance@s or @newtype+-- instance@s.+----------------------------------------------------------------------------+module Text.Show.Text.TH (deriveShow) where++import Control.Applicative ((<$>))++import Data.List (foldl')+import Data.Text.Lazy.Builder (Builder, fromString)++import GHC.Show (appPrec, appPrec1)++import Language.Haskell.TH++import qualified Prelude as P+import Prelude hiding (Show)++import Text.Show.Text.Class (Show(showb, showbPrec), showbParen)+import Text.Show.Text.Instances ()+import Text.Show.Text.Utils ((<>), s)++-- | Generates a 'Show' instance declaration for the given @data@ type or @newtype@.+deriveShow :: Name -> Q [Dec]+deriveShow name = withType name $ \tvbs cons -> (:[]) <$> fromCons tvbs cons+ where+ fromCons :: [TyVarBndr] -> [Con] -> Q Dec+ fromCons tvbs cons =+ instanceD (applyCon ''Show typeNames name)+ (appT classType instanceType)+ [ funD 'showbPrec [ clause [] (normalB $ consToShow cons) []+ ]+ ]+ where+ classType :: Q Type+ classType = conT ''Show+ + typeNames :: [Name]+ typeNames = map tvbName tvbs+ + instanceType :: Q Type+ instanceType = foldl' appT (conT name) $ map varT typeNames++-- | Generates code to generate the 'Show' encoding of a number of constructors.+-- All constructors must be from the same type.+consToShow :: [Con] -> Q Exp+consToShow [] = error $ "Text.Show.Text.TH.consToShow: Not a single constructor given!"+consToShow cons = do+ p <- newName "p"+ value <- newName "value"+ lam1E (if all isNullary cons then wildP else varP p)+ . lam1E (varP value)+ $ caseE (varE value) [encodeArgs p con | con <- cons]++-- | Generates code to generate the 'Show' encoding of a single constructor.+encodeArgs :: Name -> Con -> Q Match+encodeArgs _ (NormalC conName [])+ = match (conP conName [])+ (normalB [| fromString $(stringE (nameBase conName)) |])+ []+encodeArgs p (NormalC conName ts) = do+ args <- mapM newName ["arg" ++ P.show n | (_, n) <- zip ts [1 :: Int ..]]+ + let showArgs = map (appE [| showbPrec appPrec1 |] . varE) args+ mappendArgs = foldr1 (\v q -> [| $(v) <> s ' ' <> $(q) |]) showArgs+ namedArgs = [| fromString $(stringE (nameBase conName)) <> s ' ' <> $(mappendArgs) |]+ + match (conP conName $ map varP args)+ (normalB $ appE [| showbParen ($(varE p) > appPrec) |] namedArgs)+ []+encodeArgs p (RecC conName []) = encodeArgs p $ NormalC conName []+encodeArgs p (RecC conName ts) = do+ args <- mapM newName ["arg" ++ P.show n | (_, n) <- zip ts [1 :: Int ..]]+ + let showArgs = map (\(arg, (argName, _, _)) -> [| fromString $(stringE (nameBase argName)) <> fromString " = " <> showb $(varE arg) |])+ $ zip args ts+ mappendArgs = foldr1 (\v q -> [| $(v) <> fromString ", " <> $(q) |]) showArgs+ namedArgs = [| fromString $(stringE (nameBase conName)) <> s ' ' <> showbBraces $(mappendArgs) |]+ + match (conP conName $ map varP args)+ (normalB $ appE [| showbParen ($(varE p) > appPrec) |] namedArgs)+ []+encodeArgs p (InfixC _ conName _) = do+ al <- newName "argL"+ ar <- newName "argR"+ info <- reify conName+ + let conPrec = case info of+ DataConI _ _ _ (Fixity prec _) -> prec+ other -> error $ "Text.Show.Text.TH.encodeArgs: Unsupported type: " ++ P.show other+ + match (infixP (varP al) conName (varP ar))+ (normalB $ appE [| showbParen ($(varE p) > conPrec) |]+ [| showbPrec (conPrec + 1) $(varE al)+ <> s ' '+ <> fromString $(stringE (nameBase conName))+ <> s ' '+ <> showbPrec (conPrec + 1) $(varE ar)+ |]+ )+ []+encodeArgs p (ForallC _ _ con) = encodeArgs p con++-------------------------------------------------------------------------------+-- Utility functions+-------------------------------------------------------------------------------++-- | If constructor is nullary.+isNullary :: Con -> Bool+isNullary (NormalC _ []) = True+isNullary (RecC _ []) = True+isNullary _ = False++-- | Surrounds a 'Builder' with braces.+showbBraces :: Builder -> Builder+showbBraces b = s '{' <> b <> s '}'++-- | Boilerplate for top level splices.+--+-- The given 'Name' must be from a type constructor. Furthermore, the+-- type constructor must be either a data type or a newtype. Any other+-- value will result in an exception.+withType :: Name+ -> ([TyVarBndr] -> [Con] -> Q a)+ -- ^ Function that generates the actual code. Will be applied+ -- to the type variable binders and constructors extracted+ -- from the given 'Name'.+ -> Q a+ -- ^ Resulting value in the 'Q'uasi monad.+withType name f = do+ info <- reify name+ case info of+ TyConI dec ->+ case dec of+ DataD _ _ tvbs cons _ -> f tvbs cons+ NewtypeD _ _ tvbs con _ -> f tvbs [con]+ other -> error $ "Text.Show.Text.TH.withType: Unsupported type: "+ ++ P.show other+ _ -> error "Text.Show.Text.TH.withType: I need the name of a type."++-- | Extracts the name from a type variable binder.+tvbName :: TyVarBndr -> Name+tvbName (PlainTV name) = name+tvbName (KindedTV name _) = name++-- |+-- Applies a typeclass to several type parameters to produce the type predicate of an+-- instance declaration. If a recent version of Template Haskell is used, this function+-- will filter type parameters that have phantom roles (since they have no effect on+-- the instance declaration.+applyCon :: Name -> [Name] -> Name -> Q [Pred]+#if MIN_VERSION_template_haskell(2,9,0)+applyCon con typeNames targetData+ = map apply . nonPhantomNames typeNames <$> reifyRoles targetData+#else+applyCon con typeNames _+ = return $ map apply typeNames+#endif+ where+ apply :: Name -> Pred+ apply t = ClassP con [VarT t]++#if MIN_VERSION_template_haskell(2,9,0)+ -- Filters a list of tycon names based on their type roles.+ -- If a tycon has a phantom type role, remove it from the list.+ nonPhantomNames :: [Name] -> [Role] -> [Name]+ nonPhantomNames (_:ns) (PhantomR:rs) = nonPhantomNames ns rs+ nonPhantomNames (n:ns) (_:rs) = n:(nonPhantomNames ns rs)+ nonPhantomNames [] _ = []+ nonPhantomNames _ [] = []+#endif
+ src/Text/Show/Text/Text.hs view
@@ -0,0 +1,14 @@+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Text+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Imports 'Show' instances for @Text@ modules.+----------------------------------------------------------------------------+module Text.Show.Text.Text () where++import Text.Show.Text.Text.Read ()
+ src/Text/Show/Text/Text/Read.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE CPP, NoImplicitPrelude, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Text.Read+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Monomorphic 'Show' function for 'Lexeme' (and 'Number', if using a+-- recent-enough version of @base@).+----------------------------------------------------------------------------+module Text.Show.Text.Text.Read (+ showbLexemePrec+#if MIN_VERSION_base(4,7,0)+ , showbNumberPrec+#endif+ ) where++import Data.Text.Lazy.Builder (Builder, fromString)++import GHC.Show (appPrec, appPrec1)++import qualified Prelude as P+import Prelude hiding (Show)++import Text.Read.Lex (Lexeme(..))+#if MIN_VERSION_base(4,7,0)+import Text.Read.Lex (Number)+#endif+import Text.Show.Text.Class (Show(showbPrec), showbParen)+import Text.Show.Text.Data.Char (showbLitChar)+#if !(MIN_VERSION_base(4,6,0))+import Text.Show.Text.Data.Integral (showbIntegerPrec, showbRatioPrec)+#endif+import Text.Show.Text.Utils ((<>))++-- | Convert a 'Lexeme' to a 'Builder' with the given precedence.+showbLexemePrec :: Int -> Lexeme -> Builder+showbLexemePrec p (Char c) = showbParen (p > appPrec) $ "Char " <> showbLitChar c+showbLexemePrec p (String s) = showbParen (p > appPrec) $ "String " <> fromString s+showbLexemePrec p (Punc pun) = showbParen (p > appPrec) $ "Punc " <> fromString pun+showbLexemePrec p (Ident i) = showbParen (p > appPrec) $ "Ident " <> fromString i+showbLexemePrec p (Symbol s) = showbParen (p > appPrec) $ "Symbol " <> fromString s+#if MIN_VERSION_base(4,6,0)+showbLexemePrec p (Number n) = showbParen (p > appPrec) $ "Number " <> fromString (P.showsPrec appPrec1 n "")+#else+showbLexemePrec p (Int i) = showbParen (p > appPrec) $ "Int " <> showbIntegerPrec appPrec1 i+showbLexemePrec p (Rat r) = showbParen (p > appPrec) $ "Rat " <> showbRatioPrec appPrec1 r+#endif+showbLexemePrec _ EOF = "EOF"+{-# INLINE showbLexemePrec #-}++#if MIN_VERSION_base(4,7,0)+-- | Convert a 'Number' to a 'Builder' with the given precedence.+showbNumberPrec :: Int -> Number -> Builder+showbNumberPrec p n = fromString $ P.showsPrec p n ""+{-# INLINE showbNumberPrec #-}+#endif++instance Show Lexeme where+ showbPrec = showbLexemePrec+ {-# INLINE showbPrec #-}++#if MIN_VERSION_base(4,7,0)+instance Show Number where+ showbPrec = showbNumberPrec+ {-# INLINE showbPrec #-}+#endif
+ src/Text/Show/Text/Utils.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE MagicHash, NoImplicitPrelude #-}+-----------------------------------------------------------------------------+-- |+-- Module : Text.Show.Text.Utils+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Miscellaneous 'Builder' utility functions.+----------------------------------------------------------------------------+module Text.Show.Text.Utils where++import Data.Int (Int64)+import Data.Monoid (Monoid(mappend, mempty))+import Data.Text.Lazy (length, replicate)+import Data.Text.Lazy.Builder (Builder, fromLazyText, singleton, toLazyText)++import GHC.Exts (Char(C#), Int(I#))+import GHC.Prim ((+#), chr#, ord#)++import Prelude hiding (length, replicate)++infixr 6 <>++-- | Unsafe conversion for decimal digits.+i2d :: Int -> Char+i2d (I# i#) = C# (chr# (ord# '0'# +# i#))+{-# INLINE i2d #-}++-- | Infix 'mappend', defined here for backwards-compatibility with older versions+-- of base.+(<>) :: Monoid m => m -> m -> m+(<>) = mappend+{-# INLINE (<>) #-}++-- |+-- A shorter name for 'singleton' for convenience's sake (since it tends to be used+-- pretty often in @text-show@).+s :: Char -> Builder+s = singleton+{-# INLINE s #-}++-- | Computes the length of a 'Builder'.+lengthB :: Builder -> Int64+lengthB = length . toLazyText+{-# INLINE lengthB #-}++-- | @'replicateB' n b@ yields a 'Builder' containing @b@ repeated @n@ times.+replicateB :: Int64 -> Builder -> Builder+replicateB n = fromLazyText . replicate n . toLazyText+{-# INLINE replicateB #-}++-- | Merges several 'Builder's, separating them by newlines.+unlinesB :: [Builder] -> Builder+unlinesB (b:bs) = b <> s '\n' <> unlinesB bs+unlinesB [] = mempty+{-# INLINE unlinesB #-}++-- | Merges several 'Builder's, separating them by spaces.+unwordsB :: [Builder] -> Builder+unwordsB (b:bs@(_:_)) = b <> s ' ' <> unwordsB bs+unwordsB [b] = b+unwordsB [] = mempty+{-# INLINE unwordsB #-}
+ tests/Instances/BaseAndFriends.hs view
@@ -0,0 +1,507 @@+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving, StandaloneDeriving #-}+#if MIN_VERSION_base(4,4,0)+{-# LANGUAGE FlexibleContexts, TypeOperators #-}+#endif+#if MIN_VERSION_base(4,7,0)+{-# LANGUAGE TypeFamilies #-}+#endif+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Instances.BaseAndFriends+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- Provides 'Arbitrary' instances for data types located in @base@ and other+-- common libraries. This module also defines 'Show' instances for some data+-- types as well (e.g., those which do not derive 'Show' in older versions+-- of GHC).+----------------------------------------------------------------------------+module Instances.BaseAndFriends () where++import Control.Applicative (ZipList(..), (<$>), (<*>), pure)+import Control.Exception+import Control.Monad.ST (ST, fixST)++#if MIN_VERSION_bytestring(0,10,4)+import Data.ByteString.Short (ShortByteString, pack)+#endif+import Data.Char (GeneralCategory(..))+import qualified Data.Data as D (Fixity(..))+import Data.Data (Constr, ConstrRep(..), DataRep(..), DataType,+ mkConstr, mkDataType)+import Data.Dynamic (Dynamic, toDyn)+import Data.Monoid (All(..), Any(..), Dual(..), First(..),+ Last(..), Product(..), Sum(..))+#if MIN_VERSION_base(4,6,0)+import Data.Ord (Down(..))+#endif+#if MIN_VERSION_base(4,7,0)+import Data.Proxy (Proxy(..))+#endif+import Data.Text.Lazy.Builder (Builder, fromString)+#if MIN_VERSION_base(4,7,0)+import Data.Coerce (Coercible)+import Data.Type.Coercion (Coercion(..))+import Data.Type.Equality ((:~:)(..))+#endif+#if MIN_VERSION_base(4,4,0)+import Data.Typeable.Internal (Typeable, TyCon(..), TypeRep(..),+ mkTyConApp, splitTyConApp, typeOf)+import GHC.Fingerprint.Type (Fingerprint(..))+import Data.Word (Word)++#if !(MIN_VERSION_base(4,7,0))+import Data.Word (Word64)+import Numeric (showHex)+#endif+#endif+import Data.Version (Version(..))++import Foreign.C.Types+import Foreign.Ptr (FunPtr, IntPtr, Ptr, WordPtr,+ castPtrToFunPtr, nullPtr, plusPtr,+ ptrToIntPtr, ptrToWordPtr)++import GHC.Conc (BlockReason(..), ThreadStatus(..))+#if MIN_VERSION_base(4,4,0)+import GHC.IO.Encoding.Failure (CodingFailureMode(..))+import GHC.IO.Encoding.Types (CodingProgress(..))+import qualified GHC.Generics as G (Fixity(..))+import GHC.Generics (U1(..), Par1(..), Rec1(..), K1(..),+ M1(..), (:+:)(..), (:*:)(..), (:.:)(..),+ Associativity(..), Arity(..))+#endif+#if MIN_VERSION_base(4,5,0)+import GHC.Stats (GCStats(..))+#endif++import System.Exit (ExitCode(..))+import System.IO (BufferMode(..), IOMode(..), Newline(..),+ NewlineMode(..), SeekMode(..))+import System.Posix.Types++import Test.QuickCheck++instance Arbitrary Builder where+ arbitrary = fromString <$> arbitrary++#if MIN_VERSION_bytestring(0,10,4)+instance Arbitrary ShortByteString where+ arbitrary = pack <$> arbitrary+#endif++instance Arbitrary (Ptr a) where+ arbitrary = plusPtr nullPtr <$> arbitrary++instance Arbitrary (FunPtr a) where+ arbitrary = castPtrToFunPtr <$> arbitrary++instance Arbitrary IntPtr where+ arbitrary = ptrToIntPtr <$> arbitrary++instance Arbitrary WordPtr where+ arbitrary = ptrToWordPtr <$> arbitrary++-- TODO: instance Arbitrary (ForeignPtr a)++instance Arbitrary GeneralCategory where+ arbitrary = oneof $ map pure [ UppercaseLetter + , LowercaseLetter+ , TitlecaseLetter+ , ModifierLetter+ , OtherLetter+ , NonSpacingMark+ , SpacingCombiningMark+ , EnclosingMark+ , DecimalNumber+ , LetterNumber+ , OtherNumber+ , ConnectorPunctuation+ , DashPunctuation+ , OpenPunctuation+ , ClosePunctuation+ , InitialQuote+ , FinalQuote + , OtherPunctuation+ , MathSymbol+ , CurrencySymbol+ , ModifierSymbol+ , OtherSymbol+ , Space+ , LineSeparator+ , ParagraphSeparator+ , Control+ , Format+ , Surrogate+ , PrivateUse+ , NotAssigned+ ]++instance Arbitrary Version where+ arbitrary = Version <$> arbitrary <*> arbitrary++-- TODO: Be more creative with this instance+instance Arbitrary SomeException where+ arbitrary = SomeException <$> (arbitrary :: Gen AssertionFailed)++-- instance Arbitrary IOException++instance Arbitrary ArithException where+ arbitrary = oneof $ map pure [ Overflow+ , Underflow+ , LossOfPrecision+ , DivideByZero+ , Denormal+#if MIN_VERSION_base(4,6,0)+ , RatioZeroDenominator+#endif+ ]++instance Arbitrary ArrayException where+ arbitrary = oneof [ IndexOutOfBounds <$> arbitrary+ , UndefinedElement <$> arbitrary+ ]++instance Arbitrary AssertionFailed where+ arbitrary = AssertionFailed <$> arbitrary++#if MIN_VERSION_base(4,7,0)+-- TODO: Be more creative with this instance+instance Arbitrary SomeAsyncException where+ arbitrary = SomeAsyncException <$> (arbitrary :: Gen AsyncException)+#endif++instance Arbitrary AsyncException where+ arbitrary = oneof $ map pure [ StackOverflow+ , HeapOverflow+ , ThreadKilled+ , UserInterrupt+ ]++instance Arbitrary NonTermination where+ arbitrary = pure NonTermination++instance Arbitrary NestedAtomically where+ arbitrary = pure NestedAtomically++instance Arbitrary BlockedIndefinitelyOnMVar where+ arbitrary = pure BlockedIndefinitelyOnMVar++instance Arbitrary BlockedIndefinitelyOnSTM where+ arbitrary = pure BlockedIndefinitelyOnSTM++instance Arbitrary Deadlock where+ arbitrary = pure Deadlock++instance Arbitrary NoMethodError where+ arbitrary = NoMethodError <$> arbitrary++instance Arbitrary PatternMatchFail where+ arbitrary = PatternMatchFail <$> arbitrary++instance Arbitrary RecConError where+ arbitrary = RecConError <$> arbitrary++instance Arbitrary RecSelError where+ arbitrary = RecSelError <$> arbitrary++instance Arbitrary RecUpdError where+ arbitrary = RecUpdError <$> arbitrary++-- ErrorCall is a newtype starting with base-4.7.0.0, but we'll+-- manually derive Arbitrary to support older versions of GHC.+-- +-- deriving instance Arbitrary ErrorCall+instance Arbitrary ErrorCall where+ arbitrary = ErrorCall <$> arbitrary++instance Arbitrary MaskingState where+ arbitrary = oneof $ map pure [ Unmasked+ , MaskedInterruptible+ , MaskedUninterruptible+ ]++-- instance Arbitrary Lexeme+-- #if MIN_VERSION_base(4,7,0)+-- instance Arbitrary Number+-- #endif++#if MIN_VERSION_base(4,7,0)+instance Arbitrary (Proxy s) where+ arbitrary = pure Proxy+#endif++#if MIN_VERSION_base(4,4,0)+-- Borrowed from the concrete-typerep package+instance Arbitrary TypeRep where+ arbitrary = do+ nargs <- elements [0,1,2]+ mkTyConApp <$> (genTyCon nargs) <*> (vectorOf nargs arbitrary)++genTyCon :: Int -- ^ Number of arguments; must be in [0,1,2]+ -> Gen TyCon+genTyCon 0 = elements [tyConOf (__::Int), tyConOf (__::Word), tyConOf (__::Double), tyConOf (__::Bool)]+genTyCon 1 = elements [tyConOf (__::Maybe Int), tyConOf (__::IO Int), tyConOf (__::[Int])]+genTyCon 2 = elements [tyConOf (__::Either Int Int), tyConOf (__::Int -> Int)]+genTyCon _ = genTyCon 0++tyConOf :: Typeable a => a -> TyCon+tyConOf ty = fst $ splitTyConApp (typeOf ty)++__ :: t+__ = undefined++instance Arbitrary TyCon where+ arbitrary = TyCon <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary Fingerprint where+ arbitrary = Fingerprint <$> arbitrary <*> arbitrary++#if !(MIN_VERSION_base(4,7,0))+instance Show Fingerprint where+ show (Fingerprint w1 w2) = hex16 w1 ++ hex16 w2+ where+ -- | Formats a 64 bit number as 16 digits hex.+ hex16 :: Word64 -> String+ hex16 i = let hex = showHex i ""+ in replicate (16 - length hex) '0' ++ hex+#endif+#endif++-- TODO: Be more creative with this instance+instance Arbitrary Dynamic where+ arbitrary = toDyn <$> (arbitrary :: Gen Int)++instance Arbitrary Constr where+ arbitrary = mkConstr <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary ConstrRep where+ arbitrary = oneof [ AlgConstr <$> arbitrary+ , IntConstr <$> arbitrary+ , FloatConstr <$> arbitrary+ , CharConstr <$> arbitrary+ ]++instance Arbitrary DataRep where+ arbitrary = oneof [ AlgRep <$> arbitrary+ , pure IntRep+ , pure FloatRep+ , pure CharRep+ , pure NoRep+ ]++instance Arbitrary DataType where+ arbitrary = mkDataType <$> arbitrary <*> arbitrary++instance Arbitrary D.Fixity where+ arbitrary = oneof $ map pure [D.Prefix, D.Infix]++#if MIN_VERSION_base(4,7,0)+instance Coercible a b => Arbitrary (Coercion a b) where+ arbitrary = pure Coercion++instance a ~ b => Arbitrary (a :~: b) where+ arbitrary = pure Refl+#endif++instance Arbitrary BlockReason where+ arbitrary = oneof $ map pure [ BlockedOnMVar+ , BlockedOnBlackHole+ , BlockedOnException+ , BlockedOnSTM+ , BlockedOnForeignCall+ , BlockedOnOther+ ]++-- instance Arbitrary ThreadId++instance Arbitrary ThreadStatus where+ arbitrary = oneof [ pure ThreadRunning+ , pure ThreadFinished+ , ThreadBlocked <$> arbitrary+ , pure ThreadDied+ ]++instance Arbitrary (ST s a) where+ arbitrary = pure $ fixST undefined++-- instance Arbitrary Handle+-- instance Arbitrary HandlePosn++instance Arbitrary IOMode where+ arbitrary = oneof $ map pure [ReadMode, WriteMode, AppendMode, ReadWriteMode]++instance Arbitrary BufferMode where+ arbitrary = oneof [ pure NoBuffering+ , pure LineBuffering+ , BlockBuffering <$> arbitrary+ ]++instance Arbitrary SeekMode where+ arbitrary = oneof $ map pure [AbsoluteSeek, RelativeSeek, SeekFromEnd]++instance Arbitrary Newline where+ arbitrary = oneof $ map pure [LF, CRLF]++instance Arbitrary NewlineMode where+ arbitrary = NewlineMode <$> arbitrary <*> arbitrary++#if MIN_VERSION_base(4,3,0)+-- instance Arbitrary TextEncoding+#else+deriving instance Show Newline+deriving instance Show NewlineMode+#endif++#if MIN_VERSION_base(4,4,0)+instance Arbitrary CodingProgress where+ arbitrary = oneof $ map pure [InputUnderflow, OutputUnderflow, InvalidSequence]++instance Arbitrary CodingFailureMode where+ arbitrary = oneof $ map pure [ ErrorOnCodingFailure+ , IgnoreCodingFailure+ , TransliterateCodingFailure+ , RoundtripFailure+ ]+#endif++#if MIN_VERSION_base(4,5,0)+instance Arbitrary GCStats where+ arbitrary = GCStats <$> arbitrary <*> arbitrary <*> arbitrary+ <*> arbitrary <*> arbitrary <*> arbitrary+ <*> arbitrary <*> arbitrary <*> arbitrary+ <*> arbitrary <*> arbitrary <*> arbitrary+ <*> arbitrary <*> arbitrary <*> arbitrary+ <*> arbitrary <*> arbitrary <*> arbitrary+#endif++-- #if MIN_VERSION_base(4,4,0)+-- instance Arbitrary Event+-- instance Arbitrary FdKey+-- #endif++#if MIN_VERSION_base(4,4,0)+instance Arbitrary (U1 p) where+ arbitrary = pure U1++instance Arbitrary p => Arbitrary (Par1 p) where+ arbitrary = Par1 <$> arbitrary++instance Arbitrary (f p) => Arbitrary (Rec1 f p) where+ arbitrary = Rec1 <$> arbitrary++instance Arbitrary c => Arbitrary (K1 i c p) where+ arbitrary = K1 <$> arbitrary++instance Arbitrary (f p) => Arbitrary (M1 i c f p) where+ arbitrary = M1 <$> arbitrary++instance (Arbitrary (f p), Arbitrary (g p)) => Arbitrary ((f :+: g) p) where+ arbitrary = oneof [L1 <$> arbitrary, R1 <$> arbitrary]++instance (Arbitrary (f p), Arbitrary (g p)) => Arbitrary ((f :*: g) p) where+ arbitrary = (:*:) <$> arbitrary <*> arbitrary++instance Arbitrary (f (g p)) => Arbitrary ((f :.: g) p) where+ arbitrary = Comp1 <$> arbitrary++instance Arbitrary G.Fixity where+ arbitrary = oneof [pure G.Prefix, G.Infix <$> arbitrary <*> arbitrary]++instance Arbitrary Associativity where+ arbitrary = oneof $ map pure [LeftAssociative, RightAssociative, NotAssociative]++instance Arbitrary Arity where+ arbitrary = oneof [pure NoArity, Arity <$> arbitrary]++#if !(MIN_VERSION_base(4,7,0))+deriving instance Show (U1 p)+deriving instance Show p => Show (Par1 p)+deriving instance Show (f p) => Show (Rec1 f p)+deriving instance Show c => Show (K1 i c p)+deriving instance Show (f p) => Show (M1 i c f p)+deriving instance (Show (f p), Show (g p)) => Show ((f :+: g) p)++-- Due to a GHC bug (https://ghc.haskell.org/trac/ghc/ticket/9830), this Show+-- instance produces output with the wrong precedence on older versions of GHC.+-- I'll manually define the Show instance to get the correct behavior.+-- +-- deriving instance (Show (f p), Show (g p)) => Show ((f :*: g) p)+instance (Show (f p), Show (g p)) => Show ((f :*: g) p) where+ showsPrec p (l :*: r) = showParen (p > prec) $+ showsPrec (prec + 1) l+ . showString " :*: "+ . showsPrec (prec + 1) r+ where prec = 6++deriving instance Show (f (g p)) => Show ((f :.: g) p)+#endif+#endif++deriving instance Arbitrary CChar+deriving instance Arbitrary CSChar+deriving instance Arbitrary CUChar+deriving instance Arbitrary CShort+deriving instance Arbitrary CUShort+deriving instance Arbitrary CInt+deriving instance Arbitrary CUInt+deriving instance Arbitrary CLong+deriving instance Arbitrary CULong+deriving instance Arbitrary CLLong+deriving instance Arbitrary CULLong+deriving instance Arbitrary CFloat+deriving instance Arbitrary CDouble+deriving instance Arbitrary CPtrdiff+deriving instance Arbitrary CSize+deriving instance Arbitrary CWchar+deriving instance Arbitrary CSigAtomic+deriving instance Arbitrary CClock+deriving instance Arbitrary CTime+deriving instance Arbitrary CUSeconds+deriving instance Arbitrary CSUSeconds+deriving instance Arbitrary CIntPtr+deriving instance Arbitrary CUIntPtr+deriving instance Arbitrary CIntMax+deriving instance Arbitrary CUIntMax++instance Arbitrary ExitCode where+ arbitrary = oneof [pure ExitSuccess, ExitFailure <$> arbitrary]++deriving instance Arbitrary CDev+deriving instance Arbitrary CIno+deriving instance Arbitrary CMode+deriving instance Arbitrary COff+deriving instance Arbitrary CPid+deriving instance Arbitrary CSsize+deriving instance Arbitrary CGid+deriving instance Arbitrary CNlink+deriving instance Arbitrary CUid+deriving instance Arbitrary CCc+deriving instance Arbitrary CSpeed+deriving instance Arbitrary CTcflag+deriving instance Arbitrary CRLim+deriving instance Arbitrary Fd++deriving instance Arbitrary All+deriving instance Arbitrary Any+deriving instance Arbitrary a => Arbitrary (Dual a)+deriving instance Arbitrary a => Arbitrary (First a)+deriving instance Arbitrary a => Arbitrary (Last a)+deriving instance Arbitrary a => Arbitrary (Product a)+deriving instance Arbitrary a => Arbitrary (Sum a)+ +deriving instance Arbitrary a => Arbitrary (ZipList a)+#if !(MIN_VERSION_base(4,7,0))+deriving instance Show a => Show (ZipList a)+#endif++#if MIN_VERSION_base(4,6,0)+deriving instance Arbitrary a => Arbitrary (Down a)+#if !(MIN_VERSION_base(4,7,0))+deriving instance Show a => Show (Down a)+#endif+#endif
+ tests/Instances/Derived.hs view
@@ -0,0 +1,171 @@+{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, TemplateHaskell, TypeOperators #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module : Instances.Derived+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- This module defines data types that have derived 'Show' instances (using+-- "Text.Show.Text.TH") for testing purposes, including 'Arbitrary'+-- instances.+----------------------------------------------------------------------------+module Instances.Derived (+ Nullary(..)+ , PhantomNullary(..)+ , MonomorphicUnary(..)+ , PolymorphicUnary(..)+ , MonomorphicNewtype(..)+ , PolymorphicNewtype(..)+ , MonomorphicProduct(..)+ , PolymorphicProduct(..)+ , MonomorphicRecord(..)+ , PolymorphicRecord(..)+ , MonomorphicInfix(..)+ , PolymorphicInfix(..)+ , AllAtOnce(..)+ , GADT(..)+ , LeftAssocTree(..)+ , RightAssocTree(..)+ , (:?:)(..)+ ) where++import Control.Applicative ((<$>), (<*>), pure)+import GHC.Show (appPrec, appPrec1)+import Test.QuickCheck+import Text.Show.Text.TH (deriveShow)++data Nullary = Nullary deriving Show+$(deriveShow ''Nullary)+instance Arbitrary Nullary where+ arbitrary = pure Nullary++data PhantomNullary a = PhantomNullary deriving Show+$(deriveShow ''PhantomNullary)+instance Arbitrary (PhantomNullary a) where+ arbitrary = pure PhantomNullary++data MonomorphicUnary = MonomorphicUnary Int deriving Show+$(deriveShow ''MonomorphicUnary)+instance Arbitrary MonomorphicUnary where+ arbitrary = MonomorphicUnary <$> arbitrary++data PolymorphicUnary a b = PolymorphicUnary a deriving Show+$(deriveShow ''PolymorphicUnary)+instance Arbitrary a => Arbitrary (PolymorphicUnary a b) where+ arbitrary = PolymorphicUnary <$> arbitrary++newtype MonomorphicNewtype = MonomorphicNewtype Int deriving (Arbitrary, Show)+$(deriveShow ''MonomorphicNewtype)++newtype PolymorphicNewtype a b = PolymorphicNewtype a deriving (Arbitrary, Show)+$(deriveShow ''PolymorphicNewtype)++data MonomorphicProduct = MonomorphicProduct Char Double Int deriving Show+$(deriveShow ''MonomorphicProduct)+instance Arbitrary MonomorphicProduct where+ arbitrary = MonomorphicProduct <$> arbitrary <*> arbitrary <*> arbitrary++data PolymorphicProduct a b c d = PolymorphicProduct a b c deriving Show+$(deriveShow ''PolymorphicProduct)+instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (PolymorphicProduct a b c d) where+ arbitrary = PolymorphicProduct <$> arbitrary <*> arbitrary <*> arbitrary++data MonomorphicRecord = MonomorphicRecord {+ monomorphicRecord1 :: Char+ , monomorphicRecord2 :: Double+ , monomorphicRecord3 :: Int+} deriving Show+$(deriveShow ''MonomorphicRecord)+instance Arbitrary MonomorphicRecord where+ arbitrary = MonomorphicRecord <$> arbitrary <*> arbitrary <*> arbitrary++data PolymorphicRecord a b c d = PolymorphicRecord {+ polymorphicRecord1 :: a+ , polymorphicRecord2 :: b+ , polymorphicRecord3 :: c+} deriving Show+$(deriveShow ''PolymorphicRecord)+instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (PolymorphicRecord a b c d) where+ arbitrary = PolymorphicRecord <$> arbitrary <*> arbitrary <*> arbitrary++infix 7 :/:+data MonomorphicInfix = Int :/: Double deriving Show+$(deriveShow ''MonomorphicInfix)+instance Arbitrary MonomorphicInfix where+ arbitrary = (:/:) <$> arbitrary <*> arbitrary++infix 8 :\:+data PolymorphicInfix a b c = a :\: b deriving Show+$(deriveShow ''PolymorphicInfix)+instance (Arbitrary a, Arbitrary b) => Arbitrary (PolymorphicInfix a b c) where+ arbitrary = (:\:) <$> arbitrary <*> arbitrary++infix 3 :/\:+data AllAtOnce a b c d = AAONullary+ | AAOUnary a+ | AAOProduct a b c+ | AAORecord {+ aaoRecord1 :: a+ , aaoRecord2 :: b+ , aaoRecord3 :: c+ }+ | a :/\: b+ deriving Show+$(deriveShow ''AllAtOnce)+instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (AllAtOnce a b c d) where+ arbitrary = oneof [ pure AAONullary+ , AAOUnary <$> arbitrary+ , AAOProduct <$> arbitrary <*> arbitrary <*> arbitrary+ , AAORecord <$> arbitrary <*> arbitrary <*> arbitrary+ , (:/\:) <$> arbitrary <*> arbitrary+ ]++data GADT a b where+ GADTCon1 :: GADT Char b+ GADTCon2 :: Double -> GADT Double Double+ GADTCon3 :: Int -> GADT Int String+instance Show a => Show (GADT a b) where+ showsPrec _ GADTCon1 = showString "GADTCon1"+ showsPrec p (GADTCon2 d)+ = showParen (p > appPrec) $ showString "GADTCon2 " . showsPrec appPrec1 d+ showsPrec p (GADTCon3 i)+ = showParen (p > appPrec) $ showString "GADTCon3 " . showsPrec appPrec1 i+$(deriveShow ''GADT)++infixl 5 :<:+data LeftAssocTree a = LeftAssocLeaf a+ | LeftAssocTree a :<: LeftAssocTree a+ deriving Show+$(deriveShow ''LeftAssocTree)+instance Arbitrary a => Arbitrary (LeftAssocTree a) where+ arbitrary = oneof [ LeftAssocLeaf <$> arbitrary+ , (:<:) <$> arbitrary <*> arbitrary+ ]++infixl 5 :>:+data RightAssocTree a = RightAssocLeaf a+ | RightAssocTree a :>: RightAssocTree a+ deriving Show+$(deriveShow ''RightAssocTree)+instance Arbitrary a => Arbitrary (RightAssocTree a) where+ arbitrary = oneof [ RightAssocLeaf <$> arbitrary+ , (:>:) <$> arbitrary <*> arbitrary+ ]++infix 4 :?:+data a :?: b = a :?: b deriving Show+$(deriveShow ''(:?:))+instance (Arbitrary a, Arbitrary b) => Arbitrary (a :?: b) where+ arbitrary = (:?:) <$> arbitrary <*> arbitrary++-- TODO: Test data family instances, once they're supported+-- +-- data family DataFamily a b c :: *+-- data instance DataFamily [a] [b] c = DataInstance1 a+-- | DataInstance2 [b]+-- deriving Show+-- newtype instance DataFamily Int Int c = NewtypeInstance Int deriving Show
tests/Properties.hs view
@@ -1,61 +1,23 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-module Main where--import Data.Array (Array)-import Data.Complex (Complex)-import Data.Int (Int8, Int16, Int32, Int64)-import Data.Map (Map)-import Data.Ratio (Ratio)-import Data.Set (Set)-import qualified Data.Text as T-import qualified Data.Text as TL-import Data.Text.Lazy.Builder (Builder, fromString)-import Data.Word (Word, Word8, Word16, Word32, Word64)--import qualified Prelude as P-import Prelude hiding (Show(..))--import Test.QuickCheck-import Test.QuickCheck.Instances ()--import qualified Text.Show.Text as T+-----------------------------------------------------------------------------+-- |+-- Module : Properties+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- @QuickCheck@ tests for @text-show@.+----------------------------------------------------------------------------+module Main (main) where -prop_matchesShow :: (P.Show a, T.Show a, Arbitrary a) => a -> Bool-prop_matchesShow x = P.show x == T.unpack (T.show x)+import Properties.BaseAndFriends (baseAndFriendsTests)+import Properties.Derived (derivedTests) -instance Arbitrary Builder where- arbitrary = fmap fromString arbitrary+import Test.Tasty (TestTree, defaultMain, testGroup) main :: IO ()-main = do- quickCheck (prop_matchesShow :: Bool -> Bool)- quickCheck (prop_matchesShow :: Char -> Bool)- quickCheck (prop_matchesShow :: Float -> Bool)- quickCheck (prop_matchesShow :: Double -> Bool)- quickCheck (prop_matchesShow :: Int -> Bool)- quickCheck (prop_matchesShow :: Int8 -> Bool)- quickCheck (prop_matchesShow :: Int16 -> Bool)- quickCheck (prop_matchesShow :: Int32 -> Bool)- quickCheck (prop_matchesShow :: Int64 -> Bool)- quickCheck (prop_matchesShow :: Integer -> Bool)- quickCheck (prop_matchesShow :: Ordering -> Bool)- quickCheck (prop_matchesShow :: Word -> Bool)- quickCheck (prop_matchesShow :: Word8 -> Bool)- quickCheck (prop_matchesShow :: Word16 -> Bool)- quickCheck (prop_matchesShow :: Word32 -> Bool)- quickCheck (prop_matchesShow :: Word64 -> Bool)- quickCheck (prop_matchesShow :: () -> Bool)- quickCheck (prop_matchesShow :: Builder -> Bool)- quickCheck (prop_matchesShow :: String -> Bool)- quickCheck (prop_matchesShow :: T.Text -> Bool)- quickCheck (prop_matchesShow :: TL.Text -> Bool)- quickCheck (prop_matchesShow :: [Int] -> Bool)- quickCheck (prop_matchesShow :: Ratio Int -> Bool)- quickCheck (prop_matchesShow :: Complex Double -> Bool)- quickCheck (prop_matchesShow :: (Int, Double) -> Bool)- quickCheck (prop_matchesShow :: (Int, Double, Char) -> Bool)- quickCheck (prop_matchesShow :: (Int, Double, Char, String) -> Bool)- quickCheck (prop_matchesShow :: (Int, Double, Char, String, T.Text) -> Bool)- quickCheck (prop_matchesShow :: Array Int T.Text -> Bool)- quickCheck (prop_matchesShow :: Map Int T.Text -> Bool)- quickCheck (prop_matchesShow :: Set Int -> Bool)+main = defaultMain testTree++testTree :: TestTree+testTree = testGroup "QuickCheck properties" $ baseAndFriendsTests ++ derivedTests
+ tests/Properties/BaseAndFriends.hs view
@@ -0,0 +1,411 @@+{-# LANGUAGE CPP, NoImplicitPrelude #-}+#if MIN_VERSION_base(4,4,0)+{-# LANGUAGE FlexibleContexts, TypeOperators #-}+#endif+-----------------------------------------------------------------------------+-- |+-- Module : Properties.BaseAndFriends+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- @QuickCheck@ properties for for data types located in @base@ and other+-- common libraries.+----------------------------------------------------------------------------+module Properties.BaseAndFriends (baseAndFriendsTests) where++import Control.Applicative (ZipList(..), liftA2)+import Control.Exception+import Control.Monad.ST++import Data.Array (Array)+import qualified Data.ByteString as BS (ByteString)+import qualified Data.ByteString.Lazy as BL (ByteString)+#if MIN_VERSION_bytestring(0,10,4)+import Data.ByteString.Short (ShortByteString)+#endif+import Data.Char (GeneralCategory, intToDigit)+import Data.Complex (Complex)+import qualified Data.Data as D (Fixity)+import Data.Data (Constr, ConstrRep, DataRep, DataType)+import Data.Dynamic (Dynamic)+import Data.Fixed (Fixed, E0, E1, E2, E3, E6, E9, E12, showFixed)+import Data.Int (Int8, Int16, Int32, Int64)+import Data.IntMap (IntMap)+import Data.IntSet (IntSet)+import Data.Map (Map)+import Data.Monoid (All(..), Any(..), Dual(..), First(..),+ Last(..), Product(..), Sum(..))+#if MIN_VERSION_base(4,6,0)+import Data.Ord (Down(..))+#endif+#if MIN_VERSION_base(4,7,0)+import Data.Proxy (Proxy)+#endif+import Data.Ratio (Ratio)+import Data.Sequence (Seq)+import Data.Set (Set)+import qualified Data.Text as TS+import qualified Data.Text as TL+import Data.Time.Calendar (Day)+import Data.Time.Clock (DiffTime, UTCTime, NominalDiffTime)+import Data.Time.Clock.TAI (AbsoluteTime)+import Data.Time.LocalTime (TimeZone, TimeOfDay, LocalTime)+import Data.Tree (Tree)+#if MIN_VERSION_base(4,7,0)+import Data.Type.Coercion (Coercion)+import Data.Type.Equality ((:~:))+#endif+#if MIN_VERSION_base(4,4,0)+import Data.Typeable.Internal (TyCon, TypeRep)+import GHC.Fingerprint.Type (Fingerprint)+#endif+import Data.Word (Word, Word8, Word16, Word32, Word64)+import Data.Version (Version, showVersion)++import Foreign.C.Types+import Foreign.Ptr (FunPtr, IntPtr, Ptr, WordPtr)++import GHC.Conc (BlockReason, ThreadStatus)+import qualified GHC.Generics as G (Fixity)+import GHC.Generics (U1, Par1, Rec1, K1, M1, (:+:), (:*:), (:.:),+ Associativity, Arity)+#if MIN_VERSION_base(4,4,0)+import GHC.IO.Encoding.Failure (CodingFailureMode)+import GHC.IO.Encoding.Types (CodingProgress)+#endif+#if MIN_VERSION_base(4,5,0)+import GHC.Stats (GCStats)+#endif++import Instances.BaseAndFriends ()++import Numeric (showIntAtBase, showEFloat, showFFloat, showGFloat)+#if MIN_VERSION_base(4,7,0)+import Numeric (showFFloatAlt, showGFloatAlt)+#endif++import Prelude hiding (Show)++import Properties.Utils (prop_matchesShow)++import System.Exit (ExitCode)+import System.IO (BufferMode, IOMode, Newline, NewlineMode, SeekMode)+import System.Posix.Types++import Test.QuickCheck hiding (Fixed)+import Test.QuickCheck.Instances ()+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.QuickCheck (testProperty)++import Text.Show.Functions ()+import Text.Show.Text hiding (Show)+import Text.Show.Text.Functions ()+import Text.Show.Text.Data.Fixed (showbFixed)+import Text.Show.Text.Data.Floating (showbEFloat, showbFFloat, showbGFloat)+#if MIN_VERSION_base(4,7,0)+import Text.Show.Text.Data.Floating (showbFFloatAlt, showbGFloatAlt)+#endif+import Text.Show.Text.Data.Integral (showbIntAtBase)+import Text.Show.Text.Data.Version (showbVersionConcrete)++-- | Verifies 'showFixed' and 'showbFixed' generate the same output.+prop_showFixed :: Bool -> Fixed E12 -> Bool+prop_showFixed b f = fromString (showFixed b f) == showbFixed b f++-- | Verifies 'showIntAtBase' and 'showbIntAtBase' generate the same output.+prop_showIntAtBase :: Gen Bool+prop_showIntAtBase = do+ base <- arbitrary `suchThat` (liftA2 (&&) (> 1) (<= 16))+ i <- arbitrary `suchThat` (>= 0) :: Gen Int+ return $ fromString (showIntAtBase base intToDigit i "") == showbIntAtBase base intToDigit i++-- | Verifies @showXFloat@ and @showbXFloat@ generate the same output (where @X@+-- is one of E, F, or G).+prop_showXFloat :: (Maybe Int -> Double -> ShowS) -> (Maybe Int -> Double -> Builder) -> Maybe Int -> Double -> Bool+prop_showXFloat f1 f2 digs val = fromString (f1 digs val "") == f2 digs val++-- | Verifies 'showVersion' and 'showbVersion' generate the same output.+prop_showVersion :: Version -> Bool+prop_showVersion v = fromString (showVersion v) == showbVersionConcrete v++baseAndFriendsTests :: [TestTree]+baseAndFriendsTests =+ [ testGroup "Text.Show.Text.Control.Applicative"+ [ testProperty "ZipList Int instance" (prop_matchesShow :: Int -> ZipList Int -> Bool)+ ]+ , testGroup "Text.Show.Text.Control.Concurrent"+ [ testProperty "BlockReason instance" (prop_matchesShow :: Int -> BlockReason -> Bool)+-- , testProperty "ThreadId instance" (prop_matchesShow :: Int -> ThreadId -> Bool)+ , testProperty "ThreadStatus instance" (prop_matchesShow :: Int -> ThreadStatus -> Bool)+ ]+ , testGroup "Text.Show.Text.Control.Exception"+ [ testProperty "SomeException instance" (prop_matchesShow :: Int -> SomeException -> Bool)+-- , testProperty "IOException instance" (prop_matchesShow :: Int -> IOException -> Bool)+ , testProperty "ArithException instance" (prop_matchesShow :: Int -> ArithException -> Bool)+ , testProperty "ArrayException instance" (prop_matchesShow :: Int -> ArrayException -> Bool)+ , testProperty "AssertionFailed instance" (prop_matchesShow :: Int -> AssertionFailed -> Bool)+#if MIN_VERSION_base(4,7,0)+ , testProperty "SomeAsyncException instance" (prop_matchesShow :: Int -> SomeAsyncException -> Bool)+#endif+ , testProperty "AsyncException instance" (prop_matchesShow :: Int -> AsyncException -> Bool)+ , testProperty "NonTermination instance" (prop_matchesShow :: Int -> NonTermination -> Bool)+ , testProperty "NestedAtomically instance" (prop_matchesShow :: Int -> NestedAtomically -> Bool)+ , testProperty "BlockedIndefinitelyOnMVar instance" (prop_matchesShow :: Int -> BlockedIndefinitelyOnMVar -> Bool)+ , testProperty "BlockedIndefinitelyOnSTM instance" (prop_matchesShow :: Int -> BlockedIndefinitelyOnSTM -> Bool)+ , testProperty "Deadlock instance" (prop_matchesShow :: Int -> Deadlock -> Bool)+ , testProperty "NoMethodError instance" (prop_matchesShow :: Int -> NoMethodError -> Bool)+ , testProperty "PatternMatchFail instance" (prop_matchesShow :: Int -> PatternMatchFail -> Bool)+ , testProperty "RecConError instance" (prop_matchesShow :: Int -> RecConError -> Bool)+ , testProperty "RecSelError instance" (prop_matchesShow :: Int -> RecSelError -> Bool)+ , testProperty "RecUpdError instance" (prop_matchesShow :: Int -> RecUpdError -> Bool)+ , testProperty "ErrorCall instance" (prop_matchesShow :: Int -> ErrorCall -> Bool)+ ]+ , testGroup "Text.Show.Text.Control.Monad.ST"+ [ testProperty "ST instance" (prop_matchesShow :: Int -> ST Int Int -> Bool)+ ]+ , testGroup "Text.Show.Text.Data.Array"+ [ testProperty "Array Int Int instance" (prop_matchesShow :: Int -> Array Int Int -> Bool)+ ]+ , testGroup "Text.Show.Text.Data.Bool"+ [ testProperty "Bool instance" (prop_matchesShow :: Int -> Bool -> Bool)+ ]+ , testGroup "Text.Show.Text.Data.ByteString"+ [ testProperty "strict ByteString instance" (prop_matchesShow :: Int -> BS.ByteString -> Bool)+ , testProperty "lazy ByteString instance" (prop_matchesShow :: Int -> BL.ByteString -> Bool)+#if MIN_VERSION_bytestring(0,10,4)+ , testProperty "ShortByteString instance" (prop_matchesShow :: Int -> ShortByteString -> Bool)+#endif+ ]+ , testGroup "Text.Show.Text.Data.Char"+ [ testProperty "Char instance" (prop_matchesShow :: Int -> Char -> Bool)+ , testProperty "GeneralCategory instance" (prop_matchesShow :: Int -> GeneralCategory -> Bool)+ ]+ , testGroup "Text.Show.Text.Data.Containers"+ [ testProperty "IntMap Int instance" (prop_matchesShow :: Int -> IntMap Int -> Bool)+ , testProperty "IntSet instance" (prop_matchesShow :: Int -> IntSet -> Bool)+ , testProperty "Map Int Int instance" (prop_matchesShow :: Int -> Map Int Int -> Bool)+ , testProperty "Sequence Int" (prop_matchesShow :: Int -> Seq Int -> Bool)+ , testProperty "Set Int instance" (prop_matchesShow :: Int -> Set Int -> Bool)+ , testProperty "Tree Int instance" (prop_matchesShow :: Int -> Tree Int -> Bool)+ ]+ , testGroup "Text.Show.Text.Data.Data"+ [ testProperty "Constr instance" (prop_matchesShow :: Int -> Constr -> Bool)+ , testProperty "ConstrRep instance" (prop_matchesShow :: Int -> ConstrRep -> Bool)+ , testProperty "DataRep instance" (prop_matchesShow :: Int -> DataRep -> Bool)+ , testProperty "DataType instance" (prop_matchesShow :: Int -> DataType -> Bool)+ , testProperty "Fixity instance" (prop_matchesShow :: Int -> D.Fixity -> Bool)+ ]+ , testGroup "Text.Show.Text.Data.Dynamic"+ [ testProperty "Dynamic instance" (prop_matchesShow :: Int -> Dynamic -> Bool)+ ]+ , testGroup "Text.Show.Text.Data.Either"+ [ testProperty "Either Int Int instance" (prop_matchesShow :: Int -> Either Int Int -> Bool)+ ]+ , testGroup "Text.Show.Text.Data.Fixed"+ [ testProperty "Fixed E0 instance" (prop_matchesShow :: Int -> Fixed E0 -> Bool)+ , testProperty "Fixed E1 instance" (prop_matchesShow :: Int -> Fixed E1 -> Bool)+ , testProperty "Fixed E2 instance" (prop_matchesShow :: Int -> Fixed E2 -> Bool)+ , testProperty "Fixed E3 instance" (prop_matchesShow :: Int -> Fixed E3 -> Bool)+ , testProperty "Fixed E6 instance" (prop_matchesShow :: Int -> Fixed E6 -> Bool)+ , testProperty "Fixed E9 instance" (prop_matchesShow :: Int -> Fixed E9 -> Bool)+ , testProperty "Fixed E12 instance" (prop_matchesShow :: Int -> Fixed E12 -> Bool)+ , testProperty "showFixed output" prop_showFixed+ ]+ , testGroup "Text.Show.Text.Data.Floating"+ [ testProperty "Float instance" (prop_matchesShow :: Int -> Float -> Bool)+ , testProperty "Double instance" (prop_matchesShow :: Int -> Double -> Bool)+ , testProperty "Complex Double instance" (prop_matchesShow :: Int -> Complex Double -> Bool)+ , testProperty "showbEFloat output" $ prop_showXFloat showEFloat showbEFloat+ , testProperty "showbFFloat output" $ prop_showXFloat showFFloat showbFFloat+ , testProperty "showbGFloat output" $ prop_showXFloat showGFloat showbGFloat+#if MIN_VERSION_base(4,7,0)+ , testProperty "showbFFloatAlt output" $ prop_showXFloat showFFloatAlt showbFFloatAlt+ , testProperty "showbGFloatAlt output" $ prop_showXFloat showGFloatAlt showbGFloatAlt+#endif+ ]+ , testGroup "Text.Show.Text.Data.Functions"+ [ testProperty "Int -> Int instance" (prop_matchesShow :: Int -> (Int -> Int) -> Bool)+ ]+ , testGroup "Text.Show.Text.Data.Integral"+ [ testProperty "Int instance" (prop_matchesShow :: Int -> Int -> Bool)+ , testProperty "Int8 instance" (prop_matchesShow :: Int -> Int8 -> Bool)+ , testProperty "Int16 instance" (prop_matchesShow :: Int -> Int16 -> Bool)+ , testProperty "Int32 instance" (prop_matchesShow :: Int -> Int32 -> Bool)+ , testProperty "Int64 instance" (prop_matchesShow :: Int -> Int64 -> Bool)+ , testProperty "Integer instance" (prop_matchesShow :: Int -> Integer -> Bool)+ , testProperty "Word instance" (prop_matchesShow :: Int -> Word -> Bool)+ , testProperty "Word8 instance" (prop_matchesShow :: Int -> Word8 -> Bool)+ , testProperty "Word16 instance" (prop_matchesShow :: Int -> Word16 -> Bool)+ , testProperty "Word32 instance" (prop_matchesShow :: Int -> Word32 -> Bool)+ , testProperty "Word64 instance" (prop_matchesShow :: Int -> Word64 -> Bool)+ , testProperty "Ratio Int instance" (prop_matchesShow :: Int -> Ratio Int -> Bool)+ , testProperty "showbIntAtBase output" prop_showIntAtBase+ ]+ , testGroup "Text.Show.Text.Data.List"+ [ testProperty "String instance" (prop_matchesShow :: Int -> String -> Bool)+ , testProperty "[String] instance" (prop_matchesShow :: Int -> [String] -> Bool)+ , testProperty "[Int] instance" (prop_matchesShow :: Int -> [Int] -> Bool)+ ]+ , testGroup "Text.Show.Text.Data.Maybe"+ [ testProperty "Maybe Int instance" (prop_matchesShow :: Int -> Maybe Int -> Bool)+ ]+ , testGroup "Text.Show.Text.Data.Monoid"+ [ testProperty "All instance" (prop_matchesShow :: Int -> All -> Bool)+ , testProperty "Any instance" (prop_matchesShow :: Int -> Any -> Bool)+ , testProperty "Dual Int instance" (prop_matchesShow :: Int -> Dual Int -> Bool)+ , testProperty "First (Maybe Int) instance" (prop_matchesShow :: Int -> First (Maybe Int) -> Bool)+ , testProperty "Last (Maybe Int) instance" (prop_matchesShow :: Int -> Last (Maybe Int) -> Bool)+ , testProperty "Product Int instance" (prop_matchesShow :: Int -> Product Int -> Bool)+ , testProperty "Sum Int instance" (prop_matchesShow :: Int -> Sum Int -> Bool)+ ]+ , testGroup "Text.Show.Text.Data.Ord"+ [ testProperty "Ordering instance" (prop_matchesShow :: Int -> Ordering -> Bool)+#if MIN_VERSION_base(4,6,0)+ , testProperty "Down Int instance" (prop_matchesShow :: Int -> Down Int -> Bool)+#endif+ ]+ , testGroup "Text.Show.Text.Data.Text"+ [ testProperty "Builder instance" (prop_matchesShow :: Int -> Builder -> Bool)+ , testProperty "strict Text instance" (prop_matchesShow :: Int -> TS.Text -> Bool)+ , testProperty "lazy Text instance" (prop_matchesShow :: Int -> TL.Text -> Bool)+ ]+ , testGroup "Text.Show.Text.Data.Time"+ [ testProperty "Day instance" (prop_matchesShow :: Int -> Day -> Bool)+ , testProperty "DiffTime instance" (prop_matchesShow :: Int -> DiffTime -> Bool)+ , testProperty "UTCTime instance" (prop_matchesShow :: Int -> UTCTime -> Bool)+ , testProperty "NominalDiffTime instance" (prop_matchesShow :: Int -> NominalDiffTime -> Bool)+ , testProperty "AbsoluteTime instance" (prop_matchesShow :: Int -> AbsoluteTime -> Bool)+ , testProperty "TimeZone instance" (prop_matchesShow :: Int -> TimeZone -> Bool)+ , testProperty "TimeOfDay instance" (prop_matchesShow :: Int -> TimeOfDay -> Bool)+ , testProperty "LocalTime instance" (prop_matchesShow :: Int -> LocalTime -> Bool)+ ]+ , testGroup "Text.Show.Text.Data.Tuple"+ [ testProperty "() instance" (prop_matchesShow :: Int -> () -> Bool)+ , testProperty "(Int, Int) instance" (prop_matchesShow :: Int -> (Int, Int) -> Bool)+ , testProperty "(Int, Int, Int) instance" (prop_matchesShow :: Int -> (Int, Int, Int) -> Bool)+ , testProperty "(Int, Int, Int, Int) instance" (prop_matchesShow :: Int -> (Int, Int, Int, Int) -> Bool)+ , testProperty "(Int, Int, Int, Int, Int) instance" (prop_matchesShow :: Int -> (Int, Int, Int, Int, Int) -> Bool)+ ]+#if MIN_VERSION_base(4,7,0)+ , testGroup "Text.Show.Text.Data.Type.Coercion"+ [ testProperty "Coercion instance" (prop_matchesShow :: Int -> Coercion All Bool -> Bool)+ ]+ , testGroup "Text.Show.Text.Data.Type.Equality"+ [ testProperty "(:~:) instance" (prop_matchesShow :: Int -> Int :~: Int -> Bool)+ ]+#endif+#if MIN_VERSION_base(4,4,0)+ , testGroup "Text.Show.Text.Data.Typeable"+ [ testProperty "TypeRep instance" (prop_matchesShow :: Int -> TypeRep -> Bool)+ , testProperty "TyCon instance" (prop_matchesShow :: Int -> TyCon -> Bool)+ , testProperty "Fingerprint instance" (prop_matchesShow :: Int -> Fingerprint -> Bool)+#if MIN_VERSION_base(4,7,0)+ , testProperty "Proxy Int instance" (prop_matchesShow :: Int -> Proxy Int -> Bool)+#endif+ ]+#endif+ , testGroup "Text.Show.Text.Data.Version"+ [ testProperty "Version instance" (prop_matchesShow :: Int -> Version -> Bool)+ , testProperty "showbVersionConcrete output" prop_showVersion+ ]+ , testGroup "Text.Show.Text.Foreign.C.Types"+ [ testProperty "CChar" (prop_matchesShow :: Int -> CChar -> Bool)+ , testProperty "CSChar instance" (prop_matchesShow :: Int -> CSChar -> Bool)+ , testProperty "CUChar instance" (prop_matchesShow :: Int -> CUChar -> Bool)+ , testProperty "CShort instance" (prop_matchesShow :: Int -> CShort -> Bool)+ , testProperty "CUShort instance" (prop_matchesShow :: Int -> CUShort -> Bool)+ , testProperty "CInt instance" (prop_matchesShow :: Int -> CInt -> Bool)+ , testProperty "CUInt instance" (prop_matchesShow :: Int -> CUInt -> Bool)+ , testProperty "CLong instance" (prop_matchesShow :: Int -> CLong -> Bool)+ , testProperty "CULong instance" (prop_matchesShow :: Int -> CULong -> Bool)+ , testProperty "CPtrdiff instance" (prop_matchesShow :: Int -> CPtrdiff -> Bool)+ , testProperty "CSize instance" (prop_matchesShow :: Int -> CSize -> Bool)+ , testProperty "CWchar instance" (prop_matchesShow :: Int -> CWchar -> Bool)+ , testProperty "CSigAtomic instance" (prop_matchesShow :: Int -> CSigAtomic -> Bool)+ , testProperty "CLLong instance" (prop_matchesShow :: Int -> CLLong -> Bool)+ , testProperty "CULLong instance" (prop_matchesShow :: Int -> CULLong -> Bool)+ , testProperty "CIntPtr instance" (prop_matchesShow :: Int -> CIntPtr -> Bool)+ , testProperty "CUIntPtr instance" (prop_matchesShow :: Int -> CUIntPtr -> Bool)+ , testProperty "CIntMax instance" (prop_matchesShow :: Int -> CIntMax -> Bool)+ , testProperty "CUIntPtr instance" (prop_matchesShow :: Int -> CUIntPtr -> Bool)+ , testProperty "CIntMax instance" (prop_matchesShow :: Int -> CIntMax -> Bool)+ , testProperty "CUIntMax instance" (prop_matchesShow :: Int -> CUIntMax -> Bool)+ , testProperty "CClock instance" (prop_matchesShow :: Int -> CClock -> Bool)+ , testProperty "CTime instance" (prop_matchesShow :: Int -> CTime -> Bool)+ , testProperty "CUSeconds instance" (prop_matchesShow :: Int -> CUSeconds -> Bool)+ , testProperty "CSUSeconds instance" (prop_matchesShow :: Int -> CSUSeconds -> Bool)+ , testProperty "CFloat instance" (prop_matchesShow :: Int -> CFloat -> Bool)+ , testProperty "CDouble instance" (prop_matchesShow :: Int -> CUChar -> Bool)+ ]+ , testGroup "Text.Show.Text.Foreign.Ptr"+ [ testProperty "Ptr Int instance" (prop_matchesShow :: Int -> Ptr Int -> Bool)+ , testProperty "FunPtr Int instance" (prop_matchesShow :: Int -> FunPtr Int -> Bool)+ , testProperty "IntPtr instance" (prop_matchesShow :: Int -> IntPtr -> Bool)+ , testProperty "WordPtr instance" (prop_matchesShow :: Int -> WordPtr -> Bool)+-- , testProperty "ForeignPtr instance" (prop_matchesShow :: Int -> ForeignPtr Int -> Bool)+ ]+-- #if MIN_VERSION_base(4,4,0)+-- , testGroup "Text.Show.Text.GHC.Event"+-- [ testProperty "Event instance" (prop_matchesShow :: Int -> Event -> Bool)+-- , testProperty "FdKey instance" (prop_matchesShow :: Int -> FdKey -> Bool)+-- ]+-- #endif+ , testGroup "Text.Show.Text.GHC.Generics"+ [ testProperty "U1 Int instance" (prop_matchesShow :: Int -> U1 Int -> Bool)+ , testProperty "Par1 Int instance" (prop_matchesShow :: Int -> Par1 Int -> Bool)+ , testProperty "Rec1 Maybe Int instance" (prop_matchesShow :: Int -> Rec1 Maybe Int -> Bool)+ , testProperty "K1 () Int () instance" (prop_matchesShow :: Int -> K1 () Int () -> Bool)+ , testProperty "M1 () () Maybe Int instance" (prop_matchesShow :: Int -> M1 () () Maybe Int -> Bool)+ , testProperty "(Maybe :+: Maybe) Int instance" (prop_matchesShow :: Int -> (Maybe :+: Maybe) Int -> Bool)+ , testProperty "(Maybe :*: Maybe) Int instance" (prop_matchesShow :: Int -> (Maybe :*: Maybe) Int -> Bool)+ , testProperty "(Maybe :.: Maybe) Int instance" (prop_matchesShow :: Int -> (Maybe :.: Maybe) Int -> Bool)+ , testProperty "Fixity instance" (prop_matchesShow :: Int -> G.Fixity -> Bool)+ , testProperty "Associativity instance" (prop_matchesShow :: Int -> Associativity -> Bool)+ , testProperty "Arity instance" (prop_matchesShow :: Int -> Arity -> Bool)+ ]+ , testGroup "Text.Show.Text.GHC.Stats"+ [ testProperty "GCStats instance" (prop_matchesShow :: Int -> GCStats -> Bool)+ ]+ , testGroup "Text.Show.Text.System.Exit"+ [ testProperty "ExitCode instance" (prop_matchesShow :: Int -> ExitCode -> Bool)+ ]+ , testGroup "Text.Show.Text.System.IO"+ [ -- testProperty "Handle instance" (prop_matchesShow :: Int -> Handle -> Bool)+ testProperty "IOMode instance" (prop_matchesShow :: Int -> IOMode -> Bool)+ , testProperty "BufferMode instance" (prop_matchesShow :: Int -> BufferMode -> Bool)+-- , testProperty "HandlePosn instance" (prop_matchesShow :: Int -> HandlePosn -> Bool)+ , testProperty "SeekMode instance" (prop_matchesShow :: Int -> SeekMode -> Bool)+-- #if MIN_VERSION_base(4,3,0)+-- , testProperty "TextEncoding" (prop_matchesShow :: Int -> TextEncoding -> Bool)+-- #endif+#if MIN_VERSION_base(4,4,0)+ , testProperty "CodingProgress instance" (prop_matchesShow :: Int -> CodingProgress -> Bool)+ , testProperty "CodingFailureMode instance" (prop_matchesShow :: Int -> CodingFailureMode -> Bool)+#endif+ , testProperty "Newline instance" (prop_matchesShow :: Int -> Newline -> Bool)+ , testProperty "NewlineMode instance" (prop_matchesShow :: Int -> NewlineMode -> Bool)+ ]+ , testGroup "Text.Show.Text.System.Posix.Types"+ [ testProperty "CDev instance" (prop_matchesShow :: Int -> CDev -> Bool)+ , testProperty "CIno instance" (prop_matchesShow :: Int -> CIno -> Bool)+ , testProperty "CMode instance" (prop_matchesShow :: Int -> CMode -> Bool)+ , testProperty "COff instance" (prop_matchesShow :: Int -> COff -> Bool)+ , testProperty "CPid instance" (prop_matchesShow :: Int -> CPid -> Bool)+ , testProperty "CSsize instance" (prop_matchesShow :: Int -> CSsize -> Bool)+ , testProperty "CGid instance" (prop_matchesShow :: Int -> CGid -> Bool)+ , testProperty "CNlink instance" (prop_matchesShow :: Int -> CNlink -> Bool)+ , testProperty "CUid instance" (prop_matchesShow :: Int -> CUid -> Bool)+ , testProperty "CCc instance" (prop_matchesShow :: Int -> CCc -> Bool)+ , testProperty "CSpeed instance" (prop_matchesShow :: Int -> CSpeed -> Bool)+ , testProperty "CTcflag instance" (prop_matchesShow :: Int -> CTcflag -> Bool)+ , testProperty "CRLim instance" (prop_matchesShow :: Int -> CRLim -> Bool)+ , testProperty "Fd instance" (prop_matchesShow :: Int -> Fd -> Bool)+ ]+-- , testGroup "Text.Show.Text.Text.Read.Lex"+-- [ testProperty "Lexeme instance" (prop_matchesShow :: Int -> Lexeme -> Bool)+-- , testProperty "Number instance" (prop_matchesShow :: Int -> Number -> Bool)+-- ]+ ]
+ tests/Properties/Derived.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE TypeOperators #-}+-----------------------------------------------------------------------------+-- |+-- Module : Properties.BaseAndFriends+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- @QuickCheck@ properties for data types that have derived 'Show' instances+-- (using "Text.Show.Text.TH").+----------------------------------------------------------------------------+module Properties.Derived (derivedTests) where++import Data.Text.Lazy.Builder (fromString)++import Instances.Derived++import Properties.Utils (prop_matchesShow)++import Test.Tasty (TestTree, testGroup)+import Test.Tasty.QuickCheck (testProperty)++import Text.Show.Text (showb, showbPrec)++-- | Verifies that the two 'Show' instances of 'GADT' coincide.+prop_showGADT :: Int -- The precedence to show with+ -> Double -- The argument to 'GADTCon2'+ -> Int -- The argument to 'GADTCon3'+ -> Bool+prop_showGADT p d i+ = let gc1 :: GADT Char Int+ gc1 = GADTCon1+ + gc2 :: GADT Double Double+ gc2 = GADTCon2 d+ + gc3 :: GADT Int String+ gc3 = GADTCon3 i+ in fromString (show gc1) == showb gc1+ && fromString (showsPrec p gc2 "") == showbPrec p gc2+ && fromString (showsPrec p gc3 "") == showbPrec p gc3++derivedTests :: [TestTree]+derivedTests =+ [ testGroup "Template Haskell-derived data types"+ [ testProperty "Nullary instance" (prop_matchesShow :: Int -> Nullary -> Bool)+ , testProperty "PhantomNullary Int instance" (prop_matchesShow :: Int -> PhantomNullary Int -> Bool)+ , testProperty "MonomorphicUnary instance" (prop_matchesShow :: Int -> MonomorphicUnary -> Bool)+ , testProperty "PolymorphicUnary Int Int instance" (prop_matchesShow :: Int -> PolymorphicUnary Int Int -> Bool)+ , testProperty "MonomorphicNewtype instance" (prop_matchesShow :: Int -> MonomorphicNewtype -> Bool)+ , testProperty "PolymorphicNewtype Int Int instance" (prop_matchesShow :: Int -> PolymorphicNewtype Int Int -> Bool)+ , testProperty "MonomorphicProduct instance" (prop_matchesShow :: Int -> MonomorphicProduct -> Bool)+ , testProperty "PolymorphicProduct Int Int Int Int instance" (prop_matchesShow :: Int -> PolymorphicProduct Int Int Int Int -> Bool)+ , testProperty "MonomorphicRecord instance" (prop_matchesShow :: Int -> MonomorphicRecord -> Bool)+ , testProperty "PolymorphicRecord Int Int Int Int instance" (prop_matchesShow :: Int -> PolymorphicRecord Int Int Int Int -> Bool)+ , testProperty "MonomorphicInfix instance" (prop_matchesShow :: Int -> MonomorphicInfix -> Bool)+ , testProperty "PolymorphicInfix Int Int Int instance" (prop_matchesShow :: Int -> PolymorphicInfix Int Int Int -> Bool)+ , testProperty "AllAtOnce Int Int Int Int instance" (prop_matchesShow :: Int -> AllAtOnce Int Int Int Int -> Bool)+ , testProperty "GADT instance" prop_showGADT+ , testProperty "LeftAssocTree Int instance" (prop_matchesShow :: Int -> LeftAssocTree Int -> Bool)+ , testProperty "RightAssocTree Int instance" (prop_matchesShow :: Int -> RightAssocTree Int -> Bool)+ , testProperty "Int :?: Int instance" (prop_matchesShow :: Int -> Int :?: Int -> Bool)+ ]+ ]
+ tests/Properties/Utils.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE NoImplicitPrelude #-}+-----------------------------------------------------------------------------+-- |+-- Module : Properties.Utils+-- Copyright : (C) 2014 Ryan Scott+-- License : BSD-style (see the file LICENSE)+-- Maintainer : Ryan Scott+-- Stability : Experimental+-- Portability : GHC+-- +-- @QuickCheck@ property-related utility functions.+----------------------------------------------------------------------------+module Properties.Utils (prop_matchesShow) where++import Data.Text.Lazy.Builder (fromString)++import qualified Prelude as P (Show)+import Prelude hiding (Show)++import Test.QuickCheck (Arbitrary)++import qualified Text.Show.Text as T (Show)+import Text.Show.Text (showbPrec)++-- | Verifies that a type's @Show@ instances coincide for both 'String's and 'Text',+-- irrespective of precedence.+prop_matchesShow :: (P.Show a, T.Show a, Arbitrary a) => Int -> a -> Bool+prop_matchesShow k x = fromString (showsPrec k x "") == showbPrec k x
text-show.cabal view
@@ -1,10 +1,45 @@ name: text-show-version: 0.2.0.0+version: 0.3.0.0 synopsis: Efficient conversion of values into Text-description: @text-show@ offers a complete drop-in replacement of the @Show@- typeclass, but for @Text@ instead of @String@. This package was- created in the spirit of+description: @text-show@ offers a replacement for the @Show@ typeclass intended+ for use with @Text@ instead of @String@s. This package was created+ in the spirit of @<http://hackage.haskell.org/package/bytestring-show bytestring-show>@.+ .+ At the moment, @text-show@ provides @Show@ instances for most data+ types in the @<http://hackage.haskell.org/package/array array>@,+ @<http://hackage.haskell.org/package/base base>@,+ @<http://hackage.haskell.org/package/bytestring bytestring>@,+ @<http://hackage.haskell.org/package/containers containers>@,+ @<http://hackage.haskell.org/package/text text>@, and+ @<http://hackage.haskell.org/package/time time>@ packages.+ Therefore, much of the source code for @text-show@ consists of+ borrowed code from those packages in order to ensure that the+ behaviors of the two @Show@ typeclasses coincide.+ .+ For most uses, simply importing "Text.Show.Text"+ will suffice:+ .+ @+ {-# LANGUAGE NoImplicitPrelude #-}+ module Main where+ import Data.Text (Text)+ import Prelude hiding (Show(..), print)+ import Text.Show.Text+ .+ number :: Text+ number = show 27+ .+ main :: IO ()+ main = print number+ @+ .+ If you desire it, there are also monomorphic versions of the @showb@+ function available in the submodules of "Text.Show.Text". A naming+ convention is present in which functions that show different values+ depending on the precedence end with @Prec@ (e.g., @showbIntPrec@),+ whereas functions that show the same values regardless of+ precedence do not end with @Prec@ (e.g., @showbBool@). homepage: https://github.com/RyanGlScott/text-show bug-reports: https://github.com/RyanGlScott/text-show/issues license: BSD3@@ -24,23 +59,93 @@ library exposed-modules: Text.Show.Text- build-depends: array >= 0.3- , base >= 4.2 && < 5- , containers < 0.6- , text >= 0.2 && < 1.3- , text-format >= 0.2 && < 0.4+ Text.Show.Text.TH+ + Text.Show.Text.Control.Applicative+ Text.Show.Text.Control.Concurrent+ Text.Show.Text.Control.Exception+ Text.Show.Text.Control.Monad.ST+ Text.Show.Text.Data.Array+ Text.Show.Text.Data.Bool+ Text.Show.Text.Data.ByteString+ Text.Show.Text.Data.Char+ Text.Show.Text.Data.Containers+ Text.Show.Text.Data.Data+ Text.Show.Text.Data.Dynamic+ Text.Show.Text.Data.Either+ Text.Show.Text.Data.Fixed+ Text.Show.Text.Data.Floating+ Text.Show.Text.Data.Integral+ Text.Show.Text.Data.List+ Text.Show.Text.Data.Maybe+ Text.Show.Text.Data.Monoid+ Text.Show.Text.Data.Ord+ Text.Show.Text.Data.Text+ Text.Show.Text.Data.Time+ Text.Show.Text.Data.Tuple+ Text.Show.Text.Data.Typeable+ Text.Show.Text.Data.Version+ Text.Show.Text.Foreign.C.Types+ Text.Show.Text.Foreign.Ptr+ Text.Show.Text.Functions+ Text.Show.Text.System.Exit+ Text.Show.Text.System.IO+ Text.Show.Text.System.Posix.Types+ Text.Show.Text.Text.Read+ other-modules: Text.Show.Text.Class+ Text.Show.Text.Control+ Text.Show.Text.Data+ Text.Show.Text.Foreign+ Text.Show.Text.GHC+ Text.Show.Text.Instances+ Text.Show.Text.System+ Text.Show.Text.Text+ Text.Show.Text.Utils+ build-depends: array >= 0.3 && < 0.6+ , base >= 4.2 && < 5+ , bytestring >= 0.9 && < 0.11+ , containers >= 0.1 && < 0.6+ , ghc-prim+ , template-haskell >= 2.4 && < 2.10+ , text >= 0.2 && < 1.3+ , text-format >= 0.2 && < 0.4+ , time >= 0.1 && < 1.6 hs-source-dirs: src ghc-options: -Wall+ + if impl(ghc >= 7.2)+ exposed-modules: Text.Show.Text.GHC.Event+ Text.Show.Text.GHC.Generics+ + if impl(ghc >= 7.4)+ exposed-modules: Text.Show.Text.GHC.Stats+ + if impl(ghc >= 7.8)+ exposed-modules: Text.Show.Text.Data.Type.Coercion+ Text.Show.Text.Data.Type.Equality -test-suite properties+test-suite text-show-properties type: exitcode-stdio-1.0 main-is: Properties.hs+ other-modules: Instances.BaseAndFriends+ Instances.Derived+ Properties.BaseAndFriends+ Properties.Derived+ Properties.Utils hs-source-dirs: tests- build-depends: array >= 0.3- , base >= 4.2 && < 5- , containers < 0.6- , QuickCheck >= 2.4 && < 2.8- , quickcheck-instances- , text >= 0.2 && < 1.3- , text-show == 0.2.0.0+ build-depends: array >= 0.3 && < 0.6+ , base >= 4.2 && < 5+ , bytestring >= 0.9 && < 0.11+ , containers >= 0.1 && < 0.6+ , QuickCheck >= 2.4 && < 2.8+ , quickcheck-instances >= 0.1 && < 0.4+ , tasty >= 0.8 && < 0.11+ , tasty-quickcheck >= 0.8 && < 0.9+ , text >= 0.2 && < 1.3+ , text-show >= 0.3 && < 0.4+ , time >= 0.1 && < 1.6 ghc-options: -Wall+ + -- Prior to GHC 7.6, GHC generics lived in ghc-prim+ if impl(ghc >= 7.2) && impl(ghc < 7.6)+ build-depends: ghc-prim