summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorguibou <>2018-04-16 14:46:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-04-16 14:46:00 (GMT)
commit44698bb15132c84dbc0c6f4490bcd2a97a18c380 (patch)
treea5aa26242ef2bfe415f63cb7e4c41aa5fd83192b
version 0.5.0.00.5.0.0
-rw-r--r--ChangeLog.md31
-rw-r--r--LICENSE30
-rw-r--r--PyF.cabal48
-rw-r--r--Readme.md290
-rw-r--r--Setup.hs2
-rw-r--r--src/PyF.hs95
-rw-r--r--src/PyF/Formatters.hs300
-rw-r--r--src/PyF/Internal/PythonSyntax.hs312
-rw-r--r--src/PyF/Internal/QQ.hs204
-rw-r--r--test/Spec.hs186
10 files changed, 1498 insertions, 0 deletions
diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
index 0000000..b72f9ad
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,31 @@
+# Revision history for FormatStringLiteral
+## 0.5.0.0 -- 2018-04-16
+
+- Support for negative zero
+- Support for 0 modifier
+- Exponential formatter now behaves as python
+- Support for alternate floatting point represenation
+- Lot of documentation
+- Test are auto verified with the python reference implementation
+
+## 0.4.0.0 -- 2018-04-13
+
+- Support for grouping option
+- Support for inner allignment
+- Correct display of NaN and Infinity
+- Fix a few cosmetic with python implementation
+- Introduce `PyF.Formatters`, type safe generic number formatter solution
+- Remove dependency to `scientific`
+
+
+## 0.3.0.0 -- 2018-04-01
+
+* Support for haskell subexpression
+
+## 0.1.1.0 -- 2018-01-07
+
+* Add support for the `sign` field.
+
+## 0.1.0.0 -- 2018-01-03
+
+* First version. Released on an unsuspecting world.
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..d6a1972
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2017, Guillaume Bouchard
+
+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 Guillaume Bouchard 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.
diff --git a/PyF.cabal b/PyF.cabal
new file mode 100644
index 0000000..017759f
--- /dev/null
+++ b/PyF.cabal
@@ -0,0 +1,48 @@
+name: PyF
+version: 0.5.0.0
+synopsis: Quasiquotations for a python like interpolated string formater
+description: Quasiquotations for a python like interpolated string formater.
+license: BSD3
+license-file: LICENSE
+author: Guillaume Bouchard
+maintainer: guillaum.bouchard@gmail.com
+category: Text
+build-type: Simple
+extra-source-files: ChangeLog.md Readme.md
+cabal-version: >=1.10
+
+library
+ exposed-modules:
+ PyF
+ PyF.Internal.PythonSyntax
+ PyF.Internal.QQ
+ PyF.Formatters
+
+ build-depends: base >= 4.9 && < 5.0
+ , template-haskell >= 2.11 && < 2.13
+
+ -- Parsec and some transitive deps
+ , megaparsec >= 6.0 && < 6.5
+ , text >= 0.11 && < 1.3
+ , containers >= 0.5 && < 0.6
+
+ -- Formatting and some transitive deps
+ , formatting >= 6.2 && < 6.4
+
+ --
+ , haskell-src-meta
+ hs-source-dirs: src
+ ghc-options: -Wall
+ default-language: Haskell2010
+
+test-suite pyf-test
+ type: exitcode-stdio-1.0
+ hs-source-dirs: test
+ main-is: Spec.hs
+ build-depends: base, PyF, hspec, text, template-haskell, formatting, process
+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
+ default-language: Haskell2010
+
+source-repository head
+ type: git
+ location: http://github.com/guibou/PyF
diff --git a/Readme.md b/Readme.md
new file mode 100644
index 0000000..a2cea03
--- /dev/null
+++ b/Readme.md
@@ -0,0 +1,290 @@
+*PyF* is a Haskell library for string interpolation and formatting.
+
+*PyF* exposes a quasiquoter `f` for the [Formatting](https://hackage.haskell.org/package/formatting) library. The quasiquotation introduces string interpolation and formatting with a mini language inspired from printf and Python.
+
+# Quick Start
+
+The following *Formatting* example:
+
+```haskell
+>>> import Formatting
+
+>>> name = "Dave"
+>>> age = 54
+
+>>> format ("Person's name is " % text % ", age is " % hex) name age
+"Person's name is Dave, age is 36"
+```
+
+can be written as:
+
+```haskell
+>>> import Formatting
+>>> import PyF
+
+>>> name = "Dave"
+>>> age = 54
+
+>>> format [f|Person's name is {name}, age is {age:x}|]
+"Person's name is Dave, age is 36"
+```
+
+The formatting mini language can represent:
+
+- Numbers with different representations (fixed point, general representation, binary, hexadecimal, octal)
+- Padding, with the choice of padding char, alignment (left, right, around, between sign and number)
+- Sign handling, to display or not the `+` for positive number
+- Number grouping
+- Floating point representation
+- The interpolated value can be any Haskell expression
+
+You will need the extension `QuasiQuotes`, enable it with `{-# LANGUAGE QuasiQuotes #-}` in top of your source file or with `:set -XQuasiQuotes` in your `ghci` session.
+
+Expression to be formatted are referenced by `{expression:formatingOptions}` where `formatingOptions` follows the [Python format mini-language](https://docs.python.org/3/library/string.html#formatspec). It is recommended to read the python documentation, but the [Test file](https://github.com/guibou/PyF/blob/master/test/Spec.hs) as well as this readme contain many examples.
+
+# More Examples
+
+## Padding
+
+Left `<` / Right `>` / Around `^` padding:
+
+```haskell
+>>> name = "Guillaume"
+>>> format [f|{name:<11}|]
+"Guillaume "
+>>> format [f|{name:>11}|]
+" Guillaume"
+>>> format [f|{name:|^13}|]
+"||Guillaume||"
+```
+
+Padding inside `=` the sign:
+
+```haskell
+>>> [fString|{-pi:=10.3}|]
+"- 3.142"
+```
+
+## Float rounding
+
+```haskell
+>>> format [f|{pi:.2}|]
+"3.14"
+```
+
+## Binary / Octal / Hex representation (with or without prefix)
+
+```haskell
+>>> v = 31
+>>> format [f|Binary: {v:#b}|]
+"Binary: 0b11111"
+>>> format [f|Octal (no prefix): {age:o}|]
+"Octal (no prefix): 37"
+>>> format [f|Hexa (caps and prefix): {age:#X}|]
+"Hexa (caps and prefix): 0x1F"
+```
+
+## Grouping
+
+Using `,` or `_`.
+
+```haskell
+>>> [fString|{10 ^ 9 - 1:,}|]
+"999,999,999"
+>>> [fString|{2 ^ 32 -1:_b}|]
+"1111_1111_1111_1111_1111_1111_1111_1111"
+```
+
+## Sign handling
+
+Using `+` to display the positive sign (if any) or ` ` to display a space instead:
+
+```haskell
+>>> [fString|{pi:+.3}|]
+"+3.142"
+>>> [fString|{pi: .3}|]
+" 3.142"
+```
+
+## 0
+
+Preceding the width with a `0` enables sign-aware zero-padding, this is equivalent to inside `=` padding with a fill char of `0`.
+
+```haskell
+>>> [fString{-10:010}|]
+-000000010
+```
+
+## Sub-expressions
+
+First argument inside the curly braces can be a valid Haskell expression, for example:
+
+```haskell
+>>> format [f|2pi = {2* pi:.2}|]
+6.28
+>>> format [f|tail "hello" = {tail "hello":->6}|]
+"tail \"hello\" = --ello"
+```
+
+However the expression must not contain `}` or `:` characters.
+
+## Combined
+
+Most options can be combined. This generally leads to totally unreadable format string ;)
+
+```haskell
+>>> format [f|{pi:~>5.2}|]
+"~~3.14"
+```
+
+# Other quasiquoters
+
+*PyF* main entry point is `f` but for convenience some other quasiquoters are provided:
+
+- `f(StrictText|LazyText|String|Builder|IO)` directly call the underlying `Formatting` runner and produce the specified type.
+- `f'` use type inference to deduce the type.
+
+`PyF` reexport most of `Formatting` runners, such as `format`, `sformat`, `formatToString`, ...
+
+For example:
+
+```haskell
+>>> [f'|hello {pi.2}|] :: String
+"hello 3.14"
+>>> :type [fString|hello|]
+[Char]
+```
+
+# Caveats
+
+## Type inference
+
+Type inference with numeric literals can be unreliable if your variables are too polymorphic. A type annotation or the extension `ExtendedDefaultRules` will help.
+
+```haskell
+>>> v = 10 :: Double
+>>> [f|A float: {v}|]
+A float: 10
+```
+
+## Error reporting
+
+Template haskell is generally known to give developers a lot of
+frustration when it comes to error message, dumping an unreadable
+piece of generated code.
+
+However, in PyF, we took great care to provide clear error reporting, this means that:
+
+- Any parsing error on the mini language results in a clear indication of the error, for example:
+
+```haskell
+>>> [f|{age:.3d}|]
+
+<interactive>:77:4: error:
+ • <interactive>:1:8:
+ |
+1 | {age:.3d}
+ | ^
+Type incompatible with precision (.3), use any of {'e', 'E', 'f', 'F', 'g', 'G', 'n', 's', '%'} or remove the precision field.
+```
+
+- Error in variable name are also readable:
+
+```haskell
+>>> [f|{toto}|]
+<interactive>:78:4: error: Variable not in scope: toto
+```
+
+- However, if the interpolated name is not of a compatible type (or
+ too polymorphic), you will get an awful error:
+
+```haskell
+>>*> [fString|{True:d}|]
+
+<interactive>:80:10: error:
+ • No instance for (Integral Bool)
+ arising from a use of ‘PyF.Internal.QQ.formatAnyIntegral’
+...
+```
+
+- There is also one class of error related to alignement which can be triggered, when using alignement inside sign (i.e. `=`) with string. This can fail in two flavors:
+
+```haskell
+>>> [fString|{"hello":=10s}|]
+
+<interactive>:88:1: error:
+ • Exception when trying to run compile-time code:
+ String Cannot be aligned with the inside `=` mode
+CallStack (from HasCallStack):
+ error, called at src/PyF/Internal/QQ.hs:143:18 in PyF-0.4.0.0-inplace:PyF.Internal.QQ
+ Code: quoteExp fString "{\"hello\":=10s}"
+ • In the quasi-quotation: [fString|{"hello":=10s}|]
+```
+
+And
+
+```haskell
+*PyF PyF.Internal.QQ> [fString|{"hello":=10}|]
+
+<interactive>:89:10: error:
+ • String Cannot be aligned with the inside `=` mode
+...
+```
+
+- Finally, if you make any type error inside the expression field, you are on your own:
+
+```haskell
+>>> [fString|{3 + pi + "hello":10}|]
+
+<interactive>:99:10: error:
+ • No instance for (Floating [Char]) arising from a use of ‘pi’
+ ...
+```
+
+## Difference with the Python Syntax
+
+The implementation is unit-tested against the reference python implementation (python 3.6.4) and should match its result. However some formatters are not supported or some (minor) differences can be observed.
+
+### 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 literal integers accepts binary/octal/hexa/decimal literals, PyF only accept decimal ones, hdece in to 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 `[f|{today:%Y-%M-%D}`. I don't know how to support that now.
+
+### Difference
+
+- General formatters *g* and *G* behaves a bit differently. Precision influence the number of significant digits instead of the number of the magnitude at which the representation changes between fixed and exponential.
+- Grouping options allows grouping with an `_` for floating point, python only allows `,`.
+
+# Build / test
+
+Should work with `stack build; stack test`, and with `cabal` and (optionally) `nix`:
+
+```shell
+nix-shell # Optional, if you use nix
+cabal new-build
+cabal new-test
+```
+
+# TODO
+
+- Improve the error reporting with more Parsec annotation
+- Improve the parser for sub-expression (handle the `:` and `}` cases if possible).
+- Allow extension to others type / custom formatters (for date for example)
+- Improve code quality. This code is really ugly, but there is a really strong test suite so, well.
+- Work on performance, do we really care? For now, everything is internally done with `String`.
+
+# Library note
+
+`PyF.Formatters` exposes two functions to format numbers. They are type-safe (as much as possible) and comes with a combination of formatting options not seen in other formatting libraries:
+
+```haskell
+>>> formatIntegral Binary Plus (Just (20, AlignInside, '~')) (Just (4, ',')) 255
+"+~~~~~~~~~~1111,1111"
+```
+
+# Conclusion
+
+Don't hesitate to make any suggestion, I'll be more than happy to work on it.
+
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/src/PyF.hs b/src/PyF.hs
new file mode 100644
index 0000000..b6126b7
--- /dev/null
+++ b/src/PyF.hs
@@ -0,0 +1,95 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeApplications #-}
+{- | A lot of quasiquoters to format and interpolate string expression
+-}
+module PyF
+ (f,
+ f',
+ fIO,
+ fString,
+ fBuilder,
+ fLazyText,
+ fStrictText,
+
+ -- * Formatting re-export
+ runFormat,
+ format,
+ sformat,
+ bprint,
+ fprint,
+ hprint)
+where
+
+import Language.Haskell.TH.Quote (QuasiQuoter(..))
+import qualified PyF.Internal.QQ as QQ
+
+import Formatting (runFormat, format, sformat, bprint, fprint, hprint)
+import qualified Formatting as F
+import Language.Haskell.TH
+
+import qualified Data.Text.Lazy as LText
+import qualified Data.Text as SText
+import qualified Data.Text.Lazy.Builder as Builder
+
+templateF :: String -> QuasiQuoter
+templateF fName = QuasiQuoter {
+ quoteExp = QQ.toExp
+ , quotePat = err "pattern"
+ , quoteType = err "type"
+ , quoteDec = err "declaration"
+ }
+ where
+ err name = error (fName ++ ": This QuasiQuoter can not be used as a " ++ name ++ "!")
+
+-- | Returns an expression usable with Formatting.format (and similar functions)
+f :: QuasiQuoter
+f = templateF "f"
+
+-- | Generic formatter, can format an expression to (lazy) Text, String, Builder and IO () depending on type inference
+f' :: QuasiQuoter
+f' = wrapQQ (templateF "f'") (VarE 'magicFormat)
+
+wrapQQ :: QuasiQuoter -> Exp -> QuasiQuoter
+wrapQQ qq wrap = qq {
+ quoteExp = \s -> do
+ e <- quoteExp qq s
+ pure (AppE wrap e)
+ }
+
+class MagicFormat t where
+ magicFormat :: F.Format t t -> t
+
+instance MagicFormat (IO ()) where
+ magicFormat = F.fprint
+
+instance MagicFormat [Char] where
+ magicFormat = F.formatToString
+
+instance MagicFormat SText.Text where
+ magicFormat = F.sformat
+
+instance MagicFormat LText.Text where
+ magicFormat = F.format
+
+instance MagicFormat Builder.Builder where
+ magicFormat = F.bprint
+
+-- Monomorphic formatters
+fIO, fString, fStrictText, fLazyText, fBuilder :: QuasiQuoter
+
+
+-- | Format the format string and directly print it to stdout
+fIO = wrapQQ (templateF "fIO") (VarE 'F.fprint)
+
+-- | Format the format string as a 'String'
+fString = wrapQQ (templateF "fString") (VarE 'F.formatToString)
+
+-- | Format the format string as a strict 'SText.Text'
+fStrictText = wrapQQ (templateF "fStrictTeext") (VarE 'F.sformat)
+
+-- | Format the format string as a Lazy 'LText.Text'
+fLazyText = wrapQQ (templateF "fLazy") (VarE 'F.sformat)
+
+-- | Format the format string as a 'Builder.Builder'
+fBuilder = wrapQQ (templateF "fBuilder") (VarE 'F.bprint)
diff --git a/src/PyF/Formatters.hs b/src/PyF/Formatters.hs
new file mode 100644
index 0000000..a24a192
--- /dev/null
+++ b/src/PyF/Formatters.hs
@@ -0,0 +1,300 @@
+{-# LANGUAGE DataKinds, KindSignatures, GADTs, ViewPatterns, OverloadedStrings, StandaloneDeriving, LambdaCase #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DeriveLift #-}
+{- |
+
+Formatters for integral / fractional and strings.
+
+Is support:
+
+For all types:
+
+ * Grouping of the integral part (i.e: adding a custom char to separate groups of digits)
+ * Padding (left, right, around, and between the sign and the number)
+ * Sign handling (i.e: display the positive sign or not)
+
+For floating:
+
+ * Precision
+ * Fixed / Exponential / Generic formatting
+
+For integrals:
+
+ * Binary / Hexa / Octal / Character representation
+-}
+
+module PyF.Formatters
+ (
+ -- * Generic formating function
+ formatString
+ , formatIntegral
+ , formatFractional
+ -- * Formatter details
+ , AltStatus(..)
+ , UpperStatus(..)
+ , FormatType (..)
+ , Format(..)
+ , SignMode(..)
+ , AnyAlign(..)
+ -- * Internal usage only
+ , AlignMode(..)
+ , getAlignForString
+ , AlignForString(..)
+)
+where
+
+import Data.Monoid ((<>))
+import Data.List (intercalate)
+import Data.Char (toUpper, chr)
+import qualified Numeric
+import Language.Haskell.TH.Syntax
+
+-- ADT for API
+-- | Sign handling
+data SignMode = Plus -- ^ Display '-' sign and '+' sign
+ | Minus -- ^ Only display '-' sign
+ | Space -- ^ Display '-' sign and a space for positive numbers
+ deriving (Show)
+
+data AlignForString = AlignAll | AlignNumber
+ deriving (Show)
+
+-- | Alignement
+data AlignMode (k :: AlignForString) where
+ -- | Left padding
+ AlignLeft :: AlignMode 'AlignAll
+ -- | Right padding
+ AlignRight :: AlignMode 'AlignAll
+ -- | Padding will be added between the sign and the number
+ AlignInside :: AlignMode 'AlignNumber
+ -- | Padding will be added around the valueber
+ AlignCenter :: AlignMode 'AlignAll
+
+deriving instance Show (AlignMode k)
+
+-- The generic version
+-- | Existential version of 'AlignMode'
+data AnyAlign where
+ AnyAlign :: AlignMode (k :: AlignForString) -> AnyAlign
+
+deriving instance Show AnyAlign
+deriving instance Lift AnyAlign
+
+-- I hate how a must list all cases, any solution ?
+-- o = Just o does not work
+getAlignForString :: AlignMode k -> Maybe (AlignMode 'AlignAll)
+getAlignForString AlignInside = Nothing
+getAlignForString AlignRight = Just AlignRight
+getAlignForString AlignCenter = Just AlignCenter
+getAlignForString AlignLeft = Just AlignLeft
+
+-- | This formatter support alternate version
+data AltStatus = CanAlt | NoAlt
+
+-- | This formatter support Upper case version
+data UpperStatus = CanUpper | NoUpper
+
+-- | This formatter formats an integral or a fractional
+data FormatType = Fractional | Integral
+
+-- | All the Formatters
+data Format (k :: AltStatus) (k' :: UpperStatus) (k'' :: FormatType) where
+ -- Integrals
+ Decimal :: Format 'NoAlt 'NoUpper 'Integral
+ Character :: Format 'NoAlt 'NoUpper 'Integral
+ Binary :: Format 'CanAlt 'NoUpper 'Integral
+ Hexa :: Format 'CanAlt 'CanUpper 'Integral
+ Octal :: Format 'CanAlt 'NoUpper 'Integral
+
+ -- Fractionals
+ Fixed :: Format 'CanAlt 'CanUpper 'Fractional
+ Exponent :: Format 'CanAlt 'CanUpper 'Fractional
+ Generic :: Format 'CanAlt 'CanUpper 'Fractional
+ Percent :: Format 'CanAlt 'NoUpper 'Fractional
+
+ -- Meta formats
+ Alternate :: Format 'CanAlt u f -> Format 'NoAlt u f
+ -- Upper should come AFTER Alt, so this disallow any future alt
+ Upper :: Format alt 'CanUpper f -> Format 'NoAlt 'NoUpper f
+
+-- Internal Integral
+-- Todo: remove the Show constraint ?
+-- Needed for debug in Numeric function, this is painful
+reprIntegral :: (Show i, Integral i) => Format t t' 'Integral -> i -> Repr
+reprIntegral fmt i = IntegralRepr sign $ format fmt
+ where
+ format :: Format t t' 'Integral -> String
+ format = \case
+ Decimal -> Numeric.showInt iAbs ""
+ Octal -> Numeric.showOct iAbs ""
+ Binary -> Numeric.showIntAtBase 2 (\digit -> if digit == 0 then '0' else '1') iAbs ""
+ Hexa -> Numeric.showHex iAbs ""
+ Upper fmt' -> map toUpper $ format fmt'
+ Character -> [chr (fromIntegral i)]
+ Alternate fmt' -> format fmt'
+
+ (sign, iAbs) = splitSign i
+
+prefixIntegral :: Format t t' 'Integral -> String
+prefixIntegral (Alternate Octal) = "0o"
+prefixIntegral (Alternate Binary) = "0b"
+prefixIntegral (Alternate Hexa) = "0x"
+prefixIntegral (Upper f) = toUpper <$> prefixIntegral f
+prefixIntegral _ = ""
+
+splitSign :: (Num b, Ord b) => b -> (Sign, b)
+splitSign v = (if v < 0 then Negative else Positive, abs v)
+
+-- Internal Fractional
+reprFractional :: (RealFloat f) => Format t t' 'Fractional -> Maybe Int -> f -> Repr
+reprFractional fmt precision f
+ | isInfinite f = Infinite sign (upperIt "inf")
+ | isNaN f = NaN (upperIt "nan")
+ | isNegativeZero f = let (FractionalRepr Positive aa bb cc) = reprFractional fmt precision (abs f)
+ in FractionalRepr Negative aa bb cc
+ | otherwise = FractionalRepr sign decimalPart fractionalPart suffixPart
+ where
+ upperIt s = case fmt of
+ Upper _ -> toUpper <$> s
+ _ -> s
+
+ (sign, iAbs) = splitSign f
+ (decimalPart, fractionalPart, suffixPart) = format fmt
+
+ format :: Format t t' 'Fractional -> (String, String, String)
+ format = \case
+ Fixed -> splitFractional (Numeric.showFFloatAlt precision iAbs "")
+ Exponent -> overrideExponent precision $ splitFractionalExp (Numeric.showEFloat precision iAbs "")
+ Generic -> splitFractionalExp (Numeric.showGFloatAlt precision iAbs "")
+ Percent -> let (a, b, "") = splitFractional (Numeric.showFFloatAlt precision (iAbs * 100) "") in (a, b, "%")
+ Alternate fmt' -> format fmt'
+ Upper fmt' -> let (a, b, c) = format fmt'
+ in (a, b, map toUpper c)
+
+ splitFractional :: String -> (String, String, String)
+ splitFractional s = let (a, b) = break (=='.') s
+ in (a, drop 1 b, "")
+
+overrideExponent :: Maybe Int -> (String, String, String) -> (String, String, String)
+overrideExponent (Just 0) (a, "0", c) = (a, "", c)
+overrideExponent _ o = o
+
+splitFractionalExp :: String -> (String, String, String)
+splitFractionalExp s = let (a, b') = break (\c -> c == '.' || c == 'e' ) s
+ b = drop 1 b'
+ (fpart, e) = case b' of
+ 'e':_ -> ("", b')
+ _ -> break (=='e') b
+ in (a, fpart, case e of
+ 'e':'-':n -> "e-" ++ pad n
+ 'e':n -> "e+" ++ pad n
+ leftover -> leftover)
+ where pad n@[_] = '0':n
+ pad n = n
+
+-- Cases Integral / Fractional
+
+group :: Repr -> Maybe (Int, Char) -> Repr
+group (IntegralRepr s str) (Just (size, c)) = IntegralRepr s (groupIntercalate c size str)
+group (FractionalRepr s a b d) (Just (size, c)) = FractionalRepr s (groupIntercalate c size a) b d
+group i _ = i
+
+padAndSign :: Format t t' t'' -> String -> SignMode -> Maybe (Int, AlignMode k, Char) -> Repr -> String
+padAndSign format prefix sign padding repr = leftAlignMode <> prefixStr <> middleAlignMode <> content <> rightAlignMode
+ where
+ (signStr, content) = case repr of
+ IntegralRepr s str -> (formatSign s sign, str)
+ FractionalRepr s a b c -> (formatSign s sign, joinPoint format a b <> c)
+ Infinite s str -> (formatSign s sign, str)
+ NaN str -> ("", str)
+ prefixStr = signStr <> prefix
+
+ len = length prefixStr + length content
+ (leftAlignMode, rightAlignMode, middleAlignMode) = case padding of
+ Nothing -> ("", "", "")
+ Just (pad, padMode, padC) -> let
+ padNeeded = max 0 (pad - len)
+ in case padMode of
+ AlignLeft -> ("", replicate padNeeded padC, "")
+ AlignRight -> (replicate padNeeded padC, "", "")
+ AlignCenter -> (replicate (padNeeded `div` 2) padC, replicate (padNeeded - padNeeded `div` 2) padC, "")
+ AlignInside -> ("", "", replicate padNeeded padC)
+
+joinPoint :: Format t t' t'' -> String -> String -> String
+joinPoint (Upper f) a b = joinPoint f a b
+joinPoint (Alternate _) a b = a <> "." <> b
+joinPoint _ a "" = a
+joinPoint _ a b = a <> "." <> b
+
+-- Generic
+data Repr
+ = IntegralRepr Sign String
+ | FractionalRepr Sign String String String
+ | Infinite Sign String
+ | NaN String
+ deriving (Show)
+
+data Sign = Negative | Positive
+ deriving (Show)
+
+formatSign :: Sign -> SignMode -> String
+formatSign Positive Plus = "+"
+formatSign Positive Minus = ""
+formatSign Positive Space = " "
+formatSign Negative _ = "-"
+
+groupIntercalate :: Char -> Int -> String -> String
+groupIntercalate c i s = intercalate [c] (reverse (pack (reverse s)))
+ where
+ pack "" = []
+ pack l = reverse (take i l) : pack (drop i l)
+
+-- Final formatters
+
+-- | Format an integral number
+formatIntegral :: (Show i, Integral i)
+ => Format t t' 'Integral
+ -> SignMode
+ -> Maybe (Int, AlignMode k, Char) -- ^ Padding
+ -> Maybe (Int, Char) -- ^ Grouping
+ -> i
+ -> String
+formatIntegral f sign padding grouping i = padAndSign f (prefixIntegral f) sign padding (group (reprIntegral f i) grouping)
+
+-- | Format a fractional number
+formatFractional
+ :: (RealFloat f)
+ => Format t t' 'Fractional
+ -> SignMode
+ -> Maybe (Int, AlignMode k, Char) -- ^ Padding
+ -> Maybe (Int, Char) -- ^ Grouping
+ -> Maybe Int -- ^ Precision
+ -> f
+ -> String
+formatFractional f sign padding grouping precision i = padAndSign f "" sign padding (group (reprFractional f precision i) grouping)
+
+-- | Format a string
+formatString
+ :: Maybe (Int, AlignMode 'AlignAll, Char) -- ^ Padding
+ -> Maybe Int -- ^ Precision (will truncate before padding)
+ -> String
+ -> String
+formatString Nothing Nothing s = s
+formatString Nothing (Just i) s = take i s
+formatString (Just (padSize, padMode, padC)) size s = padLeft <> str <> padRight
+ where
+ str = formatString Nothing size s
+
+ paddingLength = max 0 (padSize - length str)
+ (padLeft, padRight) = case padMode of
+ AlignLeft -> ("", replicate paddingLength padC)
+ AlignRight -> (replicate paddingLength padC, "")
+ AlignCenter -> (replicate (paddingLength `div` 2) padC, replicate (paddingLength - paddingLength `div` 2) padC)
+-- TODO
+{-
+the .
+-}
+
+deriving instance Lift (AlignMode k)
+deriving instance Lift SignMode
+deriving instance Lift (Format k k' k'')
diff --git a/src/PyF/Internal/PythonSyntax.hs b/src/PyF/Internal/PythonSyntax.hs
new file mode 100644
index 0000000..45af36d
--- /dev/null
+++ b/src/PyF/Internal/PythonSyntax.hs
@@ -0,0 +1,312 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DeriveLift #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE DataKinds #-}
+{- |
+This module provides a parser for <https://docs.python.org/3.4/library/string.html#formatspec python format string mini language>.
+-}
+module PyF.Internal.PythonSyntax
+ ( parsePythonFormatString
+ , Item(..)
+ , FormatMode(..)
+ , Padding(..)
+ , Precision(..)
+ , TypeFormat(..)
+ , AlternateForm(..)
+ , pattern DefaultFormatMode
+ )
+where
+
+import Language.Haskell.TH.Syntax
+
+import Text.Megaparsec
+import qualified Text.Megaparsec.Char.Lexer as L
+import Text.Megaparsec.Char
+import Data.Void (Void)
+
+import qualified Data.Char
+
+import Data.Maybe (fromMaybe)
+
+import qualified Data.Set as Set -- For fancyFailure
+import PyF.Formatters
+
+type Parser t = Parsec Void String t
+
+{-
+-- TODO:
+- Better parsing of integer
+- Recursive replacement field, so "{string:.{precision}} can be parsed
+- f_expression / conversion
+- Not (Yet) implemented:
+ - types: n
+-}
+
+
+{-
+f_string ::= (literal_char | "{{" | "}}" | replacement_field)*
+replacement_field ::= "{" f_expression ["!" conversion] [":" format_spec] "}"
+f_expression ::= (conditional_expression | "*" or_expr)
+ ("," conditional_expression | "," "*" or_expr)* [","]
+ | yield_expression
+conversion ::= "s" | "r" | "a"
+format_spec ::= (literal_char | NULL | replacement_field)*
+literal_char ::= <any code point except "{", "}" or NULL>
+-}
+
+-- | A format string is composed of many chunks of raw string or replacement
+data Item = Raw String -- ^ A raw string
+ | Replacement String (Maybe FormatMode) -- ^ A replacement string, composed of an arbitrary Haskell expression followed by an optional formatter
+ deriving (Show)
+
+{- |
+Parse a string, returns a list of raw string or replacement fields
+
+>>> import Text.Megaparsec
+>>> parse parsePythonFormatString "" "hello {1+1:>10.2f}"
+Right [
+ Raw "hello ",
+ Replacement "1+1"
+ (
+ Just (FormatMode
+ (Padding 10 (Just (Nothing,AnyAlign AlignRight)))
+ (FixedF (Precision 2) NormalForm Minus)
+ Nothing))]
+-}
+parsePythonFormatString :: Parser [Item]
+parsePythonFormatString = many (rawString <|> escapedParenthesis <|> replacementField)
+
+rawString :: Parser Item
+rawString = Raw . escapeChars <$> some (noneOf ("{}" :: [Char]))
+
+escapedParenthesis :: Parser Item
+escapedParenthesis = Raw <$> (string "{{" <|> string "}}")
+
+{- | Replace escape chars with their value
+>>> escapeChars "hello \\n"
+"hello \n"
+-}
+escapeChars :: String -> String
+escapeChars "" = ""
+escapeChars s = case Data.Char.readLitChar s of
+ [] -> ""
+ ((c, xs):_) -> c : escapeChars xs
+
+replacementField :: Parser Item
+replacementField = do
+ _ <- char '{'
+ expr <- many (noneOf ("}:" :: [Char]))
+ fmt <- optional $ do
+ _ <- char ':'
+ format_spec
+ _ <- char '}'
+
+ pure (Replacement expr fmt)
+
+-- | Default formating mode, no padding, default precision, no grouping, no sign handling
+pattern DefaultFormatMode :: FormatMode
+pattern DefaultFormatMode = FormatMode PaddingDefault (DefaultF PrecisionDefault Minus) Nothing
+
+-- | A Formatter, listing padding, format and and grouping char
+data FormatMode = FormatMode Padding TypeFormat (Maybe Char)
+ deriving (Show)
+
+-- | Padding, containing the padding width, the padding char and the alignement mode
+data Padding = PaddingDefault
+ | Padding Integer (Maybe (Maybe Char, AnyAlign))
+ deriving (Show)
+
+-- | Floating point precision
+data Precision = PrecisionDefault
+ | Precision Integer
+ deriving (Show)
+{-
+
+Python format mini language
+
+format_spec ::= [[fill]align][sign][#][0][width][grouping_option][.precision][type]
+fill ::= <any character>
+align ::= "<" | ">" | "=" | "^"
+sign ::= "+" | "-" | " "
+width ::= integer
+grouping_option ::= "_" | ","
+precision ::= integer
+type ::= "b" | "c" | "d" | "e" | "E" | "f" | "F" | "g" | "G" | "n" | "o" | "s" | "x" | "X" | "%"
+-}
+
+data TypeFlag = Flagb | Flagc | Flagd | Flage | FlagE | Flagf | FlagF | Flagg | FlagG | Flagn | Flago | Flags | Flagx | FlagX | FlagPercent
+ deriving (Show)
+
+-- | All formating type
+data TypeFormat =
+ DefaultF Precision SignMode -- ^ Default, depends on the infered type of the expression
+ | BinaryF AlternateForm SignMode -- ^ Binary, such as `0b0121`
+ | CharacterF -- ^ Character, will convert an integer to its character representation
+ | DecimalF SignMode -- ^ Decimal, base 10 integer formatting
+ | ExponentialF Precision AlternateForm SignMode -- ^ Exponential notation for floatting points
+ | ExponentialCapsF Precision AlternateForm SignMode -- ^ Exponential notation with capitalised 'e'
+ | FixedF Precision AlternateForm SignMode -- ^ Fixed number of digits floating point
+ | FixedCapsF Precision AlternateForm SignMode -- ^ Capitalized version of the previous
+ | GeneralF Precision AlternateForm SignMode -- ^ General formatting: `FixedF` or `ExponentialF` depending on the number magnitude
+ | GeneralCapsF Precision AlternateForm SignMode -- ^ Same as `GeneralF` but with upper case 'E' and infinite / NaN
+ | OctalF AlternateForm SignMode -- ^ Octal, such as 00245
+ | StringF Precision -- ^ Simple string
+ | HexF AlternateForm SignMode -- ^ Hexadecimal, such as 0xaf3e
+ | HexCapsF AlternateForm SignMode -- ^ Hexadecimal with capitalized letters, such as 0XAF3E
+ | PercentF Precision AlternateForm SignMode -- ^ Percent representation
+ deriving (Show)
+
+-- | If the formatter use its alternate form
+data AlternateForm = AlternateForm | NormalForm
+ deriving (Show)
+
+lastCharFailed :: String -> Parser t
+lastCharFailed err = do
+ (SourcePos name line col) <- getPosition
+
+ -- This is right as long as there is not line break in the string
+ setPosition (SourcePos name line (mkPos (unPos col - 1)))
+ fancyFailure (Set.singleton (ErrorFail err))
+
+overrideAlignmentIfZero :: Bool -> Maybe (Maybe Char, AnyAlign) -> Maybe (Maybe Char, AnyAlign)
+overrideAlignmentIfZero True Nothing = Just (Just '0', AnyAlign AlignInside)
+overrideAlignmentIfZero True (Just (Nothing, al)) = Just (Just '0', al)
+overrideAlignmentIfZero _ v = v
+
+format_spec :: Parser FormatMode
+format_spec = do
+ al' <- optional alignment
+ s <- optional sign
+ alternateForm <- option NormalForm (AlternateForm <$ char '#')
+
+ hasZero <- option False (True <$ char '0')
+
+ let al = overrideAlignmentIfZero hasZero al'
+
+ w <- optional width
+
+ grouping <- optional grouping_option
+
+ prec <- option PrecisionDefault (char '.' *> (Precision <$> precision))
+ t <- optional type_
+
+ let padding = case w of
+ Just p -> Padding p al
+ Nothing -> PaddingDefault
+
+ case t of
+ Nothing -> pure (FormatMode padding (DefaultF prec (fromMaybe Minus s)) grouping)
+ Just flag -> case evalFlag flag prec alternateForm s of
+ Right fmt -> pure (FormatMode padding fmt grouping)
+ Left typeError -> do
+ lastCharFailed typeError
+
+evalFlag :: TypeFlag -> Precision -> AlternateForm -> Maybe SignMode -> Either String TypeFormat
+evalFlag Flagb prec alt s = failIfPrec prec (BinaryF alt (defSign s))
+evalFlag Flagc prec alt s = failIfS s =<< failIfPrec prec =<< failIfAlt alt CharacterF
+evalFlag Flagd prec alt s = failIfPrec prec =<< failIfAlt alt (DecimalF (defSign s))
+evalFlag Flage prec alt s = pure $ExponentialF prec alt (defSign s)
+evalFlag FlagE prec alt s = pure $ ExponentialCapsF prec alt (defSign s)
+evalFlag Flagf prec alt s = pure $ FixedF prec alt (defSign s)
+evalFlag FlagF prec alt s = pure $ FixedCapsF prec alt (defSign s)
+evalFlag Flagg prec alt s = pure $ GeneralF prec alt (defSign s)
+evalFlag FlagG prec alt s = pure $ GeneralCapsF prec alt (defSign s)
+evalFlag Flagn _prec _alt _s = Left ("Type 'n' not handled (yet). " ++ errgGn)
+evalFlag Flago prec alt s = failIfPrec prec $ OctalF alt (defSign s)
+evalFlag Flags prec alt s = failIfS s =<< (failIfAlt alt $ StringF prec)
+evalFlag Flagx prec alt s = failIfPrec prec $ HexF alt (defSign s)
+evalFlag FlagX prec alt s = failIfPrec prec $ HexCapsF alt (defSign s)
+evalFlag FlagPercent prec alt s = pure $ PercentF prec alt (defSign s)
+
+defSign :: Maybe SignMode -> SignMode
+defSign Nothing = Minus
+defSign (Just s) = s
+
+
+errgGn :: String
+errgGn = "Use one of {'b', 'c', 'd', 'e', 'E', 'f', 'F', 'g', 'G', 'n', 'o', 's', 'x', 'X', '%'}."
+
+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.")
+
+failIfAlt :: AlternateForm -> TypeFormat -> Either String TypeFormat
+failIfAlt NormalForm i = Right i
+failIfAlt _ _ = Left "Type incompatible with alternative form (#), use any of {'e', 'E', 'f', 'F', 'g', 'G', 'n', 'o', 'x', 'X', '%'} or remove the alternative field."
+
+failIfS :: Maybe SignMode -> TypeFormat -> Either String TypeFormat
+failIfS Nothing i = Right i
+failIfS (Just s) _ = Left ("Type incompatible with sign field (" ++ [toSignMode s] ++ "), use any of {'b', 'd', 'e', 'E', 'f', 'F', 'g', 'G', 'n', 'o', 'x', 'X', '%'} or remove the sign field.")
+
+toSignMode :: SignMode -> Char
+toSignMode Plus = '+'
+toSignMode Minus = '-'
+toSignMode Space = ' '
+
+alignment :: Parser (Maybe Char, AnyAlign)
+alignment = choice [
+ try $ do
+ c <- fill
+ mode <- align
+ pure (Just c, mode)
+ , do
+ mode <- align
+ pure (Nothing, mode)
+ ]
+
+fill :: Parser Char
+fill = anyChar
+
+align :: Parser AnyAlign
+align = choice [
+ AnyAlign AlignLeft <$ char '<',
+ AnyAlign AlignRight <$ char '>',
+ AnyAlign AlignCenter <$ char '^',
+ AnyAlign AlignInside <$ char '='
+ ]
+
+sign :: Parser SignMode
+sign = choice
+ [Plus <$ char '+',
+ Minus <$ char '-',
+ Space <$ char ' '
+ ]
+
+width :: Parser Integer
+width = integer
+
+integer :: Parser Integer
+integer = L.decimal -- incomplete: see: https://docs.python.org/3/reference/lexical_analysis.html#grammar-token-integer
+
+grouping_option :: Parser Char
+grouping_option = oneOf ("_," :: [Char])
+
+precision :: Parser Integer
+precision = integer
+
+type_ :: Parser TypeFlag
+type_ = choice [
+ Flagb <$ char 'b',
+ Flagc <$ char 'c',
+ Flagd <$ char 'd',
+ Flage <$ char 'e',
+ FlagE <$ char 'E',
+ Flagf <$ char 'f',
+ FlagF <$ char 'F',
+ Flagg <$ char 'g',
+ FlagG <$ char 'G',
+ Flagn <$ char 'n',
+ Flago <$ char 'o',
+ Flags <$ char 's',
+ Flagx <$ char 'x',
+ 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
new file mode 100644
index 0000000..375f2b5
--- /dev/null
+++ b/src/PyF/Internal/QQ.hs
@@ -0,0 +1,204 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+{- | This module uses the python mini language detailed in 'PyF.Internal.PythonSyntax' to build an template haskell expression which represents a 'Formatting.Format'.
+
+-}
+module PyF.Internal.QQ (
+ toExp)
+where
+
+import Text.Megaparsec
+
+import qualified Formatting as F
+
+import Language.Haskell.TH
+
+import Data.Maybe (fromMaybe)
+
+import qualified Data.Text.Lazy.Builder as Builder
+
+import qualified Data.Text.Lazy as LText
+import qualified Data.Text as SText
+import qualified Data.List.NonEmpty as NonEmpty
+
+import qualified Data.Word as Word
+import qualified Data.Int as Int
+import Numeric.Natural
+
+import Language.Haskell.Meta.Parse (parseExp)
+
+import PyF.Internal.PythonSyntax
+import qualified PyF.Formatters as Formatters
+import PyF.Formatters (AnyAlign(..))
+import Data.Proxy
+import GHC.TypeLits
+
+-- Be Careful: empty format string
+-- | Parse a string and return a formatter for it
+toExp:: String -> Q Exp
+toExp s = do
+ filename <- loc_filename <$> location
+ (line, col) <- loc_start <$> location
+
+ let change_log "<interactive>" currentState = currentState
+ change_log _ currentState = let
+ (SourcePos sName _ _) NonEmpty.:| xs = statePos currentState
+ in currentState {statePos = (SourcePos sName (mkPos line) (mkPos col)) NonEmpty.:| xs}
+
+ case parse (updateParserState (change_log filename) >> parsePythonFormatString) filename s of
+ Left err -> do
+
+ if filename == "<interactive>"
+ then do
+ fail (parseErrorPretty' s err)
+ else do
+ fileContent <- runIO (readFile filename)
+ fail (parseErrorPretty' fileContent err)
+ Right items -> goFormat items
+
+goFormat :: [Item] -> Q Exp
+goFormat items = foldl1 fofo <$> (mapM toFormat items)
+
+fofo :: Exp -> Exp -> Exp
+fofo s0 s1 = InfixE (Just s0) (VarE '(F.%)) (Just s1)
+
+-- Real formatting is here
+
+toFormat :: Item -> Q Exp
+toFormat (Raw x) = [| F.now (Builder.fromString x) |]
+toFormat (Replacement x y) = do
+ formatExpr <- padAndFormat (fromMaybe DefaultFormatMode y)
+
+ case parseExp x of
+ Right expr -> pure (AppE (VarE 'F.now) (VarE 'Builder.fromString `AppE` (formatExpr `AppE` expr)))
+ Left err -> fail err
+
+changePrec :: Precision -> Maybe Int
+changePrec PrecisionDefault = Just 6
+changePrec (Precision n) = Just (fromIntegral n)
+
+changePrec' :: Precision -> Maybe Int
+changePrec' PrecisionDefault = Nothing
+changePrec' (Precision n) = Just (fromIntegral n)
+
+toGrp :: Maybe b -> a -> Maybe (a, b)
+toGrp mb a = (a,) <$> mb
+
+withAlt :: AlternateForm -> Formatters.Format t t' t'' -> Q Exp
+withAlt NormalForm e = [| e |]
+withAlt AlternateForm e = [| Formatters.Alternate e |]
+
+-- Todo: Alternates for floating
+padAndFormat :: FormatMode -> Q Exp
+padAndFormat (FormatMode padding tf grouping) = case tf of
+ -- Integrals
+ BinaryF alt s -> [| formatAnyIntegral $(withAlt alt Formatters.Binary) s (newPadding padding) (toGrp grouping 4) |]
+ CharacterF -> [| formatAnyIntegral Formatters.Character Formatters.Minus (newPadding padding) Nothing |]
+ DecimalF s -> [| formatAnyIntegral Formatters.Decimal s (newPadding padding) (toGrp grouping 3) |]
+ HexF alt s -> [| formatAnyIntegral $(withAlt alt Formatters.Hexa) s (newPadding padding) (toGrp grouping 4) |]
+ OctalF alt s -> [| formatAnyIntegral $(withAlt alt Formatters.Octal) s (newPadding padding) (toGrp grouping 4) |]
+ HexCapsF alt s -> [| formatAnyIntegral (Formatters.Upper $(withAlt alt Formatters.Hexa)) s (newPadding padding) (toGrp grouping 4) |]
+
+ -- Floating
+ ExponentialF prec alt s -> [| formatAnyFractional $(withAlt alt Formatters.Exponent) s (newPadding padding) (toGrp grouping 3) (changePrec prec) |]
+ ExponentialCapsF prec alt s -> [| formatAnyFractional (Formatters.Upper $(withAlt alt Formatters.Exponent)) s (newPadding padding) (toGrp grouping 3) (changePrec prec) |]
+ GeneralF prec alt s -> [| formatAnyFractional $(withAlt alt Formatters.Generic) s (newPadding padding) (toGrp grouping 3) (changePrec prec) |]
+ GeneralCapsF prec alt s -> [| formatAnyFractional (Formatters.Upper $(withAlt alt Formatters.Generic)) s (newPadding padding) (toGrp grouping 3) (changePrec prec) |]
+ FixedF prec alt s -> [| formatAnyFractional $(withAlt alt Formatters.Fixed) s (newPadding padding) (toGrp grouping 3) (changePrec prec) |]
+ FixedCapsF prec alt s -> [| formatAnyFractional (Formatters.Upper $(withAlt alt Formatters.Fixed)) s (newPadding padding) (toGrp grouping 3) (changePrec prec) |]
+ PercentF prec alt s -> [| formatAnyFractional $(withAlt alt Formatters.Percent) s (newPadding padding) (toGrp grouping 3) (changePrec prec) |]
+
+ -- Default / String
+ DefaultF prec s -> [| \v ->
+ case categorise (Proxy :: Proxy $(typeAllowed)) v of
+ Integral i -> formatAnyIntegral Formatters.Decimal s (newPadding padding) (toGrp grouping 3) i
+ Fractional f -> formatAnyFractional Formatters.Generic s (newPadding padding) (toGrp grouping 3) (changePrec' prec) f
+ StringType f -> Formatters.formatString (newPaddingForString padding) (changePrec' prec) f
+ |]
+ where
+ typeAllowed :: Q Type
+ typeAllowed = case padding of
+ PaddingDefault -> [t| EnableForString |]
+ Padding _ Nothing -> [t| EnableForString |]
+ Padding _ (Just (_, AnyAlign a)) -> case Formatters.getAlignForString a of
+ Nothing -> [t| DisableForString |]
+ Just _ -> [t| EnableForString |]
+
+ StringF prec -> [| Formatters.formatString pad (changePrec' prec) |]
+ where pad = newPaddingForString padding
+
+newPaddingForString :: Padding -> Maybe (Int, Formatters.AlignMode 'Formatters.AlignAll, Char)
+newPaddingForString padding = case padding of
+ PaddingDefault -> Nothing
+ Padding i Nothing -> Just (fromIntegral i, Formatters.AlignLeft, ' ') -- default align left and fill with space for string
+ Padding i (Just (mc, AnyAlign a)) -> case Formatters.getAlignForString a of
+ Nothing -> error alignErrorMsg
+ Just al -> pure (fromIntegral i, al, fromMaybe ' ' mc)
+
+newPadding :: Padding -> Maybe (Integer, AnyAlign, Char)
+newPadding padding = case padding of
+ PaddingDefault -> Nothing
+ (Padding i al) -> case al of
+ Nothing -> Just (i, AnyAlign Formatters.AlignRight, ' ') -- Right align and space is default for any object, except string
+ Just (Nothing, a) -> Just (i, a, ' ')
+ Just (Just c, a) -> Just (i, a, c)
+
+formatAnyIntegral :: (Show i, Integral i) => Formatters.Format t t' 'Formatters.Integral -> Formatters.SignMode -> Maybe (Integer, AnyAlign, Char) -> Maybe (Int, Char) -> i -> String
+formatAnyIntegral f s Nothing grouping i = Formatters.formatIntegral f s Nothing grouping i
+formatAnyIntegral f s (Just (padSize, AnyAlign alignMode, c)) grouping i = Formatters.formatIntegral f s (Just (fromIntegral padSize, alignMode, c)) grouping i
+
+formatAnyFractional :: (RealFloat i) => Formatters.Format t t' 'Formatters.Fractional -> Formatters.SignMode -> Maybe (Integer, AnyAlign, Char) -> Maybe (Int, Char) -> Maybe Int -> i -> String
+formatAnyFractional f s Nothing grouping p i = Formatters.formatFractional f s Nothing grouping p i
+formatAnyFractional f s (Just (padSize, AnyAlign alignMode, c)) grouping p i = Formatters.formatFractional f s (Just (fromIntegral padSize, alignMode, c)) grouping p i
+
+data FormattingType where
+ StringType :: String -> FormattingType
+ Fractional :: RealFloat t => t -> FormattingType
+ Integral :: (Show t, Integral t) => t -> FormattingType
+
+class Categorise k t where
+ categorise :: Proxy k -> t -> FormattingType
+
+instance Categorise k Integer where categorise _ i = Integral i
+instance Categorise k Int where categorise _ i = Integral i
+instance Categorise k Int.Int8 where categorise _ i = Integral i
+instance Categorise k Int.Int16 where categorise _ i = Integral i
+instance Categorise k Int.Int32 where categorise _ i = Integral i
+instance Categorise k Int.Int64 where categorise _ i = Integral i
+
+instance Categorise k Natural where categorise _ i = Integral i
+instance Categorise k Word where categorise _ i = Integral i
+instance Categorise k Word.Word8 where categorise _ i = Integral i
+instance Categorise k Word.Word16 where categorise _ i = Integral i
+instance Categorise k Word.Word32 where categorise _ i = Integral i
+instance Categorise k Word.Word64 where categorise _ i = Integral i
+
+instance Categorise k Float where categorise _ f = Fractional f
+instance Categorise k Double where categorise _ f = Fractional f
+
+-- This may use DataKinds extension, however the need for the
+-- extension will leak inside the code calling the template haskell
+-- quasi quotes.
+data EnableForString
+data DisableForString
+
+instance Categorise EnableForString LText.Text where categorise _ t = StringType (LText.unpack t)
+instance Categorise EnableForString SText.Text where categorise _ t = StringType (SText.unpack t)
+instance Categorise EnableForString String where categorise _ t = StringType t
+
+alignErrorMsg :: String
+alignErrorMsg = "String Cannot be aligned with the inside `=` mode"
+
+instance TypeError ('Text "String Cannot be aligned with the inside `=` mode") => Categorise DisableForString LText.Text where categorise _ _ = error "unreachable"
+instance TypeError ('Text "String Cannot be aligned with the inside `=` mode") => Categorise DisableForString SText.Text where categorise _ _ = error "unreachable"
+instance TypeError ('Text "String Cannot be aligned with the inside `=` mode") => Categorise DisableForString String where categorise _ _ = error "unreachable"
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
index 0000000..963804f
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,186 @@
+{-# OPTIONS -Wno-type-defaults #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ExtendedDefaultRules #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+import Test.Hspec
+
+import PyF
+import SpecUtils
+
+{-
+ - Normal tests are done using the recommanded API: [fString|.....|]
+ - Test with $(checkExample formatString result) are checked against the python reference implementation. Result is provided as documentation.
+ - Test with $(checkExampleDiff formatString result) are not checked against the python reference implementation. This is known (and documented) differences.
+ - Test with $(check formatString) are only tested against the python reference implementation.
+-}
+
+main :: IO ()
+main = hspec spec
+
+spec :: Spec
+spec = do
+ describe "simple with external variable" $ do
+ let
+ anInt = 123
+ aFloat = 0.234
+ aString = "hello"
+ it "int" $ [fString|{anInt}|] `shouldBe` "123"
+ it "float" $ [fString|{aFloat}|] `shouldBe` "0.234"
+ it "string" $ [fString|{aString}|] `shouldBe` "hello"
+ describe "only expression" $ do
+ describe "default" $ do
+ it "int" $(checkExample "{123}" "123")
+ it "float" $(checkExample "{0.234}" "0.234")
+ it "string" $(checkExample "{\"hello\"}" "hello")
+ it "float precision" $(checkExample "{0.234:.1}" "0.2")
+ it "string precision" $(checkExample "{\"hello\":.1}" "h")
+ it "sign +" $(checkExample "{0.234:+}" "+0.234")
+ it "sign space" $(checkExample "{0.234: }" " 0.234")
+ it "sign neg" $(checkExample "{-123:+}" "-123")
+ describe "binary" $ do
+ it "simple" $(checkExample "{123:b}" "1111011")
+ it "alt" $(checkExample "{123:#b}" "0b1111011")
+ it "sign" $(checkExample "{123:+#b}" "+0b1111011")
+ describe "character" $ do
+ it "simple" $(checkExample "{123:c}" "{")
+ describe "decimal" $ do
+ it "simple" $(checkExample "{123:d}" "123")
+ it "sign" $(checkExample "{123:+d}" "+123")
+ describe "exponentiel" $ do
+ it "simple > 1" $(checkExample "{234.0:e}" "2.340000e+02")
+ it "precision > 1" $(checkExample "{234.0:.1e}" "2.3e+02")
+ it "simple < 1" $(checkExample "{0.234:e}" "2.340000e-01")
+ it "precision < 1 " $(checkExample "{0.234:.1e}" "2.3e-01")
+ describe "exponentiel caps" $ do
+ it "simple > 1" $(checkExample "{234.0:E}" "2.340000E+02")
+ it "precision > 1" $(checkExample "{234.0:.1E}" "2.3E+02")
+ it "simple < 1" $(checkExample "{0.234:E}" "2.340000E-01")
+ it "precision < 1 " $(checkExample "{0.234:.1E}" "2.3E-01")
+ describe "general" $ do
+ it "simple small" $(checkExampleDiff "{123.02:g}" "123.020000")
+ it "precision small" $(checkExampleDiff "{123.02:.1g}" "123.0")
+ it "simple big" $(checkExampleDiff "{1234567890.23:g}" "1.234568e+09")
+ it "precision big" $(checkExampleDiff "{1234567890.23:.1g}" "1.2e+09")
+ describe "general caps" $ do
+ it "simple small" $(checkExampleDiff "{123.02:G}" "123.020000")
+ it "precision small" $(checkExampleDiff "{123.02:.1G}" "123.0")
+ it "simple big" $(checkExampleDiff "{1234567890.23:G}" "1.234568E+09")
+ it "precision big" $(checkExampleDiff "{1234567890.23:.1G}" "1.2E+09")
+ describe "fixed" $ do
+ it "simple" $(checkExample "{0.234:f}" "0.234000")
+ it "precision" $(checkExample "{0.234:.1f}" "0.2")
+ describe "fixed caps" $ do
+ it "simple" $(checkExample "{0.234:F}" "0.234000")
+ it "precision" $(checkExample "{0.234:.1F}" "0.2")
+ describe "octal" $ do
+ it "simple" $(checkExample "{123:o}" "173")
+ it "alt" $(checkExample "{123:#o}" "0o173")
+ describe "string" $ do
+ it "string" $(checkExample "{\"hello\":s}" "hello")
+ it "precision" $(checkExample "{\"hello\":.2s}" "he")
+ describe "hex" $ do
+ it "simple" $(checkExample "{123:x}" "7b")
+ it "alt" $(checkExample "{123:#x}" "0x7b")
+ describe "hex caps" $ do
+ it "simple" $(checkExample "{123:X}" "7B")
+ it "alt" $(checkExample "{123:#X}" "0X7B")
+ describe "percent" $ do
+ it "simple" $(checkExample "{0.234:%}" "23.400000%")
+ it "precision" $(checkExample "{0.234:.2%}" "23.40%")
+ describe "padding" $ do
+ describe "default char" $ do
+ it "left" $(checkExample "{\"hello\":<10}" "hello ")
+ it "right" $(checkExample "{\"hello\":>10}" " hello")
+ it "center" $(checkExample "{\"hello\":^10}" " hello ")
+ describe "a char" $ do
+ it "left" $(checkExample "{\"hello\":-<10}" "hello-----")
+ it "right" $(checkExample "{\"hello\":->10}" "-----hello")
+ it "center" $(checkExample "{\"hello\":-^10}" "--hello---")
+ describe "inside" $ do
+ it "inside" $(checkExample "{123:=+10}" "+ 123")
+ it "inside" $(checkExample "{123:=10}" " 123")
+ it "inside" $(checkExample "{- 123:=10}" "- 123")
+ it "inside" $(checkExample "{- 123:|= 10}" "-||||||123")
+ it "inside" $(checkExample "{123:|= 10}" " ||||||123")
+ describe "default padding" $ do
+ it "floating" $(checkExample "{1:10f}" " 1.000000")
+ it "integral" $(checkExample "{1:10d}" " 1")
+ it "string" $(checkExample "{\"h\":10s}" "h ")
+ it "default" $(checkExample "{1:10}" " 1")
+ it "default" $(checkExample "{1.0:10}" " 1.0")
+ it "default" $(checkExample "{\"h\":10}" "h ")
+ describe "NaN" $ do
+ let nan = 0.0 / 0
+ it "nan" $(checkExample "{nan}" "nan")
+ it "nan f" $(checkExample "{nan:f}" "nan")
+ it "nan e" $(checkExample "{nan:e}" "nan")
+ it "nan g" $(checkExample "{nan:g}" "nan")
+ it "nan F" $(checkExample "{nan:F}" "NAN")
+ it "nan G" $(checkExample "{nan:G}" "NAN")
+ it "nan E" $(checkExample "{nan:E}" "NAN")
+ describe "Infinite" $ do
+ let inf = 1.0 / 0
+ it "infinite" $(checkExample "{inf}" "inf")
+ it "infinite f" $(checkExample "{inf:f}" "inf")
+ it "infinite e" $(checkExample "{inf:e}" "inf")
+ it "infinite g" $(checkExample "{inf:g}" "inf")
+ it "infinite F" $(checkExample "{inf:F}" "INF")
+ it "infinite G" $(checkExample "{inf:G}" "INF")
+ it "infinite E" $(checkExample "{inf:E}" "INF")
+ describe "Grouping" $ do
+ it "groups int" $(checkExample "{123456789:,d}" "123,456,789")
+ it "groups int with _" $(checkExample "{123456789:_d}" "123_456_789")
+ it "groups float" $(checkExample "{123456789.234:,f}" "123,456,789.234000")
+ it "groups bin" $(checkExample "{123456789:_b}" "111_0101_1011_1100_1101_0001_0101")
+ it "groups hex" $(checkExample "{123456789:_x}" "75b_cd15")
+ it "groups oct" $(checkExample "{123456789:_o}" "7_2674_6425")
+ describe "negative zero" $ do
+ it "f" $(checkExample "{-0.0:f}" "-0.000000")
+ it "e" $(checkExample "{-0.0:e}" "-0.000000e+00")
+ it "g" $(checkExampleDiff "{-0.0:g}" "-0.000000")
+ it "F" $(checkExample "{-0.0:F}" "-0.000000")
+ it "G" $(checkExampleDiff "{-0.0:G}" "-0.000000")
+ it "E" $(checkExample "{-0.0:E}" "-0.000000E+00")
+ describe "0" $ do
+ it "works" $(checkExample "{123:010}" "0000000123")
+ it "works with sign" $(checkExample "{-123:010}" "-000000123")
+ it "accept mode override" $(checkExample "{-123:<010}" "-123000000")
+ it "accept mode and char override" $(checkExample "{-123:.<010}" "-123......")
+
+ describe "no digit no dot" $ do
+ it "f" $(checkExample "{1.0:.0f}" "1")
+ it "e" $(checkExample "{1.0:.0e}" "1e+00")
+ it "g" $(checkExample "{1.0:.0g}" "1")
+ it "E" $(checkExample "{1.0:.0E}" "1E+00")
+ it "G" $(checkExample "{1.0:.0G}" "1")
+ it "percent" $(checkExample "{1.0:.0%}" "100%")
+ describe "no digit alt -> dot" $ do
+ it "f" $(checkExample "{1.0:#.0f}" "1.")
+ it "e" $(checkExample "{1.0:#.0e}" "1.e+00")
+ it "g" $(checkExample "{1.0:#.0g}" "1.")
+ it "E" $(checkExample "{1.0:#.0E}" "1.E+00")
+ it "G" $(checkExample "{1.0:#.0G}" "1.")
+ it "percent" $(checkExample "{1.0:#.0%}" "100.%")
+
+ describe "complex" $ do
+ it "works with many things at once" $
+ let
+ name = "Guillaume"
+ age = 31
+ euroToFrancs = 6.55957
+ in
+ [fString|hello {name} you are {age} years old and the conversion rate of euro is {euroToFrancs:.2}|] `shouldBe` ("hello Guillaume you are 31 years old and the conversion rate of euro is 6.56")
+
+
+ describe "error reporting" $ do
+ pure () -- TODO: find a way to test error reporting
+
+ describe "sub expressions" $ do
+ it "works" $ do
+ [fString|2pi = {2 * pi:.2}|] `shouldBe` "2pi = 6.28"
+
+ describe "escape strings" $ do
+ it "works" $ do
+ [fString|hello \n\b|] `shouldBe` "hello \n\b"