th-printf 0.5.1 → 0.6.0
raw patch · 22 files changed
+1422/−991 lines, 22 filesdep +microlens-platformdep +mtldep +parsecdep −ansi-wl-pprintdep −attoparsecdep −bytestringdep ~basesetup-changed
Dependencies added: microlens-platform, mtl, parsec, semigroups, th-lift
Dependencies removed: ansi-wl-pprint, attoparsec, bytestring, criterion, text, trifecta, utf8-string
Dependency ranges changed: base
Files
- LICENSE +17/−18
- Setup.hs +0/−2
- benchmark/benchmark.hs +0/−17
- parser/Parser.hs +144/−0
- parser/Parser/Types.hs +112/−0
- src/Language/Haskell/Printf.hs +100/−0
- src/Language/Haskell/Printf/Geometry.hs +61/−0
- src/Language/Haskell/Printf/Lib.hs +85/−0
- src/Language/Haskell/Printf/Printers.hs +149/−0
- src/Language/Haskell/PrintfArg.hs +24/−0
- src/NumUtils.hs +153/−0
- src/NumericUtils.hs +0/−162
- src/StrUtils.hs +15/−0
- src/Text/Printf/TH.hs +0/−201
- src/Text/Printf/TH/Parser.hs +0/−51
- src/Text/Printf/TH/Printer.hs +0/−216
- src/Text/Printf/TH/Printer/String.hs +0/−53
- src/Text/Printf/TH/Types.hs +0/−84
- tests/Codegen.hs +0/−120
- tests/GeneratedSpec.hs +452/−0
- tests/format.hs +36/−12
- th-printf.cabal +74/−55
LICENSE view
@@ -1,21 +1,20 @@-The MIT License (MIT)--Copyright (c) 2013 Joel Taylor+Copyright (c) 2018 Jude Taylor -Permission is hereby granted, free of charge, to any person obtaining a copy-of this software and associated documentation files (the "Software"), to deal-in the Software without restriction, including without limitation the rights-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell-copies of the Software, and to permit persons to whom the Software is-furnished to do so, subject to the following conditions:+Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions: -The above copyright notice and this permission notice shall be included in-all copies or substantial portions of the Software.+The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software. -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN-THE SOFTWARE.+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
− benchmark/benchmark.hs
@@ -1,17 +0,0 @@-{-# Language QuasiQuotes #-}--module Main- ( main- ) where--import Criterion-import Criterion.Main-import Text.Printf.TH--main :: IO ()-main =- defaultMain- [ env (pure ([s|test %50s|], [st|test %50s|])) $ \ ~(fs, ft) ->- bgroup "string" [bench "s" $ nf fs "foobar", bench "st" $ nf ft "foobar"]- , bgroup "int" [bench "s" $ nf [s|%010d|] 20, bench "st" $ nf [st|%010d|] 20]- ]
+ parser/Parser.hs view
@@ -0,0 +1,144 @@+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NoMonomorphismRestriction #-}++module Parser where++import Control.Applicative+import Control.Monad.Fix+import Control.Monad.RWS+import Data.Char+import Data.CharSet hiding (map)+import Data.Maybe+import qualified Data.Set as S+import Lens.Micro.Platform+import Parser.Types+import Text.Parsec hiding (many)+import Text.ParserCombinators.ReadP (readP_to_S)+import Text.Read.Lex (lexChar)++type Warning = String++parseStr :: String -> Either ParseError ([Atom], [[Warning]])+parseStr = fmap (unzip . map normalizeAndWarn) . parse printfStr "" . lexChars+ where+ lexChars x =+ (`fix` x) $ \f s ->+ if Prelude.null s+ then []+ else case readP_to_S lexChar s of+ ((c, rest):_) -> c : f rest+ [] -> error "malformed input"++normalizeAndWarn :: Atom -> (Atom, [Warning])+normalizeAndWarn s@Str {} = (s, [])+normalizeAndWarn (Arg f) = (Arg a, b)+ where+ (_, a, b) = runRWS (warnLength f >> go (spec f)) () f+ go c+ | c `elem` "aAeEfFgGxXo" = return ()+ go c+ | c `elem` "cs?" = warnSign >> warnPrefix >> warnZero >> warnSpace+ go c+ | c `elem` "diu" = warnPrefix+ go 'p' = warnSign >> warnPrefix >> warnZero+ go _ = undefined+ warnFlag ::+ (Eq a, MonadWriter [String] m, MonadState FormatArg m)+ => Lens' FlagSet a+ -> a+ -> a+ -> Char+ -> m ()+ warnFlag lens' bad good flagName = do+ oldVal <- use (flags_ . lens')+ when (oldVal == bad) $ do+ c <- use spec_+ flags_ . lens' .= good+ tell+ ["`" ++ [flagName] ++ "` flag has no effect on `" ++ [c] ++ "` specifier"]+ warnSign = warnFlag signed_ True False '+'+ warnPrefix = warnFlag prefixed_ True False '#'+ warnSpace = warnFlag spaced_ True False ' '+ warnZero = warnFlag adjustment_ (Just ZeroPadded) Nothing '0'+ phonyLengthSpec =+ S.fromList $ [(x, y) | x <- "diuoxX", y <- ["L"]] +++ [(x, y) | x <- "fFeEgGaA", y <- ["hh", "h", "l", "ll", "j", "z", "t"]] +++ [(x, y) | x <- "cs", y <- ["hh", "h", "ll", "j", "z", "t", "L"]] +++ map ((,) 'p') ["hh", "h", "l", "ll", "j", "z", "t", "L"]+ warnLength FormatArg {spec, lengthSpec = Just l}+ | (spec, show l) `S.member` phonyLengthSpec =+ tell+ [ "`" ++ show l ++ "` length modifier has no effect when combined with `" +++ [spec] +++ "` specifier"+ ]+ warnLength _ = return ()++flagSet :: CharSet+flagSet = fromList "-+ #0"++specSet :: CharSet+specSet = fromList "diuoxXfFeEaAgGpcs?"++lengthSpecifiers :: [(String, LengthSpecifier)]+lengthSpecifiers =+ [ ("hh", DoubleH)+ , ("h", H)+ , ("ll", DoubleL)+ , ("l", L)+ , ("j", J)+ , ("z", Z)+ , ("t", T)+ , ("L", BigL)+ ]++oneOfSet :: Stream s m Char => CharSet -> ParsecT s u m Char+oneOfSet s = satisfy (`member` s)++printfStr :: Stream s m Char => ParsecT s u m [Atom]+printfStr = do+ atoms <-+ many $+ choice [Str "%" <$ try (string "%%"), Arg <$> fmtArg, Str . return <$> noneOf "%"]+ return $ go atoms+ where+ go (Str s:Str s1:as) = go (Str (s ++ s1) : as)+ go (a:as) = a : go as+ go [] = []++fmtArg :: Stream s m Char => ParsecT s u m FormatArg+fmtArg = do+ char '%'+ flags <-+ do fs <-+ many $ do+ c <- oneOfSet flagSet <?> "flag"+ pure $+ case c of+ '-' -> FlagLJust+ '+' -> FlagSigned+ ' ' -> FlagSpaced+ '#' -> FlagPrefixed+ '0' -> FlagZeroPadded+ _ -> error "???"+ let flagSet' = S.fromList fs+ if S.size flagSet' < length fs+ then fail "Duplicate flags specified"+ else pure $ toFlagSet flagSet'+ width <- optionMaybe (choice [Given <$> nat, Need <$ char '*']) <?> "width"+ precision <-+ optionMaybe+ (do char '.'+ optionMaybe $ choice [Given <$> nat, Need <$ char '*']) <?>+ "precision"+ lengthSpec <-+ optionMaybe $ choice $ Prelude.map (\(a, b) -> b <$ string a) lengthSpecifiers+ spec <- oneOfSet specSet <?> "valid specifier"+ pure $ FormatArg flags width (fromMaybe (Given 0) <$> precision) spec lengthSpec+ where+ nat = do+ c <- many1 $ satisfy isDigit+ return (read c :: Integer)
+ parser/Parser/Types.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE NamedFieldPuns #-}++module Parser.Types where++import Data.Foldable (elem, notElem)+import qualified Data.Set as S+import Data.Set (Set)+import Language.Haskell.TH.Lift+import Lens.Micro.Platform+import Prelude hiding (elem, notElem)++data Atom+ = Arg FormatArg+ | Str String+ deriving (Show)++data LengthSpecifier+ = DoubleH+ | H+ | DoubleL+ | BigL+ | L+ | J+ | Z+ | T+ deriving (Eq)++instance Show LengthSpecifier where+ show DoubleH = "hh"+ show H = "h"+ show DoubleL = "ll"+ show BigL = "L"+ show L = "l"+ show J = "j"+ show Z = "z"+ show T = "t"++data Flag+ = FlagLJust+ | FlagSigned+ | FlagSpaced+ | FlagPrefixed+ | FlagZeroPadded+ deriving (Show, Eq, Ord)++adjustmentFlags :: Set Flag+adjustmentFlags = S.fromList [FlagLJust, FlagZeroPadded]++data Adjustment+ = LeftJustified+ | ZeroPadded+ deriving (Show, Eq)++data MaySpecify+ = Given Integer+ | Need+ deriving (Show)++data FormatArg = FormatArg+ { flags :: FlagSet+ , width :: Maybe MaySpecify+ , precision :: Maybe MaySpecify+ , spec :: Char+ , lengthSpec :: Maybe LengthSpecifier+ } deriving (Show)++type FormatStr = [Atom]++data FlagSet = FlagSet+ { adjustment :: Maybe Adjustment+ , signed :: Bool+ , spaced :: Bool+ , prefixed :: Bool+ } deriving (Show)++emptyFlagSet :: FlagSet+emptyFlagSet = FlagSet Nothing False False False++toFlagSet :: Set Flag -> FlagSet+toFlagSet fs = set'+ where+ adjustment+ | FlagLJust `S.member` fs = Just LeftJustified+ | FlagZeroPadded `S.member` fs = Just ZeroPadded+ | otherwise = Nothing+ set' =+ FlagSet+ { signed = FlagSigned `elem` fs+ , prefixed = FlagPrefixed `elem` fs+ , adjustment+ , spaced = FlagSpaced `elem` fs && FlagSigned `notElem` fs+ }++makeLensesFor+ [ ("adjustment", "adjustment_")+ , ("signed", "signed_")+ , ("spaced", "spaced_")+ , ("prefixed", "prefixed_")+ ]+ ''FlagSet++makeLensesFor+ [ ("flags", "flags_")+ , ("width", "width_")+ , ("precision", "precision_")+ , ("spec", "spec_")+ , ("lengthSpec", "lengthSpec_")+ ]+ ''FormatArg++deriveLiftMany [''Adjustment, ''FlagSet, ''LengthSpecifier]
+ src/Language/Haskell/Printf.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}++module Language.Haskell.Printf+ ( s+ , p+ , hp+ ) where++import Control.Applicative (pure)+import Control.Monad.IO.Class+import Language.Haskell.Printf.Lib+import Language.Haskell.TH.Lib+import Language.Haskell.TH.Quote+import Language.Haskell.TH.Syntax+import System.IO (hPutStr, stdout)++-- | @+-- ['s'|Hello, %s! (%d people greeted)|] :: ... -> 'String'+-- @+--+-- This formatter follows the guidelines listed+-- <http://www.cplusplus.com/reference/cstdio/printf/ here>, except for+-- @%n@ (store number of printed characters) for obvious+-- reasons.+--+-- @+-- %c :: 'Char'+-- %s :: 'String'+--+-- -- datatypes with Show instances+-- %? :: 'Show' a => a+--+-- -- signed integer types+-- %d, %i :: 'Integral' i => i+--+-- -- unsigned integer types+-- %u :: ('Bounded' i, 'Integral' i) => i+-- %o :: ('Bounded' i, 'Integral' i) => i+-- %x, %X :: ('Bounded' i, 'Integral' i) => i+--+-- -- floats+-- %a, %A :: 'RealFloat' f => f+-- %e, %E :: 'RealFloat' f => f+-- %f, %F :: 'RealFloat' f => f+-- %g, %G :: 'RealFloat' f => f+--+-- %p :: 'Foreign.Ptr.Ptr' a+-- @+--+-- N.B.: For consistency with other @printf@ implementations, arguments formatted as+-- unsigned integer types will \"underflow\" if negative.+s :: QuasiQuoter+s =+ quoter+ { quoteExp =+ \s' -> do+ (lhss, rhs) <- toSplices s'+ return $ LamE lhss rhs+ }++-- | Like 's', but prints the resulting string to @stdout@.+--+-- @+-- [p|Hello, %s! (%d people greeted)|] :: 'MonadIO' m => ... -> m ()+-- @+p :: QuasiQuoter+p =+ quoter+ { quoteExp =+ \s' -> do+ (lhss, rhs) <- toSplices s'+ lamE (map pure lhss) [|liftIO (hPutStr stdout $(pure rhs))|]+ }++-- | Like 'p', but takes as its first argument the 'System.IO.Handle' to print to.+--+-- @+-- [hp|Hello, %s! (%d people greeted)|] :: 'MonadIO' m => 'System.IO.Handle' -> ... -> m ()+-- @+hp :: QuasiQuoter+hp =+ quoter+ { quoteExp =+ \s' -> do+ (lhss, rhs) <- toSplices s'+ h <- newName "h"+ lamE (varP h : map pure lhss) [|liftIO (hPutStr $(varE h) $(pure rhs))|]+ }++quoter :: QuasiQuoter+quoter =+ QuasiQuoter+ { quoteExp = undefined+ , quotePat = error "this quoter cannot be used in a pattern context"+ , quoteType = error "this quoter cannot be used in a type context"+ , quoteDec = error "this quoter cannot be used in a declaration context"+ }
+ src/Language/Haskell/Printf/Geometry.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}++module Language.Haskell.Printf.Geometry where++import Control.Applicative ((<$>))+import Control.Monad+import Data.Maybe+import Data.Monoid (mempty)+import Data.Semigroup ((<>))+import Language.Haskell.PrintfArg+import Parser.Types (Adjustment(..))+import StrUtils++data Value = Value+ { valArg :: PrintfArg String+ , valPrefix :: Maybe String+ , valSign :: Maybe String+ } deriving (Show)++sign' :: (Num n, Ord n) => PrintfArg n -> Maybe String+sign' pf+ | value pf < 0 = Just "-"+ | spaced pf = Just " "+ | signed pf = Just "+"+ | otherwise = Nothing++padDecimal :: (Eq v, Num v) => PrintfArg v -> String -> String+padDecimal spec+ | prec spec == Just 0 && value spec == 0 = const ""+ | otherwise = maybe id (`justifyRight` '0') (prec spec)++prefix :: (Num n, Eq n) => String -> PrintfArg n -> Maybe String+prefix s pf = guard (prefixed pf && value pf /= 0) >> Just s++fromPrintfArg ::+ (n -> String)+ -> (PrintfArg n -> Maybe String)+ -> (PrintfArg n -> Maybe String)+ -> PrintfArg n+ -> Value+fromPrintfArg f b c a = Value (f <$> a) (b a) (c a)++formatOne :: Value -> String+formatOne Value {..}+ | Nothing <- width valArg = prefix' <> text+ | Just w <- width valArg =+ case adjustment valArg of+ Just ZeroPadded+ | isn'tDecimal || isNothing (prec valArg) ->+ prefix' <> justifyRight (w - length prefix') ('0') text+ Just LeftJustified -> justifyLeft w ' ' (prefix' <> text)+ _ -> justify' w (prefix' <> text)+ | otherwise = error "unreachable"+ where+ isn'tDecimal = fieldSpec valArg `notElem` ("diouxX" :: String)+ justify' n+ | n < 0 = justifyLeft (abs n) ' '+ | otherwise = justifyRight n ' '+ prefix' = fromMaybe mempty valSign <> fromMaybe mempty valPrefix+ text = value valArg
+ src/Language/Haskell/Printf/Lib.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE TemplateHaskell #-}++module Language.Haskell.Printf.Lib+ ( toSplices+ ) where++import Control.Applicative ((<$>), pure)+import Data.Maybe+import Data.Semigroup ((<>))+import Data.String (fromString)+import Language.Haskell.Printf.Geometry (formatOne)+import qualified Language.Haskell.Printf.Printers as Printers+import Language.Haskell.PrintfArg+import Language.Haskell.TH+import Language.Haskell.TH.Syntax+import Parser (parseStr)+import Parser.Types hiding (lengthSpec, width)++-- | Takes a format string as input and produces a tuple @(args, outputExpr)@.+--+-- This function processes character escapes as they would appear in Haskell source code.+-- It will emit warnings (or throw an error, as appropriate) when given an invalid format+-- string.+--+-- Use if you wish to leverage @th-printf@ in conjunction with, for example, an existing+-- logging library.+toSplices :: String -> Q ([Pat], Exp)+toSplices s' =+ case parseStr s' of+ Left x -> fail $ show x+ Right (y, warns) -> do+ mapM_ (qReport False) (concat warns)+ (lhss, rhss) <- unzip <$> mapM extractExpr y+ rhss' <- foldr1 (\x y' -> infixApp x [|(<>)|] y') rhss+ return (map VarP $ concat lhss, rhss')++extractExpr :: Atom -> Q ([Name], ExpQ)+extractExpr (Str s') = return ([], [|fromString $(stringE s')|])+extractExpr (Arg (FormatArg flags' width' precision' spec' lengthSpec')) = do+ (warg, wexp) <- extractArgs width'+ (parg, pexp) <- extractArgs precision'+ varg <- newName "arg"+ return+ ( catMaybes [warg, parg, Just varg]+ , appE+ [|formatOne|]+ (appE+ formatter+ [|PrintfArg+ { flagSet = $(lift flags')+ , width = $(wexp)+ , prec = $(pexp)+ , value = $(varE varg)+ , lengthSpec = $(lift lengthSpec')+ , fieldSpec = $(lift spec')+ }|]))+ where+ extractArgs n =+ case n of+ Just Need -> do+ a <- newName "arg"+ pure (Just a, [|Just (fromInteger (fromIntegral $(varE a)))|])+ Just (Given n') -> pure (Nothing, [|Just $(litE $ integerL n')|])+ Nothing -> pure (Nothing, [|Nothing|])+ formatter =+ case spec' of+ 's' -> [|Printers.printfString|]+ '?' -> [|Printers.printfShow|]+ 'd' -> [|Printers.printfDecimal|]+ 'i' -> [|Printers.printfDecimal|]+ 'p' -> [|Printers.printfPtr|]+ 'c' -> [|Printers.printfChar|]+ 'u' -> [|Printers.printfUnsigned|]+ 'x' -> [|Printers.printfHex False|]+ 'X' -> [|Printers.printfHex True|]+ 'o' -> [|Printers.printfOctal|]+ 'f' -> [|Printers.printfFloating False|]+ 'F' -> [|Printers.printfFloating True|]+ 'e' -> [|Printers.printfScientific False|]+ 'E' -> [|Printers.printfScientific True|]+ 'g' -> [|Printers.printfGeneric False|]+ 'G' -> [|Printers.printfGeneric True|]+ 'a' -> [|Printers.printfFloatHex False|]+ 'A' -> [|Printers.printfFloatHex True|]+ _ -> undefined
+ src/Language/Haskell/Printf/Printers.hs view
@@ -0,0 +1,149 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE OverloadedStrings #-}++module Language.Haskell.Printf.Printers where++import Control.Applicative ((<$>), pure)+import Data.Char+import Data.List+import Data.String (fromString)+import Foreign.Ptr+import GHC.Float (FFFormat(..))+import Language.Haskell.Printf.Geometry+import Language.Haskell.PrintfArg+import NumUtils+import qualified Parser.Types as P++type Printer n = PrintfArg n -> Value++printfString :: Printer String+printfString spec =+ Value+ { valArg =+ case prec spec of+ Nothing -> spec+ Just c -> take c <$> spec+ , valPrefix = Nothing+ , valSign = Nothing+ }++printfShow :: Show a => Printer a+printfShow spec = printfString (fromString . show <$> spec)++printfChar :: Printer Char+printfChar spec = Value {valArg = pure <$> spec, valPrefix = Nothing, valSign = Nothing}++printfPtr :: Printer (Ptr a)+printfPtr spec =+ Value+ { valArg =+ PrintfArg+ { width = width spec+ , prec = Nothing+ , flagSet = P.emptyFlagSet {P.prefixed = True}+ , lengthSpec = Nothing+ , fieldSpec = 'p'+ , value = showIntAtBase 16 intToDigit (toInt $ value spec)+ }+ , valPrefix = Just "0x"+ , valSign = Nothing+ }+ where+ toInt x = x `minusPtr` nullPtr++printfDecimal spec =+ Value+ { valArg = padDecimal spec . showIntAtBase 10 intToDigit . abs <$> spec+ , valPrefix = Nothing+ , valSign = sign' spec+ }++fmtUnsigned ::+ forall a. (Bounded a, Integral a)+ => (Integer -> String)+ -> (PrintfArg a -> Maybe String)+ -> Printer a+fmtUnsigned shower p spec =+ Value+ { valArg = padDecimal spec . shower . clamp <$> spec+ , valPrefix = p spec+ , valSign = Nothing+ }+ where+ lb = minBound :: a+ clamp :: a -> Integer+ clamp x+ | x < 0 = toInteger x + (-2 * toInteger lb)+ | otherwise = toInteger x++printfHex b =+ fmtUnsigned+ showHex+ (prefix+ (if b+ then "0X"+ else "0x"))+ where+ showHex =+ showIntAtBase+ 16+ ((if b+ then toUpper+ else id) .+ intToDigit)++printfUnsigned = fmtUnsigned (showIntAtBase 10 intToDigit) (const Nothing)++printfOctal spec+ | "0" `isPrefixOf` value valArg = v+ | otherwise = v {valPrefix = prefix "0" spec}+ where+ v@Value {..} = fmtUnsigned (showIntAtBase 8 intToDigit) (const Nothing) spec++printfFloating upperFlag spec =+ Value {valArg = showFloat . abs <$> spec, valPrefix = Nothing, valSign = sign' spec}+ where+ precision =+ case prec spec of+ Just n -> Just (fromIntegral n)+ Nothing+ | Just P.ZeroPadded <- adjustment spec -> Just 6+ _ -> Nothing+ showFloat = formatRealFloatAlt FFFixed precision (prefixed spec) upperFlag++printfScientific upperFlag spec =+ Value {valArg = showSci . abs <$> spec, valPrefix = Nothing, valSign = sign' spec}+ where+ showSci =+ formatRealFloatAlt+ FFExponent+ (fromIntegral <$> prec spec)+ (prefixed spec)+ upperFlag++printfGeneric upperFlag spec =+ Value {valArg = showSci . abs <$> spec, valPrefix = Nothing, valSign = sign' spec}+ where+ showSci =+ formatRealFloatAlt+ FFGeneric+ (fromIntegral <$> prec spec)+ (prefixed spec)+ upperFlag++printfFloatHex upperFlag spec =+ Value+ { valArg = showHexFloat . abs <$> spec+ , valPrefix =+ Just+ (if upperFlag+ then "0X"+ else "0x")+ , valSign = sign' spec+ }+ where+ showHexFloat = formatHexFloat (fromIntegral <$> prec spec) (prefixed spec) upperFlag
+ src/Language/Haskell/PrintfArg.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE DeriveFunctor #-}++module Language.Haskell.PrintfArg where++import qualified Parser.Types as P++data PrintfArg v = PrintfArg+ { flagSet :: P.FlagSet+ , width :: Maybe Int+ , prec :: Maybe Int+ , lengthSpec :: Maybe P.LengthSpecifier+ , fieldSpec :: Char+ , value :: v+ } deriving (Show, Functor)++adjustment :: PrintfArg v -> Maybe P.Adjustment+adjustment = P.adjustment . flagSet++signed, spaced, prefixed :: PrintfArg v -> Bool+signed = P.signed . flagSet++spaced = P.spaced . flagSet++prefixed = P.prefixed . flagSet
+ src/NumUtils.hs view
@@ -0,0 +1,153 @@+{-# OPTIONS_GHC -fno-warn-dodgy-imports #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE OverloadedStrings #-}++module NumUtils where++import Control.Applicative (pure)+import Data.Bits+import Data.Char+import Data.Foldable+import Data.Ord+import Data.Semigroup ((<>))+import Data.String (fromString)+import Data.Tuple+import GHC.Base hiding ((<>), foldr)+import GHC.Float (FFFormat(..), roundTo)+import Numeric (floatToDigits)+import Prelude hiding (exp, foldr)+import StrUtils++showIntAtBase :: (Show a, Integral a) => a -> (Int -> Char) -> a -> String+showIntAtBase base toChr n0+ | base <= 1 = error "unsupported base"+ | n0 < 0 = error $ "negative number " ++ show n0+ | otherwise = showIt (quotRem n0 base) ""+ where+ showIt (n, d) r =+ case n of+ 0 -> r'+ _ -> showIt (quotRem n base) r'+ where+ c = id (toChr (fromIntegral d))+ r' = (:) c r++formatRealFloatAlt :: RealFloat a => FFFormat -> Maybe Int -> Bool -> Bool -> a -> String+formatRealFloatAlt fmt decs forceDot upper x+ | isNaN x = "NaN"+ | isInfinite x =+ if x < 0+ then "-Infinity"+ else "Infinity"+ | x < 0 || isNegativeZero x = (:) (id '-') (doFmt fmt (floatToDigits 10 (-x)) False)+ | otherwise = doFmt fmt (floatToDigits 10 x) False+ where+ eChar+ | upper = id 'E'+ | otherwise = id 'e'+ doFmt FFFixed (digs, exp) fullRounding+ | exp < 0 = doFmt FFFixed (replicate (negate exp) 0 ++ digs, 0) fullRounding+ | null part =+ fromDigits False whole <>+ (if forceDot+ then "."+ else "")+ | null whole = "0." <> fromDigits False part+ | otherwise = fromDigits False whole <> "." <> fromDigits False part+ where+ (whole, part) =+ uncurry (flip splitAt) (toRoundedDigits decs (digs, exp) fullRounding)+ doFmt FFExponent ([0], _) _+ | forceDot = "0.e+00"+ | otherwise = "0e+00"+ doFmt FFExponent (digs, exp) fullRounding = shownDigs <> (:) eChar shownExponent+ where+ shownDigs =+ case digs' of+ [] -> undefined+ [x'] ->+ pure (id (intToDigit x')) <>+ (if forceDot+ then "."+ else "")+ (x':xs) -> (:) (id (intToDigit x')) ((:) (id '.') (fromDigits False xs))+ digs' =+ case decs of+ Just n ->+ case roundTo+ 10+ (if fullRounding+ then min (length digs) n+ else n + 1)+ digs of+ (1, xs) -> 1 : xs+ (_, ys) -> ys+ Nothing -> digs+ exp' = exp - 1+ shownExponent =+ (:)+ (id $+ if exp' < 0+ then '-'+ else '+') $+ justifyRight 2 (id '0') $ showIntAtBase 10 intToDigit $ abs exp'+ doFmt FFGeneric d _ =+ minimumBy (comparing length) [doFmt FFFixed d True, doFmt FFExponent d True]++toRoundedDigits :: Maybe Int -> ([Int], Int) -> Bool -> ([Int], Int)+toRoundedDigits Nothing (digs, exp) _ = (digs, exp)+toRoundedDigits (Just prec) (digs, exp) fullRounding = (digs', exp + overflow)+ where+ (overflow, digs') =+ roundTo+ 10+ (if fullRounding && prec > exp+ then min (length digs) prec+ else prec + exp)+ digs++fromDigits :: Bool -> [Int] -> String+fromDigits upper =+ foldr+ ((:) .+ id .+ (if upper+ then toUpper+ else id) .+ intToDigit)+ []++formatHexFloat :: RealFloat a => Maybe Int -> Bool -> Bool -> a -> String+formatHexFloat decs alt upper x = doFmt (floatToDigits 2 x)+ where+ pChar+ | upper = id 'P'+ | otherwise = id 'p'+ doFmt ([], _) = undefined+ doFmt ([0], 0) = "0" <> pure pChar <> "+0"+ doFmt (_:bits, exp) =+ fromString (show (1 + overflow)) <>+ (if not (null hexDigits) || alt+ then "."+ else "") <>+ fromDigits upper hexDigits <>+ pure pChar <>+ (if exp > 0+ then "+"+ else "") <>+ fromString (show (exp - 1))+ where+ hexDigits' = go bits+ (overflow, hexDigits) =+ case decs of+ Just n ->+ case roundTo 16 n hexDigits' of+ (1, _:digs) -> (1, digs)+ x' -> x'+ Nothing -> (0, hexDigits')+ go (a:b:c:d:xs) =+ ((a `shiftL` 3) .|. (b `shiftL` 2) .|. (c `shiftL` 1) .|. d) : go xs+ go [a, b, c] = go [a, b, c, 0]+ go [a, b] = go [a, b, 0, 0]+ go [a] = go [a, 0, 0, 0]+ go [] = []
− src/NumericUtils.hs
@@ -1,162 +0,0 @@-{-# Language MagicHash #-}--module NumericUtils- ( module NumericUtils- , intToDigit- , FFFormat(..)- ) where--import Data.Char-import Data.Foldable-import Data.Ord-import GHC.Base-import GHC.Float (FFFormat(..), roundTo)-import Numeric (floatToDigits)-import Text.Printf.TH.Printer--intToDigitUpper :: Int -> Char-intToDigitUpper (I# i)- | isTrue# (i >=# 0#) && isTrue# (i <=# 9#) = unsafeChr (ord '0' + I# i)- | isTrue# (i >=# 10#) && isTrue# (i <=# 15#) = unsafeChr (ord 'A' + I# i - 10)- | otherwise = error ("Char.intToDigit: not a digit " ++ show (I# i))--showIntAtBase :: (Integral i, Monoid b, Printer b) => i -> (Int -> Char) -> i -> b-showIntAtBase base toB n0 = showIt (quotRem n0 base) mempty- where- showIt (n, d) r =- case n of- 0 -> r'- _ -> showIt (quotRem n base) r'- where- r' = cons (toB $ fromIntegral d) r---- based on GHC.Float.formatRealFloatAlt, except this adds an uppercasing--- flag and "fixes" (imo) the (Just 0) precision case-formatRealFloatAlt :: RealFloat a => FFFormat -> Maybe Int -> Bool -> Bool -> a -> String-formatRealFloatAlt fmt decs alt upper x- | isNaN x = "NaN"- | isInfinite x =- if x < 0- then "-Infinity"- else "Infinity"- | x < 0 || isNegativeZero x = '-' : doFmt fmt (floatToDigits base (-x))- | otherwise = doFmt fmt (floatToDigits base x)- where- eChar- | upper = 'E'- | otherwise = 'e'- base = 10- doFmt format (is, e) =- let ds = map intToDigit is- in case format of- FFGeneric ->- minimumBy- (comparing length)- [doFmt FFExponent (is, e), doFmt FFFixed (is, e)]- FFExponent ->- case decs of- Nothing ->- let show_e' = show (e - 1)- in case ds of- "0" -> "0.0" ++ (eChar : "0")- [d] -> d : ".0" ++ [eChar] ++ show_e'- (d:ds') -> d : '.' : ds' ++ [eChar] ++ show_e'- [] -> error "formatRealFloat/doFmt/FFExponent: []"- Just dec ->- let dec' = max dec 0- in case is of- [0] ->- (if dec' == 0- then "0"- else "0.") ++- take dec' (repeat '0') ++ (eChar : "0")- _ ->- let (ei, is') = roundTo base (dec' + 1) is- (d:ds') =- map- intToDigit- (if ei > 0- then init is'- else is')- in (if null ds' && not alt- then [d]- else d : ".") ++- ds' ++ eChar : show (e - 1 + ei)- FFFixed ->- let mk0 ls =- case ls of- "" -> "0"- _ -> ls- in case decs of- Nothing- | e <= 0 -> "0." ++ replicate (-e) '0' ++ ds- | otherwise ->- let f 0 s rs = mk0 (reverse s) ++ '.' : mk0 rs- f n s "" = f (n - 1) ('0' : s) ""- f n s (r:rs) = f (n - 1) (r : s) rs- in f e "" ds- Just dec ->- let dec' = max dec 0- in if e >= 0- then let (ei, is') = roundTo base (dec' + e) is- (ls, rs) =- splitAt (e + ei) (map intToDigit is')- in mk0 ls ++- (if null rs && not alt- then ""- else '.' : rs)- else let (ei, is') =- roundTo- base- dec'- (replicate (-e) 0 ++ is)- d:ds' =- map- intToDigit- (if ei > 0- then is'- else 0 : is')- in d :- (if null ds' && not alt- then ""- else '.' : ds')---- we don't add 0x here because it's handled by the formatter-formatFloatHex :: RealFloat a => Maybe Int -> Bool -> Bool -> a -> String-formatFloatHex decs alt upper x = doFmt (floatToDigits 2 x)- where- pChar- | upper = 'P'- | otherwise = 'p'- round' =- case decs of- Just d ->- \x ->- let (a, b) = roundTo 16 d x- in ( intToDigit (a + 1)- , if a > 0- then tail b- else b)- Nothing -> \x -> ('1', x)- doFmt ([0], 0) = "0" ++ [pChar] ++ "+0"- doFmt ((_:bits), exp) =- first :- (if null digs && not alt- then ""- else ".") ++- map- (if upper- then intToDigitUpper- else intToDigit)- digs ++- [pChar] ++- (if exp >= 1- then "+"- else "") ++- show (exp - 1)- where- (first, digs) = round' $ go bits- go (a:b:c:d:xs) = foldl (\a b -> 2 * a + b) 0 [a, b, c, d] : go xs- go [] = []- go ys = go (take 4 $ ys ++ repeat 0)- doFmt _ = error "nonsense"
+ src/StrUtils.hs view
@@ -0,0 +1,15 @@+module StrUtils where++justifyLeft :: Int -> Char -> String -> String+justifyLeft n c s+ | diff <= 0 = s+ | otherwise = s ++ replicate diff c+ where+ diff = n - length s++justifyRight :: Int -> Char -> String -> String+justifyRight n c s+ | diff <= 0 = s+ | otherwise = replicate diff c ++ s+ where+ diff = n - length s
− src/Text/Printf/TH.hs
@@ -1,201 +0,0 @@-{-# Language CPP #-}-{-# Language DeriveDataTypeable #-}-{-# Language FlexibleInstances #-}-{-# Language QuasiQuotes #-}-{-# Language RecordWildCards #-}-{-# Language ScopedTypeVariables #-}-{-# Language TemplateHaskell #-}-{-# Language TupleSections #-}--module Text.Printf.TH- ( -- * Formatting strings- s- , st- , sb- -- * Printing strings- , hp- , p- ) where--import Control.Exception (Exception, throw)-import Control.Monad.IO.Class-import Data.ByteString.UTF8 (fromString)-import Data.Maybe-import Data.Proxy (Proxy(..))-import Data.Text (pack)-import Language.Haskell.TH-import Language.Haskell.TH.Quote-import Language.Haskell.TH.Syntax-import System.IO-import Text.PrettyPrint.ANSI.Leijen as Pretty hiding ((<$>), (<>), empty, line)-import Text.Trifecta--import Text.Printf.TH.Parser-import Text.Printf.TH.Printer-import Text.Printf.TH.Printer.String ()-import Text.Printf.TH.Types--data ParseError =- ParseError- deriving (Show)--instance Exception ParseError---- * Formatting strings--- | @--- ['s'|Hello, %s! (%d people greeted)|] :: ... -> String--- @------ This formatter follows the guidelines listed--- <http://www.cplusplus.com/reference/cstdio/printf/ here>, except for--- @%n@ (store number of printed characters) for obvious--- reasons.------ @--- %c :: 'Char'--- %s :: 'String'------ %? :: 'Show' a => a------ %u :: 'Numeric.Natural.Natural'------ %d, %i :: 'Integral' i => i--- %o :: 'Integral' i => i--- %x, %X :: 'Integral' i => i------ %a, %A :: 'RealFloat' f => f--- %e, %E :: 'RealFloat' f => f--- %f, %F :: 'RealFloat' f => f--- %g, %G :: 'RealFloat' f => f------ %p :: 'Foreign.Ptr.Ptr' a--- @-s :: QuasiQuoter-s = quoter 'id---- | @--- ['st'|Hello, %s! (%d people greeted)|] :: ... -> 'Data.Text.Text'--- @-st :: QuasiQuoter-st = quoter 'pack---- | @--- ['sb'|Hello, %s! (%d people greeted)|] :: ... -> 'Data.ByteString.ByteString'--- @------ The resulting string is UTF8-encoded.-sb :: QuasiQuoter-sb = quoter 'fromString---- | @--- ['hp'|Hello, %s! (%d people greeted)|] :: 'MonadIO' m => 'Handle' -> ... -> m ()--- @------ Prints the produced string to the provided 'Handle'. Like C printf, newline is not--- appended.-hp :: QuasiQuoter-hp =- QuasiQuoter- { quoteExp =- \s -> do- LamE pats body <- parse 'id s- arg <- newName "arg"- ps <- [|liftIO . hPutStr $(varE arg)|]- pure $ LamE ((VarP arg) : pats) $ AppE ps body- , quotePat = error "printf cannot be used in a pattern context"- , quoteType = error "printf cannot be used in a type context"- , quoteDec = error "printf cannot be used in a decl context"- }---- | @--- ['p'|Hello, %s! (%d people greeted)|] :: 'MonadIO' m => ... -> m ()--- @------ @--- [p|...|] arg1 arg2...--- @------ is equivalent to------ @--- [hp|...|] 'System.IO.stdout' arg1 arg2...--- @-p :: QuasiQuoter-p =- QuasiQuoter- { quoteExp =- \s -> do- LamE pats body <- parse 'id s- ps <- [|liftIO . putStr|]- pure $ LamE pats $ AppE ps body- , quotePat = error "printf cannot be used in a pattern context"- , quoteType = error "printf cannot be used in a type context"- , quoteDec = error "printf cannot be used in a decl context"- }--quoter f =- QuasiQuoter- { quoteExp = parse f- , quotePat = error "printf cannot be used in a pattern context"- , quoteType = error "printf cannot be used in a type context"- , quoteDec = error "printf cannot be used in a decl context"- }--parse f s =- case parseString parseFmtStr mempty s of- Success fmtStr -> build f ''String fmtStr- Failure xs -> do- runIO $ displayIO stderr $ renderPretty 0.8 80 $ _errDoc xs- throw ParseError--build f outputType fmtStr = do- pairs <- mapM mkExpr fmtStr- let (args, exprs) = unzip pairs- lamE (map varP $ concat args) $- appE (varE f) $- appsE [[|finalize|], [|Proxy :: Proxy $(conT outputType)|], listE exprs]--mkExpr (Str s) = pure ([] :: [Name], [|valOf (literal $(stringE s))|])-mkExpr (Arg (FormatArg flags width precision spec)) = do- (warg, wexp) <- extractArgs width- (parg, pexp) <- extractArgs precision- varg <- newName "arg"- pure- ( catMaybes [warg, parg, Just varg]- , appE- formatter- [|ArgSpec- { flagSet = $(lift flags)- , width = $(wexp)- , prec = $(pexp)- , value = $(varE varg)- }|])- where- extractArgs n =- case n of- Just Need -> do- a <- newName "arg"- pure (Just a, [|Just $(varE a)|])- Just (Given n) -> pure (Nothing, [|Just $(litE $ integerL n)|])- Nothing -> pure (Nothing, [|Nothing|])- formatter =- case spec of- x- | x `elem` "id" -> [|formatDec|]- 'u' -> [|formatNat|]- 'o' -> [|formatOct|]- 'x' -> [|formatHex|]- 'X' -> [|formatHexUpper|]- 's' -> [|formatStr|]- 'f' -> [|formatFloat|]- 'F' -> [|formatFloat|]- 'a' -> [|formatHexFloat|]- 'A' -> [|formatHexFloatUpper|]- 'e' -> [|formatSci|]- 'E' -> [|formatSciUpper|]- 'g' -> [|formatG|]- 'G' -> [|formatGUpper|]- 'p' -> [|formatPtr|]- 'c' -> [|formatChar|]- '?' -> [|formatShowable|]- _ -> error "???"
− src/Text/Printf/TH/Parser.hs
@@ -1,51 +0,0 @@-{-# Language NoMonomorphismRestriction #-}--module Text.Printf.TH.Parser where--import Control.Applicative-import Data.CharSet (fromList)-import Text.Trifecta-import qualified Data.Set as S--import Text.Printf.TH.Types--flagSet = fromList "-+ #0"--specSet = fromList "diuoxXfFeEaAgGpcs?"--parseFmtStr = do- atoms <-- many $- choice [Str "%" <$ string "%%", Arg <$> fmtArg, Str . return <$> noneOf "%"]- return $ go atoms- where- go (Str s:Str s1:as) = go (Str (s ++ s1) : as)- go (a:as) = a : go as- go [] = []--fmtArg = do- char '%'- flags <-- do fs <-- many $ do- c <- oneOfSet flagSet <?> "flag"- pure $- case c of- '-' -> FlagLJust- '+' -> FlagSigned- ' ' -> FlagSpaced- '#' -> FlagPrefixed- '0' -> FlagZeroPadded- _ -> error "???"- let flagSet = S.fromList fs- if S.size flagSet < length fs- then fail "Duplicate flags specified"- else pure $ toFlagSet flagSet- width <- optional $ choice [Given <$> natural, Need <$ char '*'] <?> "width"- precision <-- optional $- (do char '.'- choice [Given <$> natural, Need <$ char '*']) <?>- "precision"- spec <- oneOfSet specSet <?> "valid specifier"- pure $ FormatArg flags width precision spec
− src/Text/Printf/TH/Printer.hs
@@ -1,216 +0,0 @@-{-# Language RecordWildCards #-}-{-# Language DefaultSignatures #-}-{-# Language OverloadedStrings #-}-{-# Language NamedFieldPuns #-}-{-# Language FlexibleContexts #-}-{-# Language FlexibleInstances #-}-{-# Language TypeSynonymInstances #-}-{-# Language TypeFamilies #-}--module Text.Printf.TH.Printer where--import Control.Monad.Fix-import Data.Monoid-import Data.String-import Foreign.Ptr-import Foreign.Storable-import Numeric.Natural-import Text.ParserCombinators.ReadP (readP_to_S)-import Text.Printf.TH.Types hiding (width)-import Text.Read.Lex--class (IsString a, Monoid a) =>- Printer a- where- type Output a- string :: String -> a- cons :: Char -> a -> a- cons c = (formatChar' c <>)- rjust :: Char -> Int -> a -> a- ljust :: Int -> a -> a- output :: proxy a -> a -> Output a- formatChar' :: Char -> a- formatDec' :: Integral i => i -> a- formatOct' :: Integral i => i -> a- formatHex' :: Integral i => i -> a- formatHexUpper' :: Integral i => i -> a- formatFloat' :: RealFloat f => Maybe Int -> (f -> a, f -> a)- formatHexFloat' :: RealFloat f => Maybe Int -> (f -> a, f -> a)- formatHexFloatUpper' :: RealFloat f => Maybe Int -> (f -> a, f -> a)- formatSci' :: RealFloat f => Maybe Int -> (f -> a, f -> a)- formatSciUpper' :: RealFloat f => Maybe Int -> (f -> a, f -> a)- formatG' :: RealFloat f => Maybe Int -> (f -> a, f -> a)- formatGUpper' :: RealFloat f => Maybe Int -> (f -> a, f -> a)--data ArgSpec v = ArgSpec- { flagSet :: FlagSet- , width :: Maybe Int- , prec :: Maybe Int- , value :: v- }--forcePrefix a@ArgSpec {flagSet} = a {flagSet = flagSet {prefixed = True}}--forceSize n a@ArgSpec {flagSet} =- a {width = Just n, flagSet = flagSet {adjustment = Just ZeroPadded}}--forceNoZero a@ArgSpec {flagSet} =- a {flagSet = flagSet {adjustment = noZero (adjustment flagSet)}}- where- noZero (Just ZeroPadded) = Nothing- noZero x = x--data Direction- = Leftward- | Rightward- deriving (Show)--data Pad- = Space- | Zero- deriving (Eq, Show)--data Val v = Val- { valLit :: v- , valWidth :: Maybe Int- , valPrefix :: Maybe (Int, v)- , valSign :: Maybe (Int, v)- , valPad :: Pad- , valDirection :: Direction- } deriving (Show)--valOf x =- Val- { valLit = x- , valWidth = Nothing- , valPrefix = Nothing- , valSign = Nothing- , valPad = Space- , valDirection = Rightward- }--valSign' = maybe mempty snd . valSign--valPrefix' = maybe mempty snd . valPrefix--setSign x v = v {valSign = Just $ fmap literal x}--setPrefix x v = v {valPrefix = Just $ fmap literal x}--setRightAligned v = v {valDirection = Rightward}--setLeftAligned v = v {valDirection = Leftward}--setWidth n v = v {valWidth = Just n}--setWidth' n v = v {valWidth = n}--setZero v = v {valPad = Zero}--instance Functor ArgSpec where- fmap f a@(ArgSpec {value}) = a {value = f value}--adjust (ArgSpec flags width _ _) =- setWidth' width .- case adjustment flags of- Nothing -> id- Just LeftJustified -> setLeftAligned- Just ZeroPadded -> setZero--helper :: (Num a, Eq a, Printer p) => (a -> p) -> String -> ArgSpec a -> Val p-helper f pref spec = adjustAndSign pref spec $ valOf $ f (abs $ value spec)--adjustAndSign :: (Num n, Printer a, Eq n) => String -> ArgSpec n -> Val a -> Val a-adjustAndSign pref (ArgSpec flags width _ num) =- adj . setWidth' width . sign flags num . prefix pref flags num- where- adj =- case adjustment flags of- Nothing -> id- Just LeftJustified -> setLeftAligned- Just ZeroPadded -> setZero--prefix _ _ 0 = id-prefix s flags _- | prefixed flags = setPrefix (length s, s)- | otherwise = id--sign flags n- | signum n == -1 = setSign (1, "-")- | spaced flags = setSign (1, " ")- | signed flags = setSign (1, "+")- | otherwise = id--formatDec = helper formatDec' ""--formatOct = helper formatOct' "0"--formatHex = helper formatHex' "0x"--formatPtr =- helper formatHex' "0x" .- fmap (`minusPtr` nullPtr) . forcePrefix . forceSize (sizeOf nullPtr * 2)--formatHexUpper = helper formatHexUpper' "0X"--helper' spec pair = helper'' spec pair ""--helper'' spec pair pref- | prefixed (flagSet spec) = helper (snd pair) pref spec- | otherwise = helper (fst pair) pref spec--formatFloat spec = helper' spec (formatFloat' (prec spec))--formatSci spec = helper' spec (formatSci' (prec spec))--formatSciUpper spec = helper' spec (formatSciUpper' (prec spec))--formatHexFloat spec- | isNaN x = helper (const "NaN") "" $ forceNoZero spec- | isInfinite x = helper (const "Infinity") "" $ forceNoZero spec- | otherwise = helper'' (forcePrefix spec) (formatHexFloat' (prec spec)) "0x"- where- x = value spec--formatHexFloatUpper spec- | isNaN x = helper (const "NaN") "" $ forceNoZero spec- | isInfinite x = helper (const "Infinity") "" $ forceNoZero spec- | otherwise = helper'' (forcePrefix spec) (formatHexFloatUpper' (prec spec)) "0X"- where- x = value spec--formatG spec = helper' spec (formatG' (prec spec))--formatGUpper spec = helper' spec (formatGUpper' (prec spec))--formatNat = formatDec . fmap (fromIntegral :: Natural -> Integer)--fOne v@(Val {valWidth = Nothing, ..}) = mconcat [valSign' v, valPrefix' v, valLit]-fOne v@(Val {valWidth = Just n, valDirection = Rightward, ..}) =- if valPad == Zero- then mconcat- [ maybe mempty snd valSign- , maybe mempty snd valPrefix- , rjust '0' (n - extra) valLit- ]- else rjust ' ' n $ fOne (v {valWidth = Nothing})- where- extra = maybe 0 fst valPrefix + maybe 0 fst valSign-fOne v@(Val {valWidth = Just n, valDirection = Leftward, ..}) =- ljust n $ fOne (v {valWidth = Nothing})--finalize p = foldMap (output p . fOne)--formatStr spec = adjust spec $ valOf $ literal (value spec)--formatChar spec = adjust spec $ valOf $ formatChar' (value spec)--literal x- | '\\' `elem` x =- (`fix` x) $ \f s ->- case readP_to_S lexChar s of- ((c, rest):_) -> cons c (f rest)- [] -> mempty- | otherwise = string x--formatShowable spec = adjust spec $ valOf $ literal (show $ value spec)
− src/Text/Printf/TH/Printer/String.hs
@@ -1,53 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# Language FlexibleContexts #-}-{-# Language RecordWildCards #-}-{-# Language TypeSynonymInstances #-}-{-# Language TypeFamilies #-}-{-# Language FlexibleInstances #-}--module Text.Printf.TH.Printer.String where--import NumericUtils-import Text.Printf.TH.Printer--instance Printer String where- type Output String = String- string = id- formatChar' = pure- cons = (:)- output _ = id- rjust c n s- | diff <= 0 = s- | otherwise = replicate diff c ++ s- where- diff = fromIntegral n - length s- ljust n s- | diff <= 0 = s- | otherwise = s ++ replicate diff ' '- where- diff = fromIntegral n - length s- formatDec' = showIntAtBase 10 intToDigit- formatOct' = showIntAtBase 8 intToDigit- formatHex' = showIntAtBase 16 intToDigit- formatHexUpper' = showIntAtBase 16 intToDigitUpper- formatFloat' p =- ( formatRealFloatAlt FFFixed (fromIntegral <$> p) False False- , formatRealFloatAlt FFFixed (fromIntegral <$> p) True False)- formatHexFloat' p =- ( formatFloatHex (fromIntegral <$> p) False False- , formatFloatHex (fromIntegral <$> p) True False)- formatHexFloatUpper' p =- ( formatFloatHex (fromIntegral <$> p) False True- , formatFloatHex (fromIntegral <$> p) True True)- formatSci' p =- ( formatRealFloatAlt FFExponent (fromIntegral <$> p) False False- , formatRealFloatAlt FFExponent (fromIntegral <$> p) True False)- formatSciUpper' p =- ( formatRealFloatAlt FFExponent (fromIntegral <$> p) False True- , formatRealFloatAlt FFExponent (fromIntegral <$> p) True True)- formatG' p =- ( formatRealFloatAlt FFGeneric (fromIntegral <$> p) False False- , formatRealFloatAlt FFGeneric (fromIntegral <$> p) True False)- formatGUpper' p =- ( formatRealFloatAlt FFGeneric (fromIntegral <$> p) False True- , formatRealFloatAlt FFGeneric (fromIntegral <$> p) True True)
− src/Text/Printf/TH/Types.hs
@@ -1,84 +0,0 @@-{-# Language TemplateHaskell #-}-{-# Language NamedFieldPuns #-}--module Text.Printf.TH.Types where--import qualified Data.Set as S-import Data.Set (Set)-import Language.Haskell.TH.Syntax--data Atom- = Arg FormatArg- | Str String- deriving (Show)--data Flag- = FlagLJust- | FlagSigned- | FlagSpaced- | FlagPrefixed- | FlagZeroPadded- deriving (Show, Eq, Ord)--adjustmentFlags = S.fromList [FlagLJust, FlagZeroPadded]--data Adjustment- = LeftJustified- | ZeroPadded- deriving (Show)--data MaySpecify- = Given Integer- | Need- deriving (Show)--data FormatArg = FormatArg- { flags :: FlagSet- , width :: Maybe MaySpecify- , precision :: Maybe MaySpecify- , spec :: Char- } deriving (Show)--type FormatStr = [Atom]--instance Lift FlagSet where- lift (FlagSet a s b p) =- [|FlagSet- { adjustment = $(a')- , signed = $(lift s)- , spaced = $(lift b)- , prefixed = $(lift p)- }|]- where- a' =- case a of- Just LeftJustified -> [|Just LeftJustified|]- Just ZeroPadded -> [|Just ZeroPadded|]- Nothing -> [|Nothing|]--data FlagSet = FlagSet- { adjustment :: Maybe Adjustment- , signed :: Bool- , spaced :: Bool- , prefixed :: Bool- } deriving (Show)--toFlagSet :: Set Flag -> FlagSet-toFlagSet fs- | S.size (S.intersection fs adjustmentFlags) > 1 =- error- "Error: multiple adjustment flags specified; you can only have one of '-', '0', ' '"- | spaced set && signed set = error "'+' and ' ' specifiers cannot be used together"- | otherwise = set- where- adjustment- | FlagLJust `S.member` fs = Just LeftJustified- | FlagZeroPadded `S.member` fs = Just ZeroPadded- | otherwise = Nothing- set =- FlagSet- { signed = FlagSigned `elem` fs- , prefixed = FlagPrefixed `elem` fs- , adjustment- , spaced = FlagSpaced `elem` fs- }
− tests/Codegen.hs
@@ -1,120 +0,0 @@-{-# Language TemplateHaskell #-}--module Codegen- ( gen- , str- ) where--import Language.Haskell.TH.Lib-import Language.Haskell.TH.Quote-import Language.Haskell.TH.Syntax (Name)-import Test.HUnit.Base-import Test.Hspec-import Test.QuickCheck--str :: Gen String-str = do- n <- elements [7 .. 20]- vectorOf n (elements $ ['A' .. 'Z'] ++ ['a' .. 'z'])--gen :: String -> Name -> QuasiQuoter -> ExpQ-gen name f quoter =- [|describe $(stringE name) $ do- describe "string" $ do- it "basic" $ do- $(q "\\1234") @?= "\1234"- $(q "\12\&34") @?= "\12\&34"- $(q "%s") "foo" @?= "foo"- $(q "%10s") "foo" @?= " foo"- $(q "%10s") "fübar" @?= $(varE f) " fübar"- $(q "%-10s") "foo" @?= "foo "- $(q "%010s") "foo" @?= "0000000foo"- it "precision" $ forAll str $ \n -> $(q "%.10s") n == $(q "%s") n- it "prefix" $ forAll str $ \n -> $(q "%#s") n == $(q "%s") n- it "words with format" $ do- $(q "This is a string: %10s. It's nice") "foobar" @?=- "This is a string: foobar. It's nice"- describe "char" $ do- it "basic" $ do- $(q "%c") 'U' @?= "U"- $(q "%c") '\65210' @?= $(varE f) "\65210"- $(q "%5c") '\65210' @?= $(varE f) " \65210"- describe "decimal" $ do- it "basic" $ do- $(q "%d") 20 @?= "20"- $(q "%d") (negate 10) @?= "-10"- $(q "%10d") 20 @?= " 20"- $(q "%10d") (negate 10) @?= " -10"- $(q "%*d") 10 20 @?= " 20"- $(q "%*d") 10 (negate 10) @?= " -10"- $(q "%010d") 20 @?= "0000000020"- $(q "%010d") (negate 10) @?= "-000000010"- $(q "% d") 20 @?= " 20"- $(q "% d") (negate 10) @?= "-10"- $(q "%+d") 20 @?= "+20"- $(q "%+10d") 20 @?= " +20"- $(q "%-10d") 20 @?= "20 "- $(q "%-10d") (negate 10) @?= "-10 "- $(q "%+-10d") 20 @?= "+20 "- describe "unsigned" $ do it "basic" $ do $(q "%u") 20 @?= "20"- describe "octal" $ do- it "basic" $ do- $(q "%o") 1500 @?= "2734"- $(q "%o") (negate 1500) @?= "-2734"- it "prefix" $ do- $(q "%#o") 1500 @?= "02734"- $(q "%#o") 0 @?= "0"- $(q "%#o") (negate 1500) @?= "-02734"- $(q "%#010o") 1500 @?= "0000002734"- $(q "%#010o") (negate 1500) @?= "-000002734"- $(q "%#-10o") (negate 1500) @?= "-02734 "- $(q "%#-1o") (negate 1500) @?= "-02734"- describe "hex" $ do- it "basic" $ do- $(q "%x") 12513024 @?= "beef00"- $(q "%X") 12513024 @?= "BEEF00"- it "prefix" $ do- $(q "%#x") 12513024 @?= "0xbeef00"- $(q "%#X") 12513024 @?= "0XBEEF00"- $(q "%#15x") 12513024 @?= " 0xbeef00"- $(q "%#015x") 12513024 @?= "0x0000000beef00"- describe "float" $ do- it "basic" $ do- $(q "%f") 1234.56 @?= "1234.56"- $(q "%f") (negate 1234.56) @?= "-1234.56"- it "precision" $ do- $(q "%.5f") 1234.56 @?= "1234.56000"- $(q "%.1f") 1234.56 @?= "1234.6"- $(q "%.0f") 1234.56 @?= "1235"- it "prefix flag" $ do $(q "%#.0f") 1234.56 @?= "1235."- describe "scientific" $ do- it "basic" $ do- $(q "%e") 1234.56 @?= "1.23456e3"- $(q "%e") (negate 1234.56) @?= "-1.23456e3"- $(q "%e") 0.00035 @?= "3.5e-4"- $(q "%E") 1234.56 @?= "1.23456E3"- it "precision" $ do- $(q "%.5e") 12.34 @?= "1.23400e1"- $(q "%.0e") 12.34 @?= "1e1"- $(q "%#.0e") 12.34 @?= "1.e1"- $(q "%15.5e") 12.34 @?= " 1.23400e1"- $(q "%+015.5e") 12.34 @?= "+000001.23400e1"- $(q "%+-15.5e") 12.34 @?= "+1.23400e1 "- describe "g-format" $ do- it "basic" $ do- $(q "%g") 1234.56 @?= "1234.56"- $(q "%g") 123456789.876 @?= "123456789.876"- $(q "%G") 123456789.876 @?= "123456789.876"- $(q "%.3g") 1234.56 @?= "1.235e3"- $(q "%.3g") 123456789.876 @?= "1.235e8"- $(q "%.3G") 123456789.876 @?= "1.235E8"- $(q "%#g") 1234.56 @?= "1234.56"- describe "hexadecimal floating point" $ do- it "basic" $ do- $(q "%a") 0.857421875 @?= "0x1.b7p-1"- $(q "%A") 3.1415926 @?= "0X1.921FB4D12D84AP+1"- $(q "%.3a") 0.7576 @?= "0x1.83ep-1"- $(q "%.3a") 1.999999999 @?= "0x2.000p+0"- $(q "%015.3a") 0.7576 @?= "0x000001.83ep-1"|]- where- q = quoteExp quoter
+ tests/GeneratedSpec.hs view
@@ -0,0 +1,452 @@+-- This file contains autogenerated erroneous printf strings, which th-printf+-- will warn about, but they shouldn't break a -Werror build+{-# OPTIONS_GHC -Wwarn #-}+{-# LANGUAGE QuasiQuotes #-}++module GeneratedSpec where++import Data.Int+import Data.Word+import Language.Haskell.Printf+import Test.HUnit+import Test.Hspec++-- XXX This code generated automatically by gen-testcases.hs+-- from ../../printf-tests.txt . You probably do not want to+-- manually edit this file.+spec = do+ it "test-case #1" $ [s|%.*f|] (2 :: Int32) (0.33333333 :: Double) @?= "0.33"+ it "test-case #2" $ [s|%.3s|] "foobar" @?= "foo"+ it "test-case #3" $ [s|%10.5d|] (4 :: Int32) @?= " 00004"+ it "test-case #4" $ [s|% d|] (42 :: Int32) @?= " 42"+ it "test-case #5" $ [s|% d|] (-42 :: Int32) @?= "-42"+ it "test-case #6" $ [s|% 5d|] (42 :: Int32) @?= " 42"+ it "test-case #7" $ [s|% 5d|] (-42 :: Int32) @?= " -42"+ it "test-case #8" $ [s|% 15d|] (42 :: Int32) @?= " 42"+ it "test-case #9" $ [s|% 15d|] (-42 :: Int32) @?= " -42"+ it "test-case #10" $ [s|%+d|] (42 :: Int32) @?= "+42"+ it "test-case #11" $ [s|%+d|] (-42 :: Int32) @?= "-42"+ it "test-case #12" $ [s|%+5d|] (42 :: Int32) @?= " +42"+ it "test-case #13" $ [s|%+5d|] (-42 :: Int32) @?= " -42"+ it "test-case #14" $ [s|%+15d|] (42 :: Int32) @?= " +42"+ it "test-case #15" $ [s|%+15d|] (-42 :: Int32) @?= " -42"+ it "test-case #16" $ [s|%0d|] (42 :: Int32) @?= "42"+ it "test-case #17" $ [s|%0d|] (-42 :: Int32) @?= "-42"+ it "test-case #18" $ [s|%05d|] (42 :: Int32) @?= "00042"+ it "test-case #19" $ [s|%05d|] (-42 :: Int32) @?= "-0042"+ it "test-case #20" $ [s|%015d|] (42 :: Int32) @?= "000000000000042"+ it "test-case #21" $ [s|%015d|] (-42 :: Int32) @?= "-00000000000042"+ it "test-case #22" $ [s|%-d|] (42 :: Int32) @?= "42"+ it "test-case #23" $ [s|%-d|] (-42 :: Int32) @?= "-42"+ it "test-case #24" $ [s|%-5d|] (42 :: Int32) @?= "42 "+ it "test-case #25" $ [s|%-5d|] (-42 :: Int32) @?= "-42 "+ it "test-case #26" $ [s|%-15d|] (42 :: Int32) @?= "42 "+ it "test-case #27" $ [s|%-15d|] (-42 :: Int32) @?= "-42 "+ it "test-case #28" $ [s|%-0d|] (42 :: Int32) @?= "42"+ it "test-case #29" $ [s|%-0d|] (-42 :: Int32) @?= "-42"+ it "test-case #30" $ [s|%-05d|] (42 :: Int32) @?= "42 "+ it "test-case #31" $ [s|%-05d|] (-42 :: Int32) @?= "-42 "+ it "test-case #32" $ [s|%-015d|] (42 :: Int32) @?= "42 "+ it "test-case #33" $ [s|%-015d|] (-42 :: Int32) @?= "-42 "+ it "test-case #34" $ [s|%0-d|] (42 :: Int32) @?= "42"+ it "test-case #35" $ [s|%0-d|] (-42 :: Int32) @?= "-42"+ it "test-case #36" $ [s|%0-5d|] (42 :: Int32) @?= "42 "+ it "test-case #37" $ [s|%0-5d|] (-42 :: Int32) @?= "-42 "+ it "test-case #38" $ [s|%0-15d|] (42 :: Int32) @?= "42 "+ it "test-case #39" $ [s|%0-15d|] (-42 :: Int32) @?= "-42 "+ it "test-case #43" $ [s|%.2f|] (42.8952 :: Double) @?= "42.90"+ it "test-case #44" $ [s|%.2F|] (42.8952 :: Double) @?= "42.90"+ it "test-case #45" $ [s|%.10f|] (42.8952 :: Double) @?= "42.8952000000"+ it "test-case #46" $ [s|%1.2f|] (42.8952 :: Double) @?= "42.90"+ it "test-case #47" $ [s|%6.2f|] (42.8952 :: Double) @?= " 42.90"+ it "test-case #49" $ [s|%+6.2f|] (42.8952 :: Double) @?= "+42.90"+ it "test-case #50" $ [s|%5.10f|] (42.8952 :: Double) @?= "42.8952000000"+ -- 51: anti-test+ -- 52: anti-test+ -- 53: excluded for Haskell+ -- 55: excluded for Haskell+ -- 56: excluded for Haskell+ -- 58: excluded for Haskell+ -- 59: excluded for Haskell+ it "test-case #60" $ [s|%*s|] (4 :: Int32) "foo" @?= " foo"+ it "test-case #61" $+ [s|%*.*f|] (10 :: Int32) (2 :: Int32) (3.14159265 :: Double) @?= " 3.14"+ it "test-case #63" $+ [s|%-*.*f|] (10 :: Int32) (2 :: Int32) (3.14159265 :: Double) @?= "3.14 "+ -- 64: anti-test+ -- 65: anti-test+ it "test-case #66" $ [s|+%s+|] "hello" @?= "+hello+"+ it "test-case #67" $ [s|+%d+|] (10 :: Int32) @?= "+10+"+ it "test-case #68" $ [s|%c|] 'a' @?= "a"+ -- unsound test: it "test-case #69" $ [s|%c|] (32 :: Int32) @?= " "+ -- unsound test: it "test-case #70" $ [s|%c|] (36 :: Int32) @?= "$"+ it "test-case #71" $ [s|%d|] (10 :: Int32) @?= "10"+ -- 72: anti-test+ -- 73: anti-test+ -- 74: excluded for Haskell+ -- 75: excluded for Haskell+ it "test-case #76" $+ [s|%+#22.15e|] (7.89456123e8 :: Double) @?= "+7.894561230000000e+08"+ it "test-case #77" $+ [s|%-#22.15e|] (7.89456123e8 :: Double) @?= "7.894561230000000e+08 "+ it "test-case #78" $+ [s|%#22.15e|] (7.89456123e8 :: Double) @?= " 7.894561230000000e+08"+ it "test-case #79" $ [s|%#1.1g|] (7.89456123e8 :: Double) @?= "8.e+08"+ it "test-case #81" $ [s|%+8lld|] (100 :: Int64) @?= " +100"+ it "test-case #82" $ [s|%+.8lld|] (100 :: Int64) @?= "+00000100"+ it "test-case #83" $ [s|%+10.8lld|] (100 :: Int64) @?= " +00000100"+ -- 84: excluded for Haskell+ it "test-case #85" $ [s|%-1.5lld|] (-100 :: Int64) @?= "-00100"+ it "test-case #86" $ [s|%5lld|] (100 :: Int64) @?= " 100"+ it "test-case #87" $ [s|%5lld|] (-100 :: Int64) @?= " -100"+ it "test-case #88" $ [s|%-5lld|] (100 :: Int64) @?= "100 "+ it "test-case #89" $ [s|%-5lld|] (-100 :: Int64) @?= "-100 "+ it "test-case #90" $ [s|%-.5lld|] (100 :: Int64) @?= "00100"+ it "test-case #91" $ [s|%-.5lld|] (-100 :: Int64) @?= "-00100"+ it "test-case #92" $ [s|%-8.5lld|] (100 :: Int64) @?= "00100 "+ it "test-case #93" $ [s|%-8.5lld|] (-100 :: Int64) @?= "-00100 "+ it "test-case #94" $ [s|%05lld|] (100 :: Int64) @?= "00100"+ it "test-case #95" $ [s|%05lld|] (-100 :: Int64) @?= "-0100"+ it "test-case #96" $ [s|% lld|] (100 :: Int64) @?= " 100"+ it "test-case #97" $ [s|% lld|] (-100 :: Int64) @?= "-100"+ it "test-case #98" $ [s|% 5lld|] (100 :: Int64) @?= " 100"+ it "test-case #99" $ [s|% 5lld|] (-100 :: Int64) @?= " -100"+ it "test-case #100" $ [s|% .5lld|] (100 :: Int64) @?= " 00100"+ it "test-case #101" $ [s|% .5lld|] (-100 :: Int64) @?= "-00100"+ it "test-case #102" $ [s|% 8.5lld|] (100 :: Int64) @?= " 00100"+ it "test-case #103" $ [s|% 8.5lld|] (-100 :: Int64) @?= " -00100"+ it "test-case #104" $ [s|%.0lld|] (0 :: Int64) @?= ""+ it "test-case #105" $ [s|%#+21.18llx|] (-100 :: Int64) @?= " 0x00ffffffffffffff9c"+ it "test-case #106" $ [s|%#.25llo|] (-100 :: Int64) @?= "0001777777777777777777634"+ it "test-case #107" $ [s|%#+24.20llo|] (-100 :: Int64) @?= " 01777777777777777777634"+ it "test-case #108" $ [s|%#+18.21llX|] (-100 :: Int64) @?= "0X00000FFFFFFFFFFFFFF9C"+ it "test-case #109" $ [s|%#+20.24llo|] (-100 :: Int64) @?= "001777777777777777777634"+ it "test-case #110" $ [s|%#+25.22llu|] (-1 :: Int64) @?= " 0018446744073709551615"+ it "test-case #111" $ [s|%#+25.22llu|] (-1 :: Int64) @?= " 0018446744073709551615"+ it "test-case #112" $+ [s|%#+30.25llu|] (-1 :: Int64) @?= " 0000018446744073709551615"+ it "test-case #113" $ [s|%+#25.22lld|] (-1 :: Int64) @?= " -0000000000000000000001"+ it "test-case #114" $ [s|%#-8.5llo|] (100 :: Int64) @?= "00144 "+ it "test-case #115" $ [s|%#-+ 08.5lld|] (100 :: Int64) @?= "+00100 "+ it "test-case #116" $ [s|%#-+ 08.5lld|] (100 :: Int64) @?= "+00100 "+ it "test-case #117" $+ [s|%.40lld|] (1 :: Int64) @?= "0000000000000000000000000000000000000001"+ it "test-case #118" $+ [s|% .40lld|] (1 :: Int64) @?= " 0000000000000000000000000000000000000001"+ it "test-case #119" $+ [s|% .40d|] (1 :: Int32) @?= " 0000000000000000000000000000000000000001"+ -- 121: excluded for Haskell+ -- 124: excluded for Haskell+ it "test-case #125" $ [s|% d|] (1 :: Int32) @?= " 1"+ it "test-case #126" $ [s|%+ d|] (1 :: Int32) @?= "+1"+ it "test-case #129" $ [s|%#012x|] (1 :: Int32) @?= "0x0000000001"+ it "test-case #130" $ [s|%#04.8x|] (1 :: Int32) @?= "0x00000001"+ it "test-case #131" $ [s|%#-08.2x|] (1 :: Int32) @?= "0x01 "+ it "test-case #132" $ [s|%#08o|] (1 :: Int32) @?= "00000001"+ -- 133: excluded for Haskell+ -- 137: excluded for Haskell+ it "test-case #142" $ [s|%.1s|] "foo" @?= "f"+ it "test-case #143" $ [s|%.*s|] (1 :: Int32) "foo" @?= "f"+ it "test-case #144" $ [s|%*s|] (-5 :: Int32) "foo" @?= "foo "+ it "test-case #145" $ [s|hello|] @?= "hello"+ -- 147: excluded for Haskell+ it "test-case #148" $ [s|%3c|] 'a' @?= " a"+ it "test-case #149" $ [s|%3d|] (1234 :: Int32) @?= "1234"+ -- 150: excluded for Haskell+ it "test-case #152" $ [s|%-1d|] (2 :: Int32) @?= "2"+ it "test-case #153" $ [s|%2.4f|] (8.6 :: Double) @?= "8.6000"+ it "test-case #154" $ [s|%0f|] (0.6 :: Double) @?= "0.600000"+ it "test-case #155" $ [s|%.0f|] (0.6 :: Double) @?= "1"+ it "test-case #156" $ [s|%2.4e|] (8.6 :: Double) @?= "8.6000e+00"+ it "test-case #157" $ [s|% 2.4e|] (8.6 :: Double) @?= " 8.6000e+00"+ it "test-case #159" $ [s|% 2.4e|] (-8.6 :: Double) @?= "-8.6000e+00"+ it "test-case #160" $ [s|%+2.4e|] (8.6 :: Double) @?= "+8.6000e+00"+ it "test-case #161" $ [s|%2.4g|] (8.6 :: Double) @?= "8.6"+ it "test-case #162" $ [s|%-i|] (-1 :: Int32) @?= "-1"+ it "test-case #163" $ [s|%-i|] (1 :: Int32) @?= "1"+ it "test-case #164" $ [s|%+i|] (1 :: Int32) @?= "+1"+ it "test-case #165" $ [s|%o|] (10 :: Int32) @?= "12"+ -- 166: excluded for Haskell+ -- 167: excluded for Haskell+ it "test-case #169" $ [s|%s|] "%%%%" @?= "%%%%"+ it "test-case #170" $ [s|%u|] (-1 :: Int32) @?= "4294967295"+ -- 171: excluded for Haskell+ -- 172: excluded for Haskell+ -- 173: excluded for Haskell+ -- 174: excluded for Haskell+ -- 176: excluded for Haskell+ it "test-case #177" $ [s|%%0|] @?= "%0"+ -- 178: excluded for Haskell+ -- unsound test: it "test-case #179" $ [s|%hhx|] 'a' @?= "61"+ it "test-case #181" $ [s|Hallo heimur|] @?= "Hallo heimur"+ it "test-case #182" $ [s|%s|] "Hallo heimur" @?= "Hallo heimur"+ it "test-case #183" $ [s|%d|] (1024 :: Int32) @?= "1024"+ it "test-case #184" $ [s|%d|] (-1024 :: Int32) @?= "-1024"+ it "test-case #185" $ [s|%i|] (1024 :: Int32) @?= "1024"+ it "test-case #186" $ [s|%i|] (-1024 :: Int32) @?= "-1024"+ it "test-case #187" $ [s|%u|] (1024 :: Int32) @?= "1024"+ it "test-case #188" $ [s|%u|] (4294966272 :: Word32) @?= "4294966272"+ it "test-case #189" $ [s|%o|] (511 :: Int32) @?= "777"+ it "test-case #190" $ [s|%o|] (4294966785 :: Word32) @?= "37777777001"+ it "test-case #191" $ [s|%x|] (305441741 :: Int32) @?= "1234abcd"+ it "test-case #192" $ [s|%x|] (3989525555 :: Word32) @?= "edcb5433"+ it "test-case #193" $ [s|%X|] (305441741 :: Int32) @?= "1234ABCD"+ it "test-case #194" $ [s|%X|] (3989525555 :: Word32) @?= "EDCB5433"+ it "test-case #195" $ [s|%c|] 'x' @?= "x"+ it "test-case #196" $ [s|%%|] @?= "%"+ it "test-case #197" $ [s|%+s|] "Hallo heimur" @?= "Hallo heimur"+ it "test-case #198" $ [s|%+d|] (1024 :: Int32) @?= "+1024"+ it "test-case #199" $ [s|%+d|] (-1024 :: Int32) @?= "-1024"+ it "test-case #200" $ [s|%+i|] (1024 :: Int32) @?= "+1024"+ it "test-case #201" $ [s|%+i|] (-1024 :: Int32) @?= "-1024"+ it "test-case #202" $ [s|%+u|] (1024 :: Int32) @?= "1024"+ it "test-case #203" $ [s|%+u|] (4294966272 :: Word32) @?= "4294966272"+ it "test-case #204" $ [s|%+o|] (511 :: Int32) @?= "777"+ it "test-case #205" $ [s|%+o|] (4294966785 :: Word32) @?= "37777777001"+ it "test-case #206" $ [s|%+x|] (305441741 :: Int32) @?= "1234abcd"+ it "test-case #207" $ [s|%+x|] (3989525555 :: Word32) @?= "edcb5433"+ it "test-case #208" $ [s|%+X|] (305441741 :: Int32) @?= "1234ABCD"+ it "test-case #209" $ [s|%+X|] (3989525555 :: Word32) @?= "EDCB5433"+ it "test-case #210" $ [s|%+c|] 'x' @?= "x"+ it "test-case #211" $ [s|% s|] "Hallo heimur" @?= "Hallo heimur"+ it "test-case #212" $ [s|% d|] (1024 :: Int32) @?= " 1024"+ it "test-case #213" $ [s|% d|] (-1024 :: Int32) @?= "-1024"+ it "test-case #214" $ [s|% i|] (1024 :: Int32) @?= " 1024"+ it "test-case #215" $ [s|% i|] (-1024 :: Int32) @?= "-1024"+ it "test-case #216" $ [s|% u|] (1024 :: Int32) @?= "1024"+ it "test-case #217" $ [s|% u|] (4294966272 :: Word32) @?= "4294966272"+ it "test-case #218" $ [s|% o|] (511 :: Int32) @?= "777"+ it "test-case #219" $ [s|% o|] (4294966785 :: Word32) @?= "37777777001"+ it "test-case #220" $ [s|% x|] (305441741 :: Int32) @?= "1234abcd"+ it "test-case #221" $ [s|% x|] (3989525555 :: Word32) @?= "edcb5433"+ it "test-case #222" $ [s|% X|] (305441741 :: Int32) @?= "1234ABCD"+ it "test-case #223" $ [s|% X|] (3989525555 :: Word32) @?= "EDCB5433"+ it "test-case #224" $ [s|% c|] 'x' @?= "x"+ it "test-case #225" $ [s|%+ s|] "Hallo heimur" @?= "Hallo heimur"+ it "test-case #226" $ [s|%+ d|] (1024 :: Int32) @?= "+1024"+ it "test-case #227" $ [s|%+ d|] (-1024 :: Int32) @?= "-1024"+ it "test-case #228" $ [s|%+ i|] (1024 :: Int32) @?= "+1024"+ it "test-case #229" $ [s|%+ i|] (-1024 :: Int32) @?= "-1024"+ it "test-case #230" $ [s|%+ u|] (1024 :: Int32) @?= "1024"+ it "test-case #231" $ [s|%+ u|] (4294966272 :: Word32) @?= "4294966272"+ it "test-case #232" $ [s|%+ o|] (511 :: Int32) @?= "777"+ it "test-case #233" $ [s|%+ o|] (4294966785 :: Word32) @?= "37777777001"+ it "test-case #234" $ [s|%+ x|] (305441741 :: Int32) @?= "1234abcd"+ it "test-case #235" $ [s|%+ x|] (3989525555 :: Word32) @?= "edcb5433"+ it "test-case #236" $ [s|%+ X|] (305441741 :: Int32) @?= "1234ABCD"+ it "test-case #237" $ [s|%+ X|] (3989525555 :: Word32) @?= "EDCB5433"+ it "test-case #238" $ [s|%+ c|] 'x' @?= "x"+ it "test-case #239" $ [s|%#o|] (511 :: Int32) @?= "0777"+ it "test-case #240" $ [s|%#o|] (4294966785 :: Word32) @?= "037777777001"+ it "test-case #241" $ [s|%#x|] (305441741 :: Int32) @?= "0x1234abcd"+ it "test-case #242" $ [s|%#x|] (3989525555 :: Word32) @?= "0xedcb5433"+ it "test-case #243" $ [s|%#X|] (305441741 :: Int32) @?= "0X1234ABCD"+ it "test-case #244" $ [s|%#X|] (3989525555 :: Word32) @?= "0XEDCB5433"+ it "test-case #245" $ [s|%#o|] (0 :: Word32) @?= "0"+ it "test-case #246" $ [s|%#x|] (0 :: Word32) @?= "0"+ it "test-case #247" $ [s|%#X|] (0 :: Word32) @?= "0"+ it "test-case #248" $ [s|%1s|] "Hallo heimur" @?= "Hallo heimur"+ it "test-case #249" $ [s|%1d|] (1024 :: Int32) @?= "1024"+ it "test-case #250" $ [s|%1d|] (-1024 :: Int32) @?= "-1024"+ it "test-case #251" $ [s|%1i|] (1024 :: Int32) @?= "1024"+ it "test-case #252" $ [s|%1i|] (-1024 :: Int32) @?= "-1024"+ it "test-case #253" $ [s|%1u|] (1024 :: Int32) @?= "1024"+ it "test-case #254" $ [s|%1u|] (4294966272 :: Word32) @?= "4294966272"+ it "test-case #255" $ [s|%1o|] (511 :: Int32) @?= "777"+ it "test-case #256" $ [s|%1o|] (4294966785 :: Word32) @?= "37777777001"+ it "test-case #257" $ [s|%1x|] (305441741 :: Int32) @?= "1234abcd"+ it "test-case #258" $ [s|%1x|] (3989525555 :: Word32) @?= "edcb5433"+ it "test-case #259" $ [s|%1X|] (305441741 :: Int32) @?= "1234ABCD"+ it "test-case #260" $ [s|%1X|] (3989525555 :: Word32) @?= "EDCB5433"+ it "test-case #261" $ [s|%1c|] 'x' @?= "x"+ it "test-case #262" $ [s|%20s|] "Hallo" @?= " Hallo"+ it "test-case #263" $ [s|%20d|] (1024 :: Int32) @?= " 1024"+ it "test-case #264" $ [s|%20d|] (-1024 :: Int32) @?= " -1024"+ it "test-case #265" $ [s|%20i|] (1024 :: Int32) @?= " 1024"+ it "test-case #266" $ [s|%20i|] (-1024 :: Int32) @?= " -1024"+ it "test-case #267" $ [s|%20u|] (1024 :: Int32) @?= " 1024"+ it "test-case #268" $ [s|%20u|] (4294966272 :: Word32) @?= " 4294966272"+ it "test-case #269" $ [s|%20o|] (511 :: Int32) @?= " 777"+ it "test-case #270" $ [s|%20o|] (4294966785 :: Word32) @?= " 37777777001"+ it "test-case #271" $ [s|%20x|] (305441741 :: Int32) @?= " 1234abcd"+ it "test-case #272" $ [s|%20x|] (3989525555 :: Word32) @?= " edcb5433"+ it "test-case #273" $ [s|%20X|] (305441741 :: Int32) @?= " 1234ABCD"+ it "test-case #274" $ [s|%20X|] (3989525555 :: Word32) @?= " EDCB5433"+ it "test-case #275" $ [s|%20c|] 'x' @?= " x"+ it "test-case #276" $ [s|%-20s|] "Hallo" @?= "Hallo "+ it "test-case #277" $ [s|%-20d|] (1024 :: Int32) @?= "1024 "+ it "test-case #278" $ [s|%-20d|] (-1024 :: Int32) @?= "-1024 "+ it "test-case #279" $ [s|%-20i|] (1024 :: Int32) @?= "1024 "+ it "test-case #280" $ [s|%-20i|] (-1024 :: Int32) @?= "-1024 "+ it "test-case #281" $ [s|%-20u|] (1024 :: Int32) @?= "1024 "+ it "test-case #282" $ [s|%-20u|] (4294966272 :: Word32) @?= "4294966272 "+ it "test-case #283" $ [s|%-20o|] (511 :: Int32) @?= "777 "+ it "test-case #284" $ [s|%-20o|] (4294966785 :: Word32) @?= "37777777001 "+ it "test-case #285" $ [s|%-20x|] (305441741 :: Int32) @?= "1234abcd "+ it "test-case #286" $ [s|%-20x|] (3989525555 :: Word32) @?= "edcb5433 "+ it "test-case #287" $ [s|%-20X|] (305441741 :: Int32) @?= "1234ABCD "+ it "test-case #288" $ [s|%-20X|] (3989525555 :: Word32) @?= "EDCB5433 "+ it "test-case #289" $ [s|%-20c|] 'x' @?= "x "+ it "test-case #290" $ [s|%020d|] (1024 :: Int32) @?= "00000000000000001024"+ it "test-case #291" $ [s|%020d|] (-1024 :: Int32) @?= "-0000000000000001024"+ it "test-case #292" $ [s|%020i|] (1024 :: Int32) @?= "00000000000000001024"+ it "test-case #293" $ [s|%020i|] (-1024 :: Int32) @?= "-0000000000000001024"+ it "test-case #294" $ [s|%020u|] (1024 :: Int32) @?= "00000000000000001024"+ it "test-case #295" $ [s|%020u|] (4294966272 :: Word32) @?= "00000000004294966272"+ it "test-case #296" $ [s|%020o|] (511 :: Int32) @?= "00000000000000000777"+ it "test-case #297" $ [s|%020o|] (4294966785 :: Word32) @?= "00000000037777777001"+ it "test-case #298" $ [s|%020x|] (305441741 :: Int32) @?= "0000000000001234abcd"+ it "test-case #299" $ [s|%020x|] (3989525555 :: Word32) @?= "000000000000edcb5433"+ it "test-case #300" $ [s|%020X|] (305441741 :: Int32) @?= "0000000000001234ABCD"+ it "test-case #301" $ [s|%020X|] (3989525555 :: Word32) @?= "000000000000EDCB5433"+ it "test-case #302" $ [s|%#20o|] (511 :: Int32) @?= " 0777"+ it "test-case #303" $ [s|%#20o|] (4294966785 :: Word32) @?= " 037777777001"+ it "test-case #304" $ [s|%#20x|] (305441741 :: Int32) @?= " 0x1234abcd"+ it "test-case #305" $ [s|%#20x|] (3989525555 :: Word32) @?= " 0xedcb5433"+ it "test-case #306" $ [s|%#20X|] (305441741 :: Int32) @?= " 0X1234ABCD"+ it "test-case #307" $ [s|%#20X|] (3989525555 :: Word32) @?= " 0XEDCB5433"+ it "test-case #308" $ [s|%#020o|] (511 :: Int32) @?= "00000000000000000777"+ it "test-case #309" $ [s|%#020o|] (4294966785 :: Word32) @?= "00000000037777777001"+ it "test-case #310" $ [s|%#020x|] (305441741 :: Int32) @?= "0x00000000001234abcd"+ it "test-case #311" $ [s|%#020x|] (3989525555 :: Word32) @?= "0x0000000000edcb5433"+ it "test-case #312" $ [s|%#020X|] (305441741 :: Int32) @?= "0X00000000001234ABCD"+ it "test-case #313" $ [s|%#020X|] (3989525555 :: Word32) @?= "0X0000000000EDCB5433"+ it "test-case #314" $ [s|%0-20s|] "Hallo" @?= "Hallo "+ it "test-case #315" $ [s|%0-20d|] (1024 :: Int32) @?= "1024 "+ it "test-case #316" $ [s|%0-20d|] (-1024 :: Int32) @?= "-1024 "+ it "test-case #317" $ [s|%0-20i|] (1024 :: Int32) @?= "1024 "+ it "test-case #318" $ [s|%0-20i|] (-1024 :: Int32) @?= "-1024 "+ it "test-case #319" $ [s|%0-20u|] (1024 :: Int32) @?= "1024 "+ it "test-case #320" $ [s|%0-20u|] (4294966272 :: Word32) @?= "4294966272 "+ it "test-case #321" $ [s|%-020o|] (511 :: Int32) @?= "777 "+ it "test-case #322" $ [s|%-020o|] (4294966785 :: Word32) @?= "37777777001 "+ it "test-case #323" $ [s|%-020x|] (305441741 :: Int32) @?= "1234abcd "+ it "test-case #324" $ [s|%-020x|] (3989525555 :: Word32) @?= "edcb5433 "+ it "test-case #325" $ [s|%-020X|] (305441741 :: Int32) @?= "1234ABCD "+ it "test-case #326" $ [s|%-020X|] (3989525555 :: Word32) @?= "EDCB5433 "+ it "test-case #327" $ [s|%-020c|] 'x' @?= "x "+ it "test-case #328" $ [s|%*s|] (20 :: Int32) "Hallo" @?= " Hallo"+ it "test-case #329" $+ [s|%*d|] (20 :: Int32) (1024 :: Int32) @?= " 1024"+ it "test-case #330" $+ [s|%*d|] (20 :: Int32) (-1024 :: Int32) @?= " -1024"+ it "test-case #331" $+ [s|%*i|] (20 :: Int32) (1024 :: Int32) @?= " 1024"+ it "test-case #332" $+ [s|%*i|] (20 :: Int32) (-1024 :: Int32) @?= " -1024"+ it "test-case #333" $+ [s|%*u|] (20 :: Int32) (1024 :: Int32) @?= " 1024"+ it "test-case #334" $+ [s|%*u|] (20 :: Int32) (4294966272 :: Word32) @?= " 4294966272"+ it "test-case #335" $ [s|%*o|] (20 :: Int32) (511 :: Int32) @?= " 777"+ it "test-case #336" $+ [s|%*o|] (20 :: Int32) (4294966785 :: Word32) @?= " 37777777001"+ it "test-case #337" $+ [s|%*x|] (20 :: Int32) (305441741 :: Int32) @?= " 1234abcd"+ it "test-case #338" $+ [s|%*x|] (20 :: Int32) (3989525555 :: Word32) @?= " edcb5433"+ it "test-case #339" $+ [s|%*X|] (20 :: Int32) (305441741 :: Int32) @?= " 1234ABCD"+ it "test-case #340" $+ [s|%*X|] (20 :: Int32) (3989525555 :: Word32) @?= " EDCB5433"+ it "test-case #341" $ [s|%*c|] (20 :: Int32) 'x' @?= " x"+ it "test-case #342" $ [s|%.20s|] "Hallo heimur" @?= "Hallo heimur"+ it "test-case #343" $ [s|%.20d|] (1024 :: Int32) @?= "00000000000000001024"+ it "test-case #344" $ [s|%.20d|] (-1024 :: Int32) @?= "-00000000000000001024"+ it "test-case #345" $ [s|%.20i|] (1024 :: Int32) @?= "00000000000000001024"+ it "test-case #346" $ [s|%.20i|] (-1024 :: Int32) @?= "-00000000000000001024"+ it "test-case #347" $ [s|%.20u|] (1024 :: Int32) @?= "00000000000000001024"+ it "test-case #348" $ [s|%.20u|] (4294966272 :: Word32) @?= "00000000004294966272"+ it "test-case #349" $ [s|%.20o|] (511 :: Int32) @?= "00000000000000000777"+ it "test-case #350" $ [s|%.20o|] (4294966785 :: Word32) @?= "00000000037777777001"+ it "test-case #351" $ [s|%.20x|] (305441741 :: Int32) @?= "0000000000001234abcd"+ it "test-case #352" $ [s|%.20x|] (3989525555 :: Word32) @?= "000000000000edcb5433"+ it "test-case #353" $ [s|%.20X|] (305441741 :: Int32) @?= "0000000000001234ABCD"+ it "test-case #354" $ [s|%.20X|] (3989525555 :: Word32) @?= "000000000000EDCB5433"+ it "test-case #355" $ [s|%20.5s|] "Hallo heimur" @?= " Hallo"+ it "test-case #356" $ [s|%20.5d|] (1024 :: Int32) @?= " 01024"+ it "test-case #357" $ [s|%20.5d|] (-1024 :: Int32) @?= " -01024"+ it "test-case #358" $ [s|%20.5i|] (1024 :: Int32) @?= " 01024"+ it "test-case #359" $ [s|%20.5i|] (-1024 :: Int32) @?= " -01024"+ it "test-case #360" $ [s|%20.5u|] (1024 :: Int32) @?= " 01024"+ it "test-case #361" $ [s|%20.5u|] (4294966272 :: Word32) @?= " 4294966272"+ it "test-case #362" $ [s|%20.5o|] (511 :: Int32) @?= " 00777"+ it "test-case #363" $ [s|%20.5o|] (4294966785 :: Word32) @?= " 37777777001"+ it "test-case #364" $ [s|%20.5x|] (305441741 :: Int32) @?= " 1234abcd"+ it "test-case #365" $ [s|%20.10x|] (3989525555 :: Word32) @?= " 00edcb5433"+ it "test-case #366" $ [s|%20.5X|] (305441741 :: Int32) @?= " 1234ABCD"+ it "test-case #367" $ [s|%20.10X|] (3989525555 :: Word32) @?= " 00EDCB5433"+ it "test-case #369" $ [s|%020.5d|] (1024 :: Int32) @?= " 01024"+ it "test-case #370" $ [s|%020.5d|] (-1024 :: Int32) @?= " -01024"+ it "test-case #371" $ [s|%020.5i|] (1024 :: Int32) @?= " 01024"+ it "test-case #372" $ [s|%020.5i|] (-1024 :: Int32) @?= " -01024"+ it "test-case #373" $ [s|%020.5u|] (1024 :: Int32) @?= " 01024"+ it "test-case #374" $ [s|%020.5u|] (4294966272 :: Word32) @?= " 4294966272"+ it "test-case #375" $ [s|%020.5o|] (511 :: Int32) @?= " 00777"+ it "test-case #376" $ [s|%020.5o|] (4294966785 :: Word32) @?= " 37777777001"+ it "test-case #377" $ [s|%020.5x|] (305441741 :: Int32) @?= " 1234abcd"+ it "test-case #378" $ [s|%020.10x|] (3989525555 :: Word32) @?= " 00edcb5433"+ it "test-case #379" $ [s|%020.5X|] (305441741 :: Int32) @?= " 1234ABCD"+ it "test-case #380" $ [s|%020.10X|] (3989525555 :: Word32) @?= " 00EDCB5433"+ it "test-case #381" $ [s|%.0s|] "Hallo heimur" @?= ""+ it "test-case #382" $ [s|%20.0s|] "Hallo heimur" @?= " "+ it "test-case #383" $ [s|%.s|] "Hallo heimur" @?= ""+ it "test-case #384" $ [s|%20.s|] "Hallo heimur" @?= " "+ it "test-case #385" $ [s|%20.0d|] (1024 :: Int32) @?= " 1024"+ it "test-case #386" $ [s|%20.d|] (-1024 :: Int32) @?= " -1024"+ it "test-case #387" $ [s|%20.d|] (0 :: Int32) @?= " "+ it "test-case #388" $ [s|%20.0i|] (1024 :: Int32) @?= " 1024"+ it "test-case #389" $ [s|%20.i|] (-1024 :: Int32) @?= " -1024"+ it "test-case #390" $ [s|%20.i|] (0 :: Int32) @?= " "+ it "test-case #391" $ [s|%20.u|] (1024 :: Int32) @?= " 1024"+ it "test-case #392" $ [s|%20.0u|] (4294966272 :: Word32) @?= " 4294966272"+ it "test-case #393" $ [s|%20.u|] (0 :: Word32) @?= " "+ it "test-case #394" $ [s|%20.o|] (511 :: Int32) @?= " 777"+ it "test-case #395" $ [s|%20.0o|] (4294966785 :: Word32) @?= " 37777777001"+ it "test-case #396" $ [s|%20.o|] (0 :: Word32) @?= " "+ it "test-case #397" $ [s|%20.x|] (305441741 :: Int32) @?= " 1234abcd"+ it "test-case #398" $ [s|%20.0x|] (3989525555 :: Word32) @?= " edcb5433"+ it "test-case #399" $ [s|%20.x|] (0 :: Word32) @?= " "+ it "test-case #400" $ [s|%20.X|] (305441741 :: Int32) @?= " 1234ABCD"+ it "test-case #401" $ [s|%20.0X|] (3989525555 :: Word32) @?= " EDCB5433"+ it "test-case #402" $ [s|%20.X|] (0 :: Word32) @?= " "+ it "test-case #403" $+ [s|% -0+*.*s|] (20 :: Int32) (5 :: Int32) "Hallo heimur" @?=+ "Hallo "+ it "test-case #404" $+ [s|% -0+*.*d|] (20 :: Int32) (5 :: Int32) (1024 :: Int32) @?=+ "+01024 "+ it "test-case #405" $+ [s|% -0+*.*d|] (20 :: Int32) (5 :: Int32) (-1024 :: Int32) @?=+ "-01024 "+ it "test-case #406" $+ [s|% -0+*.*i|] (20 :: Int32) (5 :: Int32) (1024 :: Int32) @?=+ "+01024 "+ it "test-case #407" $+ [s|% 0-+*.*i|] (20 :: Int32) (5 :: Int32) (-1024 :: Int32) @?=+ "-01024 "+ it "test-case #408" $+ [s|% 0-+*.*u|] (20 :: Int32) (5 :: Int32) (1024 :: Int32) @?=+ "01024 "+ it "test-case #409" $+ [s|% 0-+*.*u|] (20 :: Int32) (5 :: Int32) (4294966272 :: Word32) @?=+ "4294966272 "+ it "test-case #410" $+ [s|%+ -0*.*o|] (20 :: Int32) (5 :: Int32) (511 :: Int32) @?=+ "00777 "+ it "test-case #411" $+ [s|%+ -0*.*o|] (20 :: Int32) (5 :: Int32) (4294966785 :: Word32) @?=+ "37777777001 "+ it "test-case #412" $+ [s|%+ -0*.*x|] (20 :: Int32) (5 :: Int32) (305441741 :: Int32) @?=+ "1234abcd "+ it "test-case #413" $+ [s|%+ -0*.*x|] (20 :: Int32) (10 :: Int32) (3989525555 :: Word32) @?=+ "00edcb5433 "+ it "test-case #414" $+ [s|% -+0*.*X|] (20 :: Int32) (5 :: Int32) (305441741 :: Int32) @?=+ "1234ABCD "+ it "test-case #415" $+ [s|% -+0*.*X|] (20 :: Int32) (10 :: Int32) (3989525555 :: Word32) @?=+ "00EDCB5433 "+ it "test-case #416" $ [s|%*sx|] (-3 :: Int32) "hi" @?= "hi x"
tests/format.hs view
@@ -1,18 +1,42 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# Language CPP #-}-{-# Language OverloadedStrings #-}-{-# Language TemplateHaskell #-}-{-# Language QuasiQuotes #-}+{-# OPTIONS_GHC -Wwarn #-}+{-# LANGUAGE QuasiQuotes #-} -module Main (main) where+module Main where -import Codegen-import qualified Data.Text as T+import Foreign.Ptr+import GeneratedSpec+import Language.Haskell.Printf+import Test.HUnit import Test.Hspec-import Text.Printf.TH main :: IO () main =- hspec $ do- $(gen "String quoter" 'id s)- $(gen "Text quoter" 'T.pack st)+ hspec $+ describe "th-printf" $ do+ GeneratedSpec.spec+ it "hexadecimal float" $ do+ [s|%a|] 0.857421875 @?= "0x1.b7p-1"+ [s|%A|] 3.1415926 @?= "0X1.921FB4D12D84AP+1"+ [s|%.3a|] 1.999999999 @?= "0x2.000p+0"+ [s|%.0a|] 1.999999999 @?= "0x2p+0"+ [s|%#.0a|] 1.999999999 @?= "0x2.p+0"+ [s|%.3a|] 0.7576 @?= "0x1.83ep-1"+ [s|%015.3a|] 0.7576 @?= "0x000001.83ep-1"+ [s|% 15.3a|] 0.7576 @?= " 0x1.83ep-1"+ it "Show instances" $ do+ [s|%?|] () @?= "()"+ [s|%10?|] () @?= " ()"+ it "pointer" $ do+ [s|%p|] nullPtr @?= "0x0"+ [s|%15p|] fakePtr @?= " 0xdeadbeef"+ -- sign flag does nothing+ [s|%+p|] fakePtr @?= "0xdeadbeef"+ -- prefix flag does nothing+ [s|%#p|] fakePtr @?= "0xdeadbeef"+ -- zero flag does nothing+ [s|%015p|] fakePtr @?= " 0xdeadbeef"+ -- left-pad flag does nothing+ [s|%-15p|] fakePtr @?= " 0xdeadbeef"++fakePtr :: Ptr ()+fakePtr = nullPtr `plusPtr` 0xdeadbeef
th-printf.cabal view
@@ -1,63 +1,82 @@-name: th-printf-version: 0.5.1-synopsis: Compile-time printf-description: Quasiquoters for printf: string, bytestring, text.-license: MIT-license-file: LICENSE-author: Jude Taylor-maintainer: me@jude.xy-category: Text-homepage: https://github.com/pikajude/th-printf-build-type: Simple cabal-version: >= 1.10 +-- This file has been generated from package.yaml by hpack version 0.29.6.+--+-- see: https://github.com/sol/hpack+--+-- hash: 02f18fcc2963d061d9c5bff9a6cd352518b69cf49131279a887e54cc33c0ea3e++name: th-printf+version: 0.6.0+synopsis: Quasiquoters for printf+description: Quasiquoters for printf: string, bytestring, text.+category: Text+homepage: https://github.com/pikajude/th-printf#readme+bug-reports: https://github.com/pikajude/th-printf/issues+author: Jude Taylor+maintainer: me@jude.xyz+license: MIT+license-file: LICENSE+tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3+build-type: Simple+ source-repository head- type: git- location: git://github.com/pikajude/th-printf.git+ type: git+ location: https://github.com/pikajude/th-printf -library- exposed-modules: Text.Printf.TH- other-modules: NumericUtils- Text.Printf.TH.Parser- Text.Printf.TH.Printer- Text.Printf.TH.Printer.String- Text.Printf.TH.Types- hs-source-dirs: src- build-depends: base >= 4.8 && < 5- , ansi-wl-pprint- , attoparsec- , charset- , containers- , template-haskell- , text- , transformers- , trifecta- , utf8-string- default-language: Haskell2010- default-extensions: NoMonomorphismRestriction- ghc-options: -Wall -fno-warn-missing-signatures -fno-warn-name-shadowing- -fno-warn-unused-do-bind+flag werror+ description: Build with -Werror+ manual: True+ default: False -test-suite format- type: exitcode-stdio-1.0- main-is: format.hs- other-modules: Codegen- hs-source-dirs: tests- build-depends: base- , HUnit- , QuickCheck- , bytestring- , hspec- , template-haskell- , text- , th-printf+library+ exposed-modules:+ Language.Haskell.Printf+ Language.Haskell.Printf.Lib+ other-modules:+ Language.Haskell.Printf.Geometry+ Language.Haskell.Printf.Printers+ Language.Haskell.PrintfArg+ NumUtils+ StrUtils+ Parser+ Parser.Types+ Paths_th_printf+ hs-source-dirs:+ src+ parser+ ghc-options: -Wall+ build-depends:+ base ==4.*+ , charset+ , containers+ , microlens-platform+ , mtl+ , parsec+ , semigroups+ , template-haskell+ , th-lift+ , transformers+ if flag(werror)+ ghc-options: -Werror default-language: Haskell2010- ghc-options: -Wall -fno-warn-type-defaults -benchmark perf- type: exitcode-stdio-1.0- main-is: benchmark.hs- hs-source-dirs: benchmark- build-depends: base, criterion, text, th-printf+test-suite format+ type: exitcode-stdio-1.0+ main-is: format.hs+ other-modules:+ GeneratedSpec+ Paths_th_printf+ hs-source-dirs:+ tests+ ghc-options: -Wall+ build-depends:+ HUnit+ , QuickCheck+ , base ==4.*+ , hspec+ , template-haskell+ , th-printf+ if flag(werror)+ ghc-options: -Werror default-language: Haskell2010- ghc-options: -O2 -Wall -fno-warn-type-defaults