{-# LANGUAGE OverloadedStrings #-}
module Data.Text.Format.Heavy.Build
( format
, formatEither
, makeBuilder
,
align
, applySign
, applySharp
, convertText
, formatInt
, formatStr
, formatFloat
, formatBool
)
where
import Control.Monad
import Data.Monoid
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as B
import Data.Text.Lazy.Builder.Int ( decimal
, hexadecimal
)
import Data.Text.Lazy.Builder.RealFloat
import Data.Text.Format.Heavy.Types
import Data.Text.Format.Heavy.Formats
makeBuilder :: VarContainer c => Format -> c -> Either String B.Builder
makeBuilder (Format items) vars = mconcat `fmap` mapM go items
where
go (FString s ) = Right $ B.fromLazyText s
go (FVariable name fmt) = case lookupVar name vars of
Nothing -> Left $ "Parameter not found: " ++ TL.unpack name
Just var -> formatVar fmt var
{-# INLINE makeBuilder #-}
format :: VarContainer vars => Format -> vars -> TL.Text
format fmt vars = either error id $ formatEither fmt vars
formatEither :: VarContainer vars => Format -> vars -> Either String TL.Text
formatEither fmt vars = B.toLazyText `fmap` makeBuilder fmt vars
align' :: Int -> Align -> Char -> B.Builder -> B.Builder
align' width AlignLeft fill text =
B.fromLazyText $ TL.justifyLeft (fromIntegral width) fill $ B.toLazyText text
align' width AlignRight fill text =
B.fromLazyText $ TL.justifyRight (fromIntegral width) fill $ B.toLazyText text
align' width AlignCenter fill text =
B.fromLazyText $ TL.center (fromIntegral width) fill $ B.toLazyText text
align :: GenericFormat -> B.Builder -> B.Builder
align fmt text = case (gfAlign fmt, gfWidth fmt) of
(Just a, Just w) -> align' w a (gfFillChar fmt) text
_ -> text
applySign :: (Num a, Ord a) => Sign -> a -> B.Builder -> B.Builder
applySign Always x text =
if x >= 0 then B.singleton '+' <> text else B.singleton '-' <> text
applySign OnlyNegative x text =
if x >= 0 then text else B.singleton '-' <> text
applySign SpaceForPositive x text =
if x >= 0 then B.singleton ' ' <> text else B.singleton '-' <> text
applySharp :: Bool -> Radix -> B.Builder -> B.Builder
applySharp False _ text = text
applySharp True Decimal text = text
applySharp True Hexadecimal text = B.fromLazyText "0x" <> text
convertText :: Maybe Conversion -> B.Builder -> B.Builder
convertText Nothing builder = builder
convertText (Just conv) builder = B.fromLazyText $ converter $ B.toLazyText
builder
where
converter = case conv of
UpperCase -> TL.toUpper
LowerCase -> TL.toLower
TitleCase -> TL.toTitle
formatInt :: Integral a => GenericFormat -> a -> B.Builder
formatInt fmt x = align fmt $ applySign (gfSign fmt) x $ applySharp
(gfLeading0x fmt)
radix
inRadix
where
radix = fromMaybe Decimal (gfRadix fmt)
conversion = fromMaybe LowerCase (gfConvert fmt)
inRadix = case radix of
Decimal -> decimal (abs x)
Hexadecimal -> case conversion of
LowerCase -> hexadecimal (abs x)
_ -> B.fromLazyText . TL.toUpper . B.toLazyText . hexadecimal . abs $ x
formatFloat :: RealFloat a => GenericFormat -> a -> B.Builder
formatFloat fmt x =
align fmt
$ applySign (gfSign fmt) x
$ formatRealFloat Fixed (gfPrecision fmt)
$ abs x
formatStr :: GenericFormat -> TL.Text -> B.Builder
formatStr fmt text =
convertText (gfConvert fmt) $ align fmt $ B.fromLazyText text
formatBool :: BoolFormat -> Bool -> B.Builder
formatBool fmt True = B.fromLazyText $ bfTrue fmt
formatBool fmt False = B.fromLazyText $ bfFalse fmt