------------------------------------------------------------------------
-- |
-- Module           : Lang.Crucible.LLVM.Printf
-- Description      : Interpretation of 'printf' style conversion codes
-- Copyright        : (c) Galois, Inc 2015-2016
-- License          : BSD3
-- Maintainer       : Rob Dockins <rdockins@galois.com>
-- Stability        : provisional
--
-- A model of C's @printf@ function. This does not entirely conform to the C
-- standard's specification of @printf@; see @doc/limitations.md@ for the
-- specifics.
--
------------------------------------------------------------------------

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}

module Lang.Crucible.LLVM.Printf
( PrintfFlag(..)
, PrintfLengthModifier(..)
, Case(..)
, IntFormat(..)
, FloatFormat(..)
, PrintfConversionType(..)
, PrintfDirective(..)
, parseDirectives
, ConversionDirective(..)
, PrintfOperations(..)
, executeDirectives
, formatInteger
, formatRational
) where

import           Data.Char (toUpper)
import qualified Numeric as N
import           Control.Applicative
import           Data.Attoparsec.ByteString.Char8 hiding (take)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import           Data.Maybe
import           Data.Set (Set)
import qualified Data.Set as Set
import           Data.Word
import qualified GHC.Stack as GHC

data PrintfFlag
  = PrintfAlternateForm   -- #
  | PrintfZeroPadding     -- 0
  | PrintfNegativeWidth   -- -
  | PrintfPosSpace        -- ' '
  | PrintfPosPlus         -- +
  | PrintfThousandsSep    -- '
 deriving (PrintfFlag -> PrintfFlag -> Bool
(PrintfFlag -> PrintfFlag -> Bool)
-> (PrintfFlag -> PrintfFlag -> Bool) -> Eq PrintfFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrintfFlag -> PrintfFlag -> Bool
== :: PrintfFlag -> PrintfFlag -> Bool
$c/= :: PrintfFlag -> PrintfFlag -> Bool
/= :: PrintfFlag -> PrintfFlag -> Bool
Eq,Eq PrintfFlag
Eq PrintfFlag =>
(PrintfFlag -> PrintfFlag -> Ordering)
-> (PrintfFlag -> PrintfFlag -> Bool)
-> (PrintfFlag -> PrintfFlag -> Bool)
-> (PrintfFlag -> PrintfFlag -> Bool)
-> (PrintfFlag -> PrintfFlag -> Bool)
-> (PrintfFlag -> PrintfFlag -> PrintfFlag)
-> (PrintfFlag -> PrintfFlag -> PrintfFlag)
-> Ord PrintfFlag
PrintfFlag -> PrintfFlag -> Bool
PrintfFlag -> PrintfFlag -> Ordering
PrintfFlag -> PrintfFlag -> PrintfFlag
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PrintfFlag -> PrintfFlag -> Ordering
compare :: PrintfFlag -> PrintfFlag -> Ordering
$c< :: PrintfFlag -> PrintfFlag -> Bool
< :: PrintfFlag -> PrintfFlag -> Bool
$c<= :: PrintfFlag -> PrintfFlag -> Bool
<= :: PrintfFlag -> PrintfFlag -> Bool
$c> :: PrintfFlag -> PrintfFlag -> Bool
> :: PrintfFlag -> PrintfFlag -> Bool
$c>= :: PrintfFlag -> PrintfFlag -> Bool
>= :: PrintfFlag -> PrintfFlag -> Bool
$cmax :: PrintfFlag -> PrintfFlag -> PrintfFlag
max :: PrintfFlag -> PrintfFlag -> PrintfFlag
$cmin :: PrintfFlag -> PrintfFlag -> PrintfFlag
min :: PrintfFlag -> PrintfFlag -> PrintfFlag
Ord,Int -> PrintfFlag -> ShowS
[PrintfFlag] -> ShowS
PrintfFlag -> String
(Int -> PrintfFlag -> ShowS)
-> (PrintfFlag -> String)
-> ([PrintfFlag] -> ShowS)
-> Show PrintfFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrintfFlag -> ShowS
showsPrec :: Int -> PrintfFlag -> ShowS
$cshow :: PrintfFlag -> String
show :: PrintfFlag -> String
$cshowList :: [PrintfFlag] -> ShowS
showList :: [PrintfFlag] -> ShowS
Show)

data PrintfLengthModifier
  = Len_Byte                  -- hh
  | Len_Short                 -- h
  | Len_Long                  -- l
  | Len_LongLong              -- ll
  | Len_LongDouble            -- L
  | Len_IntMax                -- j
  | Len_PtrDiff               -- t
  | Len_Sizet                 -- z
  | Len_NoMod                 -- <<no length modifier>>
 deriving (PrintfLengthModifier -> PrintfLengthModifier -> Bool
(PrintfLengthModifier -> PrintfLengthModifier -> Bool)
-> (PrintfLengthModifier -> PrintfLengthModifier -> Bool)
-> Eq PrintfLengthModifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrintfLengthModifier -> PrintfLengthModifier -> Bool
== :: PrintfLengthModifier -> PrintfLengthModifier -> Bool
$c/= :: PrintfLengthModifier -> PrintfLengthModifier -> Bool
/= :: PrintfLengthModifier -> PrintfLengthModifier -> Bool
Eq,Eq PrintfLengthModifier
Eq PrintfLengthModifier =>
(PrintfLengthModifier -> PrintfLengthModifier -> Ordering)
-> (PrintfLengthModifier -> PrintfLengthModifier -> Bool)
-> (PrintfLengthModifier -> PrintfLengthModifier -> Bool)
-> (PrintfLengthModifier -> PrintfLengthModifier -> Bool)
-> (PrintfLengthModifier -> PrintfLengthModifier -> Bool)
-> (PrintfLengthModifier
    -> PrintfLengthModifier -> PrintfLengthModifier)
-> (PrintfLengthModifier
    -> PrintfLengthModifier -> PrintfLengthModifier)
-> Ord PrintfLengthModifier
PrintfLengthModifier -> PrintfLengthModifier -> Bool
PrintfLengthModifier -> PrintfLengthModifier -> Ordering
PrintfLengthModifier
-> PrintfLengthModifier -> PrintfLengthModifier
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PrintfLengthModifier -> PrintfLengthModifier -> Ordering
compare :: PrintfLengthModifier -> PrintfLengthModifier -> Ordering
$c< :: PrintfLengthModifier -> PrintfLengthModifier -> Bool
< :: PrintfLengthModifier -> PrintfLengthModifier -> Bool
$c<= :: PrintfLengthModifier -> PrintfLengthModifier -> Bool
<= :: PrintfLengthModifier -> PrintfLengthModifier -> Bool
$c> :: PrintfLengthModifier -> PrintfLengthModifier -> Bool
> :: PrintfLengthModifier -> PrintfLengthModifier -> Bool
$c>= :: PrintfLengthModifier -> PrintfLengthModifier -> Bool
>= :: PrintfLengthModifier -> PrintfLengthModifier -> Bool
$cmax :: PrintfLengthModifier
-> PrintfLengthModifier -> PrintfLengthModifier
max :: PrintfLengthModifier
-> PrintfLengthModifier -> PrintfLengthModifier
$cmin :: PrintfLengthModifier
-> PrintfLengthModifier -> PrintfLengthModifier
min :: PrintfLengthModifier
-> PrintfLengthModifier -> PrintfLengthModifier
Ord,Int -> PrintfLengthModifier -> ShowS
[PrintfLengthModifier] -> ShowS
PrintfLengthModifier -> String
(Int -> PrintfLengthModifier -> ShowS)
-> (PrintfLengthModifier -> String)
-> ([PrintfLengthModifier] -> ShowS)
-> Show PrintfLengthModifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrintfLengthModifier -> ShowS
showsPrec :: Int -> PrintfLengthModifier -> ShowS
$cshow :: PrintfLengthModifier -> String
show :: PrintfLengthModifier -> String
$cshowList :: [PrintfLengthModifier] -> ShowS
showList :: [PrintfLengthModifier] -> ShowS
Show)

