typelits-printf (empty) → 0.1.0.0

raw patch · 9 files changed

+1434/−0 lines, 9 filesdep +basedep +symbolsdep +textsetup-changed

Dependencies added: base, symbols, text, vinyl

Files

• CHANGELOG.md +11/−0
• LICENSE +30/−0
• README.md +152/−0
• Setup.hs +2/−0
• src/GHC/TypeLits/Printf.hs +259/−0
• src/GHC/TypeLits/Printf/Internal.hs +515/−0
• src/GHC/TypeLits/Printf/Internal/Parser.hs +187/−0
• src/GHC/TypeLits/Printf/Parse.hs +224/−0
• typelits-printf.cabal +54/−0

@@ -0,0 +1,11 @@+Changelog+=========++Version 0.1.0.0+---------------++*February 25, 2020*++<https://github.com/mstksg/symbols-printf/releases/tag/v0.1.0.0>++*   Initial release

@@ -0,0 +1,30 @@+Copyright Justin Le (c) 2019++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Justin Le nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,152 @@+# symbols-printf++(Heavily inspired by *[Data.Symbol.Examples.Printf][symbols]*)++[symbols]: https://hackage.haskell.org/package/symbols-0.3.0.0/docs/Data-Symbol-Examples-Printf.html++```haskell+ghci> putStrLn $ printf @"You have %.2f dollars, %s" 3.62 "Luigi"+You have 3.62 dollars, Luigi+```++An extensible and type-safe printf from parsing GHC TypeLits Symbol literals,+matching the semantics of *[Text.Printf][]* in *base*.  The difference is that+the variants here will always fail to compile if given arguments of the wrong+type (or too many or too little arguments). Most of the variants also provide+useful type feedback, telling you the type of arguments it expects and how many+when queried with `:t` or with typed holes.++[Text.Printf]: https://hackage.haskell.org/package/base/docs/Text-Printf.html++There are three main calling conventions offered:++```haskell+ghci> putStrLn $ printf @"You have %.2f dollars, %s" 3.62 "Luigi"+You have 3.62 dollars, Luigi++ghci> putStrLn $ pprintf @"You have %.2f dollars, %s" (PP 3.62) (PP "Luigi")+You have 3.62 dollars, Luigi++ghci> putStrLn $ rprintf @"You have %.2f dollars, %s" (3.62 :% "Luigi" :% RNil)+You have 3.62 dollars, Luigi+```++Comparing their types:++```haskell+ghci> :t printf @"You have %.2f dollars, %s" 3.62 "Luigi"+FormatFun '[ .... ] fun => fun++ghci> :t pprintf @"You have %.2f dollars, %s" 3.62 "Luigi"+PP "f" -> PP "s" -> String++ghci> :t rprintf @"You have %.2f dollars, %s" 3.62 "Luigi"+FormatArgs '["f", "s"] -> String+```++*   The type of `printf` doesn't tell you immediately what you+    you need.  However, if you do try to use it, the type errors will guide you+    along the way, iteratively.++    ```haskell+    ghci> printf @"You have %.2f dollars, %s"+    -- ERROR: Call to printf missing argument fulfilling "%.2f"+    -- Either provide an argument or rewrite the format string to not expect+    -- one.++    ghci> 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.++    ghci> printf @"You have %.2f dollars, %s" 3.62 "Luigi"+    You have 3.62 dollars, Luigi++    ghci> printf @"You have %.2f dollars, %s" 3.62 "Luigi" 72+    -- ERROR: An extra argument of type Integer was given to a call to printf+    -- Either remove the argument, or rewrite the format string to include the+    -- appropriate hole.+    ```++*   For `pprintf`, it shows you need two arguments: A `PP "f"` (which is a+    value that supports being formatted by `f`) like `PP 3.62`, and a `PP "s"`,+    like `PP "Luigi"`.++*   `rprintf` tells you you need a two-item hlist (from "Data.Vinyl.Core"),+    where the first item implements `f` and the second item implements `s`:+    `3.62 :% "Luigi" :% RNil` will do.++The following table summarizes the features and drawbacks of each+method:++| Method    | True Polyarity   | Naked Arguments    | Type feedback        |+| --------- | ---------------- | ------------------ | -------------------- |+| `printf`  | Yes              | Yes                | Partial (via errors) |+| `pprintf` | Yes              | No (requires `PP`) | Yes                  |+| `rprintf` | No (HList-based) | Yes                | Yes                  |++*Ideally* we would have a solution that has all three.  However, as of now, we+have a "pick two" sort of situation.  Suggestions are definitely welcome,+however, if you find something that satisfies all three benefits while still+allowing for polymorphism!++You can extend functionality with formatting for your own types by providing+instances of `FormatType`.++## Caveats++For medium-length or long strings, the parsing can be fairly slow and cause+slow compile times.  This might be due to the underlying mechanism that the+*[symbols][]* package exploits.++[symbols]: https://hackage.haskell.org/package/symbols++Moving to typechecker plugin based parsing *does* improve performance ...+however, I'm not sure how to get around requiring every module using `printf`+to require enabling the typechecker plugin, which isn't too great from a+usability standpoint.  Template Haskell based alternatives (like+*[th-printf][]*) already do require an extra pragma (for *QuasiQuotes*), though+so it might not be too bad in comparison.++## Comparisons++There are a few other options for type-safe printfs out on hackage, and they+all differ in a few key ways.  Some, like *[th-printf][]* and+*[safe-printf][]*, offer Template Haskell-based ways to generate your printf+functions.  This package is intended as a "template-haskell free" alternative.+However, it is notable that with a Template-Haskell based approach, we can+solve the "pick two" situation above: *[th-printf][]*'s printf fulfills all+three requirements in the table above, with the only potential drawback being+Template Haskell usage.++Some others, like *[safe-printf][]*, *[formatting][]*, *[printf-safe][]*,+*[xformat][]*, and *[category-printf][]*, require manually constructing your+fomatters, and so you always need to duplicate double-quotes for string+literals.  This detracts from one of the main convenience aspects of *printf*,+in my opinion.++```haskell+"You have " % f' 2 % " dollars, " % s+-- vs+"You have %.2f dollars, %s"+```++However, calling these libraries "safe printf libraries" does not do them+justice.  A library like *[formatting][]* is a feature-rich formatting library,+handling things like dates and other useful formatting features in a+first-class way that embraces Haskell idioms.  This library here is merely a+type-safe printf, emulating the features of *base*'s printf and C `printf(3)`.++[th-printf]: https://hackage.haskell.org/package/th-printf+[safe-printf]: https://hackage.haskell.org/package/safe-printf+[formatting]: https://hackage.haskell.org/package/formatting+[printf-safe]: https://hackage.haskell.org/package/printf-safe+[xformat]: https://hackage.haskell.org/package/xformat+[category-printf]: https://hackage.haskell.org/package/category-printf++## Todo++*   Make faster+*   Tests+*   Support for localization/dynamic strings.  Should be possible, but we'd+    have to re-implement a subset of singletons.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,259 @@+{-# LANGUAGE AllowAmbiguousTypes    #-}+{-# LANGUAGE ConstraintKinds        #-}+{-# LANGUAGE DefaultSignatures      #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs                  #-}+{-# LANGUAGE KindSignatures         #-}+{-# LANGUAGE LambdaCase             #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE PatternSynonyms        #-}+{-# LANGUAGE RankNTypes             #-}+{-# LANGUAGE ScopedTypeVariables    #-}+{-# LANGUAGE TypeApplications       #-}+{-# LANGUAGE TypeFamilies           #-}+{-# LANGUAGE TypeInType             #-}+{-# LANGUAGE TypeOperators          #-}+{-# LANGUAGE UndecidableInstances   #-}++-- |+-- Module      : GHC.TypeLits.Printf+-- Copyright   : (c) Justin Le 2019+-- License     : BSD3+--+-- Maintainer  : justin@jle.im+-- Stability   : experimental+-- Portability : non-portable+--+-- An extensible and type-safe printf from parsing GHC TypeLits Symbol+-- literals, matching the semantics of 'P.printf' from "Text.Printf" in+-- /base/.  The difference is that the variants here will always fail to+-- compile if given arguments of the wrong type (or too many or too little+-- arguments).  Most of the variants also provide useful type feedback,+-- telling you the type of arguments it expects and how many when queried+-- with @:t@ or with typed holes.  See documentation in "Text.Printf" for+-- details on how this formats items of various types, and the differences+-- with C @printf(3)@.+--+-- There are three main calling conventions supported:+--+-- >>> putStrLn $ printf @"You have %.2f dollars, %s" 3.62 "Luigi"+-- You have 3.62 dollars, Luigi+-- >>> putStrLn $ pprintf @"You have %.2f dollars, %s" (PP 3.62) (PP "Luigi")+-- You have 3.62 dollars, Luigi+-- >>> putStrLn $ rprintf @"You have %.2f dollars, %s" (3.62 :% "Luigi" :% RNil)+-- You have 3.62 dollars, Luigi+--+-- Now comparing their types:+--+-- >>> :t printf @"You have %.2f dollars, %s" 3.62 "Luigi"+-- FormatFun '[ .... ] fun => fun+-- >>> :t pprintf @"You have %.2f dollars, %s" 3.62 "Luigi"+-- PP "f" -> PP "s" -> String+-- >>> :t rprintf @"You have %.2f dollars, %s" 3.62 "Luigi"+-- FormatArgs '["f", "s"] -> String+--+-- *   The type of `printf` doesn't tell you immediately what you you need.+--     However, if you do try to use it, the type errors will guide you+--     along the way, iteratively.+--+--     >>> printf @"You have %.2f dollars, %s"+--     -- ERROR: Call to printf missing argument fulfilling "%.2f"+--     -- Either provide an argument or rewrite the format string to not expect+--     -- one.+--+--     >>> 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.+--+--     >>> printf @"You have %.2f dollars, %s" 3.62 "Luigi"+--     You have 3.62 dollars, Luigi+--+--     >>> printf @"You have %.2f dollars, %s" 3.62 "Luigi" 72+--     -- ERROR: An extra argument of type Integer was given to a call to printf+--     -- Either remove the argument, or rewrite the format string to include the+--     -- appropriate hole.+--+-- *   For 'pprintf', it shows you need two arguments: A @'PP' "f"@ (which+--     is a value that supports being formatted by @f@) like @PP 3.62@, and+--     a @'PP' "s"@, like @PP "Luigi"@.+--+-- *   'rprintf' tells you you need a two-item hlist (from+--     "Data.Vinyl.Core"), where the first item implements @f@ and the+--     second item implements @s@: @3.62 ':%' "Luigi" :% 'RNil'@ will do.+--+-- The following table summarizes the features and drawbacks of each+-- method:+--+-- +-----------+------------------+--------------------+----------------------++-- | Method    | True Polyarity   | Naked Arguments    | Type feedback        |+-- +===========+==================+====================+======================++-- | 'printf'  | Yes              | Yes                | Partial (via errors) |+-- +-----------+------------------+--------------------+----------------------++-- | 'pprintf' | Yes              | No (requires 'PP') | Yes                  |+-- +-----------+------------------+--------------------+----------------------++-- | 'rprintf' | No (HList-based) | Yes                | Yes                  |+-- +-----------+------------------+--------------------+----------------------++--+-- /Ideally/ we would have a solution that has all three.  However, as of+-- now, we have a "pick two" sort of situation.  Suggestions are definitely+-- welcome, however, if you find something that satisfies all three+-- benefits while still allowing for polymorphism!+--+-- You can extend functionality with formatting for your own types by+-- providing instances of @FormatType@.+--+-- Also in this module is 'pfmt', which allows you to format individual+-- items according to a single format specifier.++module GHC.TypeLits.Printf (+  -- * Formattable things+    FormatType(..)+  , SChar+  -- * Printf+  -- ** Unguarded polyarity+  , printf, printf_+  , PHelp, pHelp+  , FormatFun+  -- ** Guarded polyarity+  , pprintf+  , pprintf_+  , PP(..)+  -- ** List-based polyarity+  , rprintf, rprintf_+  , Rec((:%), RNil), FormatArgs+  -- * Single item+  , pfmt+  , PFmt+  , mkPFmt, mkPFmt_+  ) where++import           Data.Proxy+import           Data.Vinyl+import           Data.Vinyl.Curry+import           GHC.TypeLits.Printf.Internal++-- | Type-safe printf with faked polyarity.  Pass in a "list" of arguments+-- (using ':%' and 'RNil'), instead of as multiple arguments.  Call it like+-- @'rprintf' \@"you have %.02f dollars, %s"@.+--+-- >>> :t rprintf @"You have %.2f dollars, %s"+-- FormatArgs '["f", "s"] -> String+--+-- This means that it is expecting something that can be printed with @f@+-- and something that can be printed with @s@.  We can provide a 'Double'+-- and a 'String':+--+-- >>> putStrLn $ rprintf @"You have %.2f dollars, %s" (3.62 ':%' "Luigi" :% 'RNil')+-- You have 3.62 dollars, Luigi+--+-- See 'pprintf' for a version with true polyarity and good clear types,+-- but requires wrapping its arguments, and 'printf' for a version with+-- true polyarity but less clear types.  Also see top-level module+-- documentation  "GHC.TypeLits.Printf" for a more comprehensive summary.+rprintf :: forall str ps. RPrintf str ps => FormatArgs ps -> String+rprintf = rprintf_ (Proxy @str)++-- | Pattern and constructor allowing you to construct a 'FormatArgs'.+--+-- To construct a @'FormatArgs' '["f", "s"]@, for instance, you need to+-- give a value formattable by @f@ and a value formattable by @s@, given+-- like a linked list, with ':%' for cons and 'RNil' for nil.+--+-- @+-- 3.62 ':%' "Luigi" :% 'RNil'+-- @+--+-- (This should evoke the idea of of @3.62 : "Luigi" : []@, even though the+-- latter is not possible in Haskell)+pattern (:%) :: () => FormatType c a => a -> FormatArgs cs -> FormatArgs (c ': cs)+pattern x :% xs = PP x :& xs+infixr 7 :%+{-# COMPLETE (:%) #-}++-- | A version of 'pprintf' taking an explicit proxy, which allows usage+-- without /TypeApplications/+--+-- >>> :t pprintf_ (Proxy :: Proxy "You have %.2f dollars, %s")+-- PP "f" -> PP "s" -> String+pprintf_ :: forall str ps p. (RPrintf str ps, RecordCurry ps) => p str -> CurriedF PP ps String+pprintf_ p = rcurry @ps (rprintf_ p)++-- | Type-safe printf with true guarded polyarity.  Call it like @'pprintf'+-- \@"you have %.02f dollars, %s"@.+--+-- A call to printf on a valid string will /always/ give a well-defined+-- type for a function in return:+--+-- >>> :t pprintf @"You have %.2f dollars, %s"+-- PP "f" -> PP "s" -> String+--+-- You can always query the type, and get a well-defined type back, which+-- you can utilize using typed holes or other type-guided development+-- techniques.+--+-- To give 'pprintf' its arguments, however, they must be wrapped in 'PP':+--+-- >>> putStrLn $ pprintf @"You have %.2f dollars, %s" (PP 3.62) (PP "Luigi")+-- You have 3.62 dollars, Luigi+--+-- See 'printf' for a polyariadic method that doesn't require 'PP' on its+-- inputs, but with a less helpful type signature, and 'rprintf' for+-- a fake-polyariadic method that doesn't require 'PP', but requires+-- arguments in a single list instead. Also see top-level module+-- documentation  "GHC.TypeLits.Printf" for a more comprehensive summary.+pprintf :: forall str ps. (RPrintf str ps, RecordCurry ps) => CurriedF PP ps String+pprintf = pprintf_ @str @ps (Proxy @str)++-- | Type-safe printf with true naked polyarity.  Call it like @'printf'+-- \@"you have %.02f dollars, %s"@.+--+-- >>> putStrLn $ printf @"You have %.2f dollars, %s" 3.62 "Luigi"+-- You have 3.62 dollars, Luigi+--+-- While the type of @'printf' \@"my fmt string"@ isn't going to be very+-- helpful, the error messages should help guide you along the way:+--+-- >>> printf @"You have %.2f dollars, %s"+-- -- ERROR: Call to printf missing argument fulfilling "%.2f"+-- -- Either provide an argument or rewrite the format string to not expect+-- -- one.+--+-- >>> 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.+--+-- >>> printf @"You have %.2f dollars, %s" 3.62 "Luigi"+-- You have 3.62 dollars, Luigi+--+-- >>> printf @"You have %.2f dollars, %s" 3.62 "Luigi" 72+-- -- ERROR: An extra argument of type Integer was given to a call to printf+-- -- Either remove the argument, or rewrite the format string to include the+-- -- appropriate hole.+--+-- If you're having problems getting the error messages to give helpful+-- feedback, try using 'pHelp':+--+-- >>> 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.+--+-- 'pHelp' can give the type system the nudge it needs to provide good+-- errors.+--+-- See 'pprintf' for a version of this with nicer types and type errors,+-- but requires wrapping arguments, and 'rprintf' for a version of this+-- with "fake" polyarity, taking a list as input instead. Also see+-- top-level module documentation  "GHC.TypeLits.Printf" for a more+-- comprehensive summary.+--+-- Note that this also supports the "interpret as an IO action to print out+-- results" functionality that "Text.Printf" supports.  This also supports+-- returning strict 'Data.Text.Text' and lazy 'Data.Text.Lazy.Text' as+-- well.+printf :: forall str fun. Printf str fun => fun+printf = printf_ (Proxy @str)+

