{-# LANGUAGE OverloadedStrings, RelaxedPolyRec #-}

-- |
-- Module      : Data.Text.Format
-- Copyright   : (c) 2011 MailRank, Inc.
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- Fast, efficient, flexible support for formatting text strings.

module Data.Text.Format
    (
    -- * Types
      Format
    , Only(..)
    -- ** Types for format control
    , Shown(..)
    -- * Rendering
    , format
    , print
    , hprint
    , build
    -- * Format control
    , left
    , right
    -- ** Integers
    , hex
    -- ** Floating point numbers
    , expt
    , fixed
    , prec
    , shortest
    ) where

import Data.Semigroup ((<>))
import Control.Monad.IO.Class (MonadIO(liftIO))
import Data.Text.Format.Params (Params(..))
import Data.Text.Format.Types.Internal (Format(..), Only(..), Shown(..))
import Data.Text.Format.Types.Internal (Hex(..))
import Data.Text.Lazy.Builder
import Prelude hiding (exp, print)
import System.IO (Handle)
import qualified Data.Double.Conversion.Text as C
import qualified Data.Text as ST
import qualified Data.Text.Buildable as B
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.IO as LT

-- Format strings are almost always constants, and they're expensive
-- to interpret (which we refer to as "cracking" here).  We'd really
-- like to have GHC memoize the cracking of a known-constant format
-- string, so that it occurs at most once.
--
-- To achieve this, we arrange to have the cracked version of a format
-- string let-floated out as a CAF, by inlining the definitions of
-- build and functions that invoke it.  This works well with GHC 7.

-- | Render a format string and arguments to a 'Builder'.
build :: Params ps => Format -> ps -> Builder
build :: Format -> ps -> Builder
build Format
fmt ps
ps = [Builder] -> [Builder] -> Builder
zipParams (Format -> [Builder]
crack Format
fmt) (ps -> [Builder]
forall ps. Params ps => ps -> [Builder]
buildParams ps
ps)
{-# INLINE build #-}

zipParams :: [Builder] -> [Builder] -> Builder
zipParams :: [Builder] -> [Builder] -> Builder
zipParams [Builder]
fragments [Builder]
params = [Builder] -> [Builder] -> Builder
forall p. Semigroup p => [p] -> [p] -> p
go [Builder]
fragments [Builder]
params
  where go :: [p] -> [p] -> p
go (p
f:[p]
fs) (p
y:[p]
ys) = p
f p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
y p -> p -> p
forall a. Semigroup a => a -> a -> a
<> [p] -> [p] -> p
go [p]
fs [p]
ys
        go [p
f] []        = p
f
        go [p]
_ [p]
_ = [Char] -> p
forall a. HasCallStack => [Char] -> a
error ([Char] -> p) -> (Text -> [Char]) -> Text -> p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
LT.unpack (Text -> p) -> Text -> p
forall a b. (a -> b) -> a -> b
$ Format -> (Int, Int) -> Text
forall ps. Params ps => Format -> ps -> Text
format
                 Format
"Data.Text.Format.build: {} sites, but {} parameters"
                 ([Builder] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Builder]
fragments Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, [Builder] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Builder]
params)

crack :: Format -> [Builder]
crack :: Format -> [Builder]
crack = (Text -> Builder) -> [Text] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Builder
fromText ([Text] -> [Builder]) -> (Format -> [Text]) -> Format -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
ST.splitOn Text
"{}" (Text -> [Text]) -> (Format -> Text) -> Format -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Text
fromFormat