data Case
  = UpperCase
  | LowerCase
 deriving (Case -> Case -> Bool
(Case -> Case -> Bool) -> (Case -> Case -> Bool) -> Eq Case
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Case -> Case -> Bool
== :: Case -> Case -> Bool
$c/= :: Case -> Case -> Bool
/= :: Case -> Case -> Bool
Eq,Eq Case
Eq Case =>
(Case -> Case -> Ordering)
-> (Case -> Case -> Bool)
-> (Case -> Case -> Bool)
-> (Case -> Case -> Bool)
-> (Case -> Case -> Bool)
-> (Case -> Case -> Case)
-> (Case -> Case -> Case)
-> Ord Case
Case -> Case -> Bool
Case -> Case -> Ordering
Case -> Case -> Case
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Case -> Case -> Ordering
compare :: Case -> Case -> Ordering
$c< :: Case -> Case -> Bool
< :: Case -> Case -> Bool
$c<= :: Case -> Case -> Bool
<= :: Case -> Case -> Bool
$c> :: Case -> Case -> Bool
> :: Case -> Case -> Bool
$c>= :: Case -> Case -> Bool
>= :: Case -> Case -> Bool
$cmax :: Case -> Case -> Case
max :: Case -> Case -> Case
$cmin :: Case -> Case -> Case
min :: Case -> Case -> Case
Ord,Int -> Case -> ShowS
[Case] -> ShowS
Case -> String
(Int -> Case -> ShowS)
-> (Case -> String) -> ([Case] -> ShowS) -> Show Case
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Case -> ShowS
showsPrec :: Int -> Case -> ShowS
$cshow :: Case -> String
show :: Case -> String
$cshowList :: [Case] -> ShowS
showList :: [Case] -> ShowS
Show)

data IntFormat
  = IntFormat_SignedDecimal      -- i,d
  | IntFormat_UnsignedDecimal    -- u
  | IntFormat_Octal              -- o
  | IntFormat_Hex Case           -- x,X
 deriving (IntFormat -> IntFormat -> Bool
(IntFormat -> IntFormat -> Bool)
-> (IntFormat -> IntFormat -> Bool) -> Eq IntFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IntFormat -> IntFormat -> Bool
== :: IntFormat -> IntFormat -> Bool
$c/= :: IntFormat -> IntFormat -> Bool
/= :: IntFormat -> IntFormat -> Bool
Eq,Eq IntFormat
Eq IntFormat =>
(IntFormat -> IntFormat -> Ordering)
-> (IntFormat -> IntFormat -> Bool)
-> (IntFormat -> IntFormat -> Bool)
-> (IntFormat -> IntFormat -> Bool)
-> (IntFormat -> IntFormat -> Bool)
-> (IntFormat -> IntFormat -> IntFormat)
-> (IntFormat -> IntFormat -> IntFormat)
-> Ord IntFormat
IntFormat -> IntFormat -> Bool
IntFormat -> IntFormat -> Ordering
IntFormat -> IntFormat -> IntFormat
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: IntFormat -> IntFormat -> Ordering
compare :: IntFormat -> IntFormat -> Ordering
$c< :: IntFormat -> IntFormat -> Bool
< :: IntFormat -> IntFormat -> Bool
$c<= :: IntFormat -> IntFormat -> Bool
<= :: IntFormat -> IntFormat -> Bool
$c> :: IntFormat -> IntFormat -> Bool
> :: IntFormat -> IntFormat -> Bool
$c>= :: IntFormat -> IntFormat -> Bool
>= :: IntFormat -> IntFormat -> Bool
$cmax :: IntFormat -> IntFormat -> IntFormat
max :: IntFormat -> IntFormat -> IntFormat
$cmin :: IntFormat -> IntFormat -> IntFormat
min :: IntFormat -> IntFormat -> IntFormat
Ord,Int -> IntFormat -> ShowS
[IntFormat] -> ShowS
IntFormat -> String
(Int -> IntFormat -> ShowS)
-> (IntFormat -> String)
-> ([IntFormat] -> ShowS)
-> Show IntFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IntFormat -> ShowS
showsPrec :: Int -> IntFormat -> ShowS
$cshow :: IntFormat -> String
show :: IntFormat -> String
$cshowList :: [IntFormat] -> ShowS
showList :: [IntFormat] -> ShowS
Show)

signedIntFormat :: IntFormat -> Bool
signedIntFormat :: IntFormat -> Bool
signedIntFormat IntFormat
IntFormat_SignedDecimal = Bool
True
signedIntFormat IntFormat
_ = Bool
False

data FloatFormat
  = FloatFormat_Scientific Case -- e,E
  | FloatFormat_Standard Case   -- f,F
  | FloatFormat_Auto Case       -- g,G
  | FloatFormat_Hex Case        -- a,A
 deriving (FloatFormat -> FloatFormat -> Bool
(FloatFormat -> FloatFormat -> Bool)
-> (FloatFormat -> FloatFormat -> Bool) -> Eq FloatFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FloatFormat -> FloatFormat -> Bool
== :: FloatFormat -> FloatFormat -> Bool
$c/= :: FloatFormat -> FloatFormat -> Bool
/= :: FloatFormat -> FloatFormat -> Bool
Eq,Eq FloatFormat
Eq FloatFormat =>
(FloatFormat -> FloatFormat -> Ordering)
-> (FloatFormat -> FloatFormat -> Bool)
-> (FloatFormat -> FloatFormat -> Bool)
-> (FloatFormat -> FloatFormat -> Bool)
-> (FloatFormat -> FloatFormat -> Bool)
-> (FloatFormat -> FloatFormat -> FloatFormat)
-> (FloatFormat -> FloatFormat -> FloatFormat)
-> Ord FloatFormat
FloatFormat -> FloatFormat -> Bool
FloatFormat -> FloatFormat -> Ordering
FloatFormat -> FloatFormat -> FloatFormat
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FloatFormat -> FloatFormat -> Ordering
compare :: FloatFormat -> FloatFormat -> Ordering
$c< :: FloatFormat -> FloatFormat -> Bool
< :: FloatFormat -> FloatFormat -> Bool
$c<= :: FloatFormat -> FloatFormat -> Bool
<= :: FloatFormat -> FloatFormat -> Bool
$c> :: FloatFormat -> FloatFormat -> Bool
> :: FloatFormat -> FloatFormat -> Bool
$c>= :: FloatFormat -> FloatFormat -> Bool
>= :: FloatFormat -> FloatFormat -> Bool
$cmax :: FloatFormat -> FloatFormat -> FloatFormat
max :: FloatFormat -> FloatFormat -> FloatFormat
$cmin :: FloatFormat -> FloatFormat -> FloatFormat
min :: FloatFormat -> FloatFormat -> FloatFormat
Ord,Int -> FloatFormat -> ShowS
[FloatFormat] -> ShowS
FloatFormat -> String
(Int -> FloatFormat -> ShowS)
-> (FloatFormat -> String)
-> ([FloatFormat] -> ShowS)
-> Show FloatFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FloatFormat -> ShowS
showsPrec :: Int -> FloatFormat -> ShowS
$cshow :: FloatFormat -> String
show :: FloatFormat -> String
$cshowList :: [FloatFormat] -> ShowS
showList :: [FloatFormat] -> ShowS
Show)

