Safe Haskell | None |
---|---|
Language | Haskell2010 |
Fmt
Contents
- (%<) :: FromBuilder b => Builder -> Builder -> b
- (>%) :: (Buildable a, FromBuilder b) => a -> Builder -> b
- (%<<) :: FromBuilder b => Builder -> Builder -> b
- (>>%) :: (Show a, FromBuilder b) => a -> Builder -> b
- (>%%<) :: (Buildable a, FromBuilder b) => a -> Builder -> b
- (>>%%<<) :: (Show a, FromBuilder b) => a -> Builder -> b
- (>%%<<) :: (Show a, FromBuilder b) => a -> Builder -> b
- (>>%%<) :: (Buildable a, FromBuilder b) => a -> Builder -> b
- fmt :: FromBuilder b => Builder -> b
- fmtLn :: FromBuilder b => Builder -> b
- data Builder :: *
- class Buildable p where
- indent :: Int -> Builder -> Builder
- indent' :: Int -> Text -> Builder -> Builder
- nameF :: Builder -> Builder -> Builder
- listF :: (Foldable f, Buildable a) => f a -> Builder
- listF' :: Foldable f => (a -> Builder) -> f a -> Builder
- blockListF :: forall f a. (Foldable f, Buildable a) => f a -> Builder
- blockListF' :: forall f a. Foldable f => (a -> Builder) -> f a -> Builder
- jsonListF :: forall f a. (Foldable f, Buildable a) => f a -> Builder
- jsonListF' :: forall f a. Foldable f => (a -> Builder) -> f a -> Builder
- mapF :: (IsList t, Item t ~ (k, v), Buildable k, Buildable v) => t -> Builder
- mapF' :: (IsList t, Item t ~ (k, v)) => (k -> Builder) -> (v -> Builder) -> t -> Builder
- blockMapF :: (IsList t, Item t ~ (k, v), Buildable k, Buildable v) => t -> Builder
- blockMapF' :: (IsList t, Item t ~ (k, v)) => (k -> Builder) -> (v -> Builder) -> t -> Builder
- jsonMapF :: (IsList t, Item t ~ (k, v), Buildable k, Buildable v) => t -> Builder
- jsonMapF' :: forall t k v. (IsList t, Item t ~ (k, v)) => (k -> Builder) -> (v -> Builder) -> t -> Builder
- tupleF :: TupleF a => a -> Builder
- tupleLikeF :: [Builder] -> Builder
- maybeF :: Buildable a => Maybe a -> Builder
- eitherF :: (Buildable a, Buildable b) => Either a b -> Builder
- prefixF :: Buildable a => Int -> a -> Builder
- suffixF :: Buildable a => Int -> a -> Builder
- padLeftF :: Buildable a => Int -> Char -> a -> Builder
- padRightF :: Buildable a => Int -> Char -> a -> Builder
- padCenterF :: Buildable a => Int -> Char -> a -> Builder
- hexF :: FormatAsHex a => a -> Builder
- base64F :: FormatAsBase64 a => a -> Builder
- base64UrlF :: FormatAsBase64 a => a -> Builder
- ordinalF :: (Buildable a, Integral a) => a -> Builder
- commaizeF :: (Buildable a, Integral a) => a -> Builder
- octF :: Integral a => a -> Builder
- binF :: Integral a => a -> Builder
- baseF :: Integral a => Int -> a -> Builder
- floatF :: Real a => a -> Builder
- exptF :: Real a => Int -> a -> Builder
- precF :: Real a => Int -> a -> Builder
- fixedF :: Real a => Int -> a -> Builder
- whenF :: Bool -> Builder -> Builder
- unlessF :: Bool -> Builder -> Builder
Overloaded strings
You need OverloadedStrings
enabled to use this library. There are three ways to do it:
- In GHCi: do
:set -XOverloadedStrings
. - In a module: add
{-# LANGUAGE OverloadedStrings #-}
to the beginning of your module. - In a project: add
OverloadedStrings
to thedefault-extensions
section of your.cabal
file.
Examples
Here's a bunch of examples because some people learn better by looking at examples.
Insert some variables into a string:
>>>
let (a, b, n) = ("foo", "bar", 25)
>>>
("Here are some words: "%<a>%", "%<b>%"\nAlso a number: "%<n>%"") :: String
"Here are some words: foo, bar\nAlso a number: 25"
Print it:
>>>
fmtLn ("Here are some words: "%<a>%", "%<b>%"\nAlso a number: "%<n>%"")
Here are some words: foo, bar Also a number: 25
Format a list in various ways:
>>>
let xs = ["John", "Bob"]
>>>
fmtLn ("Using show: "%<<xs>>%"\nUsing listF: "%<listF xs>%"")
Using show: ["John","Bob"] Using listF: [John, Bob]
>>>
fmt ("YAML-like:\n"%<blockListF xs>%"")
YAML-like: - John - Bob
>>>
fmt ("JSON-like: "%<jsonListF xs>%"")
JSON-like: [ John , Bob ]
Basic formatting
To format strings, put variables between (%<
) and (>%
):
>>>
let name = "Alice"
>>>
"Meet "%<name>%"!" :: String
"Meet Alice!"
Of course, Text
is supported as well:
>>>
"Meet "%<name>%"!" :: Text
"Meet Alice!"
You don't actually need any type signatures; however, if you're toying with
this library in GHCi, it's recommended to either add a type signature or use
fmtLn
:
>>>
fmtLn ("Meet "%<name>%"!")
Meet Alice!
Otherwise the type of the formatted string would be resolved to IO ()
and
printed without a newline, which is not very convenient when you're in
GHCi. On the other hand, it's useful for quick-and-dirty scripts:
main = do [fin, fout] <- words <$> getArgs "Reading data from "%<fin>%"\n" xs <- readFile fin "Writing processed data to "%<fout>%"\n" writeFile fout (show (process xs))
Anyway, let's proceed. Anything Buildable
, including numbers, booleans,
characters and dates, can be put between (%<
) and (>%
):
>>>
let starCount = "173"
>>>
fmtLn ("Meet "%<name>%"! She's got "%<starCount>%" stars on Github.")
"Meet Alice! She's got 173 stars on Github."
Since the only thing (%<
) and (>%
) do is concatenate strings and do
conversion, you can use any functions you want inside them. In this case,
length
:
>>>
fmtLn (""%<name>%"'s name has "%<length name>%" letters")
Alice's name has 5 letters
If something isn't Buildable
, just use show
on it:
>>>
let pos = (3, 5)
>>>
fmtLn ("Character's position: "%<show pos>%"")
Character's position: (3,5)
Or one of many formatters provided by this library – for instance, for tuples
of various sizes there's tupleF
:
>>>
fmtLn ("Character's position: "%<tupleF pos>%"")
Character's position: (3, 5)
Finally, for convenience there's the (>%%<
) operator, which can be used if
you've got one variable following the other:
>>>
let (a, op, b, res) = (2, "*", 2, 4)
>>>
fmtLn (""%<a>%%<op>%%<b>%" = "%<res>%"")
2*2 = 4
Also, since in some codebases there are lots of types which aren't
Buildable
, there are operators (%<<
) and (>>%
), which use show
instead of build
:
(""%<show foo>%%<show bar>%"") === (""%<<foo>>%%<<bar>>%"")
Ordinary brackets
Show
brackets
Combinations
Helper functions
fmt :: FromBuilder b => Builder -> b Source #
fmt
converts things to String
, Text
or Builder
.
Most of the time you won't need it, as strings produced with (%<
) and
(>%
) can already be used as String
, Text
, etc. However, combinators
like listF
can only produce Builder
(for better type inference), and you
need to use fmt
on them.
Also, fmt
can do printing:
>>>
fmt "Hello world!\n"
Hello world!
A Builder
is an efficient way to build lazy Text
values.
There are several functions for constructing builders, but only one
to inspect them: to extract any data, you have to turn them into
lazy Text
values using toLazyText
.
Internally, a builder constructs a lazy Text
by filling arrays
piece by piece. As each buffer is filled, it is 'popped' off, to
become a new chunk of the resulting lazy Text
. All this is
hidden from the user of the Builder
.
The class of types that can be rendered to a Builder
.
Minimal complete definition
Instances
Formatters
indent :: Int -> Builder -> Builder Source #
Indent already formatted text.
>>>
fmt $ "This is a list:\n" <> indent 4 (blockListF [1,2,3])
This is a list: - 1 - 2 - 3
nameF :: Builder -> Builder -> Builder Source #
Attach a name to anything:
>>>
fmt $ nameF "clients" $ blockListF ["Alice", "Bob", "Zalgo"]
clients: - Alice - Bob - Zalgo
Lists
listF :: (Foldable f, Buildable a) => f a -> Builder Source #
A simple comma-separated list formatter.
>>>
listF ["hello", "world"]
"[hello, world]"
blockListF :: forall f a. (Foldable f, Buildable a) => f a -> Builder Source #
A multiline formatter for lists.
>>>
fmt $ blockListF [1,2,3]
- 1 - 2 - 3
It automatically handles multiline list elements:
>>> fmt $ blockListF ["hellonworld", "foonbarnquix"] - hello world - foo bar quix
blockListF' :: forall f a. Foldable f => (a -> Builder) -> f a -> Builder Source #
A version of blockListF
that lets you supply your own building function
for list elements.
jsonListF :: forall f a. (Foldable f, Buildable a) => f a -> Builder Source #
A JSON-style formatter for lists.
>>>
fmt $ jsonListF [1,2,3]
[ 1 , 2 , 3 ]
Like blockListF
, it handles multiline elements well:
>>>
fmt $ jsonListF ["hello\nworld", "foo\nbar\nquix"]
[ hello world , foo bar quix ]
(Note that, unlike blockListF
, it doesn't add blank lines in such cases.)
jsonListF' :: forall f a. Foldable f => (a -> Builder) -> f a -> Builder Source #
A version of jsonListF
that lets you supply your own building function
for list elements.
Maps
mapF' :: (IsList t, Item t ~ (k, v)) => (k -> Builder) -> (v -> Builder) -> t -> Builder Source #
A version of mapF
that lets you supply your own building function for
keys and values.
blockMapF :: (IsList t, Item t ~ (k, v), Buildable k, Buildable v) => t -> Builder Source #
A YAML-like map formatter:
>>>
fmt $ blockMapF [("Odds", blockListF [1,3]), ("Evens", blockListF [2,4])]
Odds: - 1 - 3 Evens: - 2 - 4
blockMapF' :: (IsList t, Item t ~ (k, v)) => (k -> Builder) -> (v -> Builder) -> t -> Builder Source #
A version of blockMapF
that lets you supply your own building function
for keys and values.
jsonMapF :: (IsList t, Item t ~ (k, v), Buildable k, Buildable v) => t -> Builder Source #
A JSON-like map formatter (unlike mapF
, always multiline):
>>>
fmt $ jsonMapF [("Odds", jsonListF [1,3]), ("Evens", jsonListF [2,4])]
{ Odds: [ 1 , 3 ] , Evens: [ 2 , 4 ] }
jsonMapF' :: forall t k v. (IsList t, Item t ~ (k, v)) => (k -> Builder) -> (v -> Builder) -> t -> Builder Source #
A version of jsonMapF
that lets you supply your own building function
for keys and values.
Tuples
tupleF :: TupleF a => a -> Builder Source #
Format a tuple (of up to 8 elements):
>>>
tupleF (1,2,"hi")
"(1, 2, hi)"
If any of the elements takes several lines, an alternate format is used:
>>> fmt $ tupleF ("test","foonbar","more test") ( test , foo bar , more test )
tupleLikeF :: [Builder] -> Builder Source #
Format a list like a tuple. (This function is used to define tupleF
.)
ADTs
eitherF :: (Buildable a, Buildable b) => Either a b -> Builder Source #
Format an Either
:
>>>
eitherF (Right 1)
"<Right>: 1"
Padding/trimming
prefixF :: Buildable a => Int -> a -> Builder Source #
Take the first N characters:
>>>
prefixF 3 "hello"
"hel"
suffixF :: Buildable a => Int -> a -> Builder Source #
Take the last N characters:
>>>
suffixF 3 "hello"
"llo"
padLeftF :: Buildable a => Int -> Char -> a -> Builder Source #
padLeftF n c
pads the string with character c
from the left side until it
becomes n
characters wide (and does nothing if the string is already that
long, or longer):
>>>
padLeftF 5 '0' 12
"00012">>>
padLeftF 5 '0' 123456
"123456"
padRightF :: Buildable a => Int -> Char -> a -> Builder Source #
padRightF n c
pads the string with character c
from the right side until
it becomes n
characters wide (and does nothing if the string is already
that long, or longer):
>>>
padRightF 5 ' ' "foo"
"foo ">>>
padRightF 5 ' ' "foobar"
"foobar"
padCenterF :: Buildable a => Int -> Char -> a -> Builder Source #
padCenterF n c
pads the string with character c
from both sides until
it becomes n
characters wide (and does nothing if the string is already
that long, or longer):
>>>
padCenterF 5 '=' "foo"
"=foo=">>>
padCenterF 5 '=' "foobar"
"foobar"
When padding can't be distributed equally, the left side is preferred:
>>>
padCenter 8 '=' "foo"
"===foo=="
Hex
hexF :: FormatAsHex a => a -> Builder Source #
Format a number or bytestring as hex:
>>>
hexF 3635
"e33"
Bytestrings
base64F :: FormatAsBase64 a => a -> Builder Source #
Convert a bytestring to base64:
>>>
base64F ("\0\50\63\80" :: BS.ByteString)
"ADI/UA=="
base64UrlF :: FormatAsBase64 a => a -> Builder Source #
Convert a bytestring to base64url (a variant of base64 which omits /
and
thus can be used in URLs):
>>>
base64UrlF ("\0\50\63\80" :: BS.ByteString)
"ADI_UA=="
Integers
ordinalF :: (Buildable a, Integral a) => a -> Builder Source #
Add an ordinal suffix to a number:
>>>
ordinalF 15
"15th">>>
ordinalF 22
"22nd"
commaizeF :: (Buildable a, Integral a) => a -> Builder Source #
Break digits in a number:
>>>
commaizeF 15830000
"15,830,000"
Base conversion
octF :: Integral a => a -> Builder Source #
Format a number as octal:
>>>
listF' octF [7,8,9,10]
"[7, 10, 11, 12]"
binF :: Integral a => a -> Builder Source #
Format a number as binary:
>>>
listF' binF [7,8,9,10]
"[111, 1000, 1001, 1010]"
baseF :: Integral a => Int -> a -> Builder Source #
Format a number in arbitrary base (up to 36):
>>>
baseF 3 10000
"111201101">>>
baseF 7 10000
"41104">>>
baseF 36 10000
"7ps"
Floating-point
floatF :: Real a => a -> Builder Source #
Format a floating-point number:
>>>
floatF 3.1415
"3.1415"
Numbers bigger than 1e21 or smaller than 1e-6 will be displayed using scientific notation:
>>>
listF' floatF [1e-6,9e-7]
"[0.000001, 9e-7]">>>
listF' floatF [9e20,1e21]
"[900000000000000000000, 1e21]"
exptF :: Real a => Int -> a -> Builder Source #
Format a floating-point number using scientific notation, with given amount of precision:
>>>
listF' (exptF 5) [pi,0.1,10]
"[3.14159e0, 1.00000e-1, 1.00000e1]"
precF :: Real a => Int -> a -> Builder Source #
Format a floating-point number with given amount of precision.
For small numbers, it uses scientific notation for everything smaller than 1e-6:
listF' (precF 3) [1e-5,1e-6,1e-7]
"[0.0000100, 0.00000100, 1.00e-7]"
For large numbers, it uses scientific notation for everything larger than 1eN, where N is the precision:
listF' (precF 4) [1e3,5e3,1e4]
"[1000, 5000, 1.000e4]"
fixedF :: Real a => Int -> a -> Builder Source #
Format a floating-point number without scientific notation:
>>>
listF' (fixedF 5) [pi,0.1,10]
"[3.14159, 0.10000, 10.00000]"
Conditional formatting
whenF :: Bool -> Builder -> Builder Source #
Display something only if the condition is True
(empty string otherwise).
>>> "Hello!" <> whenF showDetails (", details: "%foobar%"")
Note that it can only take a Builder
(because otherwise it would be
unusable with (%<
)-formatted strings which can resolve to any FromBuilder
). Thus, use fmt
if you need just one value:
>>> "Maybe here's a number: "%cond (fmt n)%""