@@ -0,0 +1,515 @@+{-# LANGUAGE AllowAmbiguousTypes    #-}+{-# LANGUAGE ConstraintKinds        #-}+{-# LANGUAGE DefaultSignatures      #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs                  #-}+{-# LANGUAGE KindSignatures         #-}+{-# LANGUAGE LambdaCase             #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE PatternSynonyms        #-}+{-# LANGUAGE RankNTypes             #-}+{-# LANGUAGE ScopedTypeVariables    #-}+{-# LANGUAGE TypeApplications       #-}+{-# LANGUAGE TypeFamilies           #-}+{-# LANGUAGE TypeInType             #-}+{-# LANGUAGE TypeOperators          #-}+{-# LANGUAGE UndecidableInstances   #-}+{-# OPTIONS_HADDOCK not-home        #-}++-- |+-- Module      : GHC.TypeLits.Printf.Internal+-- Copyright   : (c) Justin Le 2019+-- License     : BSD3+--+-- Maintainer  : justin@jle.im+-- Stability   : experimental+-- Portability : non-portable+--+-- 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.++module GHC.TypeLits.Printf.Internal (+    ParseFmtStr+  , ParseFmtStr_+  , ParseFmt+  , ParseFmt_+  , FormatAdjustment(..)+  , ShowFormat+  , FormatSign(..)+  , WidthMod(..)+  , Flags(..)+  , EmptyFlags+  , FieldFormat(..)+  , SChar+  , Demote+  , Reflect(..)+  , FormatType(..)+  , PP(..)+  , RPrintf(..)+  , FormatArgs+  , RFormat(..)+  , Printf(..)+  , FormatFun(..)+  , PFmt(..)+  , pfmt+  , mkPFmt, mkPFmt_+  , PHelp(..)+  ) where++import           Data.Int+import           Data.Proxy+import           Data.Symbol.Utils+import           Data.Vinyl+import           Data.Word+import           GHC.OverloadedLabels+import           GHC.TypeLits+import           GHC.TypeLits.Printf.Parse+import           Numeric.Natural+import qualified Data.Text                 as T+import qualified Data.Text.Lazy            as TL+import qualified Text.Printf               as P++-- | 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.+class FormatType (t :: SChar) a where+    formatArg :: p t -> a -> P.FieldFormat -> ShowS++    default formatArg :: P.PrintfArg a => p t -> a -> P.FieldFormat -> ShowS+    formatArg _ = P.formatArg++instance FormatType "c" Char+instance FormatType "c" Word8+instance FormatType "c" Word16++instance FormatType "d" Char+instance FormatType "d" Int+instance FormatType "d" Int8+instance FormatType "d" Int16+instance FormatType "d" Int32+instance FormatType "d" Int64+instance FormatType "d" Integer+instance FormatType "d" Natural+instance FormatType "d" Word+instance FormatType "d" Word8+instance FormatType "d" Word16+instance FormatType "d" Word32+instance FormatType "d" Word64++instance FormatType "o" Char+instance FormatType "o" Int+instance FormatType "o" Int8+instance FormatType "o" Int16+instance FormatType "o" Int32+instance FormatType "o" Int64+instance FormatType "o" Integer+instance FormatType "o" Natural+instance FormatType "o" Word+instance FormatType "o" Word8+instance FormatType "o" Word16+instance FormatType "o" Word32+instance FormatType "o" Word64++instance FormatType "x" Int+instance FormatType "x" Int8+instance FormatType "x" Int16+instance FormatType "x" Int32+instance FormatType "x" Int64+instance FormatType "x" Integer+instance FormatType "x" Natural+instance FormatType "x" Word+instance FormatType "x" Word8+instance FormatType "x" Word16+instance FormatType "x" Word32+instance FormatType "x" Word64++instance FormatType "X" Char+instance FormatType "X" Int+instance FormatType "X" Int8+instance FormatType "X" Int16+instance FormatType "X" Int32+instance FormatType "X" Int64+instance FormatType "X" Integer+instance FormatType "X" Natural+instance FormatType "X" Word+instance FormatType "X" Word8+instance FormatType "X" Word16+instance FormatType "X" Word32+instance FormatType "X" Word64++instance FormatType "b" Char+instance FormatType "b" Int+instance FormatType "b" Int8+instance FormatType "b" Int16+instance FormatType "b" Int32+instance FormatType "b" Int64+instance FormatType "b" Integer+instance FormatType "b" Natural+instance FormatType "b" Word+instance FormatType "b" Word8+instance FormatType "b" Word16+instance FormatType "b" Word32+instance FormatType "b" Word64++instance FormatType "u" Char+instance FormatType "u" Int+instance FormatType "u" Int8+instance FormatType "u" Int16+instance FormatType "u" Int32+instance FormatType "u" Int64+instance FormatType "u" Integer+instance FormatType "u" Natural+instance FormatType "u" Word+instance FormatType "u" Word8+instance FormatType "u" Word16+instance FormatType "u" Word32+instance FormatType "u" Word64++instance FormatType "f" Double+instance FormatType "f" Float++instance FormatType "F" Double+instance FormatType "F" Float++instance FormatType "g" Double+instance FormatType "g" Float++instance FormatType "G" Double+instance FormatType "G" Float++instance FormatType "e" Double+instance FormatType "e" Float++instance FormatType "E" Double+instance FormatType "E" Float++instance FormatType "s" String+instance FormatType "s" T.Text where+    formatArg _ = P.formatArg . T.unpack+instance FormatType "s" TL.Text where+    formatArg _ = P.formatArg . TL.unpack++-- | Treats as @c@+instance FormatType "v" Char+-- | Treats as @d@+instance FormatType "v" Int+-- | Treats as @d@+instance FormatType "v" Int8+-- | Treats as @d@+instance FormatType "v" Int16+-- | Treats as @d@+instance FormatType "v" Int32+-- | Treats as @d@+instance FormatType "v" Int64+-- | Treats as @d@+instance FormatType "v" Integer+-- | Treats as @u@+instance FormatType "v" Natural+-- | Treats as @u@+instance FormatType "v" Word+-- | Treats as @u@+instance FormatType "v" Word8+-- | Treats as @u@+instance FormatType "v" Word16+-- | Treats as @u@+instance FormatType "v" Word32+-- | Treats as @u@+instance FormatType "v" Word64+-- | Treats as @g@+instance FormatType "v" Double+-- | Treats as @g@+instance FormatType "v" Float+-- | Treats as @s@+instance FormatType "v" String+-- | Treats as @s@+instance FormatType "v" T.Text where+    formatArg _ = P.formatArg . T.unpack+-- | Treats as @s@+instance FormatType "v" TL.Text where+    formatArg _ = P.formatArg . TL.unpack++-- | Required wrapper around inputs to 'GHC.TypeLits.Printf.pprintf'+-- (guarded polyarity).  See documentation for+-- 'GHC.TypeLits.Printf.pprintf' for examples of usage.+--+-- You can "wrap" any value in 'PP' as long as it can be formatted as the+-- format type indicated.+--+-- For example, to make a @'PP' "f"@, you can use @'PP' 3.5@ or @'PP'+-- 94.2@, but not @'PP' (3 :: Int)@ or @'PP' "hello"@.  To make a value of+-- type @'PP' c@, you must wrap a value that can be formatted via @c@.+data PP (c :: SChar) = forall a. FormatType c a => PP a++-- | A heterogeneous list (from "Data.Vinyl.Core") used for calling with+-- 'GHC.TypeLits.Printf.rprintf'.  Instead of supplying the inputs as+-- different arguments, we can gather all the inputs into a single list to+-- give to 'GHC.TypeLits.Printf.rprintf'.+--+-- >>> :t rprintf @"You have %.2f dollars, %s"+-- FormatArgs '["f", "s"] -> String+--+-- To construct a @'FormatArgs' '["f", "s"]@, you need to give a value+-- formattable by @f@ and a value formattable by @s@, given like a linked+-- list, with 'GHC.TypeLits.Printf.:%' for cons and 'RNil' for nil.+--+-- >>> putStrLn $ rprintf @"You have %.2f dollars, %s" (3.62 :% "Luigi" :% RNil)+-- You have 3.62 dollars, Luigi+--+-- (This should evoke the idea of of @3.62 : "Luigi" : []@, even though the+-- latter is not possible in Haskell)+type FormatArgs = Rec PP++class RFormat (ffs :: [Either Symbol FieldFormat]) (ps :: [SChar]) | ffs -> ps where+    rformat :: p ffs -> FormatArgs ps -> ShowS++instance RFormat '[] '[] where+    rformat _ _ = id++instance (KnownSymbol str, RFormat ffs ps) => RFormat ('Left str ': ffs) ps where+    rformat _ r = showString (symbolVal (Proxy @str))+                . rformat (Proxy @ffs) r++instance (Reflect ff, ff ~ 'FF f w p m c, RFormat ffs ps) => RFormat ('Right ff ': ffs) (c ': ps) where+    rformat _ (PP x :& xs) = formatArg (Proxy @c) x ff+                           . rformat (Proxy @ffs) xs+      where+        ff = reflect (Proxy @ff)++class RPrintf (str :: Symbol) ps where+    -- | A version of 'GHC.TypeLits.Printf.rprintf' taking an explicit+    -- proxy, which allows usage without /TypeApplications/+    --+    -- >>> :t rprintf_ (Proxy :: Proxy "You have %.2f dollars, %s")+    -- FormatArgs '["f", "s"] -> String+    rprintf_ :: p str -> FormatArgs ps -> String++instance (Listify str lst, ffs ~ ParseFmtStr_ lst, RFormat ffs ps) => RPrintf str ps where+    rprintf_ _ = ($ "") . rformat (Proxy @ffs)++-- | The typeclass supporting polyarity used by+-- 'GHC.TypeLits.Printf.printf'. It works in mostly the same way as+-- 'P.PrintfType' from "Text.Printf", and similar the same as+-- 'Data.Symbol.Examples.Printf.FormatF'.+--+-- Ideally, you will never have to run into this typeclass or have to deal+-- with it.  It will come up if you ask for the type of+-- 'GHC.TypeLits.Printf.printf', or sometimes if you give the wrong number+-- or type of arguments to it.+--+-- >>> :t printf @"You have %.2f dollars, %s"+-- FormatFun '[ Right ..., 'Left " dollars ", 'Right ...] fun => fun+--+-- Every item in the first argument of 'FormatFun' is a chunk of the+-- formatting string, split between format holes ('Right') and string+-- chunks ('Left').  You can successively "eliminate" them by providing+-- more arguments that implement each hole:+--+-- >>> :t printf @"You have %.2f dollars, %s" 3.62+-- FormatFun '[ Right ...] fun => fun+--+-- Until you you finally fill all the holes:+--+-- >>> :t printf @"You have %.2f dollars, %s" 3.62 "Luigi"+-- FormatFun '[] t => t+--+-- at which point you may use it as a 'String' or @'IO' ()@, in the same+-- way that "Text.Printf" works.  We also support using strict 'T.Text'+-- lazy 'TL.Text' as well.+--+-- So, while it's possible to reason with this using the types, it's+-- usually more difficult than with 'pprintf' and 'rprintf'.+--+-- This is why, instead of reasoning with this using its types, it's easier+-- to reason with it using the errors instead:+--+-- >>> printf @"You have %.2f dollars, %s"+-- -- ERROR: Call to printf missing argument fulfilling "%.2f"+-- -- Either provide an argument or rewrite the format string to not expect+-- -- one.+--+-- >>> 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.+--+-- >>> printf @"You have %.2f dollars, %s" 3.62 "Luigi"+-- You have 3.62 dollars, Luigi+--+-- >>> printf @"You have %.2f dollars, %s" 3.62 "Luigi" 72+-- -- ERROR: An extra argument of type Integer was given to a call to printf+-- -- Either remove the argument, or rewrite the format string to include the+-- -- appropriate hole.+--+-- If you're having problems getting the error messages to give helpful+-- feedback, try using 'pHelp':+--+-- >>> 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.+--+-- 'pHelp' can give the type system the nudge it needs to provide good+-- errors.+class FormatFun (ffs :: [Either Symbol FieldFormat]) fun where+    formatFun :: p ffs -> String -> fun++-- | A useful token 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.+--+-- Usually things should work out on their own without needing this ... but+-- sometimes the type system could need a nudge.+--+-- See also 'pHelp'+newtype PHelp = PHelp {+    -- | A useful helper function for helping the type system give useful+    -- errors for 'printf':+    --+    -- >>> 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.+    --+    -- Usually things would work out on their own without needing this ...+    -- but sometimes the type system could need a nudge.+    pHelp :: String+  }++instance (a ~ Char) => FormatFun '[] [a] where+    formatFun _ = id+instance (a ~ Char) => FormatFun '[] PHelp where+    formatFun _ = PHelp+instance (a ~ Char) => FormatFun '[] T.Text where+    formatFun _ = T.pack+instance (a ~ Char) => FormatFun '[] TL.Text where+    formatFun _ = TL.pack+instance (a ~ ()) => FormatFun '[] (IO a) where+    formatFun _ = putStr++instance TypeError ( 'Text "Result type of a call to printf not sufficiently inferred."+               ':$$: 'Text "Please provide an explicit type annotation or other way to help inference."+                   )+      => FormatFun '[] () where+    formatFun _ = error++instance TypeError ( 'Text "An extra argument of type "+               ':<>: 'ShowType a+               ':<>: 'Text " was given to a call to printf."+               ':$$: 'Text "Either remove the argument, or rewrite the format string to include the appropriate hole"+                   )+      => FormatFun '[] (a -> b) where+    formatFun _ = error++instance (KnownSymbol str, FormatFun ffs fun) => FormatFun ('Left str ': ffs) fun where+    formatFun _ str = formatFun (Proxy @ffs) (str ++ symbolVal (Proxy @str))++instance (Reflect ff, ff ~ 'FF f w p m c, FormatType c a, FormatFun ffs fun) => FormatFun ('Right ff ': ffs) (a -> fun) where+    formatFun _ str x = formatFun (Proxy @ffs) (str ++ formatArg (Proxy @c) x ff "")+      where+        ff = reflect (Proxy @ff)++type family MissingError ff where+    MissingError ff = 'Text "Call to printf missing an argument fulfilling \"%"+                ':<>: 'Text (ShowFormat ff)+                ':<>: 'Text "\""+                ':$$: 'Text "Either provide an argument or rewrite the format string to not expect one."++instance TypeError (MissingError ff) => FormatFun ('Right ff ': ffs) String where+    formatFun _ = error+instance TypeError (MissingError ff) => FormatFun ('Right ff ': ffs) () where+    formatFun _ = error+instance TypeError (MissingError ff) => FormatFun ('Right ff ': ffs) T.Text where+    formatFun _ = error+instance TypeError (MissingError ff) => FormatFun ('Right ff ': ffs) TL.Text where+    formatFun _ = error+instance TypeError (MissingError ff) => FormatFun ('Right ff ': ffs) PHelp where+    formatFun _ = error+instance TypeError (MissingError ff) => FormatFun ('Right ff ': ffs) (IO a) where+    formatFun _ = error++class Printf (str :: Symbol) fun where+    -- | A version of 'GHC.TypeLits.Printf.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+    printf_ :: p str -> fun++instance (Listify str lst, ffs ~ ParseFmtStr_ lst, FormatFun ffs fun) => Printf str fun where+    printf_ _ = formatFun (Proxy @ffs) ""++-- | Utility type powering 'pfmt'.  See dcumentation for 'pfmt' for more+-- information on usage.+--+-- Using /OverloadedLabels/, you never need to construct this directly+-- can just write @#f@ and a @'PFmt' "f"@ will be generated.  You can also+-- create this using 'mkPFmt' or 'mkPFmt_', in the situations where+-- /OverloadedLabels/ doesn't work or is not wanted.+newtype PFmt c = PFmt P.FieldFormat++-- | A version of 'mkPFmt' that takes an explicit proxy input.+--+-- >>> pfmt (mkPFmt_ (Proxy :: Proxy ".2f") 3.6234124+-- "3.62"+mkPFmt_+    :: forall str lst ff f w q m c p. (Listify str lst, ff ~ ParseFmt_ lst, Reflect ff, ff ~ 'FF f w q m c)+    => p str+    -> PFmt c+mkPFmt_ _ = PFmt ff+  where+    ff = reflect (Proxy @ff)++-- | 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 lst ff f w q m c. (Listify str lst, ff ~ ParseFmt_ lst, Reflect ff, ff ~ 'FF f w q m c)+    => PFmt c+mkPFmt = mkPFmt_ @str @lst (Proxy @str)++instance (Listify str lst, ff ~ ParseFmt_ lst, Reflect ff, ff ~ 'FF f w p m c) => IsLabel str (PFmt c) where+    fromLabel = mkPFmt @str @lst++-- | 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 @'pfmt' #.2f 3.62@.  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 'mkPFmt':+--+-- >>> 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 does not include the leading @%@.+pfmt :: forall c a. FormatType c a => PFmt c -> a -> String+pfmt (PFmt ff) x = formatArg (Proxy @c) x ff ""

@@ -0,0 +1,187 @@+{-# LANGUAGE GADTs                #-}+{-# LANGUAGE KindSignatures       #-}+{-# LANGUAGE NoStarIsType         #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE TypeInType           #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE UndecidableInstances #-}++module GHC.TypeLits.Printf.Internal.Parser where++import           Data.Kind+import           Data.Type.Bool+import           Data.Type.Equality+import           GHC.TypeLits++-- | A type synonym for a single-character symbol.  Ideally this would just+-- be 'Char', but we don't have chars at the type level.  So, if you see+-- 'SChar' in a type signature, it means that it's expected to be+-- a symbol/string with only one single character.+type SChar = Symbol++type Parser a = a -> Type++type family RunParser (p :: Parser a) (str :: [SChar]) :: Maybe (a, [SChar])++data Pure :: a -> Parser a+type instance RunParser (Pure x) str = 'Just '(x, str)++data Sym :: SChar -> Parser SChar+type instance RunParser (Sym c) (d ': cs) = If (c == d) ('Just '(c, cs)) 'Nothing+type instance RunParser (Sym c) '[]       = 'Nothing++data NotSym :: SChar -> Parser SChar+type instance RunParser (NotSym c) (d ': cs) = If (c == d) 'Nothing ('Just '(c, cs))+type instance RunParser (NotSym c) '[]       = 'Nothing++data AnySym :: Parser SChar+type instance RunParser AnySym (c ': cs) = 'Just '(c, cs)+type instance RunParser AnySym '[]       = 'Nothing++data Alpha :: Parser SChar+type instance RunParser Alpha (c ': cs) = If (IsAlpha c) ('Just '(c, cs)) 'Nothing+type instance RunParser Alpha '[]       = 'Nothing++data (<$) :: b -> Parser a -> Parser b+type family RepHelp (x :: b) (r :: Maybe (a, [SChar])) :: Maybe (b, [SChar]) where+    RepHelp x 'Nothing        = 'Nothing+    RepHelp x ('Just '(y, s)) = 'Just '(x, s)+type instance RunParser (x <$ p) str = RepHelp x (RunParser p str)++data (<|>) :: Parser a -> Parser a -> Parser a+type family ChoiceMaybe (x :: Maybe a) (y :: Maybe a) :: Maybe a where+    ChoiceMaybe ('Just x) y = 'Just x+    ChoiceMaybe 'Nothing  y = y+type instance RunParser (x <|> y) str = ChoiceMaybe (RunParser x str) (RunParser y str)++type Optional p = ('Just <$> p) <|> Pure 'Nothing++data (*>) :: Parser a -> Parser b -> Parser b+type family SeqHelp (p :: Parser b) (r :: Maybe (a, [SChar])) :: Maybe (b, [SChar]) where+    SeqHelp p 'Nothing          = 'Nothing+    SeqHelp p ('Just '(x, str)) = RunParser p str+type instance RunParser (x *> y) str = SeqHelp y (RunParser x str)++-- | Parse a single digit+data Digit :: Parser Nat+type family DigitHelp (d :: Maybe Nat) (cs :: [SChar]) :: Maybe (Nat, [SChar]) where+    DigitHelp 'Nothing  cs = 'Nothing+    DigitHelp ('Just d) cs = 'Just '(d, cs)+type instance RunParser Digit '[]       = 'Nothing+type instance RunParser Digit (c ': cs) = DigitHelp (CharDigit c) cs++data (<$>) :: (a -> b) -> Parser a -> Parser b+type family MapConHelp (f :: a -> b) (r :: Maybe (a, [SChar])) :: Maybe (b, [SChar]) where+    MapConHelp f 'Nothing = 'Nothing+    MapConHelp f ('Just '(x, str)) = 'Just '(f x, str)+type instance RunParser (f <$> p) str = MapConHelp f (RunParser p str)++data (<*>) :: Parser (a -> b) -> Parser a -> Parser b+type family ApHelp (r :: Maybe (a -> b, [SChar])) (q :: Parser a) :: Maybe (b, [SChar]) where+    ApHelp 'Nothing q          = 'Nothing+    ApHelp ('Just '(f, str)) q = RunParser (f <$> q) str+type instance RunParser (p <*> q) str = ApHelp (RunParser p str) q++data Many :: Parser a -> Parser [a]+type instance RunParser (Many p) str = RunParser (Some p <|> Pure '[]) str+data Some :: Parser a -> Parser [a]+type instance RunParser (Some p) str = RunParser ('(:) <$> p <*> Many p) str++-- | Parse a number+data Number :: Parser Nat+type family NumberHelp (xs :: Maybe ([Nat], [SChar])) :: Maybe (Nat, [SChar]) where+    NumberHelp 'Nothing           = 'Nothing+    NumberHelp ('Just '(ns, str)) = 'Just '(FromDigits ns 0, str)+type instance RunParser Number str = NumberHelp (RunParser (Some Digit) str)++data Cat :: Parser [SChar] -> Parser Symbol+type family CatHelp (xs :: Maybe ([SChar], [SChar])) :: Maybe (Symbol, [SChar]) where+    CatHelp 'Nothing           = 'Nothing+    CatHelp ('Just '(cs, str)) = 'Just '(CatChars cs, str)+type instance RunParser (Cat p) str = CatHelp (RunParser p str)++type family EvalHelp (r :: Maybe (a, [SChar])) :: Maybe a where+    EvalHelp 'Nothing          = 'Nothing+    EvalHelp ('Just '(x, str)) = 'Just x+type EvalParser (p :: Parser a) str = EvalHelp (RunParser p str) :: Maybe a++type family EvalHelp_ (r :: Maybe (a, [SChar])) :: a where+    EvalHelp_ ('Just '(x, str)) = x+    EvalHelp_ 'Nothing          = TypeError ('Text "Parse failed")+type EvalParser_ (p :: Parser a) str = EvalHelp_ (RunParser p str) :: a++type family CharDigit (c :: SChar) :: Maybe Nat where+    CharDigit "0" = 'Just 0+    CharDigit "1" = 'Just 1+    CharDigit "2" = 'Just 2+    CharDigit "3" = 'Just 3+    CharDigit "4" = 'Just 4+    CharDigit "5" = 'Just 5+    CharDigit "6" = 'Just 6+    CharDigit "7" = 'Just 7+    CharDigit "8" = 'Just 8+    CharDigit "9" = 'Just 9+    CharDigit c   = 'Nothing++type family FromDigits (xs :: [Nat]) (n :: Nat) :: Nat where+    FromDigits '[]       n = n+    FromDigits (a ': bs) n = FromDigits bs (n * 10 + a)++type family CatChars (cs :: [SChar]) :: Symbol where+    CatChars '[]       = ""+    CatChars (c ': cs) = AppendSymbol c (CatChars cs)++type family IsAlpha (c :: SChar) :: Bool where+    IsAlpha "a" = 'True+    IsAlpha "b" = 'True+    IsAlpha "c" = 'True+    IsAlpha "d" = 'True+    IsAlpha "e" = 'True+    IsAlpha "f" = 'True+    IsAlpha "g" = 'True+    IsAlpha "h" = 'True+    IsAlpha "i" = 'True+    IsAlpha "j" = 'True+    IsAlpha "k" = 'True+    IsAlpha "l" = 'True+    IsAlpha "m" = 'True+    IsAlpha "n" = 'True+    IsAlpha "o" = 'True+    IsAlpha "p" = 'True+    IsAlpha "q" = 'True+    IsAlpha "r" = 'True+    IsAlpha "s" = 'True+    IsAlpha "t" = 'True+    IsAlpha "u" = 'True+    IsAlpha "v" = 'True+    IsAlpha "w" = 'True+    IsAlpha "x" = 'True+    IsAlpha "y" = 'True+    IsAlpha "z" = 'True+    IsAlpha "A" = 'True+    IsAlpha "B" = 'True+    IsAlpha "C" = 'True+    IsAlpha "D" = 'True+    IsAlpha "E" = 'True+    IsAlpha "F" = 'True+    IsAlpha "G" = 'True+    IsAlpha "H" = 'True+    IsAlpha "I" = 'True+    IsAlpha "J" = 'True+    IsAlpha "K" = 'True+    IsAlpha "L" = 'True+    IsAlpha "M" = 'True+    IsAlpha "N" = 'True+    IsAlpha "O" = 'True+    IsAlpha "P" = 'True+    IsAlpha "Q" = 'True+    IsAlpha "R" = 'True+    IsAlpha "S" = 'True+    IsAlpha "T" = 'True+    IsAlpha "U" = 'True+    IsAlpha "V" = 'True+    IsAlpha "W" = 'True+    IsAlpha "X" = 'True+    IsAlpha "Y" = 'True+    IsAlpha "Z" = 'True+    IsAlpha a   = 'False

@@ -0,0 +1,224 @@+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE KindSignatures         #-}+{-# LANGUAGE LambdaCase             #-}+{-# LANGUAGE NoStarIsType           #-}+{-# LANGUAGE RecordWildCards        #-}+{-# LANGUAGE ScopedTypeVariables    #-}+{-# LANGUAGE TypeApplications       #-}+{-# LANGUAGE TypeFamilies           #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE TypeInType             #-}+{-# LANGUAGE TypeOperators          #-}+{-# LANGUAGE UndecidableInstances   #-}++module GHC.TypeLits.Printf.Parse (+    ParseFmtStr+  , ParseFmtStr_+  , ParseFmt+  , ParseFmt_+  , ShowFormat+  , FormatAdjustment(..)+  , FormatSign(..)+  , WidthMod(..)+  , Flags(..)+  , EmptyFlags+  , FieldFormat(..)+  , SChar+  , Demote+  , Reflect(..)+  ) where++import           Data.Proxy+import           Data.Text                           (Text)+import           GHC.TypeLits hiding                 (natVal)+import           GHC.TypeLits.Printf.Internal.Parser+import           GHC.TypeNats+import           Numeric.Natural+import           Text.Printf                         (FormatAdjustment(..), FormatSign(..))+import qualified Data.Text                           as T+import qualified Text.Printf                         as P++-- hello, we're going to attempt to implement+-- https://docs.microsoft.com/en-us/cpp/c-runtime-library/format-specification-syntax-printf-and-wprintf-functions?view=vs-2019++data Flags = Flags+    { fAdjust    :: Maybe FormatAdjustment+    , fSign      :: Maybe FormatSign+    , fAlternate :: Bool+    }++data WidthMod = WMhh+              | WMh+              | WMl+              | WMll+              | WML++data FieldFormat = FF+    { fmtFlags     :: Flags+    , fmtWidth     :: Maybe Nat+    , fmtPrecision :: Maybe Nat+    , fmtWidthMod  :: Maybe WidthMod+    , fmtChar      :: SChar+    }++type family Demote k = a | a -> k+type instance Demote FormatAdjustment = FormatAdjustment+type instance Demote FormatSign       = FormatSign+type instance Demote Bool             = Bool+type instance Demote (Maybe a)        = Maybe (Demote a)+type instance Demote Nat              = Natural+type instance Demote Symbol           = Text+type instance Demote Flags            = Flags+type instance Demote WidthMod         = WidthMod+type instance Demote FieldFormat      = P.FieldFormat++class Reflect (x :: a) where+    reflect :: p x -> Demote a++instance Reflect 'LeftAdjust where+    reflect _ = LeftAdjust+instance Reflect 'ZeroPad where+    reflect _ = ZeroPad+instance Reflect 'SignPlus where+    reflect _ = SignPlus+instance Reflect 'SignSpace where+    reflect _ = SignSpace+instance Reflect 'WMhh where+    reflect _ = WMhh+instance Reflect 'WMh where+    reflect _ = WMh+instance Reflect 'WMl where+    reflect _ = WMl+instance Reflect 'WMll where+    reflect _ = WMll+instance Reflect 'WML where+    reflect _ = WML+instance Reflect 'False where+    reflect _ = False+instance Reflect 'True where+    reflect _ = True+instance Reflect 'Nothing where+    reflect _ = Nothing+instance Reflect x => Reflect ('Just x) where+    reflect _ = Just (reflect (Proxy @x))+instance KnownNat n => Reflect (n :: Nat) where+    reflect = natVal+instance KnownSymbol n => Reflect (n :: Symbol) where+    reflect = T.pack . symbolVal+instance (Reflect d, Reflect i, Reflect l) => Reflect ('Flags d i l) where+    reflect _ = Flags (reflect (Proxy @d))+                      (reflect (Proxy @i))+                      (reflect (Proxy @l))+instance (Reflect flags, Reflect width, Reflect prec, Reflect mods, Reflect chr)+      => Reflect ('FF flags width prec mods chr) where+    reflect _ = P.FieldFormat{..}+      where+        Flags{..}    = reflect (Proxy @flags)+        fmtWidth     = fromIntegral <$> reflect (Proxy @width)+        fmtPrecision = fromIntegral <$> reflect (Proxy @prec)+        fmtAdjust    = fAdjust+        fmtSign      = fSign+        fmtAlternate = fAlternate+        fmtModifiers = foldMap modString (reflect (Proxy @mods))+        fmtChar      = T.head (reflect (Proxy @chr))++type family ShowFormat (x :: k) :: Symbol++type instance ShowFormat 'LeftAdjust = "-"+type instance ShowFormat 'ZeroPad    = "0"+type instance ShowFormat 'SignPlus   = "+"+type instance ShowFormat 'SignSpace  = " "+type instance ShowFormat 'Nothing    = ""+type instance ShowFormat ('Just x)   = ShowFormat x+type instance ShowFormat ('Flags a s 'False) = ShowFormat a `AppendSymbol` ShowFormat s+type instance ShowFormat ('Flags a s 'True ) = ShowFormat a `AppendSymbol` ShowFormat s `AppendSymbol` "#"+type instance ShowFormat 'WMhh = "hh"+type instance ShowFormat 'WMh  = "h"+type instance ShowFormat 'WMl  = "l"+type instance ShowFormat 'WMll = "ll"+type instance ShowFormat 'WML  = "L"+type instance ShowFormat (n :: Nat) = ShowNat n+type instance ShowFormat ('FF f w 'Nothing m c) = ShowFormat f+                                   `AppendSymbol` ShowFormat w+                                   `AppendSymbol` ShowFormat m+                                   `AppendSymbol` c+type instance ShowFormat ('FF f w ('Just p) m c) = ShowFormat f+                                   `AppendSymbol` ShowFormat w+                                   `AppendSymbol` "."+                                   `AppendSymbol` ShowFormat p+                                   `AppendSymbol` ShowFormat m+                                   `AppendSymbol` c++type family ShowNat (n :: Nat) :: Symbol where+    ShowNat 0 = "0"+    ShowNat n = ShowNatHelp n++type family ShowNatHelp (n :: Nat) :: Symbol where+    ShowNatHelp 0 = ""+    ShowNatHelp n = AppendSymbol (ShowNatHelp (Div n 10)) (ShowDigit (Mod n 10))++type family ShowDigit (n :: Nat) :: SChar where+    ShowDigit 0 = "0"+    ShowDigit 1 = "1"+    ShowDigit 2 = "2"+    ShowDigit 3 = "3"+    ShowDigit 4 = "4"+    ShowDigit 5 = "5"+    ShowDigit 6 = "6"+    ShowDigit 7 = "7"+    ShowDigit 8 = "8"+    ShowDigit 9 = "9"++modString :: WidthMod -> String+modString = \case+    WMhh -> "hh"+    WMh  -> "h"+    WMl  -> "l"+    WMll -> "ll"+    WML  -> "L"++data FlagParser :: Parser Flags+type instance RunParser FlagParser str = 'Just (ProcessFlags EmptyFlags str)++type EmptyFlags = 'Flags 'Nothing 'Nothing 'False++type family ProcessFlags (f :: Flags) (str :: [SChar]) :: (Flags, [SChar]) where+    ProcessFlags ('Flags d i l) ("-" ': cs) = '( 'Flags ('Just (UpdateAdjust d 'LeftAdjust)) i l, cs)+    ProcessFlags ('Flags d i l) ("0" ': cs) = '( 'Flags ('Just (UpdateAdjust d 'ZeroPad   )) i l, cs)+    ProcessFlags ('Flags d i l) ("+" ': cs) = '( 'Flags d ('Just (UpdateSign i 'SignPlus )) l, cs)+    ProcessFlags ('Flags d i l) (" " ': cs) = '( 'Flags d ('Just (UpdateSign i 'SignSpace)) l, cs)+    ProcessFlags ('Flags d i l) ("#" ': cs) = '( 'Flags d i 'True, cs)+    ProcessFlags f              cs          = '(f, cs)++type family UpdateAdjust d1 d2 where+    UpdateAdjust 'Nothing            d2 = d2+    UpdateAdjust ('Just 'LeftAdjust) d2 = 'LeftAdjust+    UpdateAdjust ('Just 'ZeroPad   ) d2 = d2++type family UpdateSign i1 i2 where+    UpdateSign 'Nothing           i2 = i2+    UpdateSign ('Just 'SignPlus ) i2 = 'SignPlus+    UpdateSign ('Just 'SignSpace) i2 = i2+++type WMParser = (Sym "h" *> (('WMhh <$ Sym "h") <|> Pure 'WMh))+            <|> (Sym "l" *> (('WMll <$ Sym "l") <|> Pure 'WMl))+            <|> ('WML <$ Sym "L")++type FFParser = 'FF <$> FlagParser+                    <*> Optional Number+                    <*> Optional (Sym "." *> Number)+                    <*> Optional WMParser+                    <*> AnySym+                    -- <*> Alpha        -- which of these is right?++type FmtStrParser = Many ( ('Left  <$> Cat (Some (NotSym "%" <|> (Sym "%" *> Sym "%"))))+                       <|> ('Right <$> (Sym "%" *> FFParser))+                         )++type ParseFmtStr  str = EvalParser  FmtStrParser str+type ParseFmtStr_ str = EvalParser_ FmtStrParser str++type ParseFmt  str = EvalParser  FFParser str+type ParseFmt_ str = EvalParser_ FFParser str+

@@ -0,0 +1,54 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 01b7ef56880a6dc7f4e5a26769e77a08d5991bae7449cd60415d13c82f17929c++name:           typelits-printf+version:        0.1.0.0+synopsis:       Type-safe printf from parsing GHC TypeLits Symbol+description:    An extensible and type-safe printf from parsing GHC TypeLits Symbol+                literals, matching the semantics of 'P.printf' from "Text.Printf" in /base/.+                The difference is that the variants here will always fail to compile if+                given arguments of the wrong type (or too many or too little arguments).+                Most of the variants also provide useful type feedback, telling you the type+                of arguments it expects and how many when queried with @:t@ or with typed+                holes.+                .+                See README and documentation of "GHC.TypeLits.Printf" for more information+category:       Text+homepage:       https://github.com/mstksg/typelits-printf#readme+bug-reports:    https://github.com/mstksg/typelits-printf/issues+author:         Justin Le+maintainer:     justin@jle.im+copyright:      (c) Justin Le 2019+license:        BSD3+license-file:   LICENSE+tested-with:    GHC >= 8.8 && < 8.10+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/mstksg/typelits-printf++library+  exposed-modules:+      GHC.TypeLits.Printf+      GHC.TypeLits.Printf.Internal+  other-modules:+      GHC.TypeLits.Printf.Internal.Parser+      GHC.TypeLits.Printf.Parse+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Werror=incomplete-patterns+  build-depends:+      base >=4.13 && <5+    , symbols >=0.3 && <0.4+    , text+    , vinyl >=0.12.1+  default-language: Haskell2010