data PrintfConversionType
  = Conversion_Integer  IntFormat
  | Conversion_Floating FloatFormat
  | Conversion_Char             -- c
  | Conversion_String           -- s
  | Conversion_Pointer          -- p
  | Conversion_CountChars       -- n
 deriving (PrintfConversionType -> PrintfConversionType -> Bool
(PrintfConversionType -> PrintfConversionType -> Bool)
-> (PrintfConversionType -> PrintfConversionType -> Bool)
-> Eq PrintfConversionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrintfConversionType -> PrintfConversionType -> Bool
== :: PrintfConversionType -> PrintfConversionType -> Bool
$c/= :: PrintfConversionType -> PrintfConversionType -> Bool
/= :: PrintfConversionType -> PrintfConversionType -> Bool
Eq,Eq PrintfConversionType
Eq PrintfConversionType =>
(PrintfConversionType -> PrintfConversionType -> Ordering)
-> (PrintfConversionType -> PrintfConversionType -> Bool)
-> (PrintfConversionType -> PrintfConversionType -> Bool)
-> (PrintfConversionType -> PrintfConversionType -> Bool)
-> (PrintfConversionType -> PrintfConversionType -> Bool)
-> (PrintfConversionType
    -> PrintfConversionType -> PrintfConversionType)
-> (PrintfConversionType
    -> PrintfConversionType -> PrintfConversionType)
-> Ord PrintfConversionType
PrintfConversionType -> PrintfConversionType -> Bool
PrintfConversionType -> PrintfConversionType -> Ordering
PrintfConversionType
-> PrintfConversionType -> PrintfConversionType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PrintfConversionType -> PrintfConversionType -> Ordering
compare :: PrintfConversionType -> PrintfConversionType -> Ordering
$c< :: PrintfConversionType -> PrintfConversionType -> Bool
< :: PrintfConversionType -> PrintfConversionType -> Bool
$c<= :: PrintfConversionType -> PrintfConversionType -> Bool
<= :: PrintfConversionType -> PrintfConversionType -> Bool
$c> :: PrintfConversionType -> PrintfConversionType -> Bool
> :: PrintfConversionType -> PrintfConversionType -> Bool
$c>= :: PrintfConversionType -> PrintfConversionType -> Bool
>= :: PrintfConversionType -> PrintfConversionType -> Bool
$cmax :: PrintfConversionType
-> PrintfConversionType -> PrintfConversionType
max :: PrintfConversionType
-> PrintfConversionType -> PrintfConversionType
$cmin :: PrintfConversionType
-> PrintfConversionType -> PrintfConversionType
min :: PrintfConversionType
-> PrintfConversionType -> PrintfConversionType
Ord,Int -> PrintfConversionType -> ShowS
[PrintfConversionType] -> ShowS
PrintfConversionType -> String
(Int -> PrintfConversionType -> ShowS)
-> (PrintfConversionType -> String)
-> ([PrintfConversionType] -> ShowS)
-> Show PrintfConversionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrintfConversionType -> ShowS
showsPrec :: Int -> PrintfConversionType -> ShowS
$cshow :: PrintfConversionType -> String
show :: PrintfConversionType -> String
$cshowList :: [PrintfConversionType] -> ShowS
showList :: [PrintfConversionType] -> ShowS
Show)

data PrintfDirective
  = StringDirective BS.ByteString
  | ConversionDirective ConversionDirective
 deriving (PrintfDirective -> PrintfDirective -> Bool
(PrintfDirective -> PrintfDirective -> Bool)
-> (PrintfDirective -> PrintfDirective -> Bool)
-> Eq PrintfDirective
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrintfDirective -> PrintfDirective -> Bool
== :: PrintfDirective -> PrintfDirective -> Bool
$c/= :: PrintfDirective -> PrintfDirective -> Bool
/= :: PrintfDirective -> PrintfDirective -> Bool
Eq,Eq PrintfDirective
Eq PrintfDirective =>
(PrintfDirective -> PrintfDirective -> Ordering)
-> (PrintfDirective -> PrintfDirective -> Bool)
-> (PrintfDirective -> PrintfDirective -> Bool)
-> (PrintfDirective -> PrintfDirective -> Bool)
-> (PrintfDirective -> PrintfDirective -> Bool)
-> (PrintfDirective -> PrintfDirective -> PrintfDirective)
-> (PrintfDirective -> PrintfDirective -> PrintfDirective)
-> Ord PrintfDirective
PrintfDirective -> PrintfDirective -> Bool
PrintfDirective -> PrintfDirective -> Ordering
PrintfDirective -> PrintfDirective -> PrintfDirective
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PrintfDirective -> PrintfDirective -> Ordering
compare :: PrintfDirective -> PrintfDirective -> Ordering
$c< :: PrintfDirective -> PrintfDirective -> Bool
< :: PrintfDirective -> PrintfDirective -> Bool
$c<= :: PrintfDirective -> PrintfDirective -> Bool
<= :: PrintfDirective -> PrintfDirective -> Bool
$c> :: PrintfDirective -> PrintfDirective -> Bool
> :: PrintfDirective -> PrintfDirective -> Bool
$c>= :: PrintfDirective -> PrintfDirective -> Bool
>= :: PrintfDirective -> PrintfDirective -> Bool
$cmax :: PrintfDirective -> PrintfDirective -> PrintfDirective
max :: PrintfDirective -> PrintfDirective -> PrintfDirective
$cmin :: PrintfDirective -> PrintfDirective -> PrintfDirective
min :: PrintfDirective -> PrintfDirective -> PrintfDirective
Ord,Int -> PrintfDirective -> ShowS
[PrintfDirective] -> ShowS
PrintfDirective -> String
(Int -> PrintfDirective -> ShowS)
-> (PrintfDirective -> String)
-> ([PrintfDirective] -> ShowS)
-> Show PrintfDirective
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrintfDirective -> ShowS
showsPrec :: Int -> PrintfDirective -> ShowS
$cshow :: PrintfDirective -> String
show :: PrintfDirective -> String
$cshowList :: [PrintfDirective] -> ShowS
showList :: [PrintfDirective] -> ShowS
Show)

data ConversionDirective = Conversion
    { ConversionDirective -> Maybe Int
printfAccessField :: Maybe Int
    , ConversionDirective -> Set PrintfFlag
printfFlags     :: Set PrintfFlag
    , ConversionDirective -> Int
printfMinWidth  :: Int
    , ConversionDirective -> Maybe Int
printfPrecision :: Maybe Int
    , ConversionDirective -> PrintfLengthModifier
printfLengthMod :: PrintfLengthModifier
    , ConversionDirective -> PrintfConversionType
printfType      :: PrintfConversionType
    }
 deriving (ConversionDirective -> ConversionDirective -> Bool
(ConversionDirective -> ConversionDirective -> Bool)
-> (ConversionDirective -> ConversionDirective -> Bool)
-> Eq ConversionDirective
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConversionDirective -> ConversionDirective -> Bool
== :: ConversionDirective -> ConversionDirective -> Bool
$c/= :: ConversionDirective -> ConversionDirective -> Bool
/= :: ConversionDirective -> ConversionDirective -> Bool
Eq,Eq ConversionDirective
Eq ConversionDirective =>
(ConversionDirective -> ConversionDirective -> Ordering)
-> (ConversionDirective -> ConversionDirective -> Bool)
-> (ConversionDirective -> ConversionDirective -> Bool)
-> (ConversionDirective -> ConversionDirective -> Bool)
-> (ConversionDirective -> ConversionDirective -> Bool)
-> (ConversionDirective
    -> ConversionDirective -> ConversionDirective)
-> (ConversionDirective
    -> ConversionDirective -> ConversionDirective)
-> Ord ConversionDirective
ConversionDirective -> ConversionDirective -> Bool
ConversionDirective -> ConversionDirective -> Ordering
ConversionDirective -> ConversionDirective -> ConversionDirective
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ConversionDirective -> ConversionDirective -> Ordering
compare :: ConversionDirective -> ConversionDirective -> Ordering
$c< :: ConversionDirective -> ConversionDirective -> Bool
< :: ConversionDirective -> ConversionDirective -> Bool
$c<= :: ConversionDirective -> ConversionDirective -> Bool
<= :: ConversionDirective -> ConversionDirective -> Bool
$c> :: ConversionDirective -> ConversionDirective -> Bool
> :: ConversionDirective -> ConversionDirective -> Bool
$c>= :: ConversionDirective -> ConversionDirective -> Bool
>= :: ConversionDirective -> ConversionDirective -> Bool
$cmax :: ConversionDirective -> ConversionDirective -> ConversionDirective
max :: ConversionDirective -> ConversionDirective -> ConversionDirective
$cmin :: ConversionDirective -> ConversionDirective -> ConversionDirective
min :: ConversionDirective -> ConversionDirective -> ConversionDirective
Ord,Int -> ConversionDirective -> ShowS
[ConversionDirective] -> ShowS
ConversionDirective -> String
(Int -> ConversionDirective -> ShowS)
-> (ConversionDirective -> String)
-> ([ConversionDirective] -> ShowS)
-> Show ConversionDirective
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConversionDirective -> ShowS
showsPrec :: Int -> ConversionDirective -> ShowS
$cshow :: ConversionDirective -> String
show :: ConversionDirective -> String
$cshowList :: [ConversionDirective] -> ShowS
showList :: [ConversionDirective] -> ShowS
Show)


