{-# LANGUAGE OverloadedStrings #-}

-- | Examples that should always compile. If reading on Haddock, you
-- can view the sources to each of these.

module Formatting.Examples
  ( hello
  , strings
  , texts
  , builders
  , integers
  , floats
  , hexes
  , padding
  ) where

import Data.Text.Lazy (Text)
import Data.Text.Lazy.Builder (Builder)
import Formatting

-- | Simple hello, world!
hello :: Text
hello :: Text
hello = Format Text Text -> Text
forall a. Format Text a -> a
format Format Text Text
"Hello, World!"

-- | Printing strings.
strings :: Text
strings :: Text
strings =
  Format Text (String -> String -> Text) -> String -> String -> Text
forall a. Format Text a -> a
format (Format (String -> String -> Text) (String -> String -> Text)
"Here comes a string: " Format (String -> String -> Text) (String -> String -> Text)
-> Format Text (String -> String -> Text)
-> Format Text (String -> String -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (String -> Text) (String -> String -> Text)
forall r. Format r (String -> r)
string Format (String -> Text) (String -> String -> Text)
-> Format Text (String -> Text)
-> Format Text (String -> String -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (String -> Text) (String -> Text)
" and another " Format (String -> Text) (String -> Text)
-> Format Text (String -> Text) -> Format Text (String -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text (String -> Text)
forall r. Format r (String -> r)
string)
         String
"Hello, World!"
         String
"Ahoy!"

-- | Printing texts.
texts :: Text
texts :: Text
texts =
  Format Text (Text -> Text -> Text) -> Text -> Text -> Text
forall a. Format Text a -> a
format (Format (Text -> Text -> Text) (Text -> Text -> Text)
"Here comes a string: " Format (Text -> Text -> Text) (Text -> Text -> Text)
-> Format Text (Text -> Text -> Text)
-> Format Text (Text -> Text -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (Text -> Text) (Text -> Text -> Text)
forall r. Format r (Text -> r)
text Format (Text -> Text) (Text -> Text -> Text)
-> Format Text (Text -> Text) -> Format Text (Text -> Text -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (Text -> Text) (Text -> Text)
" and another " Format (Text -> Text) (Text -> Text)
-> Format Text (Text -> Text) -> Format Text (Text -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text (Text -> Text)
forall r. Format r (Text -> r)
text)
         Text
"Hello, World!"
         Text
"Ahoy!"

-- | Printing builders.
builders :: Text
builders :: Text
builders =
  Format Text (Builder -> Text -> Text) -> Builder -> Text -> Text
forall a. Format Text a -> a
format (Format (Builder -> Text -> Text) (Builder -> Text -> Text)
"Here comes a string: " Format (Builder -> Text -> Text) (Builder -> Text -> Text)
-> Format Text (Builder -> Text -> Text)
-> Format Text (Builder -> Text -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (Text -> Text) (Builder -> Text -> Text)
forall r. Format r (Builder -> r)
builder Format (Text -> Text) (Builder -> Text -> Text)
-> Format Text (Text -> Text)
-> Format Text (Builder -> Text -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (Text -> Text) (Text -> Text)
" and another " Format (Text -> Text) (Text -> Text)
-> Format Text (Text -> Text) -> Format Text (Text -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text (Text -> Text)
forall r. Format r (Text -> r)
text)
         (Builder
"Hello, World!" :: Builder)
         Text
"Ahoy!"

-- | Printing integers.
integers :: Text
integers :: Text
integers =
  Format Text (Int -> Integer -> Text) -> Int -> Integer -> Text
forall a. Format Text a -> a
format (Format (Int -> Integer -> Text) (Int -> Integer -> Text)
"Here comes an integer: " Format (Int -> Integer -> Text) (Int -> Integer -> Text)
-> Format Text (Int -> Integer -> Text)
-> Format Text (Int -> Integer -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (Integer -> Text) (Int -> Integer -> Text)
forall a r. Integral a => Format r (a -> r)
int Format (Integer -> Text) (Int -> Integer -> Text)
-> Format Text (Integer -> Text)
-> Format Text (Int -> Integer -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format (Integer -> Text) (Integer -> Text)
" and another: " Format (Integer -> Text) (Integer -> Text)
-> Format Text (Integer -> Text) -> Format Text (Integer -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text (Integer -> Text)
forall a r. Integral a => Format r (a -> r)
int)
         (Int
23 :: Int)
         (Integer
0 :: Integer)

-- | Printing floating points.
floats :: Text
floats :: Text
floats =
  Format Text (Float -> Text) -> Float -> Text
forall a. Format Text a -> a
format (Format (Float -> Text) (Float -> Text)
"Here comes a float: " Format (Float -> Text) (Float -> Text)
-> Format Text (Float -> Text) -> Format Text (Float -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text (Float -> Text)
forall a r. Real a => Format r (a -> r)
float)
         (Float
123.2342 :: Float)

-- | Printing integrals in hex (base-16).
hexes :: Text
hexes :: Text
hexes =
  Format Text (Int -> Text) -> Int -> Text
forall a. Format Text a -> a
format (Format (Int -> Text) (Int -> Text)
"Here comes a hex: " Format (Int -> Text) (Int -> Text)
-> Format Text (Int -> Text) -> Format Text (Int -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Format Text (Int -> Text)
forall a r. Integral a => Format r (a -> r)
hex)
         (Int
123 :: Int)

-- | Padding.
padding :: Text
padding :: Text
padding =
  Format Text (Int -> Text) -> Int -> Text
forall a. Format Text a -> a
format (Format (Int -> Text) (Int -> Text)
"A left-padded number: " Format (Int -> Text) (Int -> Text)
-> Format Text (Int -> Text) -> Format Text (Int -> Text)
forall r a r'. Format r a -> Format r' r -> Format r' a
% Int -> Char -> Format Text (Int -> Text)
forall a r. Buildable a => Int -> Char -> Format r (a -> r)
left Int
3 Char
'0')
         (Int
9 :: Int)