{-# LANGUAGE CPP #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}

#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif

#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE PolyKinds #-}
#endif

#if __GLASGOW_HASKELL__ >= 800 && __GLASGOW_HASKELL__ < 806
{-# LANGUAGE TypeInType #-}
#endif

{-# OPTIONS_GHC -fno-warn-deprecations #-}

{-|
Module:      Data.Proxied
Copyright:   (C) 2016-2017 Ryan Scott
License:     BSD-style (see the file LICENSE)
Maintainer:  Ryan Scott
Stability:   Provisional
Portability: GHC

Convert 'undefined'-consuming functions to 'Proxy'-consuming ones with 'proxied'.

/Since: 0.1/
-}
module Data.Proxied (
      -- * 'proxied' and 'unproxied'
      proxied
#if MIN_VERSION_base(4,7,0)
    , proxyHashed
#endif
    , unproxied
    , module Data.Proxy
      -- * Proxified functions
      -- ** "Data.Bits"
    , bitSizeProxied
    , isSignedProxied
#if MIN_VERSION_base(4,7,0)
    , bitSizeMaybeProxied
    , finiteBitSizeProxied
#endif
      -- ** "Data.Data"
    , dataTypeOfProxied
      -- ** "Data.Typeable"
    , typeOfProxied
      -- ** "Foreign.Storable"
    , sizeOfProxied
    , alignmentProxied
      -- ** "GHC.Generics"
    , datatypeNameProxied
    , moduleNameProxied
#if MIN_VERSION_base(4,7,0)
    , isNewtypeProxied
#endif
#if MIN_VERSION_base(4,9,0)
    , packageNameProxied
#endif
    , conNameProxied
    , conFixityProxied
    , conIsRecordProxied
    , selNameProxied
#if MIN_VERSION_base(4,9,0)
    , selSourceUnpackednessProxied
    , selSourceStrictnessProxied
    , selDecidedStrictnessProxied
#endif
      -- ** "Prelude"
    , floatRadixProxied
    , floatDigitsProxied
    , floatRangeProxied
#if MIN_VERSION_base(4,7,0)
      -- ** "Text.Printf"
    , parseFormatProxied
#endif
    ) where

import Data.Bits (Bits(..))
import Data.Data hiding (Fixity)
#if MIN_VERSION_base(4,9,0)
import Data.Kind (Type)
#endif
import Data.Proxy

import Foreign.Storable (Storable(..))

#if MIN_VERSION_base(4,6,0)
import GHC.Generics
#else
import Generics.Deriving.Base
import Generics.Deriving.Instances ()
#endif

#if MIN_VERSION_base(4,7,0)
import Data.Bits (FiniteBits(..))
import GHC.Exts (Proxy#)
import Text.Printf (PrintfArg(..), ModifierParser)
#endif

-- | Converts a constant function to one that takes a @proxy@ argument.
--
-- /Since: 0.1/
proxied :: forall proxy a b. (a -> b) -> proxy a -> b
proxied :: forall (proxy :: * -> *) a b. (a -> b) -> proxy a -> b
proxied a -> b
f proxy a
_ = a -> b
f a
forall a. HasCallStack => a
undefined

#if MIN_VERSION_base(4,7,0)
-- | Converts a constant function to one that takes a @Proxy#@ argument.
-- This function is only available with @base-4.7@ or later.
--
-- /Since: 0.2/
proxyHashed :: forall a b. (a -> b) -> Proxy# a -> b
proxyHashed :: forall a b. (a -> b) -> Proxy# a -> b
proxyHashed a -> b
f Proxy# a
_ = a -> b
f a
forall a. HasCallStack => a
undefined
#endif

-- | Converts a constant function that takes a 'Proxy' argument to one that
-- doesn't require a @proxy@ argument. (I'm not sure why you'd want this,
-- but it's here for symmetry.)
--
-- /Since: 0.1/
unproxied :: forall a b. (Proxy a -> b) -> a -> b
unproxied :: forall a b. (Proxy a -> b) -> a -> b
unproxied Proxy a -> b
f a
_ = Proxy a -> b
f Proxy a
forall {k} (t :: k). Proxy t
Proxy

-------------------------------------------------------------------------------
-- Data.Bits
-------------------------------------------------------------------------------

-- | @'bitSizeProxied' = 'proxied' 'bitSize'@
--
-- /Since: 0.1/
bitSizeProxied :: forall proxy a. Bits a => proxy a -> Int
bitSizeProxied :: forall (proxy :: * -> *) a. Bits a => proxy a -> Int
bitSizeProxied = (a -> Int) -> proxy a -> Int
forall (proxy :: * -> *) a b. (a -> b) -> proxy a -> b
proxied a -> Int
forall a. Bits a => a -> Int
bitSize

-- | @'isSignedProxied' = 'proxied' 'isSigned'@
--
-- /Since: 0.1/
isSignedProxied :: forall proxy a. Bits a => proxy a -> Bool
isSignedProxied :: forall (proxy :: * -> *) a. Bits a => proxy a -> Bool
isSignedProxied = (a -> Bool) -> proxy a -> Bool
forall (proxy :: * -> *) a b. (a -> b) -> proxy a -> b
proxied a -> Bool
forall a. Bits a => a -> Bool
isSigned

#if MIN_VERSION_base(4,7,0)
-- | @'bitSizeMaybeProxied' = 'proxied' 'bitSizeMaybe'@
--
-- This function is only available with @base-4.7@ or later.
--
-- /Since: 0.1/
bitSizeMaybeProxied :: forall proxy a. Bits a => proxy a -> Maybe Int
bitSizeMaybeProxied :: forall (proxy :: * -> *) a. Bits a => proxy a -> Maybe Int
bitSizeMaybeProxied = (a -> Maybe Int) -> proxy a -> Maybe Int
forall (proxy :: * -> *) a b. (a -> b) -> proxy a -> b
proxied a -> Maybe Int
forall a. Bits a => a -> Maybe Int
bitSizeMaybe

-- | @'finiteBitSizeProxied' = 'proxied' 'finiteBitSize'@
--
-- This function is only available with @base-4.7@ or later.
--
-- /Since: 0.1/
finiteBitSizeProxied :: forall proxy a. FiniteBits a => proxy a -> Int
finiteBitSizeProxied :: forall (proxy :: * -> *) a. FiniteBits a => proxy a -> Int
finiteBitSizeProxied = (a -> Int) -> proxy a -> Int
forall (proxy :: * -> *) a b. (a -> b) -> proxy a -> b
proxied a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize
#endif

-------------------------------------------------------------------------------
-- Data.Data
-------------------------------------------------------------------------------

-- | @'dataTypeOfProxied' = 'proxied' 'dataTypeOf'@
--
-- /Since: 0.1/
dataTypeOfProxied :: forall proxy a. Data a => proxy a -> DataType
dataTypeOfProxied :: forall (proxy :: * -> *) a. Data a => proxy a -> DataType
dataTypeOfProxied = (a -> DataType) -> proxy a -> DataType
forall (proxy :: * -> *) a b. (a -> b) -> proxy a -> b
proxied a -> DataType
forall a. Data a => a -> DataType
dataTypeOf

-------------------------------------------------------------------------------
-- Data.Typeable
-------------------------------------------------------------------------------

-- | @'typeOfProxied' = 'proxied' 'typeOf'@
--
-- On @base-4.7@ and later, this is identical to 'typeRep'.
--
-- /Since: 0.1/
typeOfProxied :: forall
#if MIN_VERSION_base(4,9,0)
                        k
#endif
                        proxy
#if MIN_VERSION_base(4,7,0)
                        (a :: k)
#else
                        a
#endif
                        . Typeable a => proxy a -> TypeRep
#if MIN_VERSION_base(4,7,0)
typeOfProxied :: forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeOfProxied = proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep
#else
typeOfProxied = proxied typeOf
#endif

-------------------------------------------------------------------------------
-- Foreign.Storable
-------------------------------------------------------------------------------

-- | @'sizeOfProxied' = 'proxied' 'sizeOf'@
--
-- /Since: 0.1/
sizeOfProxied :: forall proxy a. Storable a => proxy a -> Int
sizeOfProxied :: forall (proxy :: * -> *) a. Storable a => proxy a -> Int
sizeOfProxied = (a -> Int) -> proxy a -> Int
forall (proxy :: * -> *) a b. (a -> b) -> proxy a -> b
proxied a -> Int
forall a. Storable a => a -> Int
sizeOf

-- | @'alignmentProxied' = 'proxied' 'alignment'@
--
-- /Since: 0.1/
alignmentProxied :: forall proxy a. Storable a => proxy a -> Int
alignmentProxied :: forall (proxy :: * -> *) a. Storable a => proxy a -> Int
alignmentProxied = (a -> Int) -> proxy a -> Int
forall (proxy :: * -> *) a b. (a -> b) -> proxy a -> b
proxied a -> Int
forall a. Storable a => a -> Int
alignment

-------------------------------------------------------------------------------
-- GHC.Generics
-------------------------------------------------------------------------------

#define GENERIC_FORALL(t,letter) forall K_KINDS proxy T_TYPE(t) letter f a

#if MIN_VERSION_base(4,9,0)
# define K_KINDS k1 k2
#else
# define K_KINDS
#endif

#if MIN_VERSION_base(4,10,0)
# define T_TYPE(t) (t :: k1 -> (k2   -> Type) -> k2 -> Type)
#elif MIN_VERSION_base(4,9,0)
# define T_TYPE(t) (t :: k1 -> (Type -> Type) -> k2 -> Type)
#else
# define T_TYPE(t) (t :: *  -> (*    -> *)    -> *  -> *)
#endif

-- | @'datatypeNameProxied' = 'proxied' 'datatypeName'@
--
-- /Since: 0.1/
datatypeNameProxied :: GENERIC_FORALL(t,d). Datatype d
                    => proxy (T_TYPE(t) d f a)
                    -> [Char]
datatypeNameProxied :: forall k1 k2 (proxy :: * -> *) (t :: k1 -> (k2 -> *) -> k2 -> *)
       (d :: k1) (f :: k2 -> *) (a :: k2).
Datatype d =>
proxy (t d f a) -> [Char]
datatypeNameProxied = (t d f a -> [Char]) -> proxy (t d f a) -> [Char]
forall (proxy :: * -> *) a b. (a -> b) -> proxy a -> b
proxied t d f a -> [Char]
forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> [Char]
forall k1 (t :: k1 -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t d f a -> [Char]
datatypeName

-- | @'moduleNameProxied' = 'proxied' 'moduleName'@
--
-- /Since: 0.1/
moduleNameProxied :: GENERIC_FORALL(t,d). Datatype d
                  => proxy (T_TYPE(t) d f a)
                  -> [Char]
moduleNameProxied :: forall k1 k2 (proxy :: * -> *) (t :: k1 -> (k2 -> *) -> k2 -> *)
       (d :: k1) (f :: k2 -> *) (a :: k2).
Datatype d =>
proxy (t d f a) -> [Char]
moduleNameProxied = (t d f a -> [Char]) -> proxy (t d f a) -> [Char]
forall (proxy :: * -> *) a b. (a -> b) -> proxy a -> b
proxied t d f a -> [Char]
forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> [Char]
forall k1 (t :: k1 -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t d f a -> [Char]
moduleName

#if MIN_VERSION_base(4,7,0)
-- | @'isNewtypeProxied' = 'proxied' 'isNewtype'@
--
-- This function is only available with @base-4.7@ or later.
--
-- /Since: 0.1/
isNewtypeProxied :: GENERIC_FORALL(t,d). Datatype d
                 => proxy (T_TYPE(t) d f a)
                 -> Bool
isNewtypeProxied :: forall k1 k2 (proxy :: * -> *) (t :: k1 -> (k2 -> *) -> k2 -> *)
       (d :: k1) (f :: k2 -> *) (a :: k2).
Datatype d =>
proxy (t d f a) -> Bool
isNewtypeProxied = (t d f a -> Bool) -> proxy (t d f a) -> Bool
forall (proxy :: * -> *) a b. (a -> b) -> proxy a -> b
proxied t d f a -> Bool
forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> Bool
forall k1 (t :: k1 -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t d f a -> Bool
isNewtype
#endif

#if MIN_VERSION_base(4,9,0)
-- | @'packageNameProxied' = 'proxied' 'packageName'@
--
-- This function is only avaiable with @base-4.9@ or later.
--
-- /Since: 0.1/
packageNameProxied :: GENERIC_FORALL(t,d). Datatype d
                   => proxy (T_TYPE(t) d f a)
                   -> [Char]
packageNameProxied :: forall k1 k2 (proxy :: * -> *) (t :: k1 -> (k2 -> *) -> k2 -> *)
       (d :: k1) (f :: k2 -> *) (a :: k2).
Datatype d =>
proxy (t d f a) -> [Char]
packageNameProxied = (t d f a -> [Char]) -> proxy (t d f a) -> [Char]
forall (proxy :: * -> *) a b. (a -> b) -> proxy a -> b
proxied t d f a -> [Char]
forall {k} (d :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Datatype d =>
t d f a -> [Char]
forall k1 (t :: k1 -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t d f a -> [Char]
packageName
#endif

-- | @'conNameProxied' = 'proxied' 'conName'@
--
-- /Since: 0.1/
conNameProxied :: GENERIC_FORALL(t,c). Constructor c
               => proxy (T_TYPE(t) c f a)
               -> [Char]
conNameProxied :: forall k1 k2 (proxy :: * -> *) (t :: k1 -> (k2 -> *) -> k2 -> *)
       (c :: k1) (f :: k2 -> *) (a :: k2).
Constructor c =>
proxy (t c f a) -> [Char]
conNameProxied = (t c f a -> [Char]) -> proxy (t c f a) -> [Char]
forall (proxy :: * -> *) a b. (a -> b) -> proxy a -> b
proxied t c f a -> [Char]
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> [Char]
forall k1 (t :: k1 -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> [Char]
conName

-- | @'conFixityProxied' = 'proxied' 'conFixity'@
--
-- /Since: 0.1/
conFixityProxied :: GENERIC_FORALL(t,c). Constructor c
                 => proxy (T_TYPE(t) c f a)
                 -> Fixity
conFixityProxied :: forall k1 k2 (proxy :: * -> *) (t :: k1 -> (k2 -> *) -> k2 -> *)
       (c :: k1) (f :: k2 -> *) (a :: k2).
Constructor c =>
proxy (t c f a) -> Fixity
conFixityProxied = (t c f a -> Fixity) -> proxy (t c f a) -> Fixity
forall (proxy :: * -> *) a b. (a -> b) -> proxy a -> b
proxied t c f a -> Fixity
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Fixity
forall k1 (t :: k1 -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> Fixity
conFixity

-- | @'conIsRecordProxied' = 'proxied' 'conIsRecord'@
--
-- /Since: 0.1/
conIsRecordProxied :: GENERIC_FORALL(t,c). Constructor c
                   => proxy (T_TYPE(t) c f a)
                   -> Bool
conIsRecordProxied :: forall k1 k2 (proxy :: * -> *) (t :: k1 -> (k2 -> *) -> k2 -> *)
       (c :: k1) (f :: k2 -> *) (a :: k2).
Constructor c =>
proxy (t c f a) -> Bool
conIsRecordProxied = (t c f a -> Bool) -> proxy (t c f a) -> Bool
forall (proxy :: * -> *) a b. (a -> b) -> proxy a -> b
proxied t c f a -> Bool
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> Bool
forall k1 (t :: k1 -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> Bool
conIsRecord

-- | @'selNameProxied' = 'proxied' 'selName'@
--
-- /Since: 0.1/
selNameProxied :: GENERIC_FORALL(t,s). Selector s
               => proxy (T_TYPE(t) s f a)
               -> [Char]
selNameProxied :: forall k1 k2 (proxy :: * -> *) (t :: k1 -> (k2 -> *) -> k2 -> *)
       (s :: k1) (f :: k2 -> *) (a :: k2).
Selector s =>
proxy (t s f a) -> [Char]
selNameProxied = (t s f a -> [Char]) -> proxy (t s f a) -> [Char]
forall (proxy :: * -> *) a b. (a -> b) -> proxy a -> b
proxied t s f a -> [Char]
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> [Char]
forall k1 (t :: k1 -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> [Char]
selName

#if MIN_VERSION_base(4,9,0)
-- | @'selSourceUnpackednessProxied' = 'proxied' 'selSourceUnpackedness'@
--
-- This function is only available with @base-4.9@ or later.
--
-- /Since: 0.1/
selSourceUnpackednessProxied :: GENERIC_FORALL(t,s). Selector s
                             => proxy (T_TYPE(t) s f a)
                             -> SourceUnpackedness
selSourceUnpackednessProxied :: forall k1 k2 (proxy :: * -> *) (t :: k1 -> (k2 -> *) -> k2 -> *)
       (s :: k1) (f :: k2 -> *) (a :: k2).
Selector s =>
proxy (t s f a) -> SourceUnpackedness
selSourceUnpackednessProxied = (t s f a -> SourceUnpackedness)
-> proxy (t s f a) -> SourceUnpackedness
forall (proxy :: * -> *) a b. (a -> b) -> proxy a -> b
proxied t s f a -> SourceUnpackedness
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> SourceUnpackedness
forall k1 (t :: k1 -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> SourceUnpackedness
selSourceUnpackedness

-- | @'selSourceStrictnessProxied' = 'proxied' 'selSourceStrictness'@
--
-- This function is only available with @base-4.9@ or later.
--
-- /Since: 0.1/
selSourceStrictnessProxied :: GENERIC_FORALL(t,s). Selector s
                           => proxy (T_TYPE(t) s f a)
                           -> SourceStrictness
selSourceStrictnessProxied :: forall k1 k2 (proxy :: * -> *) (t :: k1 -> (k2 -> *) -> k2 -> *)
       (s :: k1) (f :: k2 -> *) (a :: k2).
Selector s =>
proxy (t s f a) -> SourceStrictness
selSourceStrictnessProxied = (t s f a -> SourceStrictness)
-> proxy (t s f a) -> SourceStrictness
forall (proxy :: * -> *) a b. (a -> b) -> proxy a -> b
proxied t s f a -> SourceStrictness
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> SourceStrictness
forall k1 (t :: k1 -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> SourceStrictness
selSourceStrictness

-- | @'selDecidedStrictnessProxied' = 'proxied' 'selDecidedStrictness'@
--
-- This function is only available with @base-4.9@ or later.
--
-- /Since: 0.1/
selDecidedStrictnessProxied :: GENERIC_FORALL(t,s). Selector s
                            => proxy (T_TYPE(t) s f a)
                            -> DecidedStrictness
selDecidedStrictnessProxied :: forall k1 k2 (proxy :: * -> *) (t :: k1 -> (k2 -> *) -> k2 -> *)
       (s :: k1) (f :: k2 -> *) (a :: k2).
Selector s =>
proxy (t s f a) -> DecidedStrictness
selDecidedStrictnessProxied = (t s f a -> DecidedStrictness)
-> proxy (t s f a) -> DecidedStrictness
forall (proxy :: * -> *) a b. (a -> b) -> proxy a -> b
proxied t s f a -> DecidedStrictness
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> DecidedStrictness
forall k1 (t :: k1 -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> DecidedStrictness
selDecidedStrictness
#endif

-------------------------------------------------------------------------------
-- Prelude
-------------------------------------------------------------------------------

-- | @'floatRadixProxied' = 'proxied' 'floatRadix'@
--
-- /Since: 0.1/
floatRadixProxied :: forall proxy a. RealFloat a => proxy a -> Integer
floatRadixProxied :: forall (proxy :: * -> *) a. RealFloat a => proxy a -> Integer
floatRadixProxied = (a -> Integer) -> proxy a -> Integer
forall (proxy :: * -> *) a b. (a -> b) -> proxy a -> b
proxied a -> Integer
forall a. RealFloat a => a -> Integer
floatRadix

-- | @'floatDigitsProxied' = 'proxied' 'floatDigits'@
--
-- /Since: 0.1/
floatDigitsProxied :: forall proxy a. RealFloat a => proxy a -> Int
floatDigitsProxied :: forall (proxy :: * -> *) a. RealFloat a => proxy a -> Int
floatDigitsProxied = (a -> Int) -> proxy a -> Int
forall (proxy :: * -> *) a b. (a -> b) -> proxy a -> b
proxied a -> Int
forall a. RealFloat a => a -> Int
floatDigits

-- | @'floatRangeProxied' = 'proxied' 'floatRange'@
--
-- /Since: 0.1/
floatRangeProxied :: forall proxy a. RealFloat a => proxy a -> (Int, Int)
floatRangeProxied :: forall (proxy :: * -> *) a. RealFloat a => proxy a -> (Int, Int)
floatRangeProxied = (a -> (Int, Int)) -> proxy a -> (Int, Int)
forall (proxy :: * -> *) a b. (a -> b) -> proxy a -> b
proxied a -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange

-------------------------------------------------------------------------------
-- Text.Printf
-------------------------------------------------------------------------------

#if MIN_VERSION_base(4,7,0)
-- | @'parseFormatProxied' = 'proxied' 'parseFormat'@
--
-- This function is only available with @base-4.7@ or later.
--
-- /Since: 0.1/
parseFormatProxied :: forall proxy a. PrintfArg a => proxy a -> ModifierParser
parseFormatProxied :: forall (proxy :: * -> *) a.
PrintfArg a =>
proxy a -> ModifierParser
parseFormatProxied = (a -> ModifierParser) -> proxy a -> ModifierParser
forall (proxy :: * -> *) a b. (a -> b) -> proxy a -> b
proxied a -> ModifierParser
forall a. PrintfArg a => a -> ModifierParser
parseFormat
#endif