data PrintfOperations m
  = PrintfOperations
    { forall (m :: Type -> Type).
PrintfOperations m
-> Int -> Bool -> PrintfLengthModifier -> m (Maybe Integer)
printfGetInteger  :: Int  -- Field number
                        -> Bool -- is Signed?
                        -> PrintfLengthModifier
                        -> m (Maybe Integer)
    , forall (m :: Type -> Type).
PrintfOperations m
-> Int -> PrintfLengthModifier -> m (Maybe Rational)
printfGetFloat    :: Int -- FieldNumber
                        -> PrintfLengthModifier
                        -> m (Maybe Rational)
    , forall (m :: Type -> Type). PrintfOperations m -> Int -> m String
printfGetPointer  :: Int -- FieldNumber
                        -> m String
    , forall (m :: Type -> Type).
PrintfOperations m -> Int -> Maybe Int -> m [Word8]
printfGetString   :: Int -- FieldNumber
                        -> Maybe Int -- Number of chars to read; if Nothing, read until null terminator
                        -> m [Word8]
    , forall (m :: Type -> Type).
PrintfOperations m -> Int -> PrintfLengthModifier -> Int -> m ()
printfSetInteger  :: Int -- FieldNumber
                        -> PrintfLengthModifier
                        -> Int -- value to set
                        -> m ()

    , forall (m :: Type -> Type).
PrintfOperations m -> forall a. HasCallStack => String -> m a
printfUnsupported :: !(forall a. GHC.HasCallStack => String -> m a)
    }

formatInteger
  :: Maybe Integer
  -> IntFormat
  -> Int -- min width
  -> Maybe Int -- precision
  -> Set PrintfFlag
  -> String
formatInteger :: Maybe Integer
-> IntFormat -> Int -> Maybe Int -> Set PrintfFlag -> String
formatInteger Maybe Integer
mi IntFormat
fmt Int
minwidth Maybe Int
prec Set PrintfFlag
flags =
  case Maybe Integer
mi of
    Maybe Integer
Nothing ->
      let n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
4 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
minwidth (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
prec))
       in Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
'?'
    Just Integer
i  -> do
      case IntFormat
fmt of
        IntFormat
IntFormat_SignedDecimal ->
           Integer -> Int -> Maybe Int -> Set PrintfFlag -> String
formatSignedDec Integer
i Int
minwidth Maybe Int
prec Set PrintfFlag
flags
        IntFormat
IntFormat_UnsignedDecimal ->
           Integer -> Int -> Maybe Int -> Set PrintfFlag -> String
formatUnsignedDec Integer
i Int
minwidth Maybe Int
prec Set PrintfFlag
flags
        IntFormat
IntFormat_Octal ->
           Integer -> Int -> Maybe Int -> Set PrintfFlag -> String
formatOctal Integer
i Int
minwidth Maybe Int
prec Set PrintfFlag
flags
        IntFormat_Hex Case
c ->
           Integer -> Case -> Int -> Maybe Int -> Set PrintfFlag -> String
formatHex Integer
i Case
c Int
minwidth Maybe Int
prec Set PrintfFlag
flags

insertThousands :: Char -> String -> String
insertThousands :: Char -> ShowS
insertThousands Char
sep = ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
go ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse
 where
  go :: ShowS
go (Char
a:Char
b:Char
c:xs :: String
xs@(Char
_:String
_)) = Char
aChar -> ShowS
forall a. a -> [a] -> [a]
:Char
bChar -> ShowS
forall a. a -> [a] -> [a]
:Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:Char
sepChar -> ShowS
forall a. a -> [a] -> [a]
:ShowS
go String
xs
  go String
xs = String
xs


addLeadingZeros ::
  Maybe Int -> -- precision
  String ->
  String
addLeadingZeros :: Maybe Int -> ShowS
addLeadingZeros Maybe Int
Nothing String
digits = String
digits
addLeadingZeros (Just Int
p) String
digits =
   let n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length String
digits) in
   Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
'0' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
digits

formatSignedDec
  :: Integer -- value to format
  -> Int     -- minwidth
  -> Maybe Int     -- precision
  -> Set PrintfFlag
  -> String
formatSignedDec :: Integer -> Int -> Maybe Int -> Set PrintfFlag -> String
formatSignedDec Integer
i Int
minwidth Maybe Int
prec Set PrintfFlag
flags = do
  let sgn :: String
sgn = if | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0  -> String
"-"
               | PrintfFlag -> Set PrintfFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PrintfFlag
PrintfPosPlus  Set PrintfFlag
flags -> String
"+"
               | PrintfFlag -> Set PrintfFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PrintfFlag
PrintfPosSpace Set PrintfFlag
flags -> String
" "
               | Bool
otherwise -> String
""
  let digits :: String
digits = Integer -> ShowS
forall a. Integral a => a -> ShowS
N.showInt (Integer -> Integer
forall a. Num a => a -> a
abs Integer
i) []
  let precdigits :: String
precdigits = Maybe Int -> ShowS
addLeadingZeros Maybe Int
prec String
digits
  let sepdigits :: String
sepdigits = if PrintfFlag -> Set PrintfFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PrintfFlag
PrintfThousandsSep Set PrintfFlag
flags then
                      Char -> ShowS
insertThousands Char
',' String
precdigits -- FIXME, get thousands separator from somewhere?
                  else
                      String
precdigits
  let pad :: Int
pad = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
minwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length String
sepdigits Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length String
sgn)
  if | PrintfFlag -> Set PrintfFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PrintfFlag
PrintfNegativeWidth Set PrintfFlag
flags ->
          String
sgn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sepdigits String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
pad Char
' '
     | PrintfFlag -> Set PrintfFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PrintfFlag
PrintfZeroPadding Set PrintfFlag
flags Bool -> Bool -> Bool
&& Maybe Int
prec Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
forall a. Maybe a
Nothing ->
          -- FIXME? this interacts poorly with the thousands seperation flag...
          String
sgn String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
pad Char
'0' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sepdigits
     | Bool
otherwise ->
          Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
pad Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sgn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sepdigits

formatUnsignedDec
  :: Integer -- value to format
  -> Int     -- minwidth
  -> Maybe Int     -- precision
  -> Set PrintfFlag
  -> String
formatUnsignedDec :: Integer -> Int -> Maybe Int -> Set PrintfFlag -> String
formatUnsignedDec Integer
i Int
minwidth Maybe Int
prec Set PrintfFlag
flags = do
  let digits :: String
digits = Integer -> ShowS
forall a. Integral a => a -> ShowS
N.showInt (Integer -> Integer
forall a. Num a => a -> a
abs Integer
i) []
  let precdigits :: String
precdigits = Maybe Int -> ShowS
addLeadingZeros Maybe Int
prec String
digits
  let sepdigits :: String
sepdigits = if PrintfFlag -> Set PrintfFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PrintfFlag
PrintfThousandsSep Set PrintfFlag
flags then
                      Char -> ShowS
insertThousands Char
',' String
precdigits -- FIXME, get thousands separator from somewhere?
                  else
                      String
precdigits
  let pad :: Int
pad = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
minwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length String
sepdigits)
  if | PrintfFlag -> Set PrintfFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PrintfFlag
PrintfNegativeWidth Set PrintfFlag
flags ->
          String
sepdigits String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
pad Char
' '
     | PrintfFlag -> Set PrintfFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PrintfFlag
PrintfZeroPadding Set PrintfFlag
flags Bool -> Bool -> Bool
&& Maybe Int
prec Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
forall a. Maybe a
Nothing ->
          -- FIXME? this interacts poorly with the thousands seperation flag...
          Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
pad Char
'0' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sepdigits
     | Bool
otherwise ->
          Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
pad Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sepdigits

formatOctal
  :: Integer -- value to format
  -> Int     -- minwidth
  -> Maybe Int     -- precision
  -> Set PrintfFlag
  -> String
formatOctal :: Integer -> Int -> Maybe Int -> Set PrintfFlag -> String
formatOctal Integer
i Int
minwidth Maybe Int
prec Set PrintfFlag
flags = do
  let digits :: String
