packages feed

text-format-heavy (empty) → 0.1.0.0

raw patch · 13 files changed

+921/−0 lines, 13 filesdep +basedep +containersdep +data-defaultsetup-changed

Dependencies added: base, containers, data-default, parsec, text, time

Files

+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for text-format-heavy++## 0.1.0.0  -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ Data/Text/Format/Heavy.hs view
@@ -0,0 +1,42 @@+-- | This is the main module of @text-format-heavy@ library.+-- +-- In most cases, you need to import only this module, and probably also the +-- Data.Text.Format.Heavy.Time module, if you want to format time/date values.+-- +-- This package exports the @format@ function and @Format@ data type. +-- The Format type implements the instance of IsString, so in the code you may+-- use formatting strings as literals, if you enable @OverloadedStrings@ extension.+--+-- Formatting strings syntax is based on Python's string.format() syntax.+--+-- The simple usage example is+--+-- @+-- {-\# LANGUAGE OverloadedStrings #\-}+-- module Main where+--+-- import Data.Time+-- import qualified Data.Text.Lazy.IO as TLIO+-- import Data.Text.Format.Heavy+-- import Data.Text.Format.Heavy.Time+--+-- main :: IO ()+-- main = do+--   name <- getLine+--   time <- getZonedTime+--   TLIO.putStrLn $ format "Hello, {}! It is {:%H:%M:%S} now." (name, time)+-- @+--    +module Data.Text.Format.Heavy+  (+    module Data.Text.Format.Heavy.Types,+    module Data.Text.Format.Heavy.Formats,+    module Data.Text.Format.Heavy.Build,+    module Data.Text.Format.Heavy.Instances+  ) where++import Data.Text.Format.Heavy.Types+import Data.Text.Format.Heavy.Formats+import Data.Text.Format.Heavy.Build (format)+import Data.Text.Format.Heavy.Instances (Single (..), Shown (..))+
+ Data/Text/Format/Heavy/Build.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Text.Format.Heavy.Build+  (format, formatEither,+   makeBuilder,+   -- * Formatters building utilities+   align, applySign, applySharp,+   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 #-}++-- | The main formatting function.+-- This function throws @error@ if some error detected during format string parsing or formatting itself.+format :: VarContainer vars => Format -> vars -> TL.Text+format fmt vars = either error id $ formatEither fmt vars++-- | The main formatting function.+-- This version returns @Left@ value with error description in case of error in +-- format string or error during formatting.+formatEither :: VarContainer vars => Format -> vars -> Either String TL.Text+formatEither fmt vars = either Left (Right . B.toLazyText) $ 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 text within available width according to format+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++-- | Add @+/-@ sign to the number representation, if required+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++-- | Add @0x@ to the number representation, if required+applySharp :: Bool -> Radix -> B.Builder -> B.Builder+applySharp False _ text = text+applySharp True Decimal text = text+applySharp True Hexadecimal text = B.fromLazyText "0x" <> text++-- | Format integer number according to GenericFormat+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)+   inRadix = case radix of+               Decimal -> decimal (abs x)+               Hexadecimal -> hexadecimal (abs x)++-- | Format floating-point number according to GenericFormat+formatFloat :: RealFloat a => GenericFormat -> a -> B.Builder+formatFloat fmt x =+  align fmt $ applySign (gfSign fmt) x $ formatRealFloat Fixed (gfPrecision fmt) $ abs x++-- | Format Text according to GenericFormat.+formatStr :: GenericFormat -> TL.Text -> B.Builder+formatStr fmt text = align fmt $ B.fromLazyText text++-- | Format boolean value.+formatBool :: BoolFormat -> Bool -> B.Builder+formatBool fmt True = B.fromLazyText $ bfTrue fmt+formatBool fmt False = B.fromLazyText $ bfFalse fmt+
+ Data/Text/Format/Heavy/Formats.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE OverloadedStrings #-}+-- | This module contains format descriptions for most used variable types.+module Data.Text.Format.Heavy.Formats where++import Data.Default+import qualified Data.Text.Lazy as TL++import Data.Text.Format.Heavy.Types++-- | Alignment of string within specified width+data Align = AlignLeft | AlignRight | AlignCenter+  deriving (Eq, Show)++-- | Whether to show the sign of number+data Sign = Always | OnlyNegative | SpaceForPositive+  deriving (Eq, Show)++-- | Number base+data Radix = Decimal | Hexadecimal+  deriving (Eq, Show)++-- | Generic format description. This is usable for integers, floats and strings.+data GenericFormat = GenericFormat {+    gfFillChar :: Char+  , gfAlign :: Maybe Align+  , gfSign :: Sign+  , gfLeading0x :: Bool+  , gfWidth :: Maybe Int+  , gfPrecision :: Maybe Int+  , gfRadix :: Maybe Radix+  }+  deriving (Eq, Show)++instance Default GenericFormat where+  def = GenericFormat {+          gfFillChar = ' '+        , gfAlign = Nothing+        , gfSign = OnlyNegative+        , gfLeading0x = False+        , gfWidth = Nothing+        , gfPrecision = Nothing+        , gfRadix = Nothing+        }++data BoolFormat = BoolFormat {+    bfTrue :: TL.Text+  , bfFalse :: TL.Text+  }+  deriving (Eq, Show)++instance Default BoolFormat where+  def = BoolFormat "true" "false"+
+ Data/Text/Format/Heavy/Instances.hs view
@@ -0,0 +1,201 @@+{-# LANGUAGE OverloadedStrings, FlexibleInstances, UndecidableInstances #-}+-- | This module contains Formatable and VarContainer instances for most used types.+module Data.Text.Format.Heavy.Instances+  (-- * Utility data types+   Single (..), Shown (..),+   -- * Generic formatters+   genericIntFormat, genericFloatFormat+  ) where++import Data.String+import Data.Char+import Data.Default+import qualified Data.Map as M+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.Format.Heavy.Types+import Data.Text.Format.Heavy.Formats+import Data.Text.Format.Heavy.Parse+import Data.Text.Format.Heavy.Build++instance IsString Format where+  fromString str = parseFormat' (fromString str)++----------------------- IsVarFormat instances --------------------------------------++instance IsVarFormat GenericFormat where+  parseVarFormat text = either (Left . show) Right $ parseGenericFormat text++++---------------------- Generic formatters -------------------------------------------++-- | Generic formatter for integer types+genericIntFormat :: Integral a => VarFormat -> a -> Either String B.Builder+genericIntFormat Nothing x = Right $ formatInt def x+genericIntFormat (Just fmtStr) x =+    case parseGenericFormat fmtStr of+      Left err -> Left $ show err+      Right fmt -> Right $ formatInt fmt x++-- | Generic formatter for floating-point types+genericFloatFormat :: RealFloat a => VarFormat -> a -> Either String B.Builder+genericFloatFormat Nothing x = Right $ formatFloat def x+genericFloatFormat (Just fmtStr) x =+    case parseGenericFormat fmtStr of+      Left err -> Left $ show err+      Right fmt -> Right $ formatFloat fmt x++------------------------ Formatable instances -------------------------------------------++instance Formatable Int where+  formatVar fmt x = genericIntFormat fmt x++instance Formatable Integer where+  formatVar fmt x = genericIntFormat fmt x++instance Formatable Float where+  formatVar fmt x = genericFloatFormat fmt x++instance Formatable Double where+  formatVar fmt x = genericFloatFormat fmt x++instance Formatable String where+  formatVar Nothing text = Right $ formatStr def (fromString text)+  formatVar (Just fmtStr) text =+    case parseGenericFormat fmtStr of+      Left err -> Left $ show err+      Right fmt -> Right $ formatStr fmt (fromString text)++instance Formatable T.Text where+  formatVar Nothing text = Right $ formatStr def $ TL.fromStrict text+  formatVar (Just fmtStr) text =+    case parseGenericFormat fmtStr of+      Left err -> Left $ show err+      Right fmt -> Right $ formatStr fmt $ TL.fromStrict text++instance Formatable TL.Text where+  formatVar Nothing text = Right $ formatStr def text+  formatVar (Just fmtStr) text =+    case parseGenericFormat fmtStr of+      Left err -> Left $ show err+      Right fmt -> Right $ formatStr fmt text++instance Formatable Bool where+  formatVar Nothing x = Right $ formatBool def x+  formatVar (Just fmtStr) x =+    case parseBoolFormat fmtStr of+      Left err -> Left $ show err+      Right fmt -> Right $ formatBool fmt x++-- | Container for single parameter.+-- Example usage:+--+-- @+-- format "Hello, {}!" (Single name)+-- @+data Single a = Single {getSingle :: a}+  deriving (Eq, Show)++instance Formatable a => Formatable (Single a) where+  formatVar fmt (Single x) = formatVar fmt x++-- | Values packed in Shown will be formatted using their Show instance.+--+-- For example,+--+-- @+-- formatText "values: {}." (Shown (True, False)) ==> "values: (True, False)."+-- @+data Shown a = Shown { shown :: a }+  deriving (Eq)++instance Show a => Show (Shown a) where+  show (Shown x) = show x++instance Show a => Formatable (Shown a) where+  formatVar _ (Shown x) = Right $ B.fromLazyText $ TL.pack $ show x++instance Formatable a => Formatable (Maybe a) where+  formatVar Nothing Nothing = Right mempty+  formatVar fmt (Just x) = formatVar fmt x++instance (Formatable a, Formatable b) => Formatable (Either a b) where+  formatVar fmt (Left x) = formatVar fmt x+  formatVar fmt (Right y) = formatVar fmt y++------------------------------- VarContainer instances -------------------------------------++instance Formatable a => VarContainer (Single a) where+  lookupVar "0" (Single x) = Just $ Variable x+  lookupVar _ _ = Nothing++instance VarContainer () where+  lookupVar _ _ = Nothing++instance (Formatable a, Formatable b) => VarContainer (a, b) where+  lookupVar "0" (a,_) = Just $ Variable a+  lookupVar "1" (_,b) = Just $ Variable b+  lookupVar _ _ = Nothing+  +instance (Formatable a, Formatable b, Formatable c) => VarContainer (a, b, c) where+  lookupVar "0" (a,_,_) = Just $ Variable a+  lookupVar "1" (_,b,_) = Just $ Variable b+  lookupVar "2" (_,_,c) = Just $ Variable c+  lookupVar _ _ = Nothing+  +instance (Formatable a, Formatable b, Formatable c, Formatable d) => VarContainer (a, b, c, d) where+  lookupVar "0" (a,_,_,_) = Just $ Variable a+  lookupVar "1" (_,b,_,_) = Just $ Variable b+  lookupVar "2" (_,_,c,_) = Just $ Variable c+  lookupVar "3" (_,_,_,d) = Just $ Variable d+  lookupVar _ _ = Nothing++instance (Formatable a, Formatable b, Formatable c, Formatable d, Formatable e)+     => VarContainer (a, b, c, d, e) where+  lookupVar "0" (a,_,_,_,_) = Just $ Variable a+  lookupVar "1" (_,b,_,_,_) = Just $ Variable b+  lookupVar "2" (_,_,c,_,_) = Just $ Variable c+  lookupVar "3" (_,_,_,d,_) = Just $ Variable d+  lookupVar "4" (_,_,_,_,e) = Just $ Variable e+  lookupVar _ _ = Nothing++instance (Formatable a, Formatable b, Formatable c, Formatable d, Formatable e, Formatable f)+     => VarContainer (a, b, c, d, e, f) where+  lookupVar "0" (a,_,_,_,_,_) = Just $ Variable a+  lookupVar "1" (_,b,_,_,_,_) = Just $ Variable b+  lookupVar "2" (_,_,c,_,_,_) = Just $ Variable c+  lookupVar "3" (_,_,_,d,_,_) = Just $ Variable d+  lookupVar "4" (_,_,_,_,e,_) = Just $ Variable e+  lookupVar "5" (_,_,_,_,_,f) = Just $ Variable f+  lookupVar _ _ = Nothing++instance (Formatable a, Formatable b, Formatable c, Formatable d, Formatable e, Formatable f, Formatable g)+     => VarContainer (a, b, c, d, e, f, g) where+  lookupVar "0" (a,_,_,_,_,_,_) = Just $ Variable a+  lookupVar "1" (_,b,_,_,_,_,_) = Just $ Variable b+  lookupVar "2" (_,_,c,_,_,_,_) = Just $ Variable c+  lookupVar "3" (_,_,_,d,_,_,_) = Just $ Variable d+  lookupVar "4" (_,_,_,_,e,_,_) = Just $ Variable e+  lookupVar "5" (_,_,_,_,_,f,_) = Just $ Variable f+  lookupVar "6" (_,_,_,_,_,_,g) = Just $ Variable g+  lookupVar _ _ = Nothing++instance Formatable a => VarContainer [a] where+  lookupVar name lst =+    if not $ TL.all isDigit name+      then Nothing+      else let n = read (TL.unpack name)+           in  if n >= length lst+               then Nothing+               else Just $ Variable (lst !! n)+  +instance Formatable x => VarContainer [(TL.Text, x)] where+  lookupVar name pairs = Variable `fmap` lookup name pairs++instance Formatable x => VarContainer (M.Map TL.Text x) where+  lookupVar name pairs = Variable `fmap` M.lookup name pairs+
+ Data/Text/Format/Heavy/Parse.hs view
@@ -0,0 +1,215 @@+{-# LANGUAGE OverloadedStrings #-}+-- | This module contains parsers for formatting strings.+-- We have to deal with two kinds of strings:+--+-- * String formats. This is the whole construct like @"Hello, {}! Your account balance is {1:+8.4}."@.+-- * Variable formats. This is only part after colon in braces, i.e. the @+8.4@ thing in previous example.+--+-- The string format syntax is supposed to be very stable and simple. It is basically defined by phrase+-- "any part in braces is variable substitution".+--+-- Variable formats syntax depends on type of data which we are going to format. These formats can be+-- pretty complex, for example they can include alignment, rounding, and so on.+--+module Data.Text.Format.Heavy.Parse+  (-- * Parse functions+   parseFormat, parseFormat',+   parseGenericFormat, parseBoolFormat,+   -- * Parsec functions+   pFormat, pGenericFormat, pBoolFormat,+   -- * Utility types+   Parser, ParserState (..), initParserState+  ) where++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 Text.Parsec++import Data.Text.Format.Heavy.Types+import Data.Text.Format.Heavy.Formats++data ParserState = ParserState {+    psNextIndex :: Int+  }+  deriving (Eq, Show)++initParserState :: ParserState+initParserState = ParserState 0++type Parser a = Parsec TL.Text ParserState a++-- TODO: proper handling of escaping+anyChar' :: Parser Char+anyChar' =+  noneOf "{}" <|> try ('{' <$ string "\\{") <|> try ('}' <$ string "\\}")++pVerbatim :: Parser FormatItem+pVerbatim = (FString . TL.pack) `fmap` many1 anyChar'++pVariable :: Parser FormatItem+pVariable = do+    (name, fmt) <- between (char '{') (char '}') variable+    return $ FVariable (TL.pack name) fmt+  where+    variable = do+      name <- many alphaNum+      mbColon <- optionMaybe $ char ':'+      fmt <- case mbColon of+               Nothing -> return Nothing+               Just _ -> do+                  fmtStr <- many anyChar'+                  return $ Just $ TL.pack fmtStr+      name' <- if null name+                 then do+                      st <- getState+                      let n = psNextIndex st+                      modifyState $ \st -> st {psNextIndex = psNextIndex st + 1}+                      return $ show n+                 else return name+      return (name', fmt)++-- | Parsec parser for string format.+pFormat :: Parser Format+pFormat = Format `fmap` many (try pVariable <|> pVerbatim)++-- | Parse string format definition.+parseFormat :: TL.Text -> Either ParseError Format+parseFormat text = runParser pFormat initParserState "<format string>" text++-- | Version of parseFormat which throws @error@ in case of syntax error in the formatting string.+parseFormat' :: TL.Text -> Format+parseFormat' text = either (error . show) id $ parseFormat text++-- | Parsec parser for generic (Python-like) variable format.+pGenericFormat :: Parsec TL.Text st GenericFormat+pGenericFormat = do+    mbFillAlign <- optionMaybe (try pFillAlign <?> "fill and align specification")+    let fill = fromMaybe ' ' $ fst `fmap` mbFillAlign+    let align = snd `fmap` mbFillAlign+    mbSign <- optionMaybe (pSign <?> "sign specification")+    let sign = fromMaybe OnlyNegative mbSign+    mbLeading0x <- optionMaybe (pLeading0x <?> "leading 0x specification")+    let leading0x = fromMaybe False mbLeading0x+    mbWidth <- optionMaybe (pWidth <?> "width specification")+    mbPrecision <- optionMaybe (pPrecision <?> "precision specification")+    mbRadix <- optionMaybe (pRadix <?> "radix specification")+    return $ GenericFormat {+               gfFillChar = fill+             , gfAlign = align+             , gfSign = sign+             , gfLeading0x = leading0x+             , gfWidth = mbWidth+             , gfPrecision = mbPrecision+             , gfRadix = mbRadix+             }+  where+    pAlign :: Parsec TL.Text st Align+    pAlign = do+      alignChar <- oneOf "<>^"+      align <- case alignChar of+                 '<' -> return AlignLeft+                 '>' -> return AlignRight+                 '^' -> return AlignCenter+                 _ -> fail $ "Unexpected align char: " ++ [alignChar]+      return align++    pAlignWithFill :: Parsec TL.Text st (Char, Align)+    pAlignWithFill = do+      fill <- noneOf "<>=^"+      align <- pAlign+      return (fill, align)++    pAlignWithoutFill :: Parsec TL.Text st (Char, Align)+    pAlignWithoutFill = do+      align <- pAlign+      return (' ', align)++    pFillAlign :: Parsec TL.Text st (Char, Align)+    pFillAlign = do+      try pAlignWithoutFill <|> pAlignWithFill++    pSign :: Parsec TL.Text st Sign+    pSign = do+      signChar <- oneOf "+- "+      sign <- case signChar of+                '+' -> return Always+                '-' -> return OnlyNegative+                ' ' -> return SpaceForPositive+                _ -> fail $ "Unexpected sign char: " ++ [signChar]+      return sign++    pLeading0x :: Parsec TL.Text st Bool+    pLeading0x = do+      mbSharp <- optionMaybe $ char '#'+      case mbSharp of+        Nothing -> return False+        Just _ -> return True++    natural :: Parsec TL.Text st Int+    natural = do+      ws <- many1 $ oneOf "0123456789"+      return $ read ws++    pWidth :: Parsec TL.Text st Int+    pWidth = natural++    pPrecision :: Parsec TL.Text st Int+    pPrecision = do+      char '.'+      natural+    +    pRadix :: Parsec TL.Text st Radix+    pRadix = do+      rc <- oneOf "xhd"+      case rc of+        'x' -> return Hexadecimal+        'h' -> return Hexadecimal+        'd' -> return Decimal++-- | Parse generic variable format.+--+-- Syntax is:+--+-- @+-- [[fill]align][sign][#][width][.precision][radix]+-- @+--+-- where:+--+-- * fill - padding character (space by default)+-- * align - alignment indicator (@<@, @>@, or @^@)+-- * sign - when to show number's sign (@+@, @-@, or space)+-- * @#@ - if specified, then for hexadecimal numbers the leading @0x@ will be added+-- * width - minimum length of the field+-- * precision - number of decimal places after point, for floatting-point numbers+-- * radix - @h@ or @x@ for hexadecimal, @d@ for decimal (default).+--+parseGenericFormat :: TL.Text -> Either ParseError GenericFormat+parseGenericFormat text = runParser pGenericFormat () "<variable format specification>" text++-- | Parsec parser for Bool format+pBoolFormat :: Parsec TL.Text st BoolFormat+pBoolFormat = do+  true <- many $ noneOf ":,;"+  oneOf ":,;"+  false <- many $ anyChar+  return $ BoolFormat (TL.pack true) (TL.pack false)++-- | Parse Bool format.+--+-- Syntax is:+--+-- @+-- TRUE:FALSE+-- @+--+-- Colon can be replaced with comma or semicolon.+--+-- For example, valid format specifications are @true:false@ (the default one),+-- @True:False@, @yes:no@, and so on.+--+parseBoolFormat :: TL.Text -> Either ParseError BoolFormat+parseBoolFormat text = runParser pBoolFormat () "<boolean format specification>" text+
+ Data/Text/Format/Heavy/Time.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings, FlexibleInstances, UndecidableInstances #-}+-- | This module contains Formatable instances for time/date values,+-- which use Data.Time.Format notation for formats (like @%H:%M@).+-- Default date/time format is RFC 822.+--+-- This module is not re-exported by Data.Text.Format.Heavy by default,+-- because it defines only one of possible time formatting strings syntaxes.+-- One may like other syntax for some reason; if we re-exported this module by+-- default, it would be impossible to hide these instances to implement other.+--+module Data.Text.Format.Heavy.Time where++import Data.String+import Data.Char+import Data.Default+import Data.Time+import Data.Time.Format+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as B++import Data.Text.Format.Heavy.Types+import Data.Text.Format.Heavy.Parse+import Data.Text.Format.Heavy.Build++-- | Generic time formatter, using Data.Time.Format+genericTimeFormat :: FormatTime t => VarFormat -> t -> Either String B.Builder+genericTimeFormat Nothing x = Right $ B.fromString $ formatTime defaultTimeLocale rfc822DateFormat x+genericTimeFormat (Just fmtStr) x =+  Right $ B.fromString $ formatTime defaultTimeLocale (TL.unpack fmtStr) x++------------------------ Formatable instances -------------------------------------------++-- instance Formatable UniversalTime where+--   formatVar fmt x = genericTimeFormat fmt x++instance Formatable Day where+  formatVar fmt x = genericTimeFormat fmt x++instance Formatable UTCTime where+  formatVar fmt x = genericTimeFormat fmt x++instance Formatable TimeZone where+  formatVar fmt x = genericTimeFormat fmt x++instance Formatable TimeOfDay where+  formatVar fmt x = genericTimeFormat fmt x++instance Formatable LocalTime where+  formatVar fmt x = genericTimeFormat fmt x++instance Formatable ZonedTime where+  formatVar fmt x = genericTimeFormat fmt x+
+ Data/Text/Format/Heavy/Types.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE ExistentialQuantification, TypeFamilies, FlexibleContexts, OverloadedStrings #-}+-- | This module contains basic type definitions+module Data.Text.Format.Heavy.Types where++import Data.Default+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as B++-- | Variable name+type VarName = TL.Text++-- | Variable format in text form. Nothing means default format.+type VarFormat = Maybe TL.Text++-- | String format item.+data FormatItem =+    FString TL.Text        -- ^ Verbatim text+  | FVariable {+      vName :: VarName      -- ^ Variable name+    , vFormat :: VarFormat  -- ^ Variable format+    }+  deriving (Show)++-- | String format+data Format = Format [FormatItem]+  deriving (Show)++-- | Can be used for different data types describing formats of specific types.+class (Default f, Show f) => IsVarFormat f where+  -- | Left for errors.+  parseVarFormat :: TL.Text -> Either String f++instance IsVarFormat () where+  parseVarFormat "" = Right ()+  parseVarFormat fmt = Left $ "Unsupported format: " ++ TL.unpack fmt++-- | Value that can be formatted to be substituted into format string.+class Formatable a where+  -- | Format variable according to format specification.+  -- This function should usually parse format specification by itself.+  formatVar :: VarFormat                -- ^ Variable format specification in text form. Nothing is for default format.+            -> a                        -- ^ Variable value.+            -> Either String B.Builder  -- ^ Left for errors in variable format syntax, or errors during formatting.++-- | Any variable that can be substituted.+-- This type may be also used to construct heterogeneous lists:+-- @[Variable 1, Variable "x"] :: [Variable]@.+data Variable = forall a. Formatable a => Variable a++instance Formatable Variable where+  formatVar fmt (Variable x) = formatVar fmt x++-- | Format one variable according to format specification.+formatAnyVar :: VarFormat -> Variable -> Either String B.Builder+formatAnyVar fmt (Variable v) = formatVar fmt v++-- | Data structure that contains some number of variables.+class VarContainer c where+  lookupVar :: VarName -> c -> Maybe Variable++------------------------------------------------------------------------------+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2017, Ilya Portnov++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Ilya Portnov nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/Benchmarks.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE OverloadedStrings #-}++import Criterion.Main+import Data.Text.Format.Heavy+import qualified Data.Text as T+import qualified Data.Text.Lazy as L+import qualified Text.Printf as P++printf1 :: (P.PrintfArg a) => String -> a -> String+printf1 f a = P.printf f a++printf2 :: (P.PrintfArg a, P.PrintfArg b) => String -> (a,b) -> String+printf2 f (a,b) = P.printf f a b++printf3 :: (P.PrintfArg a, P.PrintfArg b, P.PrintfArg c) =>+           String -> (a,b,c) -> String+printf3 f (a,b,c) = P.printf f a b c++main = defaultMain [+         bgroup "arity" [+           bench "0" $ nf (format "hi") ()+         , bench "1" $ nf (format "hi {}") (Single $ T.pack "mom")+         , bench "2" $ nf (format "hi {}, how are {}")+                       (T.pack "mom", T.pack "you")+         , bench "3" $ nf (format "hi {}, how are {} keeping {}")+                       (T.pack "mom", T.pack "you", T.pack "now")+         , bench "4" $ nf (format "hi {}, {} - how are {} keeping {}")+                       (T.pack "mom", T.pack "hey", T.pack "you", T.pack "now")+         ]+       , bgroup "comparison" [+           bench "format1" $ nf (format "hi mom {}\n") (Single (pi::Double))+         , bench "printf1" $ nf (printf1 "hi mom %f\n") (pi::Double)+         , bench "show1" $ nf (\d -> "hi mom " ++ show d ++ "\n") (pi::Double)+         , bench "format2" $ nf (format "hi mom {} {}\n") (pi::Double, "yeah"::T.Text)+         , bench "printf2" $ nf (printf2 "hi mom %f %s\n") (pi::Double, "yeah"::String)+         , bench "show2" $ nf (\(d,s) -> "hi mom " ++ show d ++ " " ++ show s ++ "\n") (pi::Double, "yeah"::String)+         , bench "format3" $ nf (format "hi mom {} {} {}\n") (pi::Double, "yeah"::T.Text, 21212121::Int)+         , bench "printf3" $ nf (printf3 "hi mom %f %s %d\n") (pi::Double, "yeah"::String, 21212121::Int)+         , bench "show3" $ nf (\(d,s,i) -> "hi mom " ++ show d ++ " " ++ show s ++ "\n") (pi::Double, "yeah"::String, 21212121::Int)+         ]+       , bgroup "types" [+           bench "unit" $ nf (format "hi") ()+         , bgroup "int" [+             bench "small" $ nf (format "hi {}") (Single (1::Int))+           , bench "medium" $ nf (format "hi {}") (Single (1234::Int))+           , bench "large" $ nf (format "hi {}") (Single (0x7fffffff::Int))+           ]+         , bgroup "float" [+             bench "small" $ nf (format "hi {}") (Single (1::Float))+           , bench "medium" $ nf (format "hi {}") (Single (pi::Float))+           , bench "large" $ nf (format "hi {}") (Single (pi*1e37::Float))+           ]+         , bgroup "double" [+             bench "small" $ nf (format "hi {}") (Single (1::Double))+           , bench "medium" $ nf (format "hi {}") (Single (pi::Double))+           , bench "large" $ nf (format "hi {}") (Single (pi*1e37::Double))+           ]+         , bgroup "string" [+             bench "small" $ nf (format "hi {}") (Single ("mom" :: String))+           , bench "medium" $ nf (format "hi {}")+                              (Single . concat . replicate 64 $ ("mom" :: String))+           , bench "large" $ nf (format "hi {}")+                             (Single . concat . replicate 1024 $ ("mom" :: String))+           ]+         , bgroup "text" [+             bench "small" $ nf (format "hi {}") (Single (T.pack "mom"))+           , bench "medium" $ nf (format "hi {}") (Single (T.replicate 64 "mom"))+           , bench "large" $ nf (format "hi {}") (Single (T.replicate 1024 "mom"))+           ]+           , bgroup "lazytext" [+               bench "small" $ nf (format "hi {}") (Single (L.pack "mom"))+             , bench "medium" $ nf (format "hi {}")+                                (Single . L.fromChunks . replicate 64 $ "mom")+             , bench "large" $ nf (format "hi {}")+                               (Single . L.fromChunks . replicate 1024 $ "mom")+             ]+           ]+         ]
+ examples/test.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE OverloadedStrings #-}++import Data.Time+import qualified Data.Text.Lazy.IO as TLIO+import Data.Text.Format.Heavy+import Data.Text.Format.Heavy.Time++main :: IO ()+main = do+  let template = "x: {:#x}, y: <{:^10}>, z: {:+6.4}, x(d): {0}, t: {}, y: {}, r: {}; bool: {:yes:no}."+      -- xs = [Variable (18 :: Int), Variable ("hello" :: String), Variable (3 :: Int)]+      rt = (Right 7) :: Either String Int+      xs = (18 :: Int, "hello" :: String, 2.718281828 :: Double, Shown (Just (7 :: Int)), Just (8 :: Int), rt, True)+  TLIO.putStrLn $ format template xs+  time <- getZonedTime+  TLIO.putStrLn $ format "Hello, {}! It is {:%H:%M:%S} now." $ ("Ilya" :: String, time)+  +
+ text-format-heavy.cabal view
@@ -0,0 +1,58 @@+name:                text-format-heavy+version:             0.1.0.0+synopsis:            Full-weight string formatting library, analog of Python's string.format+description:         This package contains full-featured string formatting function, similar to+                     Python's string.format. Features include:+                     .+                     * Automatically numbered variable placeholders;+                     .+                     * Positional variable placeholders;+                     .+                     * Named variable placeholders;+                     .+                     * Placeholders can be used in any order; one variable can be used several+                       times or not used at all.+                     .+                     * Specific format can be used for each variable substitution.+                     .+                     This package prefers functionality over "light weight" and (probably) performance. +                     It also exposes all required interfaces to extend and customize it.+                     .+                     For more details, please refer to <https://github.com/portnov/text-format-heavy/wiki Wiki>.+                     See also the @examples/@ directory.+                     +license:             BSD3+license-file:        LICENSE+author:              Ilya Portnov+maintainer:          portnov84@rambler.ru+-- copyright:           +category:            Text+build-type:          Simple+extra-source-files:  ChangeLog.md,+                     examples/test.hs,+                     examples/Benchmarks.hs+cabal-version:       >=1.10++library+  exposed-modules:     Data.Text.Format.Heavy,+                       Data.Text.Format.Heavy.Parse,+                       Data.Text.Format.Heavy.Build,+                       Data.Text.Format.Heavy.Types,+                       Data.Text.Format.Heavy.Formats,+                       Data.Text.Format.Heavy.Instances,+                       Data.Text.Format.Heavy.Time+  -- other-modules:       +  other-extensions:    ExistentialQuantification+  build-depends:       base >=4.8 && <5,+                       text >=1.2 && <1.3,+                       parsec >=3.1 && <3.2,+                       containers >= 0.5,+                       data-default >= 0.7,+                       time >= 1.5+  -- hs-source-dirs:      +  default-language:    Haskell2010++source-repository head+  type: git+  location: https://github.com/portnov/text-format-heavy.git+