vformat 0.10.0.0 → 0.11.0.0
raw patch · 8 files changed
+399/−171 lines, 8 files
Files
- ChangeLog.md +6/−0
- src/Text/Format.hs +16/−1
- src/Text/Format/ArgFmt.hs +28/−28
- src/Text/Format/ArgKey.hs +80/−15
- src/Text/Format/Class.hs +216/−107
- src/Text/Format/Format.hs +19/−18
- test/Main.hs +32/−0
- vformat.cabal +2/−2
ChangeLog.md view
@@ -4,3 +4,9 @@ - Rewrite error system & fix bugs - Fix document - Rewrite unit tests++## V0.11.0+- Simplify `ArgKey`+- Make generic instantiate FormatArg configurable+- Expose standard formatters+- Fix some issue and doc
src/Text/Format.hs view
@@ -15,19 +15,34 @@ ( -- * Format functions format , format1- -- * Data types+ -- * Classes , FormatArg(formatArg) , FormatType(..)+ -- * Generic format arg and options+ , Options+ , defaultOptions+ , fieldLabelModifier+ , genericFormatArg+ -- * Data types , Formatter , Format , Format1 , ArgKey(..)+ , topKey+ , popKey , ArgFmt(..) , prettyArgFmt , FmtAlign(..) , FmtSign(..) , FmtNumSep(..) , (:=) (..)+ -- * Standard Formatters+ , formatString+ , formatChar+ , formatInt+ , formatWord+ , formatInteger+ , formatRealFloat -- * Errors , ArgError(..) , errorArgKey
src/Text/Format/ArgFmt.hs view
@@ -61,15 +61,15 @@ ==== The format syntax @- fmt :: [[pad] align][sign]["#"]["0"][width][sep]["." precision][specs]- pad :: char- align :: "\<" | "\>" | "^" | "="- sign :: "+" | "-" | " "- width :: int | ("{" key "}")- sep :: "_" | ","- precision :: int | ("{" key "}")- specs :: chars- key :: \<see 'ArgKey'\>+ fmt -> [[pad] align][sign]["#"]["0"][width][sep]["." precision][specs]+ pad -> char+ align -> "\<" | "\>" | "^" | "="+ sign -> "+" | "-" | " "+ width -> int | ("{" key "}")+ sep -> "_" | ","+ precision -> int | ("{" key "}")+ specs -> chars+ key -> \<see 'ArgKey'\> @ * @#@ will cause the "alternate form" to be used for integers.@@ -113,35 +113,35 @@ ==== String specs @- s- default s+ s+ default s @ ==== Integer specs @- b binary format integer- c char point ('Char' will be trasformed by 'Char.ord' first)- d decimal format integer- o octal format integer- x hex format integer (use lower-case letters)- X hex format integer (use upper-case letters)- default d+ b binary format integer+ c char point ('Char' will be trasformed by 'Char.ord' first)+ d decimal format integer+ o octal format integer+ x hex format integer (use lower-case letters)+ X hex format integer (use upper-case letters)+ default d @ ==== Floating point number specs @- e exponent notation, see 'Numeric.showEFloat'- E same as "e", but use upper-case 'E' as separator- f fixed-point notation see 'Numeric.showFFloat'- F same as "f", but converts nan to NAN and inf to INF- g general format, see 'Numeric.showGFloat'- G same as "g", but use upper-case 'E' as separator and- converts nan to NAN and inf to INF- % percentage, same as "f" except multiplies 100 first and- followed by a percent sign- default g+ e exponent notation, see 'Numeric.showEFloat'+ E same as "e", but use upper-case 'E' as separator+ f fixed-point notation see 'Numeric.showFFloat'+ F same as "f", but converts nan to NAN and inf to INF+ g general format, see 'Numeric.showGFloat'+ G same as "g", but use upper-case 'E' as separator and+ converts nan to NAN and inf to INF+ % percentage, same as "f" except multiplies 100 first and+ followed by a percent sign+ default g @ See 'Text.Format.FormatArg' to learn how to define specs for your own types.
src/Text/Format/ArgKey.hs view
@@ -1,18 +1,28 @@-module Text.Format.ArgKey ( ArgKey (..), emptyKey ) where+{-# LANGUAGE CPP #-} +module Text.Format.ArgKey ( ArgKey (..), topKey, popKey ) where+ import Control.Arrow-import Data.Char (isDigit)-import qualified Data.List as L+import Data.Char (isDigit)+import qualified Data.List as L+#if MIN_VERSION_base(4, 11, 0)+import Data.Semigroup+#endif +import Text.Format.Error + {-| A data type indicates key of format argument ==== The key syntax @- key :: [(int | chars) {"!" (int | chars)}]+ key -> [(int | chars) {"!" (int | chars)}] @ + Since the "!" is used to seprate keys, if you need to include a "!" in a+ named key, it can be escaped by doubling "!!".+ Note: See 'Format' to learn more about syntax description language Examples@@ -23,16 +33,32 @@ >>> read "country!name" :: ArgKey >>> read "country!cities!10!name" :: ArgKey -}-data ArgKey = Index Int -- ^ Refers to a positional argument or- -- index in a list like argument.- | Name String -- ^ Refers to a named argument or a record- -- name of an argument.- | Nest ArgKey ArgKey -- ^ Refers to a attribute (index or name) of- -- an argument.+data ArgKey = Index Int -- ^ Refers to a top-level positional+ -- argument or an element in an list-like+ -- data type.+ | Name String -- ^ Refers to a top-level named argument or+ -- a field of a record data type.+ | Nest ArgKey ArgKey -- ^ For @Nest k1 k2@, k1 refers to a+ -- top-level argument or an attribute+ -- (element or field) of a data type,+ -- k2 refers an attribute of the data+ -- referenced by k1. deriving (Eq, Ord) +#if MIN_VERSION_base(4, 11, 0)+instance Semigroup ArgKey where+ (<>) = associate+#endif++instance Monoid ArgKey where+ -- | @Index -1@ is used as an empty key+ mempty = Index (-1)+#if !MIN_VERSION_base(4, 11, 0)+ mappend = associate+#endif+ instance Read ArgKey where- readsPrec _ "" = [ (emptyKey, "") ]+ readsPrec _ "" = [ (mempty, "") ] readsPrec _ cs = [ parse cs ] where parse :: String -> (ArgKey, String)@@ -41,7 +67,7 @@ ("", cs1) -> (undefined, cs1) (_, "!") -> (undefined, "!") (cs1, "") -> (parse1 cs1, "")- (cs1, cs2) -> first (Nest $ parse1 cs1) (parse cs2)+ (cs1, cs2) -> first (mappend $ parse1 cs1) (parse cs2) parse1 :: String -> ArgKey parse1 cs = if all isDigit cs then Index (read cs) else Name cs@@ -55,7 +81,7 @@ (cs1, '!' : cs2) -> (cs1, cs2) instance Show ArgKey where- show k@(Index i) = if emptyKey == k then "" else show i+ show k@(Index i) = if mempty == k then "" else show i show (Name s) = escape s where escape :: String -> String@@ -64,5 +90,44 @@ escape (c : cs) = (c : escape cs) show (Nest k1 k2) = show k1 ++ "!" ++ show k2 -emptyKey :: ArgKey-emptyKey = Index (-1)++associate :: ArgKey -> ArgKey -> ArgKey+associate k (Index (-1)) = k+associate (Index (-1)) k = k+associate (Nest k11 k12) k2 = associate k11 $ associate k12 k2+associate k1 k2 = Nest k1 k2+++{-| Extract the topmost indexed or named key from a key++>>> topKey (read "k1!k2!k3") == Name "k1"+True+>>> topKey (read "name") == Name "name"+True+>>> topKey (read "123") == Index 123+True+>>> topKey mempty+*** Exception: vformat: empty arg key+-}+topKey :: ArgKey -> ArgKey+topKey (Nest k@(Nest _ _) _) = topKey k+topKey (Nest k _) = k+topKey k = if k == mempty then vferror "empty arg key"+ else k++{-| Remove the topmost indexed or named key from a key++>>> popKey (read "k1!k2!k3") == read "k2!k3"+True+>>> popKey (read "name") == mempty+True+>>> popKey (read "123") == mempty+True+>>> popKey mempty+*** Exception: vformat: empty arg key+-}+popKey :: ArgKey -> ArgKey+popKey (Nest k1@(Nest _ _) k2) = mappend (popKey k1) k2+popKey (Nest _ k) = k+popKey k = if k == mempty then vferror "empty arg key"+ else mempty
src/Text/Format/Class.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} @@ -8,9 +9,19 @@ ( Formatter , FormatArg(..) , FormatType(..)+ , Options(..)+ , defaultOptions+ , genericFormatArg , (:=) (..)+ , formatString+ , formatChar+ , formatInt+ , formatWord+ , formatInteger+ , formatRealFloat ) where + import Control.Applicative import Control.Monad.Catch import Data.Char@@ -30,6 +41,7 @@ import Text.Format.Error import Text.Format.Format + type Formatter = ArgKey -> ArgFmt -> Either SomeException String @@ -37,7 +49,8 @@ The 'formatArg' method takes a value, a key and a field format descriptor and either fails due to a 'ArgError' or produce a string as the result.-There is a default 'formatArg' for 'Generic' instances.+There is a default 'formatArg' for 'Generic' instances, which applies+'defaultOptions' to 'genericFormatArg'. There are two reasons may cause formatting fail @@ -53,129 +66,190 @@ Examples @- \{\-\# LANGUAGE DeriveGeneric \#\-\}- \{\-\# LANGUAGE OverloadedStrings \#\-\}+\{\-\# LANGUAGE DeriveGeneric \#\-\}+\{\-\# LANGUAGE OverloadedStrings \#\-\} - import Control.Exception- import GHC.Generics- import Text.Format+import Control.Exception+import GHC.Generics+import Text.Format - instance FormatArg () where- formatArg x k fmt@(ArgFmt{fmtSpecs=\"U\"}) =- let fmt' = fmt{fmtSpecs = \"\"}- in formatArg (show x) k fmt'- formatArg _ _ _ = Left ArgFmtError+-- Manually extend to ()+instance FormatArg () where+ formatArg x k fmt@(ArgFmt{fmtSpecs=\"U\"}) =+ let fmt' = fmt{fmtSpecs = \"\"}+ in formatArg (show x) k fmt'+ formatArg _ _ _ = Left $ toException ArgFmtError - data Color = Red | Yellow | Blue deriving Generic+-- Use default generic implementation for type with nullary data constructors.+data Color = Red | Yellow | Blue deriving Generic - instance FormatArg Color+instance FormatArg Color - data Triple = Triple String Int Double deriving Generic+-- Use default generic implementation for type with non-nullary data constructor.+data Triple = Triple String Int Double deriving Generic - instance FormatArg Triple+instance FormatArg Triple - data Student = Student { no :: Int- , name :: String- , age :: Int- } deriving Generic+-- Use default generic implementation for type using record syntax.+data Student = Student { no :: Int+ , name :: String+ , age :: Int+ } deriving Generic - instance FormatArg Student+instance FormatArg Student - main :: IO ()- main = do- putStrLn $ format \"A unit {:U}\" ()- putStrLn $ format \"I like {}.\" Blue- putStrLn $ format \"Triple {0!0} {0!1} {0!2}\" $ Triple \"Hello\" 123 pi- putStrLn $ format1 \"Student: {no} {name} {age}\" $ Student 1 \"neo\" 30+-- Customize field names+data Book = Book { bookName :: String+ , bookAuthor :: String+ , bookPrice :: Double+ }++instance FormatArg Book where+ formatArg x k fmt+ | k == mempty = return $ format1 \"{name} {author} {price:.2f}\" x+ | k == Name \"name\" = formatArg (bookName x) mempty fmt+ | k == Name \"author\" = formatArg (bookAuthor x) mempty fmt+ | k == Name \"price\" = formatArg (bookPrice x) mempty fmt+ | otherwise = Left $ toException $ ArgKeyError++\-\- A better way to customize field names+\-\- instance FormatArg Book where+\-\- formatArg = genericFormatArg $+\-\- defaultOptions { fieldLabelModifier = drop 4 }++main :: IO ()+main = do+ putStrLn $ format \"A unit {:U}\" ()+ putStrLn $ format \"I like {}.\" Blue+ putStrLn $ format \"Triple {0!0} {0!1} {0!2}\" $ Triple \"Hello\" 123 pi+ putStrLn $ format1 \"Student: {no} {name} {age}\" $ Student 1 \"neo\" 30+ putStrLn $ format \"A book: {}\" $ Book \"Math\" \"nobody\" 99.99+ putStrLn $ format1 \"Book: {name}, Author: {author}, Price: {price:.2f}\" $+ Book \"Math\" \"nobody\" 99.99 @ -} class FormatArg a where formatArg :: a -> Formatter default formatArg :: (Generic a, GFormatArg (Rep a)) => a -> Formatter- formatArg x = gformatArg (from x)+ formatArg = genericFormatArg defaultOptions + formatArgList :: [a] -> Formatter+ formatArgList xs (Index i) = formatArg (xs !! i) mempty+ formatArgList xs (Nest (Index i) k) = formatArg (xs !! i) k+ formatArgList _ _ = const $ throwM ArgKeyError+ -- | This method is used to get the key of a top-level argument. -- Top-level argument means argument that directly passed to format -- functions ('format', 'format1'). keyOf :: a -> ArgKey- keyOf _ = Index (-1)---- | Default specs is \"%Y-%m-%dT%H:%M:%S\", see 'formatTime'.-instance {-# OVERLAPPABLE #-} FormatTime t => FormatArg t where- formatArg = throwIfNest $ \x k fmt ->- let specs = fmtSpecs fmt <|> "%Y-%m-%dT%H:%M:%S"- x' = formatTime defaultTimeLocale specs x- fmt' = fmt{fmtSpecs=""}- in formatArg x' k fmt'--instance {-# OVERLAPPABLE #-} FormatArg a => FormatArg [a] where- formatArg x (Nest _ k@(Index i)) = formatArg (x !! i) (Index (-1))- formatArg x (Nest _ k@(Nest (Index i) _)) = formatArg (x !! i) k- formatArg _ _ = const $ throwM ArgKeyError+ keyOf _ = mempty -instance {-# OVERLAPPABLE #-} FormatArg a => FormatArg (Map String a) where- formatArg x (Nest _ k@(Name n)) = formatArg (x ! n) (Index (-1))- formatArg x (Nest _ k@(Nest (Name n) _)) = formatArg (x ! n) k- formatArg _ _ = const $ throwM ArgKeyError+instance FormatArg Bool -instance {-# OVERLAPPABLE #-} FormatArg a => FormatArg (Map Int a) where- formatArg x (Nest _ k@(Index i)) = formatArg (x ! i) (Index (-1))- formatArg x (Nest _ k@(Nest (Index i) _)) = formatArg (x ! i) k- formatArg _ _ = const $ throwM ArgKeyError+instance FormatArg Char where+ formatArg = formatChar+ formatArgList = formatString -instance FormatArg String where- formatArg = throwIfNest formatString+instance FormatArg Float where+ formatArg = formatRealFloat -instance FormatArg Char where- formatArg = throwIfNest $ formatInteger False . toInteger . ord+instance FormatArg Double where+ formatArg = formatRealFloat instance FormatArg Int where- formatArg = throwIfNest $ formatInteger True . toInteger+ formatArg = formatInt instance FormatArg Int8 where- formatArg = throwIfNest $ formatInteger True . toInteger+ formatArg = formatInt instance FormatArg Int16 where- formatArg = throwIfNest $ formatInteger True . toInteger+ formatArg = formatInt instance FormatArg Int32 where- formatArg = throwIfNest $ formatInteger True . toInteger+ formatArg = formatInt instance FormatArg Int64 where- formatArg = throwIfNest $ formatInteger True . toInteger+ formatArg = formatInt +instance FormatArg Integer where+ formatArg = formatInteger++instance FormatArg Natural where+ formatArg = formatIntegral False . toInteger+ instance FormatArg Word where- formatArg = throwIfNest $ formatInteger False . toInteger+ formatArg = formatWord instance FormatArg Word8 where- formatArg = throwIfNest $ formatInteger False . toInteger+ formatArg = formatWord instance FormatArg Word16 where- formatArg = throwIfNest $ formatInteger False . toInteger+ formatArg = formatWord instance FormatArg Word32 where- formatArg = throwIfNest $ formatInteger False . toInteger+ formatArg = formatWord instance FormatArg Word64 where- formatArg = throwIfNest $ formatInteger False . toInteger+ formatArg = formatWord -instance FormatArg Integer where- formatArg = throwIfNest $ formatInteger True+-- | Default specs is \"%Y-%m-%dT%H:%M:%S\", see 'formatTime'.+instance {-# OVERLAPPABLE #-} FormatTime t => FormatArg t where+ formatArg x k fmt =+ let specs = fmtSpecs fmt <|> "%Y-%m-%dT%H:%M:%S"+ x' = formatTime defaultTimeLocale specs x+ in formatArg x' k $ fmt{fmtSpecs=""} -instance FormatArg Natural where- formatArg = throwIfNest $ formatInteger False . toInteger+instance {-# OVERLAPPABLE #-} FormatArg a => FormatArg [a] where+ {-# SPECIALIZE instance FormatArg [Char] #-}+ formatArg = formatArgList -instance FormatArg Float where- formatArg = throwIfNest formatRealFloat+instance FormatArg a => FormatArg (Map String a) where+ formatArg x (Name n) = formatArg (x ! n) mempty+ formatArg x (Nest (Name n) k) = formatArg (x ! n) k+ formatArg _ _ = const $ throwM ArgKeyError -instance FormatArg Double where- formatArg = throwIfNest formatRealFloat+instance FormatArg a => FormatArg (Map Int a) where+ formatArg x (Index i) = formatArg (x ! i) mempty+ formatArg x (Nest (Index i) k) = formatArg (x ! i) k+ formatArg _ _ = const $ throwM ArgKeyError --------------------------------------------------------------------------------+{-| Options that specify how to format your datatype++Options can be set using record syntax on defaultOptions with the fields below.++@since 0.11.0+-}+data Options = Options { fieldLabelModifier :: String -> String+ }++{-| Default format options++@+'Options'+{ 'fieldLabelModifier' = id+}+@++@since 0.11.0+-}+defaultOptions = Options { fieldLabelModifier = id+ }+++{-| A configurable generic 'Formatter' creator.++@since 0.11.0+-}+genericFormatArg :: (Generic a, GFormatArg (Rep a)) => Options -> a -> Formatter+genericFormatArg opts x = gformatArg (from x) opts+++-------------------------------------------------------------------------------- class GFormatArg f where- gformatArg :: f p -> ArgKey -> ArgFmt -> Either SomeException String+ gformatArg :: f p -> Options -> Formatter -- Data type instance GFormatArg f => GFormatArg (D1 c f) where@@ -191,44 +265,42 @@ -- data GreetTo = Hello String | Hi String -- data Greet = Hello | Hi instance (Constructor c, GFormatArg f) => GFormatArg (C1 c f) where- gformatArg c@(M1 x) = gformatArg x+ gformatArg (M1 x) = gformatArg x -- Constructor without arguments -- e.g. data Greet = Hello | Hi instance {-# OVERLAPPING #-} Constructor c => GFormatArg (C1 c U1) where- gformatArg _ (Nest _ _) = const $ throwM ArgKeyError- gformatArg c k = formatArg (conName c) k+ gformatArg c _ = formatArg (conName c) -- Try Products one by one instance (GFormatArg f, GFormatArg g) => GFormatArg (f :*: g) where- gformatArg (x :*: y) k fmt =- gformatArg x k fmt <|> gformatArg y (dec1 k) fmt+ gformatArg (x :*: y) opts k fmt =+ gformatArg x opts k fmt <|> gformatArg y opts (dec1 k) fmt where x <|> y = catchIf isArgKeyError x $ const y dec1 :: ArgKey -> ArgKey- dec1 (Index i) = Index (i - 1)- dec1 (Nest p (Index i)) = Nest p (Index (i - 1))- dec1 (Nest p (Nest (Index i) k)) = Nest p $ Nest (Index (i - 1)) k- dec1 k = k+ dec1 (Index i) = Index (i - 1)+ dec1 (Nest k1 k2) = mappend (dec1 k1) k2+ dec1 k = k -- Selector (record and none record) -- e.g. data GreetTo = Hello String | Hi String -- data GreetTo = Hello { name :: String } | Hi { name :: String } instance (Selector c, GFormatArg f) => GFormatArg (S1 c f) where- gformatArg s@(M1 x) (Nest _ (Index 0))- | selName s == "" = gformatArg x (Index (-1))- gformatArg s@(M1 x) (Nest _ k@(Nest (Index 0) _))- | selName s == "" = gformatArg x k- gformatArg s@(M1 x) (Nest _ (Name record))- | selName s == record = gformatArg x (Index (-1))- gformatArg s@(M1 x) (Nest _ k@(Nest (Name record) _))- | selName s == record = gformatArg x k- gformatArg _ _ = const $ throwM ArgKeyError+ gformatArg s@(M1 x) opts (Index 0)+ | selName s == "" = gformatArg x opts mempty+ gformatArg s@(M1 x) opts (Nest (Index 0) k)+ | selName s == "" = gformatArg x opts k+ gformatArg s@(M1 x) opts@(Options{..}) (Name record)+ | (fieldLabelModifier $ selName s) == record = gformatArg x opts mempty+ gformatArg s@(M1 x) opts@(Options{..}) (Nest (Name record) k)+ | (fieldLabelModifier $ selName s) == record = gformatArg x opts k+ gformatArg _ _ _ = const $ throwM ArgKeyError -- FormatArg instance instance (FormatArg c) => GFormatArg (K1 i c) where- gformatArg (K1 c) = formatArg c+ gformatArg (K1 c) _ = formatArg c --------------------------------------------------------------------------------@@ -241,8 +313,9 @@ sfmt fmt args = \arg -> sfmt fmt $ insert (fixIndex $ keyOf arg) (formatArg arg) args where- fixIndex (Index (-1)) = Index $ length [n | Index n <- keys args]- fixIndex k = k+ fixIndex k+ | k == mempty = Index $ length [n | Index n <- keys args]+ | otherwise = k instance FormatType String where sfmt fmt args = formats (unFormat fmt)@@ -256,8 +329,8 @@ formats1 :: FmtItem -> String formats1 (Lit cs) = cs- formats1 (Arg key ifmt) =- either (onError (key, ifmt)) id $ (getFormatter key) key (fixArgFmt ifmt)+ formats1 (Arg key ifmt) = either (onError (key, ifmt)) id $+ (getFormatter key) (popKey key) (fixArgFmt ifmt) fixArgFmt :: ArgFmt -> ArgFmt fixArgFmt ifmt@(ArgFmt{fmtWidth=(Right key)}) =@@ -273,8 +346,7 @@ formatPrecision = formatWidth getFormatter :: ArgKey -> Formatter- getFormatter (Nest key _) = getFormatter key- getFormatter key = fromMaybe (\_ _ -> throwM ArgKeyError) $ args !? key+ getFormatter = maybe (\_ _ -> throwM ArgKeyError) id . (args !?) . topKey --------------------------------------------------------------------------------@@ -283,20 +355,25 @@ infixr 6 := instance FormatArg a => FormatArg ((:=) a) where- formatArg (_ := x) (Nest _ k) = formatArg x k- formatArg (_ := x) _ = formatArg x (Index (-1))-+ formatArg (_ := x) k = formatArg x k keyOf (ks := _) = Name ks --------------------------------------------------------------------------------+{-| Formatter for string values++@since 0.11.0+-} formatString :: String -> Formatter+formatString _ k _ | k /= mempty = throwM ArgKeyError formatString x _ fmt@(ArgFmt{fmtSpecs = ""}) = Right $ formatText fmt x formatString x _ fmt@(ArgFmt{fmtSpecs = "s"}) = Right $ formatText fmt x formatString _ _ _ = throwM ArgFmtError -formatInteger :: Bool -> Integer -> Formatter-formatInteger signed x _ fmt@ArgFmt{fmtSpecs=specs} =++formatIntegral :: Bool -> Integer -> Formatter+formatIntegral _ _ k _ | k /= mempty = throwM ArgKeyError+formatIntegral signed x _ fmt@ArgFmt{fmtSpecs=specs} = formatNumber fmt signed (sepw specs) (flag specs) <$> (showx specs x) where sepw :: String -> Int@@ -330,7 +407,44 @@ showx "X" x = map toUpper <$> showx "x" x showx _ _ = throwM ArgFmtError ++{-| Formatter for 'Char' values++@since 0.11.0+-}+formatChar :: Char -> Formatter+formatChar = formatWord . ord++{-| Formatter for 'Int' values++@since 0.11.0+ -}+formatInt :: (Integral a, Bounded a) => a -> Formatter+formatInt = formatIntegral True . toInteger+++{-| Formatter for 'Word' values++@since 0.11.0+ -}+formatWord :: (Integral a, Bounded a) => a -> Formatter+formatWord = formatIntegral False . toInteger+++{-| Formatter for 'Integer' values++@since 0.11.0+ -}+formatInteger :: Integer -> Formatter+formatInteger = formatIntegral True+++{-| Formatter for 'RealFloat' values++@since 0.11.0+ -} formatRealFloat :: RealFloat a => a -> Formatter+formatRealFloat _ k _ | k /= mempty = throwM ArgKeyError formatRealFloat x _ fmt@ArgFmt{fmtSpecs=specs, fmtPrecision=prec} = formatNumber fmt True 3 Nothing <$> showx specs prec1 x where@@ -349,8 +463,3 @@ showx "G" p x = map toUpper <$> showx "g" p x showx "%" p x = (++ "%") <$> (showx "f" p (x * 100)) showx _ _ _ = throwM ArgFmtError---throwIfNest :: (a -> Formatter) -> a -> Formatter-throwIfNest _ _ (Nest _ _) _ = throwM ArgKeyError-throwIfNest f x k fmt = f x k fmt
src/Text/Format/Format.hs view
@@ -30,9 +30,9 @@ ==== Format string syntax @- format :: {chars | ("{" [key][":"fmt] "}")}- key :: \<see 'ArgKey'\>- fmt :: \<see 'ArgFmt'\>+ format -> {chars | ("{" [key][":"fmt] "}")}+ key -> \<see 'ArgKey'\>+ fmt -> \<see 'ArgFmt'\> @ Note: This library use a description language to describe syntax,@@ -54,22 +54,22 @@ A syntax expr may contain a list of fields as followings @- identifier identifier of an expr- \<description\> use human language as an expr- :: use right hand expr to describe identifier- () a required field, may be omitted- [] an optional field- {} repeat any times of the field- | logical or, choice between left and right- "" literal text+ identifier identifier of an expr+ \<description\> use natural language as an expr+ -> use right hand expr to describe identifier+ () a required field, may be omitted+ [] an optional field+ {} repeat any times of the field+ | logical or, choice between left and right+ "" literal text @ Built-in exprs @- char :: \<any character\>- chars :: {char}- int :: \<integer without sign\>+ char -> \<any character\>+ chars -> {char}+ int -> \<integer without sign\> @ -} newtype Format = Format { unFormat :: [FmtItem] } deriving (Show, Eq)@@ -125,12 +125,13 @@ fixIndex :: Int -> [FmtItem] -> [FmtItem] fixIndex _ [] = []- -- auto-positioned arg- fixIndex next ((Arg (Index (-1)) fmt) : items) =- (Arg (Index next) fmt) : fixIndex (next + 1) items- -- once there is an explict index arg key, auto-position args not working+ -- fixing empty key+ fixIndex next ((Arg key fmt) : items)+ | key == mempty = (Arg (Index next) fmt) : fixIndex (next + 1) items+ -- once there is an explict indexed key, stop fixing fixIndex next items@((Arg (Index _) _) : _) = items fixIndex next (item : items) = item : fixIndex next items+ -- | A variant of 'Format', -- it transforms all argument's key to __Nest (Index 0) key__
test/Main.hs view
@@ -38,6 +38,7 @@ prop "keys are disordered" $ uncurry (==) . formatDisordered prop "arg format is omitted" $ uncurry (==) . formatOrdered "{:c}{}{}{}{}{}{}"+ prop "generic" $ uncurry (==) . formatGeneric it "escaped brace" $ format "{{" == ['{'] && format "}}" == ['}'] prop "alignment and padding" $ \(align, PadChar c, n) ->@@ -138,6 +139,31 @@ <*> arbitrary +data Color = Red | Yellow | Blue deriving (Generic, Show)++instance FormatArg Color+++data Flag = Flag Color Int Int deriving (Generic, Show)++instance FormatArg Flag+++data Country = Country { _name :: String+ , _flag :: Flag+ } deriving (Generic, Show)++instance FormatArg Country where+ formatArg = genericFormatArg $ defaultOptions { fieldLabelModifier = drop 1 }++instance Arbitrary Country where+ arbitrary = Country <$> genName <*> genFlag+ where+ genName = (:[]) <$> elements ['A'..'Z']+ genFlag = Flag <$> genColor <*> arbitrary <*> arbitrary+ genColor = elements [Red, Yellow, Blue]++ data PadChar = PadChar { getPadChar :: Char } deriving Show instance Arbitrary PadChar where@@ -196,6 +222,12 @@ word' = show word fs = "{6:s}{3:d}{2:g}{1:g}{4:d}{5:d}{0:c}" ++formatGeneric :: Country -> (String, String)+formatGeneric country@(Country{_flag=(Flag color width height), ..}) =+ ( format1 "{name} {flag!0} {flag!1} {flag!2}" country+ , format "{} {} {} {}" _name color width height+ ) formatAlign :: FmtAlign -> Char -> Int -> (String, String) formatAlign align c n =
vformat.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 5d5662a48ea62fc7081bff2ddcd8ec45db22cbbf6378456260cc0c35d0fbe73a+-- hash: 2036e677feacc5509914e6f6268eeb9a780e00ef9f609f19d4b52d21728b7fc6 name: vformat-version: 0.10.0.0+version: 0.11.0.0 synopsis: A Python str.format() like formatter description: Please see the http://hackage.haskell.org/package/vformat category: Text, Format