digits = Integer -> ShowS
forall a. Integral a => a -> ShowS
N.showOct (Integer -> Integer
forall a. Num a => a -> a
abs Integer
i) []
  let precdigits :: String
precdigits = Maybe Int -> ShowS
addLeadingZeros Maybe Int
prec String
digits
  let altdigits :: String
altdigits = if PrintfFlag -> Set PrintfFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PrintfFlag
PrintfAlternateForm Set PrintfFlag
flags Bool -> Bool -> Bool
&& String -> Char
forall a. HasCallStack => [a] -> a
head String
precdigits Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'0' then
                     Char
'0'Char -> ShowS
forall a. a -> [a] -> [a]
:String
precdigits
                  else
                     String
precdigits
  let pad :: Int
pad = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
minwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length String
altdigits)
  if | PrintfFlag -> Set PrintfFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PrintfFlag
PrintfNegativeWidth Set PrintfFlag
flags ->
          String
altdigits String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
pad Char
' '
     | PrintfFlag -> Set PrintfFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PrintfFlag
PrintfZeroPadding Set PrintfFlag
flags Bool -> Bool -> Bool
&& Maybe Int
prec Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
forall a. Maybe a
Nothing ->
          Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
pad Char
'0' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
altdigits
     | Bool
otherwise ->
          Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
pad Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
altdigits

formatHex
  :: Integer -- value to format
  -> Case    -- upper or lower case
  -> Int     -- minwidth
  -> Maybe Int     -- precision
  -> Set PrintfFlag
  -> String
formatHex :: Integer -> Case -> Int -> Maybe Int -> Set PrintfFlag -> String
formatHex Integer
i Case
c Int
minwidth Maybe Int
prec Set PrintfFlag
flags = do
  let digits :: String
digits = Integer -> ShowS
forall a. Integral a => a -> ShowS
N.showHex (Integer -> Integer
forall a. Num a => a -> a
abs Integer
i) []
  let precdigits :: String
precdigits = Maybe Int -> ShowS
addLeadingZeros Maybe Int
prec String
digits
  -- Why only add "0x" when i is non-zero?  I have no idea,
  -- that's just what the docs say...
  let altstring :: String
altstring = if PrintfFlag -> Set PrintfFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PrintfFlag
PrintfAlternateForm Set PrintfFlag
flags Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 then
                    String
"0x"
                  else
                    String
""
  let pad :: Int
pad = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
minwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length String
precdigits Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length String
altstring)
  let padded :: String
padded = if | PrintfFlag -> Set PrintfFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PrintfFlag
PrintfNegativeWidth Set PrintfFlag
flags ->
                       String
altstring String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
precdigits String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
pad Char
' '
                  | PrintfFlag -> Set PrintfFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PrintfFlag
PrintfZeroPadding Set PrintfFlag
flags Bool -> Bool -> Bool
&& Maybe Int
prec Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Int
forall a. Maybe a
Nothing ->
                       String
altstring String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
pad Char
'0' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
precdigits
                  | Bool
otherwise ->
                       Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
pad Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
altstring String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
precdigits
  case Case
c of
    Case
UpperCase -> (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
padded
    Case
LowerCase -> String
padded


formatRational
  :: Maybe Rational
  -> FloatFormat
  -> Int -- min width
  -> Maybe Int -- precision
  -> Set PrintfFlag
  -> Either String String   -- ^ Left indicates an error, right is OK
formatRational :: Maybe Rational
-> FloatFormat
-> Int
-> Maybe Int
-> Set PrintfFlag
-> Either String String
formatRational Maybe Rational
mr FloatFormat
fmt Int
minwidth Maybe Int
prec Set PrintfFlag
flags =
  case Maybe Rational
mr of
    Maybe Rational
Nothing ->
      let n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
4 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
minwidth (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
prec))
       in String -> Either String String
forall a. a -> Either String a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
n Char
'?')
    Just Rational
r ->
      -- FIXME, we ignore the thousands flag...
      do let toCase :: Case -> ShowS
toCase Case
c String
x = case Case
c of
                            Case
UpperCase -> (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
x
                            Case
LowerCase -> String
x
         let sgn :: String
sgn = if | Rational
r Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0  -> String
"-"
                      | PrintfFlag -> Set PrintfFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PrintfFlag
PrintfPosPlus  Set PrintfFlag
flags -> String
"+"
                      | PrintfFlag -> Set PrintfFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PrintfFlag
PrintfPosSpace Set PrintfFlag
flags -> String
" "
                      | Bool
otherwise -> String
""
         let dbl :: Double
dbl = Rational -> Double
forall a. RealFloat a => Rational -> a
N.fromRat (Rational -> Rational
forall a. Num a => a -> a
abs Rational
r) :: Double
         let prec' :: Maybe Int
prec' = case Maybe Int
prec of Maybe Int
Nothing -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
6; Maybe Int
_ -> Maybe Int
prec
         String
str <- case FloatFormat
fmt of
                  FloatFormat_Scientific Case
c ->
                       String -> Either String String
forall a. a -> Either String a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ Case -> ShowS
toCase Case
c ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
N.showEFloat Maybe Int
prec' Double
dbl []
                  FloatFormat_Standard Case
c ->
                   String -> Either String String
forall a. a -> Either String a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ Case -> ShowS
toCase Case
c ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
                     if PrintfFlag -> Set PrintfFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PrintfFlag
PrintfAlternateForm Set PrintfFlag
flags
                       then Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
N.showFFloatAlt Maybe Int
prec' Double
dbl []
                       else Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
N.showFFloat Maybe Int
prec' Double
dbl []
                  FloatFormat_Auto Case
c ->
                    String -> Either String String
forall a. a -> Either String a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ Case -> ShowS
toCase Case
c ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
                      if PrintfFlag -> Set PrintfFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PrintfFlag
PrintfAlternateForm Set PrintfFlag
flags
                         then Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
N.showGFloatAlt Maybe Int
prec' Double
dbl []
                         else Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
N.showGFloat Maybe Int
prec' Double
dbl []
                  FloatFormat_Hex Case
_c ->
                    -- FIXME, could probably implement this using N.floatToDigits...
                    String -> Either String String
forall a b. a -> Either a b
Left String
"'a' and 'A' conversion codes not currently supported"
         let pad :: Int
pad = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
minwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length String
str Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length String
sgn)
         String -> Either String String
forall a. a -> Either String a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$
           if | PrintfFlag -> Set PrintfFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PrintfFlag
PrintfNegativeWidth Set PrintfFlag
flags ->
                  String
sgn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
pad Char
' '
              | PrintfFlag -> Set PrintfFlag -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member PrintfFlag
PrintfZeroPadding Set PrintfFlag
flags ->
                   String
sgn String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
pad Char
'0' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str
              | Bool
otherwise ->
                   Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
pad Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sgn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str

-- | Given a list of 'PrintfDirective's, compute the resulting 'BS.ByteString'
-- and its length.
--
-- We make an effort not to assume a particular text encoding for the
-- 'BS.ByteString' that this returns. Some parts of the implementation do use
-- functionality from "Data.ByteString.Char8", which is limited to the subset
-- of Unicode covered by code points 0-255. We believe these uses are justified,
-- however, and we have left comments explaining the reasoning behind each use.
executeDirectives :: forall m. Monad m
                  => PrintfOperations m
                  -> [PrintfDirective]
                  -> m (BS.ByteString, Int)
executeDirectives :: forall (m :: Type -> Type).
Monad m =>
PrintfOperations m -> [PrintfDirective] -> m (ByteString, Int)
executeDirectives PrintfOperations m
ops = (ByteString -> ByteString)
-> Int -> Int -> [PrintfDirective] -> m (ByteString, Int)
go ByteString -> ByteString
forall a. a -> a
id Int
0 Int
0
  where
   go :: (BS.ByteString -> BS.ByteString) -> Int -> Int -> [PrintfDirective] -> m (BS.ByteString, Int)
   go :: (ByteString -> ByteString)