-- | Render a format string and arguments to a 'LT.Text'.
format :: Params ps => Format -> ps -> LT.Text
format :: Format -> ps -> Text
format Format
fmt ps
ps = Builder -> Text
toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Format -> ps -> Builder
forall ps. Params ps => Format -> ps -> Builder
build Format
fmt ps
ps
{-# INLINE format #-}

-- | Render a format string and arguments, then print the result.
print :: (MonadIO m, Params ps) => Format -> ps -> m ()
print :: Format -> ps -> m ()
print Format
fmt ps
ps = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Builder -> IO ()) -> Builder -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
LT.putStr (Text -> IO ()) -> (Builder -> Text) -> Builder -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText (Builder -> m ()) -> Builder -> m ()
forall a b. (a -> b) -> a -> b
$ Format -> ps -> Builder
forall ps. Params ps => Format -> ps -> Builder
build Format
fmt ps
ps
{-# INLINE print #-}

-- | Render a format string and arguments, then print the result to
-- the given file handle.
hprint :: (MonadIO m, Params ps) => Handle -> Format -> ps -> m ()
hprint :: Handle -> Format -> ps -> m ()
hprint Handle
h Format
fmt ps
ps = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Builder -> IO ()) -> Builder -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Text -> IO ()
LT.hPutStr Handle
h (Text -> IO ()) -> (Builder -> Text) -> Builder -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText (Builder -> m ()) -> Builder -> m ()
forall a b. (a -> b) -> a -> b
$ Format -> ps -> Builder
forall ps. Params ps => Format -> ps -> Builder
build Format
fmt ps
ps
{-# INLINE hprint #-}

-- | Pad the left hand side of a string until it reaches @k@
-- characters wide, if necessary filling with character @c@.
left :: B.Buildable a => Int -> Char -> a -> Builder
left :: Int -> Char -> a -> Builder
left Int
k Char
c =
    Text -> Builder
fromLazyText (Text -> Builder) -> (a -> Text) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Char -> Text -> Text
LT.justifyRight (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k) Char
c (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText (Builder -> Text) -> (a -> Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
forall p. Buildable p => p -> Builder
B.build

-- | Pad the right hand side of a string until it reaches @k@
-- characters wide, if necessary filling with character @c@.
right :: B.Buildable a => Int -> Char -> a -> Builder
right :: Int -> Char -> a -> Builder
right Int
k Char
c =
    Text -> Builder
fromLazyText (Text -> Builder) -> (a -> Text) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Char -> Text -> Text
LT.justifyLeft (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k) Char
c (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText (Builder -> Text) -> (a -> Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
forall p. Buildable p => p -> Builder
B.build

-- | Render a floating point number, with the given number of digits
-- of precision.  Uses decimal notation for values between @0.1@ and
-- @9,999,999@, and scientific notation otherwise.
prec :: (Real a) =>
        Int
     -- ^ Number of digits of precision.
     -> a -> Builder
{-# RULES "prec/Double"
    forall d x. prec d (x::Double) = B.build (C.toPrecision d x) #-}
prec :: Int -> a -> Builder
prec Int
digits = Text -> Builder
forall p. Buildable p => p -> Builder
B.build (Text -> Builder) -> (a -> Text) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double -> Text
C.toPrecision Int
digits (Double -> Text) -> (a -> Double) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
{-# NOINLINE[0] prec #-}

-- | Render a floating point number using normal notation, with the
-- given number of decimal places.
fixed :: (Real a) =>
         Int
      -- ^ Number of digits of precision after the decimal.
      -> a -> Builder
fixed :: Int -> a -> Builder
fixed Int
decs = Text -> Builder
forall p. Buildable p => p -> Builder
B.build (Text -> Builder) -> (a -> Text) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double -> Text
C.toFixed Int
decs (Double -> Text) -> (a -> Double) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
{-# RULES "fixed/Double"
    forall d x. fixed d (x::Double) = B.build (C.toFixed d x) #-}
{-# NOINLINE[0] fixed #-}

-- | Render a floating point number using scientific/engineering
-- notation (e.g. @2.3e123@), with the given number of decimal places.
expt :: (Real a) =>
        Int
     -- ^ Number of digits of precision after the decimal.
     -> a -> Builder
expt :: Int -> a -> Builder
expt Int
decs = Text -> Builder
forall p. Buildable p => p -> Builder
B.build (Text -> Builder) -> (a -> Text) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Double -> Text
C.toExponential Int
decs (Double -> Text) -> (a -> Double) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
{-# RULES "expt/Double"
    forall d x. expt d (x::Double) = B.build (C.toExponential d x) #-}
{-# NOINLINE[0] expt #-}

-- | Render a floating point number using the smallest number of
-- digits that correctly represent it.
shortest :: (Real a) => a -> Builder
shortest :: a -> Builder
shortest = Text -> Builder
forall p. Buildable p => p -> Builder
B.build (Text -> Builder) -> (a -> Text) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
C.toShortest (Double -> Text) -> (a -> Double) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac
{-# RULES "shortest/Double"
    forall x. shortest (x::Double) = B.build (C.toShortest x) #-}
{-# NOINLINE[0] shortest #-}

-- | Render an integer using hexadecimal notation.  (No leading "0x"
-- is added.)
hex :: Integral a => a -> Builder
hex :: a -> Builder
hex = Hex a -> Builder
forall p. Buildable p => p -> Builder
B.build (Hex a -> Builder) -> (a -> Hex a) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Hex a
forall a. a -> Hex a
Hex
{-# INLINE hex #-}