th-printf 0.6.0 → 0.7
raw patch · 18 files changed
+1238/−1072 lines, 18 filesdep +dlistdep +hspec-coredep +integer-logarithmssetup-changed
Dependencies added: dlist, hspec-core, integer-logarithms, primitive, text
Files
- CHANGELOG.md +21/−0
- Setup.hs +2/−0
- include/compat-defs.h +5/−0
- parser/Parser.hs +120/−111
- parser/Parser/Types.hs +27/−26
- src/Buildable.hs +76/−0
- src/Language/Haskell/Printf.hs +50/−44
- src/Language/Haskell/Printf/Geometry.hs +44/−46
- src/Language/Haskell/Printf/Lib.hs +92/−68
- src/Language/Haskell/Printf/Printers.hs +146/−124
- src/Language/Haskell/PrintfArg.hs +1/−1
- src/NumUtils.hs +119/−138
- src/StrUtils.hs +11/−12
- tests/GeneratedSpec.hs +0/−452
- tests/format.hs +0/−42
- tests/printf/GeneratedSpec.hs +450/−0
- tests/printf/format.hs +47/−0
- th-printf.cabal +27/−8
+ CHANGELOG.md view
@@ -0,0 +1,21 @@+## 0.7.0 (2019-09-12)++* New `%Q` and `%q` format specifiers accept strict and lazy Text as input+ respectively. Otherwise they function identically to the `%s` specifier.+* th-printf can now produce lazy Text as well as String, and the improved+ internal representation of format strings should slightly increase performance.+ * Directly producing Text should now be significantly faster than using the + string formatter and `pack`ing the result, especially with Text format arguments.+* Dropped support for GHC < 8.++## 0.6.0 (2018-08-18)++Backported new backpack-based code to pre GHC-8.4 versions.++* Rename of public modules+* Parser rewrite+* th-printf now prints a warning when given an erroneous format string+* Several printf behaviors have been updated to comply with spec:+ * `x`, `u`, etc. specifiers now only apply to positive integers+ * Length specifiers are allowed+* Generated testsuite covers more cases
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ include/compat-defs.h view
@@ -0,0 +1,5 @@+#if __GLASGOW_HASKELL__ >= 840+#define MONOID_HEAD Monoid a+#else+#define MONOID_HEAD (Semigroup a, Monoid a)+#endif
parser/Parser.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -fno-warn-unused-do-bind #-}+{-# LANGUAGE TupleSections #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE FlexibleContexts #-}@@ -6,139 +7,147 @@ 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)+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"+ 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 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 ()+ where+ (_, a, b) = runRWS (warnLength f >> go (spec f)) () f+ go c | c `elem` "aAeEfFgGxXo" = return ()+ go c | c `elem` "csqQ?" = 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 <- "csqQ", 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?"+specSet = fromList "diuoxXfFeEaAgGpcsQq?" lengthSpecifiers :: [(String, LengthSpecifier)] lengthSpecifiers =- [ ("hh", DoubleH)- , ("h", H)- , ("ll", DoubleL)- , ("l", L)- , ("j", J)- , ("z", Z)- , ("t", T)- , ("L", BigL)- ]+ [ ("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 [] = []+ 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)+ 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
@@ -3,12 +3,16 @@ 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)+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@@ -27,14 +31,14 @@ 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"+ 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@@ -79,18 +83,15 @@ 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- }+ 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_")
+ src/Buildable.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}++module Buildable where++import Data.String+import qualified Data.DList as D+import Data.Char ( intToDigit )+import Data.Text.Lazy ( Text )+import qualified Data.Text.Lazy.Builder as T+import qualified Data.Text.Lazy.Builder.Int as T+import Data.Semigroup ( Semigroup(..) )+import qualified Data.Text.Lazy as L+import qualified Data.Text as S++newtype Sized a = Sized { unSized :: (a, Int) } deriving (Show, Ord, Eq)++type SizedStr = Sized (D.DList Char)+type SizedBuilder = Sized T.Builder++instance IsString a => IsString (Sized a) where+ fromString s = Sized (fromString s, length s)++instance Semigroup a => Semigroup (Sized a) where+ Sized (a, b) <> Sized (c, d) = Sized (a <> c, b + d)+ {-# INLINE (<>) #-}++instance MONOID_HEAD => Monoid (Sized a) where+ mempty = Sized (mempty, 0)+ mappend = (<>)+ {-# INLINE mappend #-}++class MONOID_HEAD => Buildable a where+ type Output a :: *++ str :: String -> a++ sText :: S.Text -> a+ sText = str . S.unpack+ lText :: L.Text -> a+ lText = str . L.unpack++ singleton :: Char -> a+ digit :: Int -> a+ digit = singleton . intToDigit+ {-# INLINE digit #-}++ cons :: Char -> a -> a+ cons c s = singleton c <> s+ {-# INLINE cons #-}++ repeatN :: Int -> Char -> a+ repeatN n = str . replicate n++ size :: a -> Int++ finalize :: a -> Output a++instance Buildable SizedStr where+ type Output SizedStr = String+ str a = Sized (D.fromList a, length a)+ singleton c = Sized (D.singleton c, 1)+ finalize = D.toList . fst . unSized+ cons c (Sized (r, m)) = Sized (D.cons c r, m + 1)+ repeatN n c = Sized (D.replicate n c, n)+ size = snd . unSized++instance Buildable SizedBuilder where+ type Output SizedBuilder = Text+ str a = Sized (fromString a, length a)+ sText a = Sized (T.fromText a, S.length a)+ lText a = Sized (T.fromLazyText a, fromIntegral (L.length a))+ singleton c = Sized (T.singleton c, 1)+ digit c = Sized (T.hexadecimal c, 1)+ finalize = T.toLazyText . fst . unSized+ size = snd . unSized
src/Language/Haskell/Printf.hs view
@@ -3,19 +3,33 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-} +-- | "Text.Printf" is a useful module, but due to the typeclass hacks it uses, it can+-- be hard to tell if the format string you wrote is well-formed or not.+-- This package provides a mechanism to create formatting functions at compile time.+--+-- Note that, to maintain consistency with other printf implementations, negative ints+-- that are printed as unsigned will \"underflow\". (Text.Printf does this too.)+--+-- >>> [s|%u|] (-1 :: Int32)+-- "4294967295"+--+-- Thus, any time you want to print a number using the unsigned, octal, or hex specifiers,+-- your input must be an instance of "Bounded". module Language.Haskell.Printf- ( s- , p- , hp- ) where+ ( s+ , t+ , 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)+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 ) -- | @ -- ['s'|Hello, %s! (%d people greeted)|] :: ... -> 'String'@@ -29,6 +43,8 @@ -- @ -- %c :: 'Char' -- %s :: 'String'+-- %q :: 'Data.Text.Lazy.Text' -- lazy text+-- %Q :: 'Data.Text.Text' -- strict text -- -- -- datatypes with Show instances -- %? :: 'Show' a => a@@ -49,31 +65,26 @@ -- -- %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- }+s = quoter $ \s' -> do+ (lhss, rhs) <- toSplices s' OutputString+ return $ LamE lhss rhs +-- | Behaves identically to 's', but produces lazy 'Data.Text.Lazy.Text'.+t :: QuasiQuoter+t = quoter $ \s' -> do+ (lhss, rhs) <- toSplices s' OutputText+ 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))|]- }+p = quoter $ \s' -> do+ (lhss, rhs) <- toSplices s' OutputString+ lamE (map pure lhss) [|liftIO (putStr $(pure rhs))|] -- | Like 'p', but takes as its first argument the 'System.IO.Handle' to print to. --@@ -81,20 +92,15 @@ -- [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))|]- }+hp = quoter $ \s' -> do+ (lhss, rhs) <- toSplices s' OutputString+ 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"- }+quoter :: (String -> ExpQ) -> QuasiQuoter+quoter e = QuasiQuoter+ { quoteExp = e+ , 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
@@ -3,59 +3,57 @@ 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+import Control.Applicative ( (<$>) )+import Control.Monad+import Data.Maybe+import Data.Monoid ( mempty )+import Data.Semigroup ( (<>) )+import Language.Haskell.PrintfArg+import Parser.Types ( Adjustment(..) ) -data Value = Value- { valArg :: PrintfArg String- , valPrefix :: Maybe String- , valSign :: Maybe String+import qualified Buildable as B+import StrUtils++data Value buf = Value+ { valArg :: PrintfArg buf+ , valPrefix :: Maybe buf+ , valSign :: Maybe buf } 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+sign' :: (Num n, Ord n, B.Buildable buf) => PrintfArg n -> Maybe buf+sign' pf | value pf < 0 = Just (B.singleton '-')+ | spaced pf = Just (B.singleton ' ')+ | signed pf = Just (B.singleton '+')+ | 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)+padDecimal :: (B.Buildable buf, Eq v, Num v) => PrintfArg v -> buf -> buf+padDecimal spec | prec spec == Just 0 && value spec == 0 = const mempty+ | otherwise = maybe id (`justifyRight` '0') (prec spec) -prefix :: (Num n, Eq n) => String -> PrintfArg n -> Maybe String+prefix :: (Num n, Eq n, B.Buildable buf) => buf -> PrintfArg n -> Maybe buf 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+ :: B.Buildable buf+ => (n -> buf)+ -> (PrintfArg n -> Maybe buf)+ -> (PrintfArg n -> Maybe buf)+ -> PrintfArg n+ -> Value buf fromPrintfArg f b c a = Value (f <$> a) (b a) (c a) -formatOne :: Value -> String+formatOne :: B.Buildable buf => Value buf -> buf 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+ | Nothing <- width valArg = prefix' <> text+ | Just w <- width valArg = case adjustment valArg of+ Just ZeroPadded | isn'tDecimal || isNothing (prec valArg) ->+ prefix' <> justifyRight (w - B.size 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
@@ -1,21 +1,40 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE DeriveGeneric #-} module Language.Haskell.Printf.Lib- ( toSplices- ) where+ ( toSplices+ , OutputType (..)+ )+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)+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 GHC.Generics ( Generic ) +import Parser ( parseStr )+import Parser.Types hiding ( lengthSpec+ , width+ )+import Buildable ( finalize+ , SizedStr+ , SizedBuilder+ )++data OutputType = OutputString | OutputText+ deriving (Show, Eq, Ord, Generic, Enum, Bounded)+ -- | 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.@@ -24,62 +43,67 @@ -- -- 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')+toSplices :: String -> OutputType -> Q ([Pat], Exp)+toSplices s' ot = 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' <- appE+ [|finalize|]+ (sigE (foldr1 (\x y' -> infixApp x [|(<>)|] y') rhss) otype)+ return (map VarP $ concat lhss, rhss')+ where+ otype = case ot of+ OutputString -> [t|SizedStr|]+ OutputText -> [t|SizedBuilder|] 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+ (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|]+ 'q' -> [|Printers.printfLazyText|]+ 'Q' -> [|Printers.printfStrictText|]+ '?' -> [|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
@@ -1,149 +1,171 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RankNTypes #-} {-# 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+import Control.Applicative ( (<$>) )+import Data.Char+import Data.String ( fromString )+import Data.Maybe ( fromMaybe )+import Foreign.Ptr+import GHC.Float ( FFFormat(..) )+import Language.Haskell.Printf.Geometry+import Language.Haskell.PrintfArg+import qualified Data.Text.Lazy as L+import qualified Data.Text as S+import Math.NumberTheory.Logarithms -type Printer n = PrintfArg n -> Value+import NumUtils+import qualified Parser.Types as P+import qualified Buildable as B -printfString :: Printer String-printfString spec =- Value- { valArg =- case prec spec of- Nothing -> spec- Just c -> take c <$> spec- , valPrefix = Nothing- , valSign = Nothing- }+type Printer n buf = PrintfArg n -> Value buf -printfShow :: Show a => Printer a+printfString :: B.Buildable buf => Printer String buf+printfString spec = Value+ { valArg = case prec spec of+ Nothing -> B.str <$> spec+ Just c -> B.str . take c <$> spec+ , valPrefix = Nothing+ , valSign = Nothing+ }++printfStrictText :: B.Buildable buf => Printer S.Text buf+printfStrictText spec = Value+ { valArg = case prec spec of+ Nothing -> B.sText <$> spec+ Just c -> B.sText . S.take c <$> spec+ , valPrefix = Nothing+ , valSign = Nothing+ }++printfLazyText :: B.Buildable buf => Printer L.Text buf+printfLazyText spec = Value+ { valArg = case prec spec of+ Nothing -> B.lText <$> spec+ Just c -> B.lText . L.take (fromIntegral c) <$> spec+ , valPrefix = Nothing+ , valSign = Nothing+ }++printfShow :: (B.Buildable buf, Show a) => Printer a buf printfShow spec = printfString (fromString . show <$> spec) -printfChar :: Printer Char-printfChar spec = Value {valArg = pure <$> spec, valPrefix = Nothing, valSign = Nothing}+printfChar :: B.Buildable buf => Printer Char buf+printfChar spec = Value { valArg = B.singleton <$> 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}+{-# ANN printfPtr ("HLint: ignore Use showHex" :: String) #-}+printfPtr :: B.Buildable buf => Printer (Ptr a) buf+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)+ , fieldSpec = 'p'+ , value = showIntAtBase 16 intToDigit (ptrToWordPtr $ value spec) }- , valPrefix = Just "0x"- , valSign = Nothing- }- where- toInt x = x `minusPtr` nullPtr+ , valPrefix = Just (B.str "0x")+ , valSign = Nothing+ } -printfDecimal spec =- Value- { valArg = padDecimal spec . showIntAtBase 10 intToDigit . abs <$> spec- , valPrefix = Nothing- , valSign = sign' spec- }+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+fmtUnsigned+ :: (Bounded a, Integral a, B.Buildable buf)+ => (Integer -> buf)+ -> (PrintfArg a -> Maybe buf)+ -> Printer a buf+fmtUnsigned shower p spec = Value+ { valArg = padDecimal spec . shower . clampUnsigned <$> spec+ , valPrefix = p spec+ , valSign = Nothing+ } -printfHex b =- fmtUnsigned- showHex- (prefix- (if b- then "0X"- else "0x"))- where- showHex =- showIntAtBase- 16- ((if b- then toUpper- else id) .- intToDigit)+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+-- printing octal is really annoying. consider+--+-- printf "%#-8.5x" 1234+--+-- "0x004d2 "+-- ^~~~~~~^ width (8)+-- ^~~~^ precision (5)+-- ^^ prefix (2)+-- ^^ padding (2)+--+-- printf "%#-8.5o" 1234+--+-- "02322 "+-- ^~~~~~~^ width (8)+-- ^~~~^ precision (5)+-- ^ prefix (1)+-- ^ padding (1, same character)+--+-- in octal, when combining prefix and padding, the prefix+-- must eat the first padding char+{-# ANN printfOctal ("HLint: ignore Use showOct" :: String) #-}+printfOctal spec = fmtUnsigned+ (showIntAtBase 8 intToDigit)+ (\y -> if shouldUnpad then Nothing else prefix "0" y)+ spec+ where+ expectedWidth = integerLogBase 8 (max 1 $ clampUnsigned $ value spec) + 1+ shouldUnpad = prefixed spec && fromMaybe 0 (prec spec) > expectedWidth -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+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+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+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+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++clampUnsigned :: (Bounded a, Integral a) => a -> Integer+clampUnsigned x | x < 0 = toInteger x + (-2 * toInteger (minBound `asTypeOf` x))+ | otherwise = toInteger x
src/Language/Haskell/PrintfArg.hs view
@@ -2,7 +2,7 @@ module Language.Haskell.PrintfArg where -import qualified Parser.Types as P+import qualified Parser.Types as P data PrintfArg v = PrintfArg { flagSet :: P.FlagSet
src/NumUtils.hs view
@@ -1,153 +1,134 @@ {-# 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+import Data.Bits+import Data.Char+import Data.Foldable+import Data.Ord+import Data.Semigroup ( (<>) )+import Data.Tuple+import GHC.Float ( FFFormat(..)+ , roundTo+ )+import Numeric ( floatToDigits )+import Prelude hiding ( exp+ , foldr+ , (<>)+ ) -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+import qualified Buildable as B+import StrUtils -formatRealFloatAlt :: RealFloat a => FFFormat -> Maybe Int -> Bool -> Bool -> a -> String+showIntAtBase+ :: (B.Buildable buf, Show a, Integral a) => a -> (Int -> Char) -> a -> buf+showIntAtBase base toChr n0 | base <= 1 = error "unsupported base"+ | n0 < 0 = error $ "negative number " ++ show n0+ | otherwise = showIt (quotRem n0 base) mempty+ where+ showIt (n, d) r = case n of+ 0 -> r'+ _ -> showIt (quotRem n base) r'+ where r' = B.cons (toChr (fromIntegral d)) r++formatRealFloatAlt+ :: (B.Buildable buf, RealFloat a)+ => FFFormat+ -> Maybe Int+ -> Bool+ -> Bool+ -> a+ -> buf 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]+ | isNaN x = B.str "NaN"+ | isInfinite x = B.str $ if x < 0 then "-Infinity" else "Infinity"+ | x < 0 || isNegativeZero x = B.cons+ '-'+ (doFmt fmt (floatToDigits 10 (-x)) False)+ | otherwise = doFmt fmt (floatToDigits 10 x) False+ where+ eChar | upper = 'E'+ | otherwise = '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 B.singleton '.' else mempty)+ | null whole+ = B.str "0." <> fromDigits False part+ | otherwise+ = fromDigits False whole <> B.singleton '.' <> fromDigits False part+ where+ (whole, part) =+ uncurry (flip splitAt) (toRoundedDigits decs (digs, exp) fullRounding)+ doFmt FFExponent ([0], _) _ | forceDot = B.str "0.e+00"+ | otherwise = B.str "0e+00"+ doFmt FFExponent (digs, exp) fullRounding =+ shownDigs <> B.cons eChar shownExponent+ where+ shownDigs = case digs' of+ [] -> undefined+ [x'] ->+ B.cons (intToDigit x') (if forceDot then B.singleton '.' else mempty)+ (x' : xs) -> B.cons (intToDigit x') (B.cons '.' (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 =+ B.cons (if exp' < 0 then '-' else '+')+ $ justifyRight 2 '0'+ $ showIntAtBase 10 intToDigit+ $ abs exp'+ doFmt FFGeneric d _ =+ minimumBy (comparing B.size) [doFmt FFFixed d True, doFmt FFExponent d True] toRoundedDigits :: Maybe Int -> ([Int], Int) -> Bool -> ([Int], Int)-toRoundedDigits Nothing (digs, exp) _ = (digs, exp)+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+ where+ (overflow, digs') = roundTo+ 10+ (if fullRounding && prec > exp then min (length digs) prec else prec + exp)+ digs -fromDigits :: Bool -> [Int] -> String+fromDigits :: B.Buildable buf => Bool -> [Int] -> buf fromDigits upper =- foldr- ((:) .- id .- (if upper- then toUpper- else id) .- intToDigit)- []+ foldr (B.cons . (if upper then toUpper else id) . intToDigit) mempty -formatHexFloat :: RealFloat a => Maybe Int -> Bool -> Bool -> a -> String+formatHexFloat+ :: (B.Buildable buf, RealFloat a) => Maybe Int -> Bool -> Bool -> a -> buf 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 [] = []+ where+ pChar | upper = 'P'+ | otherwise = 'p'+ doFmt ([] , _) = undefined+ doFmt ([0], 0) = B.cons '0' (B.cons pChar (B.str "+0"))+ doFmt (_ : bits, exp) =+ B.str "1"+ <> (if not (null hexDigits) || alt then B.singleton '.' else mempty)+ <> fromDigits upper hexDigits+ <> B.singleton pChar+ <> (if exp > 0 then B.singleton '+' else mempty)+ <> B.str (show (exp - 1 + overflow))+ 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/StrUtils.hs view
@@ -1,15 +1,14 @@ 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+import Data.Semigroup ( (<>) )+import Buildable -justifyRight :: Int -> Char -> String -> String-justifyRight n c s- | diff <= 0 = s- | otherwise = replicate diff c ++ s- where- diff = n - length s+justifyLeft :: Buildable a => Int -> Char -> a -> a+justifyLeft n c s | diff <= 0 = s+ | otherwise = s <> repeatN diff c+ where diff = n - size s++justifyRight :: Buildable a => Int -> Char -> a -> a+justifyRight n c s | diff <= 0 = s+ | otherwise = repeatN diff c <> s+ where diff = n - size s
− tests/GeneratedSpec.hs
@@ -1,452 +0,0 @@--- 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
@@ -1,42 +0,0 @@-{-# OPTIONS_GHC -Wwarn #-}-{-# LANGUAGE QuasiQuotes #-}--module Main where--import Foreign.Ptr-import GeneratedSpec-import Language.Haskell.Printf-import Test.HUnit-import Test.Hspec--main :: IO ()-main =- 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
+ tests/printf/GeneratedSpec.hs view
@@ -0,0 +1,450 @@+-- 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++spec :: Spec+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/printf/format.hs view
@@ -0,0 +1,47 @@+{-# OPTIONS_GHC -Wwarn #-}+{-# LANGUAGE QuasiQuotes #-}++module Main where++import Foreign.Ptr+import GeneratedSpec+import Language.Haskell.Printf+import Test.HUnit+import Test.Hspec+import qualified Data.Text as S+import qualified Data.Text.Lazy as L++main :: IO ()+main = hspec $ describe "th-printf" $ do+ GeneratedSpec.spec+ it "text" $ do+ -- sanity checking that text can be rendered+ -- all the actual string formatting is in GeneratedSpec+ [s|Hello, %Q!|] (S.pack "world") @?= "Hello, world!"+ [s|Hello, %q!|] (L.pack "world") @?= "Hello, world!"+ it "hexadecimal float" $ do+ [s|%a|] 0.857421875 @?= "0x1.b7p-1"+ [s|%A|] 3.1415926 @?= "0X1.921FB4D12D84AP+1"+ [s|%.3a|] 1.999999999 @?= "0x1.000p+1"+ [s|%.0a|] 1.999999999 @?= "0x1p+1"+ [s|%#.0a|] 1.999999999 @?= "0x1.p+1"+ [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,15 +1,15 @@-cabal-version: >= 1.10+cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.29.6.+-- This file has been generated from package.yaml by hpack version 0.32.0. -- -- see: https://github.com/sol/hpack ----- hash: 02f18fcc2963d061d9c5bff9a6cd352518b69cf49131279a887e54cc33c0ea3e+-- hash: 62c8df7d3174235654f8edabd47054d66b3551339b9b409b40da4d405dd12733 name: th-printf-version: 0.6.0+version: 0.7 synopsis: Quasiquoters for printf-description: Quasiquoters for printf: string, bytestring, text.+description: Quasiquoters for string and text printf category: Text homepage: https://github.com/pikajude/th-printf#readme bug-reports: https://github.com/pikajude/th-printf/issues@@ -17,8 +17,11 @@ 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+tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.1 build-type: Simple+extra-source-files:+ CHANGELOG.md+ include/compat-defs.h source-repository head type: git@@ -34,6 +37,7 @@ Language.Haskell.Printf Language.Haskell.Printf.Lib other-modules:+ Buildable Language.Haskell.Printf.Geometry Language.Haskell.Printf.Printers Language.Haskell.PrintfArg@@ -45,18 +49,26 @@ hs-source-dirs: src parser+ default-extensions: CPP ghc-options: -Wall+ cpp-options: -include include/compat-defs.h build-depends: base ==4.* , charset , containers+ , dlist+ , integer-logarithms , microlens-platform , mtl , parsec , semigroups , template-haskell+ , text , th-lift , transformers+ if impl(ghcjs)+ build-depends:+ primitive ==0.6.3.0 if flag(werror) ghc-options: -Werror default-language: Haskell2010@@ -68,15 +80,22 @@ GeneratedSpec Paths_th_printf hs-source-dirs:- tests- ghc-options: -Wall+ tests/printf+ ghc-options: -Wall -fno-warn-type-defaults build-depends: HUnit , QuickCheck , base ==4.* , hspec , template-haskell+ , text , th-printf+ if impl(ghcjs)+ build-depends:+ primitive ==0.6.3.0 if flag(werror) ghc-options: -Werror+ if impl(ghcjs)+ build-depends:+ hspec-core ==2.4.8 default-language: Haskell2010