-> Int -> Int -> [PrintfDirective] -> m (ByteString, Int)
go ByteString -> ByteString
fstr !Int
len !Int
_fld [] = (ByteString, Int) -> m (ByteString, Int)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ByteString -> ByteString
fstr ByteString
BS.empty, Int
len)
   go ByteString -> ByteString
fstr !Int
len !Int
fld ((StringDirective ByteString
s):[PrintfDirective]
xs) = do
       let len' :: Int
len'  = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
s
       let fstr' :: ByteString -> ByteString
fstr' = ByteString -> ByteString
fstr (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> ByteString
BS.append ByteString
s
       (ByteString -> ByteString)
-> Int -> Int -> [PrintfDirective] -> m (ByteString, Int)
go ByteString -> ByteString
fstr' Int
len' Int
fld [PrintfDirective]
xs
   go ByteString -> ByteString
fstr !Int
len !Int
fld (ConversionDirective ConversionDirective
d:[PrintfDirective]
xs) =
       let fld' :: Int
fld' = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (Int
fldInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (ConversionDirective -> Maybe Int
printfAccessField ConversionDirective
d) in
       case ConversionDirective -> PrintfConversionType
printfType ConversionDirective
d of
         Conversion_Integer IntFormat
fmt -> do
           let sgn :: Bool
sgn = IntFormat -> Bool
signedIntFormat IntFormat
fmt
           Maybe Integer
i <- PrintfOperations m
-> Int -> Bool -> PrintfLengthModifier -> m (Maybe Integer)
forall (m :: Type -> Type).
PrintfOperations m
-> Int -> Bool -> PrintfLengthModifier -> m (Maybe Integer)
printfGetInteger PrintfOperations m
ops Int
fld' Bool
sgn (ConversionDirective -> PrintfLengthModifier
printfLengthMod ConversionDirective
d)
           -- The use of BSC.pack is fine here, as the output of formatInteger
           -- consists solely of ASCII characters.
           let istr :: ByteString
istr  = String -> ByteString
BSC.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Maybe Integer
-> IntFormat -> Int -> Maybe Int -> Set PrintfFlag -> String
formatInteger Maybe Integer
i IntFormat
fmt (ConversionDirective -> Int
printfMinWidth ConversionDirective
d) (ConversionDirective -> Maybe Int
printfPrecision ConversionDirective
d) (ConversionDirective -> Set PrintfFlag
printfFlags ConversionDirective
d)
           let len' :: Int
len'  = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
istr
           let fstr' :: ByteString -> ByteString
fstr' = ByteString -> ByteString
fstr (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> ByteString
BS.append ByteString
istr
           (ByteString -> ByteString)
-> Int -> Int -> [PrintfDirective] -> m (ByteString, Int)
go ByteString -> ByteString
fstr' Int
len' Int
fld' [PrintfDirective]
xs
         Conversion_Floating FloatFormat
fmt -> do
           Maybe Rational
r <- PrintfOperations m
-> Int -> PrintfLengthModifier -> m (Maybe Rational)
forall (m :: Type -> Type).
PrintfOperations m
-> Int -> PrintfLengthModifier -> m (Maybe Rational)
printfGetFloat PrintfOperations m
ops Int
fld' (ConversionDirective -> PrintfLengthModifier
printfLengthMod ConversionDirective
d)
           -- The use of BSC.pack is fine here, as the output of formatRational
           -- consists solely of ASCII characters.
           ByteString
rstr <- String -> ByteString
BSC.pack (String -> ByteString) -> m String -> m ByteString
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
                   case Maybe Rational
-> FloatFormat
-> Int
-> Maybe Int
-> Set PrintfFlag
-> Either String String
formatRational Maybe Rational
r FloatFormat
fmt
                           (ConversionDirective -> Int
printfMinWidth ConversionDirective
d)
                           (ConversionDirective -> Maybe Int
printfPrecision ConversionDirective
d)
                           (ConversionDirective -> Set PrintfFlag
printfFlags ConversionDirective
d) of
                     Left String
err -> PrintfOperations m -> forall a. HasCallStack => String -> m a
forall (m :: Type -> Type).
PrintfOperations m -> forall a. HasCallStack => String -> m a
printfUnsupported PrintfOperations m
ops String
err
                     Right String
a -> String -> m String
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return String
a
           let len' :: Int
len'  = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
rstr
           let fstr' :: ByteString -> ByteString
fstr' = ByteString -> ByteString
fstr (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> ByteString
BS.append ByteString
rstr
           (ByteString -> ByteString)
-> Int -> Int -> [PrintfDirective] -> m (ByteString, Int)
go ByteString -> ByteString
fstr' Int
len' Int
fld' [PrintfDirective]
xs
         PrintfConversionType
Conversion_String -> do
           ByteString
s <- [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> m [Word8] -> m ByteString
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> PrintfOperations m -> Int -> Maybe Int -> m [Word8]
forall (m :: Type -> Type).
PrintfOperations m -> Int -> Maybe Int -> m [Word8]
printfGetString PrintfOperations m
ops Int
fld' (ConversionDirective -> Maybe Int
printfPrecision ConversionDirective
d)
           let len' :: Int
len'  = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
s
           let fstr' :: ByteString -> ByteString
fstr' = ByteString -> ByteString
fstr (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> ByteString
BS.append ByteString
s
           (ByteString -> ByteString)
-> Int -> Int -> [PrintfDirective] -> m (ByteString, Int)
go ByteString -> ByteString
fstr' Int
len' Int
fld' [PrintfDirective]
xs
         PrintfConversionType
Conversion_Char -> do
           let sgn :: Bool
sgn  = Bool
False -- unsigned
           Maybe Integer
i <- PrintfOperations m
-> Int -> Bool -> PrintfLengthModifier -> m (Maybe Integer)
forall (m :: Type -> Type).
PrintfOperations m
-> Int -> Bool -> PrintfLengthModifier -> m (Maybe Integer)
printfGetInteger PrintfOperations m
ops Int
fld' Bool
sgn PrintfLengthModifier
Len_NoMod
           let Char
c :: Char = Char -> (Integer -> Char) -> Maybe Integer -> Char
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Char
'?' (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Integer -> Int) -> Integer -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger) Maybe Integer
i
           let len' :: Int
len'  = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
           -- Note the use of BSC.cons here: this assumes on the assumption
           -- that C strings are arrays of 1-byte characters.
           let fstr' :: ByteString -> ByteString
fstr' = ByteString -> ByteString
fstr (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> ByteString
BSC.cons Char
c
           (ByteString -> ByteString)
-> Int -> Int -> [PrintfDirective] -> m (ByteString, Int)
go ByteString -> ByteString
fstr' Int
len' Int
fld' [PrintfDirective]
xs
         PrintfConversionType
Conversion_Pointer -> do
           -- Note the use of BSC.pack here: this assumes that the output of
           -- printfGetPointer uses solely ASCII characters. For crux-llvm's
           -- printf override, this is always the case, as pointers are
           -- pretty-printed using the ppPtr function, which satisfies this
           -- criterion.
           ByteString
pstr <- String -> ByteString
BSC.pack (String -> ByteString) -> m String -> m ByteString
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> PrintfOperations m -> Int -> m String
forall (m :: Type -> Type). PrintfOperations m -> Int -> m String
printfGetPointer PrintfOperations m
ops Int
fld'
           let len' :: Int
len'  = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
pstr
           let fstr' :: ByteString -> ByteString
fstr' = ByteString -> ByteString
fstr (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> ByteString
BS.append ByteString
pstr
           (ByteString -> ByteString)
-> Int -> Int -> [PrintfDirective] -> m (ByteString, Int)
go ByteString -> ByteString
fstr' Int
len' Int
fld' [PrintfDirective]
xs
         PrintfConversionType
Conversion_CountChars -> do
           PrintfOperations m -> Int -> PrintfLengthModifier -> Int -> m ()
forall (m :: Type -> Type).
PrintfOperations m -> Int -> PrintfLengthModifier -> Int -> m ()
printfSetInteger PrintfOperations m
ops Int
fld' (ConversionDirective -> PrintfLengthModifier
printfLengthMod ConversionDirective
d) Int
len
           (ByteString -> ByteString)
-> Int -> Int -> [PrintfDirective] -> m (ByteString, Int)
go ByteString -> ByteString
fstr Int
len Int
fld' [PrintfDirective]
xs

parseDirectives :: [Word8] -> Either String [PrintfDirective]
parseDirectives :: [Word8] -> Either String [PrintfDirective]
parseDirectives [Word8]
xs =
  Parser [PrintfDirective]
-> ByteString -> Either String [PrintfDirective]
forall a. Parser a -> ByteString -> Either String a
parseOnly (Parser [PrintfDirective]
parseFormatString Parser [PrintfDirective]
-> Parser ByteString () -> Parser [PrintfDirective]
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
endOfInput) ([Word8] -> ByteString
BS.pack [Word8]
xs)

parseFormatString :: Parser [PrintfDirective]
parseFormatString :: Parser [PrintfDirective]
parseFormatString = Parser ByteString PrintfDirective -> Parser [PrintfDirective]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: Type -> Type) a. Alternative f => f a -> f [a]
many (Parser ByteString PrintfDirective -> Parser [PrintfDirective])
-> Parser ByteString PrintfDirective -> Parser [PrintfDirective]
forall a b. (a -> b) -> a -> b
$ [Parser ByteString PrintfDirective]
-> Parser ByteString PrintfDirective
forall (f :: Type -> Type) a. Alternative f => [f a] -> f a
choice
  [ ByteString -> PrintfDirective
StringDirective (ByteString -> PrintfDirective)
-> Parser ByteString ByteString
-> Parser ByteString PrintfDirective
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString ByteString
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'%')
  , ByteString -> Parser ByteString ByteString
string ByteString
"%%" Parser ByteString ByteString
-> Parser ByteString PrintfDirective
-> Parser ByteString PrintfDirective
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfDirective -> Parser ByteString PrintfDirective
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ByteString -> PrintfDirective
StringDirective ByteString
"%")
  , Parser ByteString PrintfDirective
parseConversion
  ]

parseConversion :: Parser PrintfDirective
parseConversion :: Parser ByteString PrintfDirective
parseConversion = do
  Char
_ <- Char -> Parser Char
char Char
'%'
  Maybe Int
field <- Maybe Int
-> Parser ByteString (Maybe Int) -> Parser ByteString (Maybe Int)
forall (f :: Type -> Type) a. Alternative f => a -> f a -> f a
option Maybe Int
forall a. Maybe a
Nothing (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int)
-> Parser ByteString Int -> Parser ByteString (Maybe Int)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
             do Int
d <- Parser ByteString Int
forall a. Integral a => Parser a
decimal
                Char
_ <- Char -> Parser Char
char Char
'$'
                Int -> Parser ByteString Int
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Int
d)
  Set PrintfFlag
flags <- Set PrintfFlag -> Parser (Set PrintfFlag)
parseFlags Set PrintfFlag
forall a. Set a
Set.empty
  Int
width <- Int -> Parser ByteString Int -> Parser ByteString Int
forall (f :: Type -> Type) a. Alternative f => a -> f a -> f a
option Int
0 Parser ByteString Int
forall a. Integral a => Parser a
decimal
  Maybe Int
prec  <- Maybe Int
-> Parser ByteString (Maybe Int) -> Parser ByteString (Maybe Int)
forall (f :: Type -> Type) a. Alternative f => a -> f a -> f a
option Maybe Int
forall a. Maybe a
Nothing (Char -> Parser Char
char Char
'.' Parser Char
-> Parser ByteString (Maybe Int) -> Parser ByteString (Maybe Int)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int)
-> Parser ByteString Int -> Parser ByteString (Maybe Int)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Int
forall a. Integral a => Parser a
decimal))
  PrintfLengthModifier
len   <- Parser PrintfLengthModifier
parseLenModifier
  PrintfConversionType
typ   <- Parser PrintfConversionType
parseConversionType
  PrintfDirective -> Parser ByteString PrintfDirective
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (PrintfDirective -> Parser ByteString PrintfDirective)
-> PrintfDirective -> Parser ByteString PrintfDirective
forall a b. (a -> b) -> a -> b
$ ConversionDirective -> PrintfDirective
ConversionDirective (ConversionDirective -> PrintfDirective)
-> ConversionDirective -> PrintfDirective
forall a b. (a -> b) -> a -> b
$ Conversion
         { printfAccessField :: Maybe Int
printfAccessField = Maybe Int
field
         , printfFlags :: Set PrintfFlag
printfFlags       = Set PrintfFlag
flags
         , printfMinWidth :: Int
printfMinWidth    = Int
width
         , printfPrecision :: Maybe Int
printfPrecision   = Maybe Int
prec
         , printfLengthMod :: PrintfLengthModifier
printfLengthMod   = PrintfLengthModifier
len
         , printfType :: PrintfConversionType
printfType        = PrintfConversionType
typ
         }

parseFlags :: Set PrintfFlag -> Parser (Set PrintfFlag)
parseFlags :: Set PrintfFlag -> Parser (Set PrintfFlag)
parseFlags Set PrintfFlag
fs = [Parser (Set PrintfFlag)] -> Parser (Set PrintfFlag)
forall (f :: Type -> Type) a. Alternative f => [f a] -> f a
choice
  [ Char -> Parser Char
char Char
'#'  Parser Char -> Parser (Set PrintfFlag) -> Parser (Set PrintfFlag)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Set PrintfFlag -> Parser (Set PrintfFlag)
parseFlags (PrintfFlag -> Set PrintfFlag -> Set PrintfFlag
forall a. Ord a => a -> Set a -> Set a
Set.insert PrintfFlag
PrintfAlternateForm Set PrintfFlag
fs)
  , Char -> Parser Char
char Char
'0'  Parser Char -> Parser (Set PrintfFlag) -> Parser (Set PrintfFlag)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Set PrintfFlag -> Parser (Set PrintfFlag)
parseFlags (PrintfFlag -> Set PrintfFlag -> Set PrintfFlag
forall a. Ord a => a -> Set a -> Set a
Set.insert PrintfFlag
PrintfZeroPadding Set PrintfFlag
fs)
  , Char -> Parser Char
char Char
'-'  Parser Char -> Parser (Set PrintfFlag) -> Parser (Set PrintfFlag)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Set PrintfFlag -> Parser (Set PrintfFlag)
parseFlags (PrintfFlag -> Set PrintfFlag -> Set PrintfFlag
forall a. Ord a => a -> Set a -> Set a
Set.insert PrintfFlag
PrintfNegativeWidth Set PrintfFlag
fs)
  , Char -> Parser Char
char Char
' '  Parser Char -> Parser (Set PrintfFlag) -> Parser (Set PrintfFlag)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Set PrintfFlag -> Parser (Set PrintfFlag)
parseFlags (PrintfFlag -> Set PrintfFlag -> Set PrintfFlag
forall a. Ord a => a -> Set a -> Set a
Set.insert PrintfFlag
PrintfPosSpace Set PrintfFlag
fs)
  , Char -> Parser Char
char Char
'+'  Parser Char -> Parser (Set PrintfFlag) -> Parser (Set PrintfFlag)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Set PrintfFlag -> Parser (Set PrintfFlag)
parseFlags (PrintfFlag -> Set PrintfFlag -> Set PrintfFlag
forall a. Ord a => a -> Set a -> Set a
Set.insert PrintfFlag
PrintfPosPlus Set PrintfFlag
fs)
  , Char -> Parser Char
char Char
'\'' Parser Char -> Parser (Set PrintfFlag) -> Parser (Set PrintfFlag)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> Set PrintfFlag -> Parser (Set PrintfFlag)
parseFlags (PrintfFlag -> Set PrintfFlag -> Set PrintfFlag
forall a. Ord a => a -> Set a -> Set a
Set.insert PrintfFlag
PrintfThousandsSep Set PrintfFlag
fs)
  , Set PrintfFlag -> Parser (Set PrintfFlag)
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Set PrintfFlag
fs
  ]

parseLenModifier :: Parser PrintfLengthModifier
parseLenModifier :: Parser PrintfLengthModifier
parseLenModifier = [Parser PrintfLengthModifier] -> Parser PrintfLengthModifier
forall (f :: Type -> Type) a. Alternative f => [f a] -> f a
choice
  [ ByteString -> Parser ByteString ByteString
string ByteString
"hh" Parser ByteString ByteString
-> Parser PrintfLengthModifier -> Parser PrintfLengthModifier
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfLengthModifier -> Parser PrintfLengthModifier
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return PrintfLengthModifier
Len_Byte
  , ByteString -> Parser ByteString ByteString
string ByteString
"h"  Parser ByteString ByteString
-> Parser PrintfLengthModifier -> Parser PrintfLengthModifier
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfLengthModifier -> Parser PrintfLengthModifier
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return PrintfLengthModifier
Len_Short
  , ByteString -> Parser ByteString ByteString
string ByteString
"ll" Parser ByteString ByteString
-> Parser PrintfLengthModifier -> Parser PrintfLengthModifier
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfLengthModifier -> Parser PrintfLengthModifier
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return PrintfLengthModifier
Len_LongLong
  , ByteString -> Parser ByteString ByteString
string ByteString
"L"  Parser ByteString ByteString
-> Parser PrintfLengthModifier -> Parser PrintfLengthModifier
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfLengthModifier -> Parser PrintfLengthModifier
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return PrintfLengthModifier
Len_LongDouble
  , ByteString -> Parser ByteString ByteString
string ByteString
"l"  Parser ByteString ByteString
-> Parser PrintfLengthModifier -> Parser PrintfLengthModifier
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfLengthModifier -> Parser PrintfLengthModifier
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return PrintfLengthModifier
Len_Long
  , ByteString -> Parser ByteString ByteString
string ByteString
"j"  Parser ByteString ByteString
-> Parser PrintfLengthModifier -> Parser PrintfLengthModifier
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfLengthModifier -> Parser PrintfLengthModifier
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return PrintfLengthModifier
Len_IntMax
  , ByteString -> Parser ByteString ByteString
string ByteString
"t"  Parser ByteString ByteString
-> Parser PrintfLengthModifier -> Parser PrintfLengthModifier
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfLengthModifier -> Parser PrintfLengthModifier
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return PrintfLengthModifier
Len_PtrDiff
  , ByteString -> Parser ByteString ByteString
string ByteString
"z"  Parser ByteString ByteString
-> Parser PrintfLengthModifier -> Parser PrintfLengthModifier
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfLengthModifier -> Parser PrintfLengthModifier
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return PrintfLengthModifier
Len_Sizet
  , PrintfLengthModifier -> Parser PrintfLengthModifier
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return PrintfLengthModifier
Len_NoMod
  ]

parseConversionType :: Parser PrintfConversionType
parseConversionType :: Parser PrintfConversionType
parseConversionType = [Parser PrintfConversionType] -> Parser PrintfConversionType
forall (f :: Type -> Type) a. Alternative f => [f a] -> f a
choice
  [ Char -> Parser Char
char Char
'd' Parser Char
-> Parser PrintfConversionType -> Parser PrintfConversionType
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfConversionType -> Parser PrintfConversionType
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (IntFormat -> PrintfConversionType
Conversion_Integer IntFormat
IntFormat_SignedDecimal)
  , Char -> Parser Char
char Char
'i' Parser Char
-> Parser PrintfConversionType -> Parser PrintfConversionType
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfConversionType -> Parser PrintfConversionType
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (IntFormat -> PrintfConversionType
Conversion_Integer IntFormat
IntFormat_SignedDecimal)
  , Char -> Parser Char
char Char
'u' Parser Char
-> Parser PrintfConversionType -> Parser PrintfConversionType
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfConversionType -> Parser PrintfConversionType
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (IntFormat -> PrintfConversionType
Conversion_Integer IntFormat
IntFormat_UnsignedDecimal)
  , Char -> Parser Char
char Char
'o' Parser Char
-> Parser PrintfConversionType -> Parser PrintfConversionType
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfConversionType -> Parser PrintfConversionType
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (IntFormat -> PrintfConversionType
Conversion_Integer IntFormat
IntFormat_Octal)
  , Char -> Parser Char
char Char
'x' Parser Char
-> Parser PrintfConversionType -> Parser PrintfConversionType
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfConversionType -> Parser PrintfConversionType
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (IntFormat -> PrintfConversionType
Conversion_Integer (Case -> IntFormat
IntFormat_Hex Case
LowerCase))
  , Char -> Parser Char
char Char
'X' Parser Char
-> Parser PrintfConversionType -> Parser PrintfConversionType
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfConversionType -> Parser PrintfConversionType
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (IntFormat -> PrintfConversionType
Conversion_Integer (Case -> IntFormat
IntFormat_Hex Case
UpperCase))
  , Char -> Parser Char
char Char
'e' Parser Char
-> Parser PrintfConversionType -> Parser PrintfConversionType
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfConversionType -> Parser PrintfConversionType
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (FloatFormat -> PrintfConversionType
Conversion_Floating (Case -> FloatFormat
FloatFormat_Scientific Case
LowerCase))
  , Char -> Parser Char
char Char
'E' Parser Char
-> Parser PrintfConversionType -> Parser PrintfConversionType
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfConversionType -> Parser PrintfConversionType
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (FloatFormat -> PrintfConversionType
Conversion_Floating (Case -> FloatFormat
FloatFormat_Scientific Case
UpperCase))
  , Char -> Parser Char
char Char
'f' Parser Char
-> Parser PrintfConversionType -> Parser PrintfConversionType
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfConversionType -> Parser PrintfConversionType
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (FloatFormat -> PrintfConversionType
Conversion_Floating (Case -> FloatFormat
FloatFormat_Standard Case
LowerCase))
  , Char -> Parser Char
char Char
'F' Parser Char
-> Parser PrintfConversionType -> Parser PrintfConversionType
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfConversionType -> Parser PrintfConversionType
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (FloatFormat -> PrintfConversionType
Conversion_Floating (Case -> FloatFormat
FloatFormat_Standard Case
UpperCase))
  , Char -> Parser Char
char Char
'g' Parser Char
-> Parser PrintfConversionType -> Parser PrintfConversionType
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfConversionType -> Parser PrintfConversionType
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (FloatFormat -> PrintfConversionType
Conversion_Floating (Case -> FloatFormat
FloatFormat_Auto Case
LowerCase))
  , Char -> Parser Char
char Char
'G' Parser Char
-> Parser PrintfConversionType -> Parser PrintfConversionType
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfConversionType -> Parser PrintfConversionType
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (FloatFormat -> PrintfConversionType
Conversion_Floating (Case -> FloatFormat
FloatFormat_Auto Case
UpperCase))
  , Char -> Parser Char
char Char
'a' Parser Char
-> Parser PrintfConversionType -> Parser PrintfConversionType
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfConversionType -> Parser PrintfConversionType
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (FloatFormat -> PrintfConversionType
Conversion_Floating (Case -> FloatFormat
FloatFormat_Hex Case
LowerCase))
  , Char -> Parser Char
char Char
'A' Parser Char
-> Parser PrintfConversionType -> Parser PrintfConversionType
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfConversionType -> Parser PrintfConversionType
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (FloatFormat -> PrintfConversionType
Conversion_Floating (Case -> FloatFormat
FloatFormat_Hex Case
UpperCase))
  , Char -> Parser Char
char Char
'c' Parser Char
-> Parser PrintfConversionType -> Parser PrintfConversionType
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfConversionType -> Parser PrintfConversionType
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return PrintfConversionType
Conversion_Char
  , Char -> Parser Char
char Char
's' Parser Char
-> Parser PrintfConversionType -> Parser PrintfConversionType
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfConversionType -> Parser PrintfConversionType
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return PrintfConversionType
Conversion_String
  , Char -> Parser Char
char Char
'p' Parser Char
-> Parser PrintfConversionType -> Parser PrintfConversionType
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfConversionType -> Parser PrintfConversionType
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return PrintfConversionType
Conversion_Pointer
  , Char -> Parser Char
char Char
'n' Parser Char
-> Parser PrintfConversionType -> Parser PrintfConversionType
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> PrintfConversionType -> Parser PrintfConversionType
forall a. a -> Parser ByteString a
forall (m :: Type -> Type) a. Monad m => a -> m a
return PrintfConversionType
Conversion_CountChars
  ]