packages feed

safe-printf (empty) → 0.1.0.0

raw patch · 13 files changed

+522/−0 lines, 13 filesdep +QuickCheckdep +basedep +doctestsetup-changed

Dependencies added: QuickCheck, base, doctest, haskell-src-meta, hspec, template-haskell, th-lift

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Hiromi ISHII++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 Hiromi ISHII 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.
+ README.md view
@@ -0,0 +1,70 @@+safe-printf -- Well-typed, variadic and flexible printf functions for Haskell+=============================================================================++[![Build Status](https://travis-ci.org/konn/safe-printf.svg?branch=master)](https://travis-ci.org/konn/safe-printf) +[![loop-effin](http://img.shields.io/hackage/v/safe-printf.svg)](http://hackage.haskell.org/package/safe-printf)++## What is this?+Haskell's standard `Text.Printf` module provides variadic `printf` function but not type-safe.+This library provides an alternative for this, more type-safe version of `printf` function,+combinators and quasiquoters.++The current implementation is just a proof-of-concept, so it is not so efficient and provides+APIs only for `String` value generation. In future, we will support `Text`+types and improve the effiiciency.++## Install+```sh+$ git clone https://github.com/konn/safe-printf.git+$ cd safe-printf+$ cabal install+```++<!--+```sh+$ cabal install safe-printf+```+-->++## Usage+We provide two interfaces to construct format: smart constructors and quasiquoters.++### Smart constructors+You need `OverloadedStrings` extension.++```haskell+{-# LANGUAGE OverloadedStrings #-}+module Main where+import Text.Printf.Safe             (printf, (%), (><))+import Text.Printf.Safe.Combinators (b', d, _S)+main = do+  putStrLn $ printf ("1 + 2 = " %d >< " and 0 == 1 is " %_S >< "." ) (1 + 2) (0 == 1)+  putStrLn $ printf ("42 is " % b' '0' 10 >< "in binary.") 42+  putStrLn $ printf ("48% of people answers that the negation of True is" %(show . not) >< ".") True+```++### Quasiquote interface+Quiasiquote interface provides more readable way for generating formats.++```haskell+{-# LANGUAGE QuasiQuotes #-}+module Main where+import Text.Printf.Safe    (printf, fmt)+main = do+  putStrLn $ printf [fmt|1 + 2 = %d and 0 == 1 is %S.|] (1 + 2) (0 == 1)+  putStrLn $ printf [fmt|42 is %010b in binary.|] 42+  putStrLn $ printf [fmt|48%% of people answers that the negation of True is %{show . not}.|] True+```++## TODO+* Support `Text` and perhaps `Builder`.+* Improve efficiency.+* Provide IO functions?++## Licence++BSD3++## Copyright++(c) Hiromi ISHII 2015
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/combinator.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where+import Text.Printf.Safe+import Text.Printf.Safe.Combinators (b', d, _S)++main :: IO ()+main = do+  putStrLn $ printf ("1 + 2 = " %d >< " and 0 == 1 is " %_S >< "." ) (1 + 2) (0 == 1)+  putStrLn $ printf ("42 is " % b' '0' 10 >< "in binary.") 42+  putStrLn $ printf ("48% of people answers that the negation of True is " %(show . not) >< ".") True
+ examples/quasi.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE QuasiQuotes #-}+module Main where+import Text.Printf.Safe (fmt, printf)++main = do+  putStrLn $ printf [fmt|1 + 2 = %d and 0 == 1 is %S.|] (1 + 2) (0 == 1)+  putStrLn $ printf [fmt|42 is %010b in binary.|] 42+  putStrLn $ printf [fmt|48%% of people answers that the negation of True is %{show . not}.|] True
+ safe-printf.cabal view
@@ -0,0 +1,55 @@+-- Initial safe-printf.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                safe-printf+version:             0.1.0.0+synopsis:            Well-typed, flexible and variadic printf for Haskell+description:         More type-safe, flexible replacement of variadic printf for Text.Printf.+homepage:            https://github.com/konn/safe-printf+license:             BSD3+license-file:        LICENSE+author:              Hiromi ISHII+maintainer:          konn.jinro_at_gmail.com+copyright:           (c) Hiromi ISHII 2015+category:            Text+build-type:          Simple+extra-source-files:  README.md, examples/*.hs+cabal-version:       >=1.10++source-repository head+  Type: git+  Location: git://github.com/konn/safe-printf.git++library+  exposed-modules:     Text.Printf.Safe,+                       Text.Printf.Safe.QQ,+                       Text.Printf.Safe.Core,+                       Text.Printf.Safe.Combinators+  other-modules:       Text.Printf.Safe.QQ.Internal+  build-depends:       base >=4 && <5+                     , haskell-src-meta >=0.6 && <0.7+                     , template-haskell >=2.9 && <2.11+                     , th-lift >=0.6 && <0.8+  hs-source-dirs:      src+  default-language:    Haskell2010++test-suite spec+  type:                 exitcode-stdio-1.0+  default-language:     Haskell2010+  hs-source-dirs:       test, src+  ghc-options:          -Wall+  Main-is:              Spec.hs+  build-depends:        QuickCheck+                      , base >=4 && <5+                      , hspec+                      , haskell-src-meta >=0.6 && <0.7+                      , template-haskell >=2.9 && <2.11+                      , th-lift >=0.6 && <0.8+test-suite doctest+  Type:                 exitcode-stdio-1.0+  Default-Language:     Haskell2010+  HS-Source-Dirs:       test+  Ghc-Options:          -threaded -Wall+  Main-Is:              doctests.hs+  Build-Depends:        base+                      , doctest
+ src/Text/Printf/Safe.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE ConstraintKinds, DataKinds, FlexibleInstances, GADTs #-}+{-# LANGUAGE OverloadedStrings, PolyKinds, ScopedTypeVariables    #-}+{-# LANGUAGE StandaloneDeriving, TypeFamilies, TypeOperators      #-}+{-# LANGUAGE UndecidableInstances                                 #-}+module Text.Printf.Safe (module Text.Printf.Safe.Core,+                         module Text.Printf.Safe.QQ,+                         module Text.Printf.Safe.Combinators) where+import Text.Printf.Safe.Combinators ((%), (+++), (><))+import Text.Printf.Safe.Core+import Text.Printf.Safe.QQ+
+ src/Text/Printf/Safe/Combinators.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE DataKinds, TypeFamilies, TypeOperators #-}+module Text.Printf.Safe.Combinators (-- * Smart constructors+                                     type (<>), (><), (%), (+++),+                                     -- * Basic formatters+                                     s, _S, _shows,+                                     -- ** Number Formatters+                                     base, d, d', o, o', b, b', h, h', f) where+import Data.Char             (intToDigit)+import Data.Type.Equality    ((:~:) (..), gcastWith)+import Numeric               (showFloat, showIntAtBase)+import Text.Printf.Safe.Core (Printf (..), Formatter)++-- * Smart constructors+type family (<>) xs ys where+  (<>) '[] xs = xs+  (<>) (x ': xs) ys = x ': (xs <> ys)++appPrf :: Printf ts -> Printf ps -> Printf (ts <> ps)+appPrf EOS ps = ps+appPrf (str :<> ts) ps = str :<> appPrf ts ps+appPrf (fm :% ts)   ps = fm :% appPrf ts ps++appNil :: Printf ts -> (ts <> '[]) :~: ts+appNil EOS = Refl+appNil (_ :<> a) = appNil a+appNil (_ :% bs) = case appNil bs of Refl -> Refl+++-- | Append plain string to format.+(><) :: Printf ts -> String -> Printf ts+xs >< str = gcastWith (appNil xs) $ appPrf xs (str :<> EOS)++-- | Append formatter to format.+(%) :: Printf ts -> (a -> String) -> Printf (ts <> '[a])+(%) xs p = appPrf xs (p :% EOS)++-- | Concatenate two prtinf formats.+(+++) :: Printf ts -> Printf ps -> Printf (ts <> ps)+(+++) = appPrf+infixr 5 +++++infixl 5 ><, %++-- | Format @String@ as it is.+s :: Formatter String+s = id++-- | Formatter for @Show@ instances.+_S :: Show a => Formatter a+_S = show++-- | Converts @'ShowS'@ function to @'Formatter'@.+_shows :: (a -> ShowS) -> Formatter a+_shows fmt = flip fmt ""++-- | Format @Integral@s at base.+base :: (Show a, Integral a)+     => a                       -- ^ Base+     -> Maybe (Char, Int)       -- ^ Padding settings.+     -> Formatter a+base adic mpd a =+  let ans = showIntAtBase adic intToDigit a ""+  in maybe "" (\(c,dig) -> replicate (dig - length ans) c) mpd ++ ans++-- | Decimal formatter with padding.+d' :: (Show a, Integral a) => Char -> Int -> Formatter a+d' c i = base 10 (Just (c,i))++-- | No padding version of @'d''@.+d :: (Show a, Integral a) => Formatter a+d = base 10 Nothing++-- | Octal formatter with padding.+o' :: (Show a, Integral a) => Char -> Int -> Formatter a+o' c i = base 8 (Just (c,i))++-- | No padding version of @'o''@.+o :: (Show a, Integral a) => Formatter a+o = base 8 Nothing++-- | Binary formatter with padding.+b' :: (Show a, Integral a) => Char -> Int -> Formatter a+b' c i = base 2 (Just (c,i))++-- | No padding version of @'b''@.+b :: (Show a, Integral a) => Formatter a+b = base 2 Nothing++-- | Binary formatter with padding.+h' :: (Show a, Integral a) => Char -> Int -> Formatter a+h' c i = base 16 (Just (c,i))++-- | No padding version of @'b''@.+h :: (Show a, Integral a) => Formatter a+h = base 16 Nothing++-- | @RealFloat@ formatter.+f :: RealFloat a => Formatter a+f = _shows showFloat
+ src/Text/Printf/Safe/Core.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE DataKinds, GADTs, TypeFamilies, TypeOperators #-}+module Text.Printf.Safe.Core (type (~>), Formatter, Printf(..),+                              HList(..), printf, printf') where+import Data.String (IsString (..))++-- | Variadic function types.+type family (~>) as b where+  (~>) '[] a = a+  (~>) (x ': xs) a = x -> xs ~> a++-- | Formatter type.+type Formatter a = a -> String++-- | Printf Format.+data Printf xs where+  EOS   :: Printf '[]+  (:<>) :: String -> Printf xs -> Printf xs+  (:%)  :: Formatter x -> Printf xs -> Printf (x ': xs)++instance (xs ~ '[]) => IsString (Printf xs) where+  fromString str = str :<> EOS++-- | Hetero list.+data HList ts where+  HNil :: HList '[]+  (:-) :: a -> HList xs -> HList (a ': xs)++infixr 9 :-, :<>, :%++-- | HList version.+printf' :: Printf ts -> HList ts -> String+printf' ps0 ts0 = go ps0 ts0 ""+  where+    go :: Printf us -> HList us -> ShowS+    go EOS          HNil      = id+    go (str :<> fs) xs        = showString str . go fs xs+    go (fm  :% fs)  (x :- ds) = showString (fm x) . go fs ds+    go _ _ = error "bug in GHC!"++-- | Variadic version.+printf :: Printf xs -> xs ~> String+printf p = go p ""+  where+    go :: Printf xs -> String -> xs ~> String+    go EOS a          = a+    go (str :<> xs) a = go xs (a ++ str)+    go (fmt :% xs)  a = \x -> go xs (a ++ fmt x)+
+ src/Text/Printf/Safe/QQ.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE RecordWildCards, TemplateHaskell #-}+module Text.Printf.Safe.QQ (fmt) where+import Language.Haskell.TH.Quote    (QuasiQuoter (..))+import Text.Printf.Safe.Core        (printf)+import Text.Printf.Safe.QQ.Internal (parse)++-- | Quasiquoter for formatter.+-- It supprots escape sequence.+-- Formatter is prefixed by @%@ and you can use @%{hoge}@ to antiquotation.+--+-- >>> :set -XQuasiQuotes+-- >>> printf [fmt|Answer is: %d and %S|] 42 True+-- "Answer is: 42 and True"+--+-- >>> printf [fmt|%02d%% of people answers %{show . not}.\n|] 4 False+-- "04% of people answers True.\n"+--+-- Predefined formatters:+--+-- [@%%@] outputs @%@.+-- [@%d@] formats @'Integral'@ value in decimal.+-- [@%/n/d@] same as above, but padding with @' '@ (space) to /n/ digits.+-- [@%0/n/d@] same as above, but padding with @'0'@ to /n/ digits.+-- [@%b@, @%o@, @%h@, @%H@] formats @'Integral'@s in binary, octet, hex and HEX resp.+--                          Padding options can be specified as @%d@.+-- [@%f@] formats @'Real'@ value with @'show'@ function.+-- [@%s@] embeds @'String'@ value.+-- [@%S@] embeds @'Show'@ instances.+-- [@%{/expr/}@, where @/expr/@ is a Haskell expression of type @a -> String@]+--    Antiquote. This formats corresponding argument by passing to @/expr/@.++fmt :: QuasiQuoter+fmt = QuasiQuoter { quoteDec = error "not implemented"+                  , quoteType = error "not implemented"+                  , quotePat  = error "not implemented"+                  , quoteExp  = parse+                  }
+ src/Text/Printf/Safe/QQ/Internal.hs view
@@ -0,0 +1,145 @@+{-# LANGUAGE RecordWildCards, TemplateHaskell #-}+module Text.Printf.Safe.QQ.Internal where+import Control.Applicative      ((<$>))+import Data.Char                (intToDigit, isDigit, isUpper, toUpper)+import Data.Char                (chr)+import Data.Maybe               (fromMaybe)+import Language.Haskell.Meta    (parseExp)+import Language.Haskell.TH      (ExpQ)+import Language.Haskell.TH.Lift (lift)+import Numeric                  (showIntAtBase)+import Numeric                  (readDec, readHex, readOct)+import Text.Printf.Safe.Core    (Printf (..))++data Fragment = StrF  String+              | ResF  FormatterConf+              | AntiF String+                deriving (Read, Show, Eq, Ord)++data FormatterConf = Float+                   | Integral { base :: Integer, padding :: Maybe Char, digits :: Maybe Int, capital :: Bool}+                   | String+                   | Show+                   deriving (Read, Show, Eq, Ord)++parse :: String -> ExpQ+parse = foldr cat [|EOS|] . parse'+  where+    cat (StrF s)      r = [| $(lift s) :<> $r |]+    cat (ResF Float)  r = [| (show :: Real a => a -> String) :% $r |]+    cat (ResF String) r = [| (id :: String -> String) :% $r |]+    cat (ResF Show)   r = [| (show :: Show a => a -> String) :% $r |]+    cat (ResF Integral{..}) r = do+      let pad = lift $ fromMaybe ' ' padding+          wid = lift digits+      [| ((\str -> replicate (maybe 0 (subtract (length str)) $wid) $pad ++ str) .  flip $([| showIntAtBase $(lift base) ($(if capital then [|toUpper|] else [|id|]) . intToDigit) |]) "")  :% $r |]+    cat (AntiF code) r = [| $(return $ either error id $ parseExp code) :% $r |]++parse' :: String -> [Fragment]+parse' = either error (foldr cat []) . parse''+  where+    cat (StrF "") xs = xs+    cat x [] = [x]+    cat (StrF x) (StrF y : xs) = cat (StrF (x ++ y)) xs+    cat x xs = x : xs++parse'' :: String -> Either String[Fragment]+parse'' str = case break (`elem`"%\\") str of+  ("", "") -> return []+  (as, "") -> return [StrF as]+  (as, '\\':bs) -> case parseEscape bs of+    Just (ch, rest) -> (StrF (as ++ ch) : ) <$> parse'' rest+    Nothing -> Left $ "illeagual escape sequence: \\" ++ (take 1 bs)+  (as, '%':'%':bs) -> (StrF as :) . (StrF "%" :) <$> parse'' bs+  (as, '%':rest)   ->+    let (pc, bs) = parseFormat rest+    in (StrF as :) . (pc:) <$> parse'' bs+  (as, bs) -> (StrF as :) <$> parse'' bs++parseEscape :: String -> Maybe (String, String)+parseEscape ('a':rest)  = Just ("\a", rest)+parseEscape ('b':rest)  = Just ("\b", rest)+parseEscape ('f':rest)  = Just ("\f", rest)+parseEscape ('n':rest)  = Just ("\n", rest)+parseEscape ('r':rest)  = Just ("\r", rest)+parseEscape ('t':rest)  = Just ("\t", rest)+parseEscape ('v':rest)  = Just ("\v", rest)+parseEscape ('\\':rest) = Just ("\\", rest)+parseEscape (']':rest) = Just ("]", rest)+parseEscape ('&':rest) = Just ("", rest)+parseEscape ('"':rest) = Just ("\"", rest)+parseEscape ('\'':rest) = Just ("\'", rest)+parseEscape ('N':'U':'L':rest) = Just ("\NUL", rest)+parseEscape ('S':'O':'H':rest) = Just ("\SOH", rest)+parseEscape ('S':'T':'X':rest) = Just ("\STX", rest)+parseEscape ('E':'T':'X':rest) = Just ("\ETX", rest)+parseEscape ('E':'O':'T':rest) = Just ("\EOT", rest)+parseEscape ('E':'N':'Q':rest) = Just ("\ENQ", rest)+parseEscape ('A':'C':'K':rest) = Just ("\ACK", rest)+parseEscape ('B':'E':'L':rest) = Just ("\BEL", rest)+parseEscape ('B':'S':rest) = Just ("\BS", rest)+parseEscape ('H':'T':rest) = Just ("\HT", rest)+parseEscape ('L':'F':rest) = Just ("\LF", rest)+parseEscape ('V':'T':rest) = Just ("\VT", rest)+parseEscape ('F':'F':rest) = Just ("\FF", rest)+parseEscape ('C':'R':rest) = Just ("\CR", rest)+parseEscape ('S':'O':rest) = Just ("\SO", rest)+parseEscape ('S':'I':rest) = Just ("\SI", rest)+parseEscape ('D':'L':'E':rest) = Just ("\DLE", rest)+parseEscape ('D':'C':'1':rest) = Just ("\DC1", rest)+parseEscape ('D':'C':'2':rest) = Just ("\DC2", rest)+parseEscape ('D':'C':'3':rest) = Just ("\DC3", rest)+parseEscape ('D':'C':'4':rest) = Just ("\DC4", rest)+parseEscape ('N':'A':'K':rest) = Just ("\NAK", rest)+parseEscape ('S':'Y':'N':rest) = Just ("\SYN", rest)+parseEscape ('E':'T':'B':rest) = Just ("\ETB", rest)+parseEscape ('C':'A':'N':rest) = Just ("\CAN", rest)+parseEscape ('E':'M':rest) = Just ("\EM", rest)+parseEscape ('S':'U':'B':rest) = Just ("\SUB", rest)+parseEscape ('E':'S':'C':rest) = Just ("\ESC", rest)+parseEscape ('F':'S':rest) = Just ("\FS", rest)+parseEscape ('G':'S':rest) = Just ("\GS", rest)+parseEscape ('R':'S':rest) = Just ("\RS", rest)+parseEscape ('U':'S':rest) = Just ("\US", rest)+parseEscape ('S':'P':rest) = Just ("\SP", rest)+parseEscape ('D':'E':'L':rest) = Just ("\DEL", rest)+parseEscape ('^':c:rest)+  | c `elem` ['A'..'Z'] ++ "@[]\\^_" =+    Just ([read ("'\\^" ++ c : "'")], rest)+parseEscape ('x':bs)+  | (ds, rest) : _ <- readHex bs = Just ([chr ds], rest)+parseEscape ('o':bs)+  | (ds, rest) : _ <- readOct bs = Just ([chr ds], rest)+parseEscape bs+  | (ds, rest) : _ <- readDec bs = Just ([chr ds], rest)+parseEscape _ = Nothing++parseFormat :: String -> (Fragment, String)+parseFormat "" = (StrF "%", "")+parseFormat ('{':r) = go (1 :: Int) "" r+  where+    go 0 c k       = (AntiF (init c), k)+    go p c ('{':k) = go (p+1) (c ++ "{") k+    go p c ('}':k) = go (p-1) (c ++ "}") k+    go p c (u:k)   = go p (c ++ [u]) k+    go _ _ [] = (StrF "{", r)+parseFormat str =+  case span isDigit str of+    ("", 's':rest) -> (ResF String, rest)+    ("", 'S':rest) -> (ResF Show, rest)+    ("", 'f':rest) -> (ResF Float, rest)+    ("", r:rest) | Just base <- getBase r ->+      (ResF (Integral base Nothing Nothing (isUpper r)), rest)+    ('0':ds, r:rest) | Just base <- getBase r ->+      (ResF (Integral base (Just '0') (Just $ read ds) (isUpper r)), rest)+    (ds, r:rest) | Just base <- getBase r ->+      (ResF (Integral base (Just ' ') (Just $ read ds) (isUpper r)), rest)+    _ -> (StrF "%", str)++getBase :: Char -> Maybe Integer+getBase 'd' = Just 10+getBase 'b' = Just 2+getBase 'o' = Just 8+getBase 'h' = Just 16+getBase 'H' = Just 16+getBase _ = Nothing
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/doctests.hs view
@@ -0,0 +1,6 @@+module Main where++import Test.DocTest++main :: IO ()+main = doctest ["-isrc", "src/Text/Printf/Safe/QQ.hs"]