packages feed

PyF (empty) → 0.5.0.0

raw patch · 10 files changed

+1498/−0 lines, 10 filesdep +PyFdep +basedep +containerssetup-changed

Dependencies added: PyF, base, containers, formatting, haskell-src-meta, hspec, megaparsec, process, template-haskell, text

Files

+ ChangeLog.md view
@@ -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.
+ LICENSE view
@@ -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.
+ PyF.cabal view
@@ -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
+ Readme.md view
@@ -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.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/PyF.hs view
@@ -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)
+ src/PyF/Formatters.hs view
@@ -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'')
+ src/PyF/Internal/PythonSyntax.hs view
@@ -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
+ src/PyF/Internal/QQ.hs view
@@ -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"
+ test/Spec.hs view
@@ -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"