diff --git a/Data/Text/Format/Heavy/Parse.hs b/Data/Text/Format/Heavy/Parse.hs --- a/Data/Text/Format/Heavy/Parse.hs +++ b/Data/Text/Format/Heavy/Parse.hs @@ -5,9 +5,20 @@ -- * 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". +-- The string format syntax is supposed to be very stable and simple. +-- There are more than one commonly used formatting string syntax, though. This package provides the +-- following syntaxes: -- +-- * The default syntax, which is basically defined by phrase "any part in braces is variable substitution". +-- This syntax is defined in @Data.Text.Format.Heavy.Parse.Braces@ module. +-- +-- * Shell-like syntax, which is basically defined by phrase "any part starting with dollar sign is variable +-- substitution". This syntax is defined in @Data.Text.Format.Heavy.Parse.Shell@ module. +-- +-- It is possible to define your own syntaxes: you just need to parse an instance of @Format@ type from some +-- sort of string. The default syntax will still remain default, in sence that @instance IsString Format@ is +-- defined in terms of this syntax in @Data.Text.Format.Heavy.Instances@ module. +-- -- 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. -- @@ -17,9 +28,7 @@ parseGenericFormat, parseBoolFormat, parseMaybeFormat, -- * Parsec functions - pFormat, pGenericFormat, pBoolFormat, - -- * Utility types - Parser, ParserState (..), initParserState + pGenericFormat, pBoolFormat ) where import Data.Maybe @@ -30,207 +39,6 @@ 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 "" 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 () "" 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 () "" text - --- | Try to parse format for @Maybe x@ type. --- The syntax is: --- --- @ --- someformat|nothing --- @ --- --- where @someformat@ is format for the @x@ type, and @nothing@ is the string --- to be substituted for @Nothing@ value. --- --- Returns Nothing, if format does not contain @|@. Otherwise, returns --- @Just (someformat, nothing)@. --- -parseMaybeFormat :: TL.Text -> Maybe (TL.Text, TL.Text) -parseMaybeFormat text = - let (xFmtStr, nothingStr) = TL.breakOnEnd "|" text - in if TL.null xFmtStr - then Nothing - else Just (TL.init xFmtStr, nothingStr) +import Data.Text.Format.Heavy.Parse.VarFormat +import Data.Text.Format.Heavy.Parse.Braces diff --git a/Data/Text/Format/Heavy/Parse/Braces.hs b/Data/Text/Format/Heavy/Parse/Braces.hs new file mode 100644 --- /dev/null +++ b/Data/Text/Format/Heavy/Parse/Braces.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | This module defines the default syntax of format strings, generally described as +-- "any part in braces is variable substitution". +-- +-- Examples of valid variable substitutions are: +-- +-- * @"Simple: {}"@ +-- +-- * @"Numbered: {0}"@ +-- +-- * @"Named: {var}"@ +-- +-- * @"Specifying variable formatting: {var:+8.4}"@ +-- +module Data.Text.Format.Heavy.Parse.Braces + (-- * Parse functions + parseFormat, parseFormat', + -- * Parsec functions + pBracesFormat + ) 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 +import Data.Text.Format.Heavy.Parse.Types + +-- 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. +pBracesFormat :: Parser Format +pBracesFormat = Format `fmap` many (try pVariable <|> pVerbatim) + +-- | Parse string format definition. +parseFormat :: TL.Text -> Either ParseError Format +parseFormat text = runParser pBracesFormat initParserState "" 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 + diff --git a/Data/Text/Format/Heavy/Parse/Shell.hs b/Data/Text/Format/Heavy/Parse/Shell.hs new file mode 100644 --- /dev/null +++ b/Data/Text/Format/Heavy/Parse/Shell.hs @@ -0,0 +1,98 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | This module defines shell-like syntax of format strings, generally described as +-- "any part after dollar sign is a variable substitution". +-- +-- Examples of valid variable substitutions are: +-- +-- * @"Simple: ${}"@. Note that to have auto-numbered placeholders in this syntax, you have to +-- write @${}@; both dollar sign and braces are necessary. +-- +-- * @"Numbered: $1"@ or @"Numbered: ${1}"@. +-- +-- * @"Named: $var"@ or @"Named: ${var}"@. +-- +-- * @"Specifying variable formatting: ${var:+8.4}"@. To specify variable format, you have to +-- use braces. +-- +-- This syntax is not the default, so to use it you have to explicitly call @parseShellFormat'@: +-- +-- @ +-- {-\# 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.Parse.Shell +-- +-- main :: IO () +-- main = do +-- name <- getLine +-- time <- getZonedTime +-- TLIO.putStrLn $ format (parseShellFormat' "Hello, ${}! It is ${:%H:%M:%S} now.") (name, time) +-- @ +-- +module Data.Text.Format.Heavy.Parse.Shell + (-- * Parse functions + parseShellFormat, parseShellFormat', + -- * Parsec functions + pShellFormat + ) 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 +import Data.Text.Format.Heavy.Parse.Types + +-- TODO: proper handling of escaping +anyChar' :: Parser Char +anyChar' = + noneOf "$" <|> try ('$' <$ string "$$") + +pVerbatim :: Parser FormatItem +pVerbatim = (FString . TL.pack) `fmap` many1 anyChar' + +pVariable :: Parser FormatItem +pVariable = do + char '$' + (name, fmt) <- try bracedVariable <|> unbracedVariable + return $ FVariable (TL.pack name) fmt + where + bracedVariable = between (char '{') (char '}') $ do + name <- many alphaNum + mbColon <- optionMaybe $ char ':' + fmt <- case mbColon of + Nothing -> return Nothing + Just _ -> do + fmtStr <- many (noneOf "}" <|> try ('}' <$ string "\\}")) + 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) + + unbracedVariable = do + name <- many1 alphaNum + return (name, Nothing) + +-- | Parsec parser for string format. +pShellFormat :: Parser Format +pShellFormat = Format `fmap` many (try pVariable <|> pVerbatim) + +-- | Parse string format definition. +parseShellFormat :: TL.Text -> Either ParseError Format +parseShellFormat text = runParser pShellFormat initParserState "" text + +-- | Version of parseShellFormat which throws @error@ in case of syntax error in the formatting string. +parseShellFormat' :: TL.Text -> Format +parseShellFormat' text = either (error . show) id $ parseShellFormat text + diff --git a/Data/Text/Format/Heavy/Parse/Types.hs b/Data/Text/Format/Heavy/Parse/Types.hs new file mode 100644 --- /dev/null +++ b/Data/Text/Format/Heavy/Parse/Types.hs @@ -0,0 +1,19 @@ + +module Data.Text.Format.Heavy.Parse.Types + (-- * Utility types + Parser, ParserState (..), initParserState + ) where + +import qualified Data.Text.Lazy as TL +import Text.Parsec + +data ParserState = ParserState { + psNextIndex :: Int + } + deriving (Eq, Show) + +initParserState :: ParserState +initParserState = ParserState 0 + +type Parser a = Parsec TL.Text ParserState a + diff --git a/Data/Text/Format/Heavy/Parse/VarFormat.hs b/Data/Text/Format/Heavy/Parse/VarFormat.hs new file mode 100644 --- /dev/null +++ b/Data/Text/Format/Heavy/Parse/VarFormat.hs @@ -0,0 +1,165 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Data.Text.Format.Heavy.Parse.VarFormat + 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 + +-- | 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 () "" 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 () "" text + +-- | Try to parse format for @Maybe x@ type. +-- The syntax is: +-- +-- @ +-- someformat|nothing +-- @ +-- +-- where @someformat@ is format for the @x@ type, and @nothing@ is the string +-- to be substituted for @Nothing@ value. +-- +-- Returns Nothing, if format does not contain @|@. Otherwise, returns +-- @Just (someformat, nothing)@. +-- +parseMaybeFormat :: TL.Text -> Maybe (TL.Text, TL.Text) +parseMaybeFormat text = + let (xFmtStr, nothingStr) = TL.breakOnEnd "|" text + in if TL.null xFmtStr + then Nothing + else Just (TL.init xFmtStr, nothingStr) + diff --git a/text-format-heavy.cabal b/text-format-heavy.cabal --- a/text-format-heavy.cabal +++ b/text-format-heavy.cabal @@ -1,5 +1,5 @@ name: text-format-heavy -version: 0.1.2.1 +version: 0.1.3.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: @@ -37,6 +37,10 @@ library exposed-modules: Data.Text.Format.Heavy, Data.Text.Format.Heavy.Parse, + Data.Text.Format.Heavy.Parse.Types, + Data.Text.Format.Heavy.Parse.VarFormat, + Data.Text.Format.Heavy.Parse.Braces, + Data.Text.Format.Heavy.Parse.Shell, Data.Text.Format.Heavy.Build, Data.Text.Format.Heavy.Types, Data.Text.Format.Heavy.Formats,