diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # Revision history for PyF +## 0.8.1.0 -- 2019-09-03 + +- Precision can now be any arbitrary haskell expression, such as `[fmt|hello pi = {pi:.{1 + 3}}|]`. + ## 0.8.0.2 -- 2019-08-27 - (minor bugfix in tests): Use python3 instead of "python" to help build on environment with both python2 and python3 diff --git a/PyF.cabal b/PyF.cabal --- a/PyF.cabal +++ b/PyF.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: PyF -version: 0.8.0.2 +version: 0.8.1.0 synopsis: Quasiquotations for a python like interpolated string formater description: Quasiquotations for a python like interpolated string formater. license: BSD-3-Clause @@ -27,6 +27,7 @@ , megaparsec >= 7.0 && < 8.0 , text >= 0.11 && < 1.3 , containers >= 0.5 && < 0.7 + , mtl -- haskell-src-meta < 0.8.2 does not correctly handle TypeApplication -- That's not critical for PyF, so you can ignore this bound if needed diff --git a/Readme.md b/Readme.md --- a/Readme.md +++ b/Readme.md @@ -139,6 +139,15 @@ Will returns `-a\n-b`. Note how the first and last line breaks are ignored. +## Arbitrary value for precision + +The precision field can be any haskell expression instead of a fixed number: + +```haskell +>>> [fmt|{pi:.{1+2}}|] +3.142 +``` + # Output type *PyF* aims at extending the string literal syntax. As such, it default to `String` type. However, if the `OverloadedString` is enabled, PyF will happilly generate `IsString t => t` instead. This means that you can use PyF to generate `String`, but also `Text` and why not `ByteString`, with all the caveats known to this extension. @@ -268,7 +277,7 @@ ### Not supported - Number `n` formatter is not supported. In python this formatter can format a number and use current locale information for decimal part and thousand separator. There is no plan to support that because of the impure interface needed to read the locale. -- Python support sub variables in the formatting options, such as `{varname:.{precision}}`, we should too. However should we accept `String` parameter (such as `<`), with a possible runtime error, or should we use the `ADT` such as `AlignRight`? +- Python support sub variables in the formatting options in every places, such as `{expression:.{precision}}`. We only support it for `precision`. This is more complexe to setup for others fields. - Python literal integers accepts binary/octal/hexa/decimal literals, PyF only accept decimal ones, I don't have a plan to support that, if you really need to format a float with a number of digit provided as a binary constant, open an issue. - Python support adding custom formatters for new types, such as date. This may be really cool, for example `[fmt|{today:%Y-%M-%D}`. I don't know how to support that now. diff --git a/src/PyF/Internal/PythonSyntax.hs b/src/PyF/Internal/PythonSyntax.hs --- a/src/PyF/Internal/PythonSyntax.hs +++ b/src/PyF/Internal/PythonSyntax.hs @@ -9,8 +9,7 @@ This module provides a parser for . -} module PyF.Internal.PythonSyntax - ( parsePythonFormatString - , parseGenericFormatString + ( parseGenericFormatString , Item(..) , FormatMode(..) , Padding(..) @@ -19,6 +18,8 @@ , AlternateForm(..) , pattern DefaultFormatMode , Parser + , ParsingContext(..) + , ExprOrValue(..) ) where @@ -28,6 +29,7 @@ import qualified Text.Megaparsec.Char.Lexer as L import Text.Megaparsec.Char import Data.Void (Void) +import Control.Monad.Reader import qualified Data.Char @@ -40,8 +42,14 @@ import qualified Language.Haskell.Exts.SrcLoc as SrcLoc import PyF.Formatters -type Parser t = Parsec Void String t +type Parser t = ParsecT Void String (Reader ParsingContext) t +data ParsingContext = ParsingContext + { delimiters :: (Char, Char) + , enabledExtensions :: [ParseExtension.Extension] + } + deriving (Show) + {- -- TODO: - Better parsing of integer @@ -82,14 +90,14 @@ (FixedF (Precision 2) NormalForm Minus) Nothing))] -} -parsePythonFormatString :: [ParseExtension.Extension] -> Parser [Item] -parsePythonFormatString exts = parseGenericFormatString exts ('{', '}') -parseGenericFormatString :: [ParseExtension.Extension] -> (Char, Char) -> Parser [Item] -parseGenericFormatString exts delimiters = many (rawString delimiters <|> escapedParenthesis delimiters <|> replacementField exts delimiters) <* eof +parseGenericFormatString :: Parser [Item] +parseGenericFormatString = do + many (rawString <|> escapedParenthesis <|> replacementField) <* eof -rawString :: (Char, Char) -> Parser Item -rawString (openingChar,closingChar) = do +rawString :: Parser Item +rawString = do + (openingChar, closingChar) <- delimiters <$> ask chars <- some (noneOf ([openingChar, closingChar])) case escapeChars chars of Left remaining -> do @@ -98,8 +106,11 @@ fancyFailure (Set.singleton (ErrorFail "lexical error in literal section")) Right escaped -> return (Raw escaped) -escapedParenthesis :: (Char, Char) -> Parser Item -escapedParenthesis (openingChar, closingChar) = Raw <$> (parseRaw openingChar <|> parseRaw closingChar) +escapedParenthesis :: Parser Item +escapedParenthesis = do + (openingChar, closingChar) <- delimiters <$> ask + + Raw <$> (parseRaw openingChar <|> parseRaw closingChar) where parseRaw c = c:[] <$ string (replicate 2 c) {- | Replace escape chars with their value. Results in a Left with the @@ -118,8 +129,11 @@ ((c, xs):_) -> (c :) <$> escapeChars xs _ -> Left s -replacementField :: [ParseExtension.Extension] -> (Char, Char) -> Parser Item -replacementField exts (charOpening, charClosing) = do +replacementField :: Parser Item +replacementField = do + exts <- enabledExtensions <$> ask + (charOpening, charClosing) <- delimiters <$> ask + _ <- char charOpening expr <- evalExpr exts (many (noneOf (charClosing:":" :: [Char]))) fmt <- optional $ do @@ -142,9 +156,15 @@ | Padding Integer (Maybe (Maybe Char, AnyAlign)) deriving (Show) +-- | Represents a value of type @t@ or an Haskell expression supposed to represents that value +data ExprOrValue t + = Value t + | HaskellExpr Exp + deriving (Show) + -- | Floating point precision data Precision = PrecisionDefault - | Precision Integer + | Precision (ExprOrValue Integer) deriving (Show) {- @@ -231,7 +251,7 @@ grouping <- optional grouping_option - prec <- option PrecisionDefault (char '.' *> (Precision <$> precision)) + prec <- option PrecisionDefault parsePrecision t <- optional type_ let padding = case w of @@ -245,6 +265,17 @@ Left typeError -> do lastCharFailed typeError +parsePrecision :: Parser Precision +parsePrecision = do + exts <- enabledExtensions <$> ask + (charOpening, charClosing) <- delimiters <$> ask + + _ <- char '.' + choice [ + Precision . Value <$> precision, + char charOpening *> (Precision . HaskellExpr <$> evalExpr exts (manyTill anySingle (char charClosing))) + ] + evalFlag :: TypeFlag -> Padding -> Maybe Char -> Precision -> AlternateForm -> Maybe SignMode -> Either String TypeFormat evalFlag Flagb _pad _grouping prec alt s = failIfPrec prec (BinaryF alt (defSign s)) evalFlag Flagc _pad _grouping prec alt s = failIfS s =<< failIfPrec prec =<< failIfAlt alt CharacterF @@ -279,7 +310,11 @@ failIfPrec :: Precision -> TypeFormat -> Either String TypeFormat failIfPrec PrecisionDefault i = Right i -failIfPrec (Precision i) _ = Left ("Type incompatible with precision (." ++ show i ++ "), use any of {'e', 'E', 'f', 'F', 'g', 'G', 'n', 's', '%'} or remove the precision field.") +failIfPrec (Precision e) _ = Left ("Type incompatible with precision (." ++ showExpr ++ "), use any of {'e', 'E', 'f', 'F', 'g', 'G', 'n', 's', '%'} or remove the precision field.") + where + showExpr = case e of + Value v -> show v + HaskellExpr expr -> show expr failIfAlt :: AlternateForm -> TypeFormat -> Either String TypeFormat failIfAlt NormalForm i = Right i @@ -353,8 +388,3 @@ FlagX <$ char 'X', FlagPercent <$ char '%' ] - - - -- TODO: remove ! -deriving instance Lift Precision -deriving instance Lift Padding diff --git a/src/PyF/Internal/QQ.hs b/src/PyF/Internal/QQ.hs --- a/src/PyF/Internal/QQ.hs +++ b/src/PyF/Internal/QQ.hs @@ -29,6 +29,7 @@ import Data.Maybe (fromMaybe) import qualified Data.Maybe +import Control.Monad.Reader import PyF.Internal.PythonSyntax import PyF.Internal.Extensions @@ -43,7 +44,7 @@ -- Be Careful: empty format string -- | Parse a string and return a formatter for it toExp:: (Char, Char) -> String -> Q Exp -toExp delimiters s = do +toExp expressionDelimiters s = do filename <- loc_filename <$> location thExts <- extsEnabled @@ -54,7 +55,8 @@ then [| fromString $(e) |] else e - case parse (parseGenericFormatString exts delimiters) filename s of + let context = ParsingContext expressionDelimiters exts + case runReader (runParserT parseGenericFormatString filename s) context of Left err -> do err' <- overrideErrorForFile filename err fail (errorBundlePretty err') @@ -113,13 +115,16 @@ formatExpr <- padAndFormat (fromMaybe DefaultFormatMode y) pure (formatExpr `AppE` expr) -changePrec :: Precision -> Q Exp -changePrec PrecisionDefault = [| Just 6 |] -changePrec (Precision n) = [| Just n |] +-- | Default precision for floating point +defaultFloatPrecision :: Maybe Int +defaultFloatPrecision = Just 6 -changePrec' :: Precision -> Q Exp -changePrec' PrecisionDefault = [| Nothing |] -changePrec' (Precision n) = [| Just n |] +-- | Precision to maybe +splicePrecision :: Maybe Int -> Precision -> Q Exp +splicePrecision def PrecisionDefault = [| def |] +splicePrecision _ (Precision p) = case p of + Value n -> [| Just n |] + HaskellExpr e -> [| Just $(pure e) |] toGrp :: Maybe Char -> Int -> Q Exp toGrp mb a = [| grp |] @@ -140,17 +145,17 @@ HexCapsF alt s -> [| formatAnyIntegral (Formatters.Upper $(withAlt alt Formatters.Hexa)) s $(newPaddingQ padding) $(toGrp grouping 4) |] -- Floating - ExponentialF prec alt s -> [| formatAnyFractional $(withAlt alt Formatters.Exponent) s $(newPaddingQ padding) $(toGrp grouping 3) $(changePrec prec) |] - ExponentialCapsF prec alt s -> [| formatAnyFractional (Formatters.Upper $(withAlt alt Formatters.Exponent)) s $(newPaddingQ padding) $(toGrp grouping 3) $(changePrec prec) |] - GeneralF prec alt s -> [| formatAnyFractional $(withAlt alt Formatters.Generic) s $(newPaddingQ padding) $(toGrp grouping 3) $(changePrec prec) |] - GeneralCapsF prec alt s -> [| formatAnyFractional (Formatters.Upper $(withAlt alt Formatters.Generic)) s $(newPaddingQ padding) $(toGrp grouping 3) $(changePrec prec) |] - FixedF prec alt s -> [| formatAnyFractional $(withAlt alt Formatters.Fixed) s $(newPaddingQ padding) $(toGrp grouping 3) $(changePrec prec) |] - FixedCapsF prec alt s -> [| formatAnyFractional (Formatters.Upper $(withAlt alt Formatters.Fixed)) s $(newPaddingQ padding) $(toGrp grouping 3) $(changePrec prec) |] - PercentF prec alt s -> [| formatAnyFractional $(withAlt alt Formatters.Percent) s $(newPaddingQ padding) $(toGrp grouping 3) $(changePrec prec) |] + ExponentialF prec alt s -> [| formatAnyFractional $(withAlt alt Formatters.Exponent) s $(newPaddingQ padding) $(toGrp grouping 3) $(splicePrecision defaultFloatPrecision prec) |] + ExponentialCapsF prec alt s -> [| formatAnyFractional (Formatters.Upper $(withAlt alt Formatters.Exponent)) s $(newPaddingQ padding) $(toGrp grouping 3) $(splicePrecision defaultFloatPrecision prec) |] + GeneralF prec alt s -> [| formatAnyFractional $(withAlt alt Formatters.Generic) s $(newPaddingQ padding) $(toGrp grouping 3) $(splicePrecision defaultFloatPrecision prec) |] + GeneralCapsF prec alt s -> [| formatAnyFractional (Formatters.Upper $(withAlt alt Formatters.Generic)) s $(newPaddingQ padding) $(toGrp grouping 3) $(splicePrecision defaultFloatPrecision prec) |] + FixedF prec alt s -> [| formatAnyFractional $(withAlt alt Formatters.Fixed) s $(newPaddingQ padding) $(toGrp grouping 3) $(splicePrecision defaultFloatPrecision prec) |] + FixedCapsF prec alt s -> [| formatAnyFractional (Formatters.Upper $(withAlt alt Formatters.Fixed)) s $(newPaddingQ padding) $(toGrp grouping 3) $(splicePrecision defaultFloatPrecision prec) |] + PercentF prec alt s -> [| formatAnyFractional $(withAlt alt Formatters.Percent) s $(newPaddingQ padding) $(toGrp grouping 3) $(splicePrecision defaultFloatPrecision prec) |] -- Default / String - DefaultF prec s -> [| formatAny s $(paddingToPaddingK padding) $(toGrp grouping 3) $(changePrec' prec) |] - StringF prec -> [| Formatters.formatString (newPaddingKForString $(paddingToPaddingK padding)) $(changePrec' prec) . pyfToString |] + DefaultF prec s -> [| formatAny s $(paddingToPaddingK padding) $(toGrp grouping 3) $(splicePrecision Nothing prec) |] + StringF prec -> [| Formatters.formatString (newPaddingKForString $(paddingToPaddingK padding)) $(splicePrecision Nothing prec) . pyfToString |] newPaddingQ :: Padding -> Q Exp newPaddingQ pad = [| pad' |] diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -215,14 +215,22 @@ it "works" $ do [fmt|hello \n\b|] `shouldBe` "hello \n\b" + describe "variable precision" $ do + it "works" $ do + let n = 3 :: Int + [fmt|{pi:.{n}}|] `shouldBe` "3.142" + it "escape chars" $ do [fmt|}}{{}}{{|] `shouldBe` "}{}{" + describe "custom delimiters" $ do it "works" $ do [myCustomFormatter|2 * pi = @2*pi:.2f!|] `shouldBe` "2 * pi = 6.28" it "escape chars" $ do [myCustomFormatter|@@!!@@!!|] `shouldBe` "@!@!" + it "works for custom precision" $ do + [myCustomFormatter|@pi:.@2!!|] `shouldBe` "3.14" describe "empty line" $ do it "works" $ do diff --git a/test/SpecFail.hs b/test/SpecFail.hs --- a/test/SpecFail.hs +++ b/test/SpecFail.hs @@ -49,7 +49,17 @@ -- Tests use a filename in a temporary directory which may have a long filename which triggers -- line wrapping, reducing the reproducibility of error message -- By setting the column size to a high value, we ensure reproducible error messages - "-dppr-cols=10000000000000" + "-dppr-cols=10000000000000", + -- Clean package environment + "-hide-all-packages", + "-package base", + "-package megaparsec", + "-package text", + "-package template-haskell", + "-package haskell-src-exts", + "-package haskell-src-meta", + "-package mtl", + "-package containers" ] "" case ecode of ExitFailure _ -> pure (CompileError (sanitize path stderr)) @@ -67,7 +77,7 @@ -- strip the filename let t = Text.pack s - in Text.unpack (Text.replace (Text.pack path) (Text.pack "INITIALPATH") t) + in Text.unpack (Text.replace (Text.pack path) (Text.pack "INITIALPATH") t) golden :: HasCallStack => String -> String -> IO () golden name output = do