├── cabal.haskell-ci ├── Setup.lhs ├── .gitignore ├── stack.yaml ├── .hgignore ├── CHANGELOG.md ├── benchmarks ├── Makefile ├── printf.c ├── wprintf.c ├── Simple.hs └── Benchmarks.hs ├── README.markdown ├── Data └── Text │ ├── Format │ ├── Types.hs │ ├── Functions.hs │ ├── Types │ │ └── Internal.hs │ ├── Int.hs │ └── Params.hs │ ├── Buildable.hs │ └── Format.hs ├── .hgtags ├── LICENSE ├── text-format.cabal └── .github └── workflows └── haskell-ci.yml /cabal.haskell-ci: -------------------------------------------------------------------------------- 1 | branches: master ci-* 2 | -------------------------------------------------------------------------------- /Setup.lhs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | > import Distribution.Simple 3 | > main = defaultMain 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal.sandbox.config 3 | .cabal-sandbox 4 | .stack-work 5 | dist-newstyle 6 | .ghc.environment.* 7 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: nightly-2022-12-12 2 | 3 | flags: 4 | text-format: 5 | developer: false 6 | 7 | extra-deps: 8 | - double-conversion-2.0.4.2 9 | -------------------------------------------------------------------------------- /.hgignore: -------------------------------------------------------------------------------- 1 | ^(?:cabal-dev|dist)$ 2 | ^benchmarks/(?:bm|simple|c-printf|c-wprintf)$ 3 | \.(?:aux|eventlog|h[ip]|log|[oa]|orig|prof|ps|rej|swp)$ 4 | ~$ 5 | syntax: glob 6 | .\#* 7 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # O.3.2.1 [Non-maintainer upload] 2 | 3 | _2022-11-21_, Andreas Abel, on behalf of the Hackage Trustees 4 | 5 | - Build with GHC 9.2 6 | 7 | # O.3.2 [Non-maintainer upload] 8 | 9 | - Semigroup-Monoid compatibility (GHC-8.4) 10 | -------------------------------------------------------------------------------- /benchmarks/Makefile: -------------------------------------------------------------------------------- 1 | ghc := ghc 2 | 3 | programs := bm simple c-printf c-wprintf 4 | 5 | all: $(programs) 6 | 7 | bm: Benchmarks.hs 8 | $(ghc) -rtsopts -O -o $@ $< 9 | 10 | simple: Simple.hs 11 | $(ghc) -rtsopts -O -o $@ $< 12 | 13 | c-printf: printf.c 14 | $(CC) -O2 -o $@ $< 15 | 16 | c-wprintf: wprintf.c 17 | $(CC) -O2 -o $@ $< 18 | 19 | clean: 20 | -rm -f $(programs) *.hi *.o *.hp 21 | -------------------------------------------------------------------------------- /README.markdown: -------------------------------------------------------------------------------- 1 | Welcome to text-format 2 | ====================== 3 | 4 | `text-format` is a fast and easy-to-use Haskell library for formatting text strings. 5 | 6 | You may report bugs via the 7 | [github issue tracker](https://github.com/haskell-trustees/text-format/issues). 8 | 9 | Authors 10 | ------- 11 | 12 | This library has been written by Bryan O'Sullivan, . 13 | 14 | Related packages 15 | ================ 16 | 17 | - https://hackage.haskell.org/package/formatting 18 | -------------------------------------------------------------------------------- /Data/Text/Format/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-} 2 | 3 | -- | 4 | -- Module : Data.Text.Format.Types 5 | -- Copyright : (c) 2011 MailRank, Inc. 6 | -- 7 | -- License : BSD-style 8 | -- Maintainer : bos@serpentine.com 9 | -- Stability : experimental 10 | -- Portability : GHC 11 | -- 12 | -- Types for text mangling. 13 | 14 | module Data.Text.Format.Types 15 | ( 16 | Format 17 | , Only(..) 18 | , Shown(..) 19 | -- * Integer format control 20 | , Hex(..) 21 | ) where 22 | 23 | import Data.Text.Format.Types.Internal 24 | -------------------------------------------------------------------------------- /.hgtags: -------------------------------------------------------------------------------- 1 | 445c2d04e07bf8aa07ddea0281f2af716cb05122 0.1.0.0 2 | 1b34f76dde9fb88b2c3d8cf92a9f249dd958206e 0.2.0.0 3 | 45d4878cb327b4f18c7ea39036b458ba1f78ca40 0.2.1.0 4 | d9b6162ca74f0f993b01745e700ce601c1fe0e0a 0.3.0.0 5 | afc1e224abef9063d95380bf5bea28a349cef2fc 0.3.0.2 6 | 6679f1e108bb5306e782acbd5edc00b5c742b598 0.3.0.3 7 | 2e98bdbb4d6c7578973bef024a3ab369462928d9 0.3.0.4 8 | 9bd748faa46d5b1f9792e980204ef689dfef381e 0.3.0.5 9 | 69d3bef4f0e9ee5f37b821887f545f5b61d73bb0 0.3.0.6 10 | c3a6c9e9c931d23a033f62fa2990f4d651b72df4 0.3.0.7 11 | e85738f54b444741f9810399dfa580fdb4e6411e 0.3.0.8 12 | ae0fb4fd90f3d87b4521ecd8bf2f1db8b456f0bc 0.3.1.0 13 | b5960b72c2e89386deb11c60f3bfd4ca1676e6a8 0.3.1.1 14 | -------------------------------------------------------------------------------- /benchmarks/printf.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | 6 | double gettime(void) 7 | { 8 | struct timeval tv; 9 | 10 | gettimeofday(&tv, NULL); 11 | 12 | return tv.tv_sec + (tv.tv_usec / 1e6); 13 | } 14 | 15 | void loop(int count) 16 | { 17 | int i; 18 | 19 | for (i = 0; i < count; i++) 20 | printf("hi mom %g\n", (double) i * M_PI); 21 | } 22 | 23 | int main(int argc, char **argv) 24 | { 25 | double start, elapsed; 26 | int i, count; 27 | 28 | count = argc == 2 ? atoi(argv[1]) : 1600000; 29 | 30 | start = gettime(); 31 | 32 | loop(count); 33 | 34 | elapsed = gettime() - start; 35 | 36 | fprintf(stderr, "%d iterations in %g secs (%g thousand/sec)\n", 37 | count, elapsed, count / elapsed / 1e3); 38 | } 39 | -------------------------------------------------------------------------------- /benchmarks/wprintf.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | 7 | double gettime(void) 8 | { 9 | struct timeval tv; 10 | 11 | gettimeofday(&tv, NULL); 12 | 13 | return tv.tv_sec + (tv.tv_usec / 1e6); 14 | } 15 | 16 | void loop(int count) 17 | { 18 | int i; 19 | 20 | for (i = 0; i < count; i++) 21 | wprintf(L"hi mom %g\n", (double) i * M_PI); 22 | } 23 | 24 | int main(int argc, char **argv) 25 | { 26 | double start, elapsed; 27 | int i, count; 28 | 29 | count = argc == 2 ? atoi(argv[1]) : 1600000; 30 | 31 | start = gettime(); 32 | 33 | loop(count); 34 | 35 | elapsed = gettime() - start; 36 | 37 | fprintf(stderr, "%d iterations in %g secs (%g thousand/sec)\n", 38 | count, elapsed, count / elapsed / 1e3); 39 | } 40 | -------------------------------------------------------------------------------- /Data/Text/Format/Functions.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE MagicHash #-} 2 | 3 | -- | 4 | -- Module : Data.Text.Format.Functions 5 | -- Copyright : (c) 2011 MailRank, Inc. 6 | -- 7 | -- License : BSD-style 8 | -- Maintainer : bos@serpentine.com 9 | -- Stability : experimental 10 | -- Portability : GHC 11 | -- 12 | -- Useful functions and combinators. 13 | 14 | module Data.Text.Format.Functions 15 | ( 16 | (Data.Text.Format.Functions.<>) 17 | , i2d 18 | ) where 19 | 20 | import Data.Monoid (mappend) 21 | import Data.Text.Lazy.Builder (Builder) 22 | import GHC.Base 23 | 24 | -- | Unsafe conversion for decimal digits. 25 | {-# INLINE i2d #-} 26 | i2d :: Int -> Char 27 | i2d (I# i#) = C# (chr# (ord# '0'# +# i#)) 28 | 29 | -- | The normal 'mappend' function with right associativity instead of 30 | -- left. 31 | (<>) :: Builder -> Builder -> Builder 32 | (<>) = mappend 33 | {-# DEPRECATED (<>) "Use <> from Data.Semigroup" #-} 34 | {-# INLINE (<>) #-} 35 | 36 | infixr 4 <> 37 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2011 MailRank, Inc. 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions 6 | are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 17 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 18 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 19 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 20 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 21 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 22 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 23 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 24 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 25 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 26 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 | -------------------------------------------------------------------------------- /text-format.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: >= 1.10 2 | name: text-format 3 | version: 0.3.2.1 4 | x-revision: 2 5 | license: BSD3 6 | license-file: LICENSE 7 | homepage: https://github.com/hackage-trustees/text-format 8 | bug-reports: https://github.com/hackage-trustees/text-format/issues 9 | category: Text 10 | author: Bryan O'Sullivan 11 | maintainer: Hackage Trustees 12 | stability: experimental 13 | synopsis: Text formatting 14 | build-type: Simple 15 | description: 16 | A text formatting library optimized for both ease of use and high 17 | performance. 18 | 19 | tested-with: 20 | GHC == 9.6.1 21 | GHC == 9.4.4 22 | GHC == 9.2.7 23 | GHC == 9.0.2 24 | GHC == 8.10.7 25 | GHC == 8.8.4 26 | GHC == 8.6.5 27 | GHC == 8.4.4 28 | GHC == 8.2.2 29 | GHC == 8.0.2 30 | GHC == 7.10.3 31 | GHC == 7.8.4 32 | GHC == 7.6.3 33 | GHC == 7.4.2 34 | GHC == 7.2.2 35 | GHC == 7.0.4 36 | 37 | extra-source-files: 38 | README.markdown 39 | CHANGELOG.md 40 | benchmarks/Makefile 41 | benchmarks/*.c 42 | benchmarks/*.hs 43 | 44 | flag developer 45 | description: operate in developer mode 46 | default: False 47 | manual: True 48 | 49 | library 50 | exposed-modules: 51 | Data.Text.Format 52 | Data.Text.Buildable 53 | Data.Text.Format.Params 54 | Data.Text.Format.Types 55 | Data.Text.Format.Types.Internal 56 | 57 | other-modules: 58 | Data.Text.Format.Functions 59 | Data.Text.Format.Int 60 | 61 | build-depends: 62 | array 63 | , base >= 4.3 && < 4.19 64 | , integer-gmp >= 0.2 65 | , double-conversion >= 0.2.0.0 66 | , ghc-prim 67 | , old-locale 68 | , text >= 0.11.0.8 69 | , time 70 | , transformers 71 | 72 | default-language: Haskell98 73 | 74 | if flag(developer) 75 | ghc-options: -Werror 76 | ghc-prof-options: -auto-all 77 | 78 | ghc-options: -Wall 79 | 80 | cpp-options: -DINTEGER_GMP 81 | 82 | if !impl(ghc >= 8.0) 83 | build-depends: 84 | semigroups >= 0.18.5 && < 0.20 85 | 86 | source-repository head 87 | type: git 88 | location: https://github.com/hackage-trustees/text-format.git 89 | -------------------------------------------------------------------------------- /Data/Text/Format/Types/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-} 2 | 3 | -- | 4 | -- Module : Data.Text.Format.Types.Internal 5 | -- Copyright : (c) 2011 MailRank, Inc. 6 | -- 7 | -- License : BSD-style 8 | -- Maintainer : bos@serpentine.com 9 | -- Stability : experimental 10 | -- Portability : GHC 11 | -- 12 | -- Types for text mangling. 13 | 14 | module Data.Text.Format.Types.Internal 15 | ( 16 | Format(..) 17 | , Only(..) 18 | , Shown(..) 19 | -- * Integer format control 20 | , Hex(..) 21 | ) where 22 | 23 | import Data.Semigroup (Semigroup (..)) 24 | import Data.Monoid (Monoid(..)) 25 | import Data.String (IsString(..)) 26 | import Data.Text (Text) 27 | import Data.Typeable (Typeable) 28 | 29 | -- | A format string. This is intentionally incompatible with other 30 | -- string types, to make it difficult to construct a format string by 31 | -- concatenating string fragments (a very common way to accidentally 32 | -- make code vulnerable to malicious data). 33 | -- 34 | -- This type is an instance of 'IsString', so the easiest way to 35 | -- construct a query is to enable the @OverloadedStrings@ language 36 | -- extension and then simply write the query in double quotes. 37 | -- 38 | -- > {-# LANGUAGE OverloadedStrings #-} 39 | -- > 40 | -- > import Data.Text.Format 41 | -- > 42 | -- > f :: Format 43 | -- > f = "hello {}" 44 | -- 45 | -- The underlying type is 'Text', so literal Haskell strings that 46 | -- contain Unicode characters will be correctly handled. 47 | newtype Format = Format { fromFormat :: Text } 48 | deriving (Eq, Ord, Typeable, Show) 49 | 50 | instance Semigroup Format where 51 | Format a <> Format b = Format (a `mappend` b) 52 | 53 | instance Monoid Format where 54 | mempty = Format mempty 55 | mappend = (<>) 56 | 57 | instance IsString Format where 58 | fromString = Format . fromString 59 | 60 | -- | Render an integral type in hexadecimal. 61 | newtype Hex a = Hex a 62 | deriving (Eq, Ord, Read, Show, Num, Real, Enum, Integral) 63 | 64 | -- | Use this @newtype@ wrapper for your single parameter if you are 65 | -- formatting a string containing exactly one substitution site. 66 | newtype Only a = Only { 67 | fromOnly :: a 68 | } deriving (Eq, Show, Read, Ord, Num, Fractional, Real, RealFrac, 69 | Floating, RealFloat, Enum, Integral, Bounded) 70 | 71 | -- | Render a value using its 'Show' instance. 72 | newtype Shown a = Shown { 73 | shown :: a 74 | } deriving (Eq, Show, Read, Ord, Num, Fractional, Real, RealFrac, 75 | Floating, RealFloat, Enum, Integral, Bounded) 76 | -------------------------------------------------------------------------------- /benchmarks/Simple.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns, OverloadedStrings #-} 2 | 3 | --module Main (main) where 4 | 5 | import Control.Monad 6 | import Data.Char 7 | import Data.Bits 8 | import System.Environment 9 | import Data.Text.Format as T 10 | import Data.Time.Clock 11 | import Data.Text (Text) 12 | import qualified Data.Text as T 13 | import Data.Text.Lazy.Encoding 14 | import qualified Data.ByteString.Lazy as L 15 | import System.IO 16 | 17 | counting :: Int -> (Int -> () -> IO ()) -> IO () 18 | counting count act = loop 0 19 | where loop !i | i < count = act i () >> loop (i+1) 20 | | otherwise = return () 21 | {-# NOINLINE counting #-} 22 | 23 | idle count = counting count $ \_ x -> return () 24 | 25 | plain count = counting count $ \_ x -> do 26 | L.putStr . encodeUtf8 $ "hi mom\n" 27 | 28 | unit count = counting count $ \_ x -> do 29 | let t = T.format "hi mom\n" x 30 | L.putStr . encodeUtf8 $ t 31 | 32 | int count = counting count $ \i x -> do 33 | let t = T.format "hi mom {}\n" (Only i) 34 | L.putStr . encodeUtf8 $ t 35 | 36 | bigint count = counting count $ \i x -> do 37 | let t = T.format "hi mom {}\n" (Only (i+100000)) 38 | L.putStr . encodeUtf8 $ t 39 | 40 | double count = counting count $ \i x -> do 41 | let t = T.format "hi mom {}\n" (Only (fromIntegral i * dpi)) 42 | L.putStr . encodeUtf8 $ t 43 | 44 | p6 count = counting count $ \i x -> do 45 | let t = T.format "hi mom {}\n" (Only (prec 6 $! fromIntegral i * dpi)) 46 | L.putStr . encodeUtf8 $ t 47 | 48 | arg :: Int -> Text 49 | arg i = "fnord" `T.append` (T.take (i `mod` 6) "foobar") 50 | {-# NOINLINE arg #-} 51 | 52 | one count = counting count $ \i x -> do 53 | let k = arg i 54 | let t = {-# SCC "one/format" #-} T.format "hi mom {}\n" (Only k) 55 | L.putStr . encodeUtf8 $ t 56 | 57 | two count = counting count $ \i x -> do 58 | let k = arg i 59 | let t = {-# SCC "two/format" #-} T.format "hi mom {} {}\n" (k,k) 60 | L.putStr . encodeUtf8 $ t 61 | 62 | three count = counting count $ \i x -> do 63 | let k = arg i 64 | let t = {-# SCC "three/format" #-} T.format "hi mom {} {} {}\n" (k,k,k) 65 | L.putStr . encodeUtf8 $ t 66 | 67 | four count = counting count $ \i x -> do 68 | let k = arg i 69 | let t = {-# SCC "four/format" #-} T.format "hi mom {} {} {} {}\n" (k,k,k,k) 70 | L.putStr . encodeUtf8 $ t 71 | 72 | five count = counting count $ \i x -> do 73 | let k = arg i 74 | let t = {-# SCC "five/format" #-} T.format "hi mom {} {} {} {} {}\n" (k,k,k,k,k) 75 | L.putStr . encodeUtf8 $ t 76 | 77 | dpi :: Double 78 | dpi = pi 79 | 80 | main = do 81 | args <- getArgs 82 | let count = case args of 83 | (_:x:_) -> read x 84 | _ -> 100000 85 | let bm = case args of 86 | ("idle":_) -> idle 87 | ("plain":_) -> plain 88 | ("unit":_) -> unit 89 | ("double":_) -> double 90 | ("p6":_) -> p6 91 | ("int":_) -> int 92 | ("bigint":_) -> bigint 93 | ("one":_) -> one 94 | ("two":_) -> two 95 | ("three":_) -> three 96 | ("four":_) -> four 97 | ("five":_) -> five 98 | _ -> error "wut?" 99 | start <- getCurrentTime 100 | bm count 101 | elapsed <- (`diffUTCTime` start) `fmap` getCurrentTime 102 | T.hprint stderr "{} iterations in {} secs ({} thousand/sec)\n" 103 | (count, elapsed, 104 | fromRational (toRational count / toRational elapsed / 1e3) :: Double) 105 | -------------------------------------------------------------------------------- /benchmarks/Benchmarks.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | import Criterion.Main 4 | import Data.Text.Format 5 | import qualified Data.Text as T 6 | import qualified Data.Text.Lazy as L 7 | import qualified Text.Printf as P 8 | 9 | printf1 :: (P.PrintfArg a) => String -> a -> String 10 | printf1 f a = P.printf f a 11 | 12 | printf2 :: (P.PrintfArg a, P.PrintfArg b) => String -> (a,b) -> String 13 | printf2 f (a,b) = P.printf f a b 14 | 15 | printf3 :: (P.PrintfArg a, P.PrintfArg b, P.PrintfArg c) => 16 | String -> (a,b,c) -> String 17 | printf3 f (a,b,c) = P.printf f a b c 18 | 19 | main = defaultMain [ 20 | bgroup "arity" [ 21 | bench "0" $ nf (format "hi") () 22 | , bench "1" $ nf (format "hi {}") (Only $ T.pack "mom") 23 | , bench "2" $ nf (format "hi {}, how are {}") 24 | (T.pack "mom", T.pack "you") 25 | , bench "3" $ nf (format "hi {}, how are {} keeping {}") 26 | (T.pack "mom", T.pack "you", T.pack "now") 27 | , bench "4" $ nf (format "hi {}, {} - how are {} keeping {}") 28 | (T.pack "mom", T.pack "hey", T.pack "you", T.pack "now") 29 | ] 30 | , bgroup "comparison" [ 31 | bench "format1" $ nf (format "hi mom {}\n") (Only (pi::Double)) 32 | , bench "printf1" $ nf (printf1 "hi mom %f\n") (pi::Double) 33 | , bench "show1" $ nf (\d -> "hi mom " ++ show d ++ "\n") (pi::Double) 34 | , bench "format2" $ nf (format "hi mom {} {}\n") (pi::Double, "yeah"::T.Text) 35 | , bench "printf2" $ nf (printf2 "hi mom %f %s\n") (pi::Double, "yeah"::String) 36 | , bench "show2" $ nf (\(d,s) -> "hi mom " ++ show d ++ " " ++ show s ++ "\n") (pi::Double, "yeah"::String) 37 | , bench "format3" $ nf (format "hi mom {} {} {}\n") (pi::Double, "yeah"::T.Text, 21212121::Int) 38 | , bench "printf3" $ nf (printf3 "hi mom %f %s %d\n") (pi::Double, "yeah"::String, 21212121::Int) 39 | , bench "show3" $ nf (\(d,s,i) -> "hi mom " ++ show d ++ " " ++ show s ++ "\n") (pi::Double, "yeah"::String, 21212121::Int) 40 | ] 41 | , bgroup "types" [ 42 | bench "unit" $ nf (format "hi") () 43 | , bgroup "int" [ 44 | bench "small" $ nf (format "hi {}") (Only (1::Int)) 45 | , bench "medium" $ nf (format "hi {}") (Only (1234::Int)) 46 | , bench "large" $ nf (format "hi {}") (Only (0x7fffffff::Int)) 47 | ] 48 | , bgroup "float" [ 49 | bench "small" $ nf (format "hi {}") (Only (1::Float)) 50 | , bench "medium" $ nf (format "hi {}") (Only (pi::Float)) 51 | , bench "large" $ nf (format "hi {}") (Only (pi*1e37::Float)) 52 | ] 53 | , bgroup "double" [ 54 | bench "small" $ nf (format "hi {}") (Only (1::Double)) 55 | , bench "medium" $ nf (format "hi {}") (Only (pi::Double)) 56 | , bench "large" $ nf (format "hi {}") (Only (pi*1e37::Double)) 57 | ] 58 | , bgroup "string" [ 59 | bench "small" $ nf (format "hi {}") (Only ("mom" :: String)) 60 | , bench "medium" $ nf (format "hi {}") 61 | (Only . concat . replicate 64 $ ("mom" :: String)) 62 | , bench "large" $ nf (format "hi {}") 63 | (Only . concat . replicate 1024 $ ("mom" :: String)) 64 | ] 65 | , bgroup "text" [ 66 | bench "small" $ nf (format "hi {}") (Only (T.pack "mom")) 67 | , bench "medium" $ nf (format "hi {}") (Only (T.replicate 64 "mom")) 68 | , bench "large" $ nf (format "hi {}") (Only (T.replicate 1024 "mom")) 69 | ] 70 | , bgroup "lazytext" [ 71 | bench "small" $ nf (format "hi {}") (Only (L.pack "mom")) 72 | , bench "medium" $ nf (format "hi {}") 73 | (Only . L.fromChunks . replicate 64 $ "mom") 74 | , bench "large" $ nf (format "hi {}") 75 | (Only . L.fromChunks . replicate 1024 $ "mom") 76 | ] 77 | ] 78 | ] 79 | -------------------------------------------------------------------------------- /Data/Text/Buildable.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP, FlexibleInstances, OverloadedStrings #-} 2 | 3 | -- | 4 | -- Module : Data.Text.Buildable 5 | -- Copyright : (c) 2011 MailRank, Inc. 6 | -- 7 | -- License : BSD-style 8 | -- Maintainer : bos@serpentine.com 9 | -- Stability : experimental 10 | -- Portability : GHC 11 | -- 12 | -- Types that can be rendered to a 'Builder'. 13 | 14 | module Data.Text.Buildable 15 | ( 16 | Buildable(..) 17 | ) where 18 | 19 | #if MIN_VERSION_base(4,8,0) 20 | import Data.Void (Void, absurd) 21 | #endif 22 | 23 | import Data.Semigroup ((<>)) 24 | import Data.Monoid (mempty) 25 | import Data.Int (Int8, Int16, Int32, Int64) 26 | import Data.Fixed (Fixed, HasResolution, showFixed) 27 | import Data.Ratio (Ratio, denominator, numerator) 28 | import Data.Text.Format.Int (decimal, hexadecimal) 29 | import Data.Text.Format.Types (Hex(..), Shown(..)) 30 | import Data.Text.Lazy.Builder 31 | import Data.Time.Calendar (Day, showGregorian) 32 | import Data.Time.Clock (DiffTime, NominalDiffTime, UTCTime, UniversalTime) 33 | import Data.Time.Clock (getModJulianDate) 34 | import Data.Time.LocalTime (LocalTime, TimeOfDay, TimeZone, ZonedTime) 35 | import Data.Word (Word, Word8, Word16, Word32, Word64) 36 | import Foreign.Ptr (IntPtr, WordPtr, Ptr, ptrToWordPtr) 37 | import qualified Data.Double.Conversion.Text as C 38 | import qualified Data.Text as ST 39 | import qualified Data.Text.Lazy as LT 40 | 41 | -- | The class of types that can be rendered to a 'Builder'. 42 | class Buildable p where 43 | build :: p -> Builder 44 | 45 | instance Buildable Builder where 46 | build = id 47 | 48 | #if MIN_VERSION_base(4,8,0) 49 | instance Buildable Void where 50 | build = absurd 51 | #endif 52 | 53 | instance Buildable LT.Text where 54 | build = fromLazyText 55 | {-# INLINE build #-} 56 | 57 | instance Buildable ST.Text where 58 | build = fromText 59 | {-# INLINE build #-} 60 | 61 | instance Buildable Char where 62 | build = singleton 63 | {-# INLINE build #-} 64 | 65 | instance Buildable [Char] where 66 | build = fromString 67 | {-# INLINE build #-} 68 | 69 | instance (Integral a) => Buildable (Hex a) where 70 | build = hexadecimal 71 | {-# INLINE build #-} 72 | 73 | instance Buildable Int8 where 74 | build = decimal 75 | {-# INLINE build #-} 76 | 77 | instance Buildable Int16 where 78 | build = decimal 79 | {-# INLINE build #-} 80 | 81 | instance Buildable Int32 where 82 | build = decimal 83 | {-# INLINE build #-} 84 | 85 | instance Buildable Int where 86 | build = decimal 87 | {-# INLINE build #-} 88 | 89 | instance Buildable Int64 where 90 | build = decimal 91 | {-# INLINE build #-} 92 | 93 | instance Buildable Integer where 94 | build = decimal 95 | {-# INLINE build #-} 96 | 97 | instance (HasResolution a) => Buildable (Fixed a) where 98 | build = build . showFixed False 99 | {-# INLINE build #-} 100 | 101 | instance Buildable Word8 where 102 | build = decimal 103 | {-# INLINE build #-} 104 | 105 | instance Buildable Word16 where 106 | build = decimal 107 | {-# INLINE build #-} 108 | 109 | instance Buildable Word32 where 110 | build = decimal 111 | {-# INLINE build #-} 112 | 113 | instance Buildable Word where 114 | build = decimal 115 | {-# INLINE build #-} 116 | 117 | instance Buildable Word64 where 118 | build = decimal 119 | {-# INLINE build #-} 120 | 121 | instance (Integral a, Buildable a) => Buildable (Ratio a) where 122 | {-# SPECIALIZE instance Buildable (Ratio Integer) #-} 123 | build a = build (numerator a) <> singleton '/' <> build (denominator a) 124 | 125 | instance Buildable Float where 126 | build = fromText . C.toPrecision 6 . realToFrac 127 | {-# INLINE build #-} 128 | 129 | instance Buildable Double where 130 | build = fromText . C.toPrecision 6 131 | {-# INLINE build #-} 132 | 133 | instance Buildable DiffTime where 134 | build = build . Shown 135 | {-# INLINE build #-} 136 | 137 | instance Buildable NominalDiffTime where 138 | build = build . Shown 139 | {-# INLINE build #-} 140 | 141 | instance Buildable UTCTime where 142 | build = build . Shown 143 | {-# INLINE build #-} 144 | 145 | instance Buildable UniversalTime where 146 | build = build . Shown . getModJulianDate 147 | {-# INLINE build #-} 148 | 149 | instance Buildable Day where 150 | build = fromString . showGregorian 151 | {-# INLINE build #-} 152 | 153 | instance (Show a) => Buildable (Shown a) where 154 | build = fromString . show . shown 155 | {-# INLINE build #-} 156 | 157 | instance (Buildable a) => Buildable (Maybe a) where 158 | build Nothing = mempty 159 | build (Just v) = build v 160 | {-# INLINE build #-} 161 | 162 | instance Buildable TimeOfDay where 163 | build = build . Shown 164 | {-# INLINE build #-} 165 | 166 | instance Buildable TimeZone where 167 | build = build . Shown 168 | {-# INLINE build #-} 169 | 170 | instance Buildable LocalTime where 171 | build = build . Shown 172 | {-# INLINE build #-} 173 | 174 | instance Buildable ZonedTime where 175 | build = build . Shown 176 | {-# INLINE build #-} 177 | 178 | instance Buildable IntPtr where 179 | build p = fromText "0x" <> hexadecimal p 180 | 181 | instance Buildable WordPtr where 182 | build p = fromText "0x" <> hexadecimal p 183 | 184 | instance Buildable (Ptr a) where 185 | build = build . ptrToWordPtr 186 | 187 | instance Buildable Bool where 188 | build True = fromText "True" 189 | build False = fromText "False" 190 | -------------------------------------------------------------------------------- /Data/Text/Format/Int.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-} 2 | 3 | -- Module: Data.Text.Format.Int 4 | -- Copyright: (c) 2011 MailRank, Inc. 5 | -- License: BSD3 6 | -- Maintainer: Bryan O'Sullivan 7 | -- Stability: experimental 8 | -- Portability: portable 9 | -- 10 | -- Efficiently serialize an integral value to a 'Builder'. 11 | 12 | module Data.Text.Format.Int 13 | ( 14 | decimal 15 | , hexadecimal 16 | , minus 17 | ) where 18 | 19 | import Data.Int (Int8, Int16, Int32, Int64) 20 | import Data.Monoid (mempty) 21 | import Data.Semigroup ((<>)) 22 | import Data.Text.Format.Functions (i2d) 23 | import Data.Text.Lazy.Builder 24 | import Data.Word (Word, Word8, Word16, Word32, Word64) 25 | import GHC.Base (quotInt, remInt) 26 | import GHC.Num (quotRemInteger) 27 | import GHC.Types (Int(..)) 28 | 29 | #ifdef __GLASGOW_HASKELL__ 30 | # if __GLASGOW_HASKELL__ < 611 31 | import GHC.Integer.Internals 32 | # else 33 | import GHC.Integer.GMP.Internals (Integer(..)) 34 | # endif 35 | #endif 36 | 37 | #ifdef INTEGER_GMP 38 | # define PAIR(a,b) (# a,b #) 39 | #else 40 | # define PAIR(a,b) (a,b) 41 | #endif 42 | 43 | decimal :: Integral a => a -> Builder 44 | {-# SPECIALIZE decimal :: Int -> Builder #-} 45 | {-# SPECIALIZE decimal :: Int8 -> Builder #-} 46 | {-# SPECIALIZE decimal :: Int16 -> Builder #-} 47 | {-# SPECIALIZE decimal :: Int32 -> Builder #-} 48 | {-# SPECIALIZE decimal :: Int64 -> Builder #-} 49 | {-# SPECIALIZE decimal :: Word -> Builder #-} 50 | {-# SPECIALIZE decimal :: Word8 -> Builder #-} 51 | {-# SPECIALIZE decimal :: Word16 -> Builder #-} 52 | {-# SPECIALIZE decimal :: Word32 -> Builder #-} 53 | {-# SPECIALIZE decimal :: Word64 -> Builder #-} 54 | {-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-} 55 | decimal i 56 | | i < 0 = minus <> go (-i) 57 | | otherwise = go i 58 | where 59 | go n | n < 10 = digit n 60 | | otherwise = go (n `quot` 10) <> digit (n `rem` 10) 61 | {-# NOINLINE[0] decimal #-} 62 | 63 | hexadecimal :: Integral a => a -> Builder 64 | {-# SPECIALIZE hexadecimal :: Int -> Builder #-} 65 | {-# SPECIALIZE hexadecimal :: Int8 -> Builder #-} 66 | {-# SPECIALIZE hexadecimal :: Int16 -> Builder #-} 67 | {-# SPECIALIZE hexadecimal :: Int32 -> Builder #-} 68 | {-# SPECIALIZE hexadecimal :: Int64 -> Builder #-} 69 | {-# SPECIALIZE hexadecimal :: Word -> Builder #-} 70 | {-# SPECIALIZE hexadecimal :: Word8 -> Builder #-} 71 | {-# SPECIALIZE hexadecimal :: Word16 -> Builder #-} 72 | {-# SPECIALIZE hexadecimal :: Word32 -> Builder #-} 73 | {-# SPECIALIZE hexadecimal :: Word64 -> Builder #-} 74 | {-# RULES "hexadecimal/Integer" hexadecimal = integer 16 :: Integer -> Builder #-} 75 | hexadecimal i 76 | | i < 0 = minus <> go (-i) 77 | | otherwise = go i 78 | where 79 | go n | n < 16 = hexDigit n 80 | | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16) 81 | {-# NOINLINE[0] hexadecimal #-} 82 | 83 | digit :: Integral a => a -> Builder 84 | digit n = singleton $! i2d (fromIntegral n) 85 | {-# INLINE digit #-} 86 | 87 | hexDigit :: Integral a => a -> Builder 88 | hexDigit n 89 | | n <= 9 = singleton $! i2d (fromIntegral n) 90 | | otherwise = singleton $! toEnum (fromIntegral n + 87) 91 | {-# INLINE hexDigit #-} 92 | 93 | minus :: Builder 94 | minus = singleton '-' 95 | 96 | int :: Int -> Builder 97 | int = decimal 98 | {-# INLINE int #-} 99 | 100 | data T = T !Integer !Int 101 | 102 | integer :: Int -> Integer -> Builder 103 | integer 10 (S# i#) = decimal (I# i#) 104 | integer 16 (S# i#) = hexadecimal (I# i#) 105 | integer base i 106 | | i < 0 = minus <> go (-i) 107 | | otherwise = go i 108 | where 109 | go n | n < maxInt = int (fromInteger n) 110 | | otherwise = putH (splitf (maxInt * maxInt) n) 111 | 112 | splitf p n 113 | | p > n = [n] 114 | | otherwise = splith p (splitf (p*p) n) 115 | 116 | splith p (n:ns) = case n `quotRemInteger` p of 117 | PAIR(q,r) | q > 0 -> q : r : splitb p ns 118 | | otherwise -> r : splitb p ns 119 | splith _ _ = error "splith: the impossible happened." 120 | 121 | splitb p (n:ns) = case n `quotRemInteger` p of 122 | PAIR(q,r) -> q : r : splitb p ns 123 | splitb _ _ = [] 124 | 125 | T maxInt10 maxDigits10 = 126 | until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1) 127 | where mi = fromIntegral (maxBound :: Int) 128 | T maxInt16 maxDigits16 = 129 | until ((>mi) . (*16) . fstT) (\(T n d) -> T (n*16) (d+1)) (T 16 1) 130 | where mi = fromIntegral (maxBound :: Int) 131 | 132 | fstT (T a _) = a 133 | 134 | maxInt | base == 10 = maxInt10 135 | | otherwise = maxInt16 136 | maxDigits | base == 10 = maxDigits10 137 | | otherwise = maxDigits16 138 | 139 | putH (n:ns) = case n `quotRemInteger` maxInt of 140 | PAIR(x,y) 141 | | q > 0 -> int q <> pblock r <> putB ns 142 | | otherwise -> int r <> putB ns 143 | where q = fromInteger x 144 | r = fromInteger y 145 | putH _ = error "putH: the impossible happened" 146 | 147 | putB (n:ns) = case n `quotRemInteger` maxInt of 148 | PAIR(x,y) -> pblock q <> pblock r <> putB ns 149 | where q = fromInteger x 150 | r = fromInteger y 151 | putB _ = mempty 152 | 153 | pblock = loop maxDigits 154 | where 155 | loop !d !n 156 | | d == 1 = digit n 157 | | otherwise = loop (d-1) q <> digit r 158 | where q = n `quotInt` base 159 | r = n `remInt` base 160 | -------------------------------------------------------------------------------- /Data/Text/Format.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings, RelaxedPolyRec #-} 2 | 3 | -- | 4 | -- Module : Data.Text.Format 5 | -- Copyright : (c) 2011 MailRank, Inc. 6 | -- 7 | -- License : BSD-style 8 | -- Maintainer : bos@serpentine.com 9 | -- Stability : experimental 10 | -- Portability : GHC 11 | -- 12 | -- Fast, efficient, flexible support for formatting text strings. 13 | 14 | module Data.Text.Format 15 | ( 16 | -- * Types 17 | Format 18 | , Only(..) 19 | -- ** Types for format control 20 | , Shown(..) 21 | -- * Rendering 22 | , format 23 | , print 24 | , hprint 25 | , build 26 | -- * Format control 27 | , left 28 | , right 29 | -- ** Integers 30 | , hex 31 | -- ** Floating point numbers 32 | , expt 33 | , fixed 34 | , prec 35 | , shortest 36 | ) where 37 | 38 | import Data.Semigroup ((<>)) 39 | import Control.Monad.IO.Class (MonadIO(liftIO)) 40 | import Data.Text.Format.Params (Params(..)) 41 | import Data.Text.Format.Types.Internal (Format(..), Only(..), Shown(..)) 42 | import Data.Text.Format.Types.Internal (Hex(..)) 43 | import Data.Text.Lazy.Builder 44 | import Prelude hiding (exp, print) 45 | import System.IO (Handle) 46 | import qualified Data.Double.Conversion.Text as C 47 | import qualified Data.Text as ST 48 | import qualified Data.Text.Buildable as B 49 | import qualified Data.Text.Lazy as LT 50 | import qualified Data.Text.Lazy.IO as LT 51 | 52 | -- Format strings are almost always constants, and they're expensive 53 | -- to interpret (which we refer to as "cracking" here). We'd really 54 | -- like to have GHC memoize the cracking of a known-constant format 55 | -- string, so that it occurs at most once. 56 | -- 57 | -- To achieve this, we arrange to have the cracked version of a format 58 | -- string let-floated out as a CAF, by inlining the definitions of 59 | -- build and functions that invoke it. This works well with GHC 7. 60 | 61 | -- | Render a format string and arguments to a 'Builder'. 62 | build :: Params ps => Format -> ps -> Builder 63 | build fmt ps = zipParams (crack fmt) (buildParams ps) 64 | {-# INLINE build #-} 65 | 66 | zipParams :: [Builder] -> [Builder] -> Builder 67 | zipParams fragments params = go fragments params 68 | where go (f:fs) (y:ys) = f <> y <> go fs ys 69 | go [f] [] = f 70 | go _ _ = error . LT.unpack $ format 71 | "Data.Text.Format.build: {} sites, but {} parameters" 72 | (length fragments - 1, length params) 73 | 74 | crack :: Format -> [Builder] 75 | crack = map fromText . ST.splitOn "{}" . fromFormat 76 | 77 | -- | Render a format string and arguments to a 'LT.Text'. 78 | format :: Params ps => Format -> ps -> LT.Text 79 | format fmt ps = toLazyText $ build fmt ps 80 | {-# INLINE format #-} 81 | 82 | -- | Render a format string and arguments, then print the result. 83 | print :: (MonadIO m, Params ps) => Format -> ps -> m () 84 | print fmt ps = liftIO . LT.putStr . toLazyText $ build fmt ps 85 | {-# INLINE print #-} 86 | 87 | -- | Render a format string and arguments, then print the result to 88 | -- the given file handle. 89 | hprint :: (MonadIO m, Params ps) => Handle -> Format -> ps -> m () 90 | hprint h fmt ps = liftIO . LT.hPutStr h . toLazyText $ build fmt ps 91 | {-# INLINE hprint #-} 92 | 93 | -- | Pad the left hand side of a string until it reaches @k@ 94 | -- characters wide, if necessary filling with character @c@. 95 | left :: B.Buildable a => Int -> Char -> a -> Builder 96 | left k c = 97 | fromLazyText . LT.justifyRight (fromIntegral k) c . toLazyText . B.build 98 | 99 | -- | Pad the right hand side of a string until it reaches @k@ 100 | -- characters wide, if necessary filling with character @c@. 101 | right :: B.Buildable a => Int -> Char -> a -> Builder 102 | right k c = 103 | fromLazyText . LT.justifyLeft (fromIntegral k) c . toLazyText . B.build 104 | 105 | -- | Render a floating point number, with the given number of digits 106 | -- of precision. Uses decimal notation for values between @0.1@ and 107 | -- @9,999,999@, and scientific notation otherwise. 108 | prec :: (Real a) => 109 | Int 110 | -- ^ Number of digits of precision. 111 | -> a -> Builder 112 | {-# RULES "prec/Double" 113 | forall d x. prec d (x::Double) = B.build (C.toPrecision d x) #-} 114 | prec digits = B.build . C.toPrecision digits . realToFrac 115 | {-# NOINLINE[0] prec #-} 116 | 117 | -- | Render a floating point number using normal notation, with the 118 | -- given number of decimal places. 119 | fixed :: (Real a) => 120 | Int 121 | -- ^ Number of digits of precision after the decimal. 122 | -> a -> Builder 123 | fixed decs = B.build . C.toFixed decs . realToFrac 124 | {-# RULES "fixed/Double" 125 | forall d x. fixed d (x::Double) = B.build (C.toFixed d x) #-} 126 | {-# NOINLINE[0] fixed #-} 127 | 128 | -- | Render a floating point number using scientific/engineering 129 | -- notation (e.g. @2.3e123@), with the given number of decimal places. 130 | expt :: (Real a) => 131 | Int 132 | -- ^ Number of digits of precision after the decimal. 133 | -> a -> Builder 134 | expt decs = B.build . C.toExponential decs . realToFrac 135 | {-# RULES "expt/Double" 136 | forall d x. expt d (x::Double) = B.build (C.toExponential d x) #-} 137 | {-# NOINLINE[0] expt #-} 138 | 139 | -- | Render a floating point number using the smallest number of 140 | -- digits that correctly represent it. 141 | shortest :: (Real a) => a -> Builder 142 | shortest = B.build . C.toShortest . realToFrac 143 | {-# RULES "shortest/Double" 144 | forall x. shortest (x::Double) = B.build (C.toShortest x) #-} 145 | {-# NOINLINE[0] shortest #-} 146 | 147 | -- | Render an integer using hexadecimal notation. (No leading "0x" 148 | -- is added.) 149 | hex :: Integral a => a -> Builder 150 | hex = B.build . Hex 151 | {-# INLINE hex #-} 152 | -------------------------------------------------------------------------------- /Data/Text/Format/Params.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : Data.Text.Format.Params 3 | -- Copyright : (c) 2011 MailRank, Inc. 4 | -- 5 | -- License : BSD-style 6 | -- Maintainer : bos@serpentine.com 7 | -- Stability : experimental 8 | -- Portability : GHC 9 | -- 10 | -- Types that can be used as a collection of arguments for formatting. 11 | 12 | module Data.Text.Format.Params 13 | ( 14 | Params(..) 15 | ) where 16 | 17 | import Data.Text.Buildable 18 | import Data.Text.Format.Types 19 | import Data.Text.Lazy.Builder 20 | 21 | -- | The class of types that can be used as a collection of arguments 22 | -- for formatting. 23 | class Params ps where 24 | buildParams :: ps -> [Builder] 25 | 26 | instance Params () where 27 | buildParams _ = [] 28 | 29 | instance (Buildable a) => Params (Only a) where 30 | buildParams (Only a) = [build a] 31 | 32 | instance (Buildable a) => Params [a] where 33 | buildParams = map build 34 | 35 | instance (Buildable a, Buildable b) => Params (a,b) where 36 | buildParams (a,b) = [build a, build b] 37 | 38 | instance (Buildable a, Buildable b, Buildable c) => Params (a,b,c) where 39 | buildParams (a,b,c) = [build a, build b, build c] 40 | 41 | instance (Buildable a, Buildable b, Buildable c, Buildable d) 42 | => Params (a,b,c,d) where 43 | buildParams (a,b,c,d) = 44 | [build a, build b, build c, build d] 45 | 46 | instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e) 47 | => Params (a,b,c,d,e) where 48 | buildParams (a,b,c,d,e) = 49 | [build a, build b, build c, build d, build e] 50 | 51 | instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, 52 | Buildable f) 53 | => Params (a,b,c,d,e,f) where 54 | buildParams (a,b,c,d,e,f) = 55 | [build a, build b, build c, build d, build e, 56 | build f] 57 | 58 | instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, 59 | Buildable f, Buildable g) 60 | => Params (a,b,c,d,e,f,g) where 61 | buildParams (a,b,c,d,e,f,g) = 62 | [build a, build b, build c, build d, build e, 63 | build f, build g] 64 | 65 | instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, 66 | Buildable f, Buildable g, Buildable h) 67 | => Params (a,b,c,d,e,f,g,h) where 68 | buildParams (a,b,c,d,e,f,g,h) = 69 | [build a, build b, build c, build d, build e, 70 | build f, build g, build h] 71 | 72 | instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, 73 | Buildable f, Buildable g, Buildable h, Buildable i) 74 | => Params (a,b,c,d,e,f,g,h,i) where 75 | buildParams (a,b,c,d,e,f,g,h,i) = 76 | [build a, build b, build c, build d, build e, 77 | build f, build g, build h, build i] 78 | 79 | instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, 80 | Buildable f, Buildable g, Buildable h, Buildable i, Buildable j) 81 | => Params (a,b,c,d,e,f,g,h,i,j) where 82 | buildParams (a,b,c,d,e,f,g,h,i,j) = 83 | [build a, build b, build c, build d, build e, 84 | build f, build g, build h, build i, build j] 85 | 86 | instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, 87 | Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, 88 | Buildable k) 89 | => Params (a,b,c,d,e,f,g,h,i,j,k) where 90 | buildParams (a,b,c,d,e,f,g,h,i,j,k) = 91 | [build a, build b, build c, build d, build e, 92 | build f, build g, build h, build i, build j, 93 | build k] 94 | 95 | instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, 96 | Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, 97 | Buildable k, Buildable l) 98 | => Params (a,b,c,d,e,f,g,h,i,j,k,l) where 99 | buildParams (a,b,c,d,e,f,g,h,i,j,k,l) = 100 | [build a, build b, build c, build d, build e, 101 | build f, build g, build h, build i, build j, 102 | build k, build l] 103 | 104 | instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, 105 | Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, 106 | Buildable k, Buildable l, Buildable m) 107 | => Params (a,b,c,d,e,f,g,h,i,j,k,l,m) where 108 | buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m) = 109 | [build a, build b, build c, build d, build e, 110 | build f, build g, build h, build i, build j, 111 | build k, build l, build m] 112 | 113 | instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, 114 | Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, 115 | Buildable k, Buildable l, Buildable m, Buildable n) 116 | => Params (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where 117 | buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = 118 | [build a, build b, build c, build d, build e, 119 | build f, build g, build h, build i, build j, 120 | build k, build l, build m, build n] 121 | 122 | instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, 123 | Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, 124 | Buildable k, Buildable l, Buildable m, Buildable n, Buildable o) 125 | => Params (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where 126 | buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = 127 | [build a, build b, build c, build d, build e, 128 | build f, build g, build h, build i, build j, 129 | build k, build l, build m, build n, build o] 130 | 131 | instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, 132 | Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, 133 | Buildable k, Buildable l, Buildable m, Buildable n, Buildable o, 134 | Buildable p) 135 | => Params (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) where 136 | buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) = 137 | [build a, build b, build c, build d, build e, 138 | build f, build g, build h, build i, build j, 139 | build k, build l, build m, build n, build o, 140 | build p] 141 | 142 | instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, 143 | Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, 144 | Buildable k, Buildable l, Buildable m, Buildable n, Buildable o, 145 | Buildable p, Buildable r) 146 | => Params (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r) where 147 | buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r) = 148 | [build a, build b, build c, build d, build e, 149 | build f, build g, build h, build i, build j, 150 | build k, build l, build m, build n, build o, 151 | build p, build r] 152 | 153 | instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, 154 | Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, 155 | Buildable k, Buildable l, Buildable m, Buildable n, Buildable o, 156 | Buildable p, Buildable r, Buildable s) 157 | => Params (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r,s) where 158 | buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r,s) = 159 | [build a, build b, build c, build d, build e, 160 | build f, build g, build h, build i, build j, 161 | build k, build l, build m, build n, build o, 162 | build p, build r, build s] 163 | 164 | instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, 165 | Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, 166 | Buildable k, Buildable l, Buildable m, Buildable n, Buildable o, 167 | Buildable p, Buildable r, Buildable s, Buildable t) 168 | => Params (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r,s,t) where 169 | buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r,s,t) = 170 | [build a, build b, build c, build d, build e, 171 | build f, build g, build h, build i, build j, 172 | build k, build l, build m, build n, build o, 173 | build p, build r, build s, build t] 174 | 175 | instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e, 176 | Buildable f, Buildable g, Buildable h, Buildable i, Buildable j, 177 | Buildable k, Buildable l, Buildable m, Buildable n, Buildable o, 178 | Buildable p, Buildable r, Buildable s, Buildable t, Buildable u) 179 | => Params (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r,s,t,u) where 180 | buildParams (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,r,s,t,u) = 181 | [build a, build b, build c, build d, build e, 182 | build f, build g, build h, build i, build j, 183 | build k, build l, build m, build n, build o, 184 | build p, build r, build s, build t, build u] 185 | 186 | -------------------------------------------------------------------------------- /.github/workflows/haskell-ci.yml: -------------------------------------------------------------------------------- 1 | # This GitHub workflow config has been generated by a script via 2 | # 3 | # haskell-ci 'github' 'text-format.cabal' 4 | # 5 | # To regenerate the script (for example after adjusting tested-with) run 6 | # 7 | # haskell-ci regenerate 8 | # 9 | # For more information, see https://github.com/haskell-CI/haskell-ci 10 | # 11 | # version: 0.15.20230312 12 | # 13 | # REGENDATA ("0.15.20230312",["github","text-format.cabal"]) 14 | # 15 | name: Haskell-CI 16 | on: 17 | push: 18 | branches: 19 | - master 20 | - ci-* 21 | pull_request: 22 | branches: 23 | - master 24 | - ci-* 25 | jobs: 26 | linux: 27 | name: Haskell-CI - Linux - ${{ matrix.compiler }} 28 | runs-on: ubuntu-20.04 29 | timeout-minutes: 30 | 60 31 | container: 32 | image: buildpack-deps:bionic 33 | continue-on-error: ${{ matrix.allow-failure }} 34 | strategy: 35 | matrix: 36 | include: 37 | - compiler: ghc-9.6.1 38 | compilerKind: ghc 39 | compilerVersion: 9.6.1 40 | setup-method: ghcup 41 | allow-failure: false 42 | - compiler: ghc-9.4.4 43 | compilerKind: ghc 44 | compilerVersion: 9.4.4 45 | setup-method: ghcup 46 | allow-failure: false 47 | - compiler: ghc-9.2.7 48 | compilerKind: ghc 49 | compilerVersion: 9.2.7 50 | setup-method: ghcup 51 | allow-failure: false 52 | - compiler: ghc-9.0.2 53 | compilerKind: ghc 54 | compilerVersion: 9.0.2 55 | setup-method: ghcup 56 | allow-failure: false 57 | - compiler: ghc-8.10.7 58 | compilerKind: ghc 59 | compilerVersion: 8.10.7 60 | setup-method: ghcup 61 | allow-failure: false 62 | - compiler: ghc-8.8.4 63 | compilerKind: ghc 64 | compilerVersion: 8.8.4 65 | setup-method: hvr-ppa 66 | allow-failure: false 67 | - compiler: ghc-8.6.5 68 | compilerKind: ghc 69 | compilerVersion: 8.6.5 70 | setup-method: hvr-ppa 71 | allow-failure: false 72 | - compiler: ghc-8.4.4 73 | compilerKind: ghc 74 | compilerVersion: 8.4.4 75 | setup-method: hvr-ppa 76 | allow-failure: false 77 | - compiler: ghc-8.2.2 78 | compilerKind: ghc 79 | compilerVersion: 8.2.2 80 | setup-method: hvr-ppa 81 | allow-failure: false 82 | - compiler: ghc-8.0.2 83 | compilerKind: ghc 84 | compilerVersion: 8.0.2 85 | setup-method: hvr-ppa 86 | allow-failure: false 87 | - compiler: ghc-7.10.3 88 | compilerKind: ghc 89 | compilerVersion: 7.10.3 90 | setup-method: hvr-ppa 91 | allow-failure: false 92 | - compiler: ghc-7.8.4 93 | compilerKind: ghc 94 | compilerVersion: 7.8.4 95 | setup-method: hvr-ppa 96 | allow-failure: false 97 | - compiler: ghc-7.6.3 98 | compilerKind: ghc 99 | compilerVersion: 7.6.3 100 | setup-method: hvr-ppa 101 | allow-failure: false 102 | - compiler: ghc-7.4.2 103 | compilerKind: ghc 104 | compilerVersion: 7.4.2 105 | setup-method: hvr-ppa 106 | allow-failure: false 107 | - compiler: ghc-7.2.2 108 | compilerKind: ghc 109 | compilerVersion: 7.2.2 110 | setup-method: hvr-ppa 111 | allow-failure: false 112 | - compiler: ghc-7.0.4 113 | compilerKind: ghc 114 | compilerVersion: 7.0.4 115 | setup-method: hvr-ppa 116 | allow-failure: false 117 | fail-fast: false 118 | steps: 119 | - name: apt 120 | run: | 121 | apt-get update 122 | apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 123 | if [ "${{ matrix.setup-method }}" = ghcup ]; then 124 | mkdir -p "$HOME/.ghcup/bin" 125 | curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup" 126 | chmod a+x "$HOME/.ghcup/bin/ghcup" 127 | "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) 128 | "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) 129 | else 130 | apt-add-repository -y 'ppa:hvr/ghc' 131 | apt-get update 132 | apt-get install -y "$HCNAME" 133 | mkdir -p "$HOME/.ghcup/bin" 134 | curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup" 135 | chmod a+x "$HOME/.ghcup/bin/ghcup" 136 | "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) 137 | fi 138 | env: 139 | HCKIND: ${{ matrix.compilerKind }} 140 | HCNAME: ${{ matrix.compiler }} 141 | HCVER: ${{ matrix.compilerVersion }} 142 | - name: Set PATH and environment variables 143 | run: | 144 | echo "$HOME/.cabal/bin" >> $GITHUB_PATH 145 | echo "LANG=C.UTF-8" >> "$GITHUB_ENV" 146 | echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" 147 | echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" 148 | HCDIR=/opt/$HCKIND/$HCVER 149 | if [ "${{ matrix.setup-method }}" = ghcup ]; then 150 | HC=$HOME/.ghcup/bin/$HCKIND-$HCVER 151 | echo "HC=$HC" >> "$GITHUB_ENV" 152 | echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV" 153 | echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV" 154 | echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" 155 | else 156 | HC=$HCDIR/bin/$HCKIND 157 | echo "HC=$HC" >> "$GITHUB_ENV" 158 | echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV" 159 | echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV" 160 | echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" 161 | fi 162 | 163 | HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') 164 | echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" 165 | echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" 166 | echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" 167 | echo "HEADHACKAGE=false" >> "$GITHUB_ENV" 168 | echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" 169 | echo "GHCJSARITH=0" >> "$GITHUB_ENV" 170 | env: 171 | HCKIND: ${{ matrix.compilerKind }} 172 | HCNAME: ${{ matrix.compiler }} 173 | HCVER: ${{ matrix.compilerVersion }} 174 | - name: env 175 | run: | 176 | env 177 | - name: write cabal config 178 | run: | 179 | mkdir -p $CABAL_DIR 180 | cat >> $CABAL_CONFIG <> $CABAL_CONFIG < cabal-plan.xz 213 | echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c - 214 | xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan 215 | rm -f cabal-plan.xz 216 | chmod a+x $HOME/.cabal/bin/cabal-plan 217 | cabal-plan --version 218 | - name: checkout 219 | uses: actions/checkout@v3 220 | with: 221 | path: source 222 | - name: initial cabal.project for sdist 223 | run: | 224 | touch cabal.project 225 | echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project 226 | cat cabal.project 227 | - name: sdist 228 | run: | 229 | mkdir -p sdist 230 | $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist 231 | - name: unpack 232 | run: | 233 | mkdir -p unpacked 234 | find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \; 235 | - name: generate cabal.project 236 | run: | 237 | PKGDIR_text_format="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/text-format-[0-9.]*')" 238 | echo "PKGDIR_text_format=${PKGDIR_text_format}" >> "$GITHUB_ENV" 239 | rm -f cabal.project cabal.project.local 240 | touch cabal.project 241 | touch cabal.project.local 242 | echo "packages: ${PKGDIR_text_format}" >> cabal.project 243 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package text-format" >> cabal.project ; fi 244 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi 245 | cat >> cabal.project <> cabal.project.local 248 | cat cabal.project 249 | cat cabal.project.local 250 | - name: dump install plan 251 | run: | 252 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all 253 | cabal-plan 254 | - name: restore cache 255 | uses: actions/cache/restore@v3 256 | with: 257 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 258 | path: ~/.cabal/store 259 | restore-keys: ${{ runner.os }}-${{ matrix.compiler }}- 260 | - name: install dependencies 261 | run: | 262 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all 263 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all 264 | - name: build w/o tests 265 | run: | 266 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 267 | - name: build 268 | run: | 269 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always 270 | - name: cabal check 271 | run: | 272 | cd ${PKGDIR_text_format} || false 273 | ${CABAL} -vnormal check 274 | - name: haddock 275 | run: | 276 | $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all 277 | - name: unconstrained build 278 | run: | 279 | rm -f cabal.project.local 280 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 281 | - name: save cache 282 | uses: actions/cache/save@v3 283 | if: always() 284 | with: 285 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 286 | path: ~/.cabal/store 287 | --------------------------------------------------------------------------------