Copyright | (c) Dong Han 2017-2019 |
---|---|
License | BSD |
Maintainer | winterland1989@gmail.com |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
This module re-exports some UTF8 compatible textual builders from Builder
.
We also provide a faster alternative to Show
class, i.e. Print
, which can be deriving using Generic
.
For example to use Print
class:
import qualified Z.Data.Text.Print as T data Foo = Bar Bytes | Qux Text Int deriving Generic deriving anyclass T.Print
Synopsis
- class Print a where
- toUTF8BuilderP :: Int -> a -> Builder ()
- toText :: Print a => a -> Text
- toString :: Print a => a -> String
- toUTF8Builder :: Print a => a -> Builder ()
- toUTF8Bytes :: Print a => a -> Bytes
- escapeTextJSON :: Text -> Builder ()
- stringUTF8 :: String -> Builder ()
- charUTF8 :: Char -> Builder ()
- string7 :: String -> Builder ()
- char7 :: Char -> Builder ()
- text :: Text -> Builder ()
- data IFormat = IFormat {}
- defaultIFormat :: IFormat
- data Padding
- int :: (Integral a, Bounded a) => a -> Builder ()
- intWith :: (Integral a, Bounded a) => IFormat -> a -> Builder ()
- integer :: Integer -> Builder ()
- hex :: forall a. (FiniteBits a, Integral a) => a -> Builder ()
- hexUpper :: forall a. (FiniteBits a, Integral a) => a -> Builder ()
- data FFormat
- double :: Double -> Builder ()
- doubleWith :: FFormat -> Maybe Int -> Double -> Builder ()
- float :: Float -> Builder ()
- floatWith :: FFormat -> Maybe Int -> Float -> Builder ()
- scientific :: Scientific -> Builder ()
- scientificWith :: FFormat -> Maybe Int -> Scientific -> Builder ()
- paren :: Builder () -> Builder ()
- curly :: Builder () -> Builder ()
- square :: Builder () -> Builder ()
- angle :: Builder () -> Builder ()
- quotes :: Builder () -> Builder ()
- squotes :: Builder () -> Builder ()
- colon :: Builder ()
- comma :: Builder ()
- intercalateVec :: Vec v a => Builder () -> (a -> Builder ()) -> v a -> Builder ()
- intercalateList :: Builder () -> (a -> Builder ()) -> [a] -> Builder ()
- parenWhen :: Bool -> Builder () -> Builder ()
Print class
A class similar to Show
, serving the purpose that quickly convert a data type to a Text
value.
You can use newtype or generic deriving to implement instance of this class quickly:
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} import GHC.Generics newtype FooInt = FooInt Int deriving (Generic) deriving anyclass Print > toText (FooInt 3) > "FooInt 3" newtype FooInt = FooInt Int deriving (Generic) deriving newtype Print > toText (FooInt 3) > "3"
Nothing
toUTF8BuilderP :: Int -> a -> Builder () Source #
Instances
Basic UTF8 builders
escapeTextJSON :: Text -> Builder () Source #
Escape text using JSON string escaping rules and add double quotes, escaping rules:
'\b': "\b" '\f': "\f" '\n': "\n" '\r': "\r" '\t': "\t" '"': "\"" '\': "\\" other chars <= 0x1F: "\u00XX"
stringUTF8 :: String -> Builder () Source #
Turn String
into Builder
with UTF8 encoding
Illegal codepoints will be written as replacementChar
s.
This is different from writing string literals builders via OverloadedStrings
, because string literals
do not provide UTF8 guarantees.
This function will be rewritten into a memcpy if possible, (running a fast UTF-8 validation at runtime first).
charUTF8 :: Char -> Builder () Source #
Turn Char
into Builder
with UTF8 encoding
Illegal codepoints will be written as replacementChar
s.
Numeric builders
Integral type formatting
Integral formatting options.
defaultIFormat :: IFormat Source #
defaultIFormat = IFormat 0 NoPadding False
Instances
Enum Padding Source # | |
Eq Padding Source # | |
Ord Padding Source # | |
Show Padding Source # | |
Arbitrary Padding Source # | |
CoArbitrary Padding Source # | |
Defined in Z.Data.Builder.Numeric coarbitrary :: Padding -> Gen b -> Gen b # |
intWith :: (Integral a, Bounded a) => IFormat -> a -> Builder () Source #
Format a Bounded
Integral
type like Int
or Word16
into decimal ASCII digits.
import Z.Data.Builder as B > B.buildText $ B.intWith defaultIFormat (12345 :: Int) "12345" > B.buildText $ B.intWith defaultIFormat{width=10, padding=RightSpacePadding} (12345 :: Int) "12345 " > B.buildText $ B.intWith defaultIFormat{width=10, padding=ZeroPadding} (12345 :: Int) "0000012345"
Fixded size hexidecimal formatting
hex :: forall a. (FiniteBits a, Integral a) => a -> Builder () Source #
Format a FiniteBits
Integral
type into hex nibbles.
import Z.Data.Builder as B import Z.Data.Text as T import Data.Word import Data.Int > T.validate . B.buildBytes $ B.hex (125 :: Int8) "7d" > T.validate . B.buildBytes $ B.hex (-1 :: Int8) "ff" > T.validate . B.buildBytes $ B.hex (125 :: Word16) "007d"
hexUpper :: forall a. (FiniteBits a, Integral a) => a -> Builder () Source #
The UPPERCASED version of hex
.
IEEE float formating
Control the rendering of floating point numbers.
Exponent | Scientific notation (e.g. |
Fixed | Standard decimal notation. |
Generic | Use decimal notation for values between |
Instances
double :: Double -> Builder () Source #
Decimal encoding of an IEEE Double
.
Using standard decimal notation for arguments whose absolute value lies
between 0.1
and 9,999,999
, and scientific notation otherwise.
Format double-precision float using drisu3 with dragon4 fallback.
float :: Float -> Builder () Source #
Decimal encoding of an IEEE Float
.
Using standard decimal notation for arguments whose absolute value lies
between 0.1
and 9,999,999
, and scientific notation otherwise.
Format single-precision float using drisu3 with dragon4 fallback.
scientific :: Scientific -> Builder () Source #
A Builder
which renders a scientific number to full
precision, using standard decimal notation for arguments whose
absolute value lies between 0.1
and 9,999,999
, and scientific
notation otherwise.
:: FFormat | |
-> Maybe Int | Number of decimal places to render. |
-> Scientific | |
-> Builder () |
Like scientific
but provides rendering options.
Helpers
:: Vec v a | |
=> Builder () | the seperator |
-> (a -> Builder ()) | value formatter |
-> v a | value vector |
-> Builder () |
Use separator to connect a vector of builders.
import Z.Data.Builder as B import Z.Data.Text as T import Z.Data.Vector as V > T.validate . B.build $ B.intercalateVec "," B.int (V.pack [1,2,3,4] :: V.PrimVector Int) "1,2,3,4"
Use separator to connect list of builders.
import Z.Data.Builder as B import Z.Data.Text as T import Z.Data.Vector as V T.validate . B.build $ B.intercalateList "," B.int ([1,2,3,4] :: [Int]) "1,2,3,4"