Copyright | (c) Justin Le 2019 |
---|---|
License | BSD3 |
Maintainer | justin@jle.im |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
GHC.TypeLits.Printf.Internal
Description
Internal workings of the printf mechanisms, exposed for potential debugging purposes.
Please do not use this module for anything besides debugging, as is definitely very unstable and might go away or change dramatically between versions.
Synopsis
- type ParseFmtStr (str :: Symbol) = EvalParser FmtStrParser str
- type ParseFmtStr_ (str :: Symbol) = EvalParser_ FmtStrParser str
- type ParseFmt (str :: Symbol) = EvalParser FFParser str
- type ParseFmt_ (str :: Symbol) = EvalParser_ FFParser str
- data FormatAdjustment
- type family ShowFormat (x :: k) :: Symbol
- data FormatSign
- data WidthMod
- data Flags = Flags {}
- type EmptyFlags = 'Flags ('Nothing :: Maybe FormatAdjustment) ('Nothing :: Maybe FormatSign) 'False
- data FieldFormat = FF {}
- type family Demote k = (a :: Type) | a -> k
- class Reflect (x :: a) where
- class FormatType (t :: Char) a where
- formatArg :: p t -> a -> FieldFormat -> ShowS
- class Printf (str :: Symbol) fun where
- printf_ :: p str -> fun
- class FormatFun (ffs :: [Either Symbol FieldFormat]) fun where
- newtype PFmt (c :: k) = PFmt FieldFormat
- pfmt :: forall (c :: Char) a. FormatType c a => PFmt c -> a -> String
- mkPFmt :: forall (str :: Symbol) (ff :: FieldFormat) (f :: Flags) (w :: Maybe Nat) (q :: Maybe Nat) (m :: Maybe WidthMod) (c :: Char). (ff ~ ParseFmt_ str, Reflect ff, ff ~ 'FF f w q m c) => PFmt c
- mkPFmt_ :: forall (str :: Symbol) (ff :: FieldFormat) (f :: Flags) (w :: Maybe Nat) (q :: Maybe Nat) (m :: Maybe WidthMod) (c :: Char) p. (ff ~ ParseFmt_ str, Reflect ff, ff ~ 'FF f w q m c) => p str -> PFmt c
- newtype PHelp = PHelp {}
Documentation
type ParseFmtStr (str :: Symbol) = EvalParser FmtStrParser str Source #
type ParseFmtStr_ (str :: Symbol) = EvalParser_ FmtStrParser str Source #
data FormatAdjustment #
Whether to left-adjust or zero-pad a field. These are
mutually exclusive, with LeftAdjust
taking precedence.
Since: base-4.7.0.0
Constructors
LeftAdjust | |
ZeroPad |
Instances
Reflect 'LeftAdjust Source # | |
Defined in GHC.TypeLits.Printf.Parse Methods reflect :: p 'LeftAdjust -> Demote FormatAdjustment Source # | |
Reflect 'ZeroPad Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
type Demote FormatAdjustment Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
type ShowFormat 'LeftAdjust Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
type ShowFormat 'ZeroPad Source # | |
Defined in GHC.TypeLits.Printf.Parse |
type family ShowFormat (x :: k) :: Symbol Source #
Instances
data FormatSign #
How to handle the sign of a numeric field. These are
mutually exclusive, with SignPlus
taking precedence.
Since: base-4.7.0.0
Instances
Reflect 'SignPlus Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
Reflect 'SignSpace Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
type Demote FormatSign Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
type ShowFormat 'SignPlus Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
type ShowFormat 'SignSpace Source # | |
Defined in GHC.TypeLits.Printf.Parse |
Instances
Reflect 'WML Source # | |
Reflect 'WMh Source # | |
Reflect 'WMhh Source # | |
Reflect 'WMl Source # | |
Reflect 'WMll Source # | |
type Demote WidthMod Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
type ShowFormat 'WML Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
type ShowFormat 'WMh Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
type ShowFormat 'WMhh Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
type ShowFormat 'WMl Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
type ShowFormat 'WMll Source # | |
Defined in GHC.TypeLits.Printf.Parse |
Constructors
Flags | |
Fields
|
Instances
(Reflect d, Reflect i, Reflect l) => Reflect ('Flags d i l :: Flags) Source # | |
type Demote Flags Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
type ShowFormat ('Flags a s 'False :: Flags) Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
type ShowFormat ('Flags a s 'True :: Flags) Source # | |
Defined in GHC.TypeLits.Printf.Parse type ShowFormat ('Flags a s 'True :: Flags) = AppendSymbol (AppendSymbol (ShowFormat a) (ShowFormat s)) "#" |
type EmptyFlags = 'Flags ('Nothing :: Maybe FormatAdjustment) ('Nothing :: Maybe FormatSign) 'False Source #
data FieldFormat Source #
Constructors
FF | |
Instances
type family Demote k = (a :: Type) | a -> k Source #
Instances
type Demote FormatAdjustment Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
type Demote FormatSign Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
type Demote Nat Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
type Demote FieldFormat Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
type Demote Flags Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
type Demote WidthMod Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
type Demote Bool Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
type Demote Char Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
type Demote Symbol Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
type Demote (Maybe a) Source # | |
Defined in GHC.TypeLits.Printf.Parse |
class Reflect (x :: a) where Source #
Instances
Reflect 'LeftAdjust Source # | |
Defined in GHC.TypeLits.Printf.Parse Methods reflect :: p 'LeftAdjust -> Demote FormatAdjustment Source # | |
Reflect 'ZeroPad Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
Reflect 'SignPlus Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
Reflect 'SignSpace Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
KnownNat n => Reflect (n :: Nat) Source # | |
Reflect 'WML Source # | |
Reflect 'WMh Source # | |
Reflect 'WMhh Source # | |
Reflect 'WMl Source # | |
Reflect 'WMll Source # | |
Reflect 'False Source # | |
Reflect 'True Source # | |
KnownChar c => Reflect (c :: Char) Source # | |
KnownSymbol n => Reflect (n :: Symbol) Source # | |
(Reflect d, Reflect i, Reflect l) => Reflect ('Flags d i l :: Flags) Source # | |
(Reflect flags, Reflect width, Reflect prec, Reflect mods, Reflect chr) => Reflect ('FF flags width prec mods chr :: FieldFormat) Source # | |
Defined in GHC.TypeLits.Printf.Parse | |
Reflect ('Nothing :: Maybe a) Source # | |
Reflect x => Reflect ('Just x :: Maybe a) Source # | |
class FormatType (t :: Char) a where Source #
Typeclass associating format types (d
, f
, etc.) with the types
that can be formatted by them.
You can extend the printf methods here for your own types by writing your instances here.
Minimal complete definition
Nothing
Methods
formatArg :: p t -> a -> FieldFormat -> ShowS Source #
Instances
class Printf (str :: Symbol) fun where Source #
Methods
printf_ :: p str -> fun Source #
A version of printf
taking an explicit
proxy, which allows usage without TypeApplications
>>>
putStrLn $ printf_ (Proxy :: Proxy "You have %.2f dollars, %s") 3.62 "Luigi"
You have 3.62 dollars, Luigi
Instances
(ffs ~ ParseFmtStr_ str, FormatFun ffs fun) => Printf str fun Source # | |
Defined in GHC.TypeLits.Printf.Internal |
class FormatFun (ffs :: [Either Symbol FieldFormat]) fun where Source #
The typeclass supporting polyarity used by
printf
. It works in mostly the same way as
PrintfType
from Text.Printf, and similar the same as
FormatF
. Ideally, you will never have to
run into this typeclass or have to deal with it directly.
Every item in the first argument of FormatFun
is a chunk of the
formatting string, split between format holes (Right
) and string
chunks (Left
).
If you want to see some useful error messages for feedback, pHelp
can
be useful:
>>>
pHelp $ printf "You have %.2f dollars, %s" 3.62
-- ERROR: Call to printf missing argument fulfilling "%s" -- Either provide an argument or rewrite the format string to not expect -- one.
Instances
newtype PFmt (c :: k) Source #
Utility type powering pfmt
. See documentation for pfmt
for more
information on usage.
Using OverloadedLabels, you never need to construct this directly
can just write #f
and a
will be generated. You can also
create this using PFmt
"f"mkPFmt
or mkPFmt_
, in the situations where
OverloadedLabels doesn't work or is not wanted.
Constructors
PFmt FieldFormat |
pfmt :: forall (c :: Char) a. FormatType c a => PFmt c -> a -> String Source #
Parse and run a single format hole on a single vale. Can be useful
for formatting individual items or for testing your own custom instances of
FormatType
.
Usually meant to be used with OverloadedLabels:
>>>
pfmt #f 3.62
"3.62"
However, current versions of GHC disallow labels that aren't valid
identifier names, disallowing things like
. While
there is an
<https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0170-unrestricted-overloadedlabels.rst
approved proposal> that allows this, if you are using an earlier GHC
version, you can get around this using pfmt
#.2f 3.62mkPFmt
:
>>>
pfmt (mkPFmt @".2f") 3.6234124
"3.62"
Ideally we'd want to be able to write
>>>
pfmt #.2f 3.6234124
"3.62"
(which should be possible in GHC 8.10+)
Note that the format string should not include the leading %
.
mkPFmt :: forall (str :: Symbol) (ff :: FieldFormat) (f :: Flags) (w :: Maybe Nat) (q :: Maybe Nat) (m :: Maybe WidthMod) (c :: Char). (ff ~ ParseFmt_ str, Reflect ff, ff ~ 'FF f w q m c) => PFmt c Source #
Useful for using pfmt
without OverloadedLabels, or also when
passing format specifiers that aren't currently allowed with
OverloadedLabels until GHC 8.10+ (like #.2f
).
>>>
pfmt (mkPFmt @".2f") 3.6234124
"3.62"
mkPFmt_ :: forall (str :: Symbol) (ff :: FieldFormat) (f :: Flags) (w :: Maybe Nat) (q :: Maybe Nat) (m :: Maybe WidthMod) (c :: Char) p. (ff ~ ParseFmt_ str, Reflect ff, ff ~ 'FF f w q m c) => p str -> PFmt c Source #
A version of mkPFmt
that takes an explicit proxy input.
>>>
pfmt (mkPFmt_ (Proxy :: Proxy ".2f")) 3.6234124
"3.62"
A useful tool for helping the type system give useful errors for
printf
:
>>>
printf "You have ".2f" dollars, %s" 3.26 :: PHelp
-- ERROR: Call to printf missing argument fulfilling "%s" -- Either provide an argument or rewrite the format string to not expect -- one.
Mostly useful if you want to force a useful type error to help see what is going on.
See also pHelp
Constructors
PHelp | |
Fields
|