| 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
- format :: (FromBuilder b, Params ps) => Format -> ps -> b
- formatLn :: (FromBuilder b, Params ps) => Format -> ps -> b
- data Format :: *
- 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
- padBothF :: 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
- genericF :: (Generic a, GBuildable (Rep a)) => a -> 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
OverloadedStringsto thedefault-extensionssection of your.cabalfile.
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 ]
Migration guide from formatting
Instead of using %, surround variables with #| and |#. You don't have
to use sformat or anything else, and also where you were using build,
int, text, etc in formatting, you don't have to use anything in fmt:
formatting sformat ("Foo: "%build%", bar: "%int) foo bar
fmt "Foo: "#|foo|#", bar: "#|bar|#""
The resulting formatted string is polymorphic and can be used as String,
Text, Builder or even IO (i.e. the string will be printed to the
screen). However, when printing it is recommended to use fmt or fmtLn for
clarity.
fmt provides lots of formatters (which are simply functions that produce
Builder):
formatting sformat ("Got another byte ("%hex%")") x
fmt "Got another byte ("#|hexF x|#")"
Instead of the shown formatter, either just use show or double brackets:
formatting sformat ("This uses Show: "%shown%") foo
fmt #1 "This uses Show: "#|show foo|#""
fmt #2 "This uses Show: "#||foo||#""
Many formatters from formatting have the same names in fmt, but with
added “F”: hexF, exptF, etc. Some have been renamed, though:
Cutting: fitLeft ->prefixFfitRight ->suffixFPadding: left ->padLeftFright ->padRightFcenter ->padBothFStuff with numbers: ords ->ordinalFcommas ->commaizeF
Also, some formatters from formatting haven't been added to fmt
yet. Specifically:
pluralandasInt(but instead ofasIntyou can usefromEnum)prefixBin,prefixOrd,prefixHex, andbytes- formatters that use
Scientific(sciandscifmt) - formatters that deal with time (anything from
Formatting.Time)
They will be added later. (On the other hand, fmt provides some useful
formatters not available in formatting, such as listF, mapF, tupleF
and so on.)
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
Operators for the operators god!
(#|) :: FromBuilder b => Builder -> Builder -> b infixr 1 #
Concatenate, then convert
(|#) :: (Buildable a, FromBuilder b) => a -> Builder -> b infixr 1 #
build and concatenate, then convert
Show brackets
More operators for the operators god!
(#||) :: FromBuilder b => Builder -> Builder -> b infixr 1 #
Concatenate, then convert
Combinations
Z̸͠A̵̕͟͠L̡̀́͠G̶̛O͝ ̴͏̀ I͞S̸̸̢͠ ̢̛͘͢C̷͟͡Ó̧̨̧͞M̡͘͟͞I̷͜N̷̕G̷̀̕
(Though you can just use "" between #| |# instead of using these
operators, and Show-brackets don't have to be used at all because there's
show available.)
(|##|) :: (Buildable a, FromBuilder b) => a -> Builder -> b infixr 1 #
(||##||) :: (Show a, FromBuilder b) => a -> Builder -> b infixr 1 #
(|##||) :: (Show a, FromBuilder b) => a -> Builder -> b infixr 1 #
(||##|) :: (Buildable a, FromBuilder b) => a -> Builder -> b infixr 1 #
Old-style formatting
format :: (FromBuilder b, Params ps) => Format -> ps -> b #
An old-style formatting function taken from text-format (see
Data.Text.Format). Unlike format from
Data.Text.Format, it can produce String and strict Text as well (and
print to console too).
To provide substitution arguments, use a tuple:
>>>format "{} + {} = {}" (2, 2, 4)"2 + 2 = 4"
You can use arbitrary formatters:
>>>format "0x{} + 0x{} = 0x{}" (hexF 130, hexF 270, hexF (130+270))"2 + 2 = 4"
To provide just one argument, use a list instead of a tuple:
>>>format "Hello {}!" ["world"]"Hello world!"
formatLn :: (FromBuilder b, Params ps) => Format -> ps -> b #
Like format, but adds a newline.
Helper functions
fmt :: FromBuilder b => Builder -> b #
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!
fmtLn :: FromBuilder b => Builder -> b #
Like fmt, but appends a newline.
Instances
| Buildable Bool | |
| Buildable Char | |
| Buildable Double | |
| Buildable Float | |
| Buildable Int | |
| Buildable Int8 | |
| Buildable Int16 | |
| Buildable Int32 | |
| Buildable Int64 | |
| Buildable Integer | |
| Buildable Word | |
| Buildable Word8 | |
| Buildable Word16 | |
| Buildable Word32 | |
| Buildable Word64 | |
| Buildable WordPtr | |
| Buildable IntPtr | |
| Buildable LocalTime | |
| Buildable ZonedTime | |
| Buildable TimeOfDay | |
| Buildable TimeZone | |
| Buildable UTCTime | |
| Buildable NominalDiffTime | |
| Buildable Day | |
| Buildable UniversalTime | |
| Buildable DiffTime | |
| Buildable Text | |
| Buildable Text | |
| Buildable Builder | |
| Buildable [Char] | |
| Buildable a => Buildable (Maybe a) | |
| (Integral a, Buildable a) => Buildable (Ratio a) | |
| Buildable (Ptr a) | |
| Integral a => Buildable (Hex a) | |
| Show a => Buildable (Shown a) | |
Formatters
indent :: Int -> Builder -> Builder #
Indent already formatted text.
>>>fmt $ "This is a list:\n" <> indent 4 (blockListF [1,2,3])This is a list: - 1 - 2 - 3
The output will always end with a newline, even when the input doesn't.
indent' :: Int -> Text -> Builder -> Builder #
Add a prefix to the first line, and indent all lines but the first one.
The output will always end with a newline, even when the input doesn't.
nameF :: Builder -> Builder -> Builder #
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 #
A simple comma-separated list formatter.
>>>listF ["hello", "world"]"[hello, world]"
For multiline output, use jsonListF.
blockListF :: forall f a. (Foldable f, Buildable a) => f a -> Builder #
A multiline formatter for lists.
>>>fmt $ blockListF [1,2,3]- 1 - 2 - 3
It automatically handles multiline list elements:
>>> fmt $ blockListF ["hello\nworld", "foo\nbar\nquix"] - hello world - foo bar quix
blockListF' :: forall f a. Foldable f => (a -> Builder) -> f a -> Builder #
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 #
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 #
A version of jsonListF that lets you supply your own building function
for list elements.
Maps
mapF :: (IsList t, Item t ~ (k, v), Buildable k, Buildable v) => t -> Builder #
A simple JSON-like map formatter; works for Map, HashMap, etc, as well as ordinary lists of pairs.
>>>mapF [("a", 1), ("b", 4)]"{a: 1, b: 4}"
For multiline output, use jsonMapF.
mapF' :: (IsList t, Item t ~ (k, v)) => (k -> Builder) -> (v -> Builder) -> t -> Builder #
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 #
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 #
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 #
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 #
A version of jsonMapF that lets you supply your own building function
for keys and values.
Tuples
tupleF :: TupleF a => a -> Builder #
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","foo\nbar","more test")
( test
,
foo
bar
,
more test )
tupleLikeF :: [Builder] -> Builder #
Format a list like a tuple. (This function is used to define tupleF.)
ADTs
eitherF :: (Buildable a, Buildable b) => Either a b -> Builder #
Format an Either:
>>>eitherF (Right 1)"<Right>: 1"
Padding/trimming
prefixF :: Buildable a => Int -> a -> Builder #
Take the first N characters:
>>>prefixF 3 "hello""hel"
suffixF :: Buildable a => Int -> a -> Builder #
Take the last N characters:
>>>suffixF 3 "hello""llo"
padLeftF :: Buildable a => Int -> Char -> a -> Builder #
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 #
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"
padBothF :: Buildable a => Int -> Char -> a -> Builder #
padBothF 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):
>>>padBothF 5 '=' "foo""=foo=">>>padBothF 5 '=' "foobar""foobar"
When padding can't be distributed equally, the left side is preferred:
>>>padBoth 8 '=' "foo""===foo=="
Hex
hexF :: FormatAsHex a => a -> Builder #
Format a number or bytestring as hex:
>>>hexF 3635"e33">>>hexF ("\0\50\63\80" :: BS.ByteString)"00323f50"
Bytestrings
base64F :: FormatAsBase64 a => a -> Builder #
Convert a bytestring to base64:
>>>base64F ("\0\50\63\80" :: BS.ByteString)"ADI/UA=="
base64UrlF :: FormatAsBase64 a => a -> Builder #
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 #
Add an ordinal suffix to a number:
>>>ordinalF 15"15th">>>ordinalF 22"22nd"
commaizeF :: (Buildable a, Integral a) => a -> Builder #
Break digits in a number:
>>>commaizeF 15830000"15,830,000"
Base conversion
octF :: Integral a => a -> Builder #
Format a number as octal:
>>>listF' octF [7,8,9,10]"[7, 10, 11, 12]"
binF :: Integral a => a -> Builder #
Format a number as binary:
>>>listF' binF [7,8,9,10]"[111, 1000, 1001, 1010]"
baseF :: Integral a => Int -> a -> Builder #
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 #
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 #
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 #
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 #
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 #
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: "#|whenF cond (fmt n)|#""
unlessF :: Bool -> Builder -> Builder #
Display something only if the condition is False (empty string otherwise).
Generic formatting
genericF :: (Generic a, GBuildable (Rep a)) => a -> Builder #
Format an arbitrary value without requiring a Buildable instance:
data Foo = Foo { x :: Bool, y :: [Int] }
deriving Generic
>>>fmt (genericF (Foo True [1,2,3]))Foo: x: True y: [1, 2, 3]
It works for non-record constructors too:
data Bar = Bar Bool [Int] deriving Generic
>>>fmtLn (genericF (Bar True [1,2,3]))<Bar: True, [1, 2, 3]>
Any fields inside the type must either be Buildable or one of the following
types:
The exact format of genericF might change in future versions, so don't rely
on it. It's merely a convenience function.