Skip to content

Commit 5ef090f

Browse files
bosbos
committed
Initial super-basic commit
0 parents  commit 5ef090f

File tree

10 files changed

+374
-0
lines changed

10 files changed

+374
-0
lines changed

‎.hgignore

+5
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
^(?:cabal-dev|dist)$
2+
\.(?:aux|eventlog|h[ip]|log|[oa]|orig|prof|ps|rej|swp)$
3+
~$
4+
syntax: glob
5+
.\#*

‎Data/Text/Format.hs

+23
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
3+
module Data.Text.Format
4+
where
5+
6+
import Data.Monoid
7+
import qualified Data.Text.Lazy as LT
8+
import qualified Data.Text as ST
9+
import Data.Text.Lazy.Builder
10+
import Data.Text.Format.Param
11+
import Data.Text.Format.Params
12+
13+
build :: Params ps => ST.Text -> ps -> Builder
14+
build fmt ps
15+
| null xs && not ("{}" `ST.isInfixOf` fmt) = fromText fmt
16+
| otherwise = zipParams (map fromText . ST.splitOn "{}" $ fmt) xs
17+
where xs = buildParams ps
18+
zipParams (f:fs) (y:ys) = f `mappend` y `mappend` zipParams fs ys
19+
zipParams [f] [] = f
20+
zipParams _ _ = error "oops"
21+
22+
format :: Params ps => ST.Text -> ps -> LT.Text
23+
format fmt ps = toLazyText $ build fmt ps

‎Data/Text/Format/Int.hs

+128
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,128 @@
1+
{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}
2+
3+
-- Module: Blaze.Text.Int
4+
-- Copyright: (c) 2011 MailRank, Inc.
5+
-- License: BSD3
6+
-- Maintainer: Bryan O'Sullivan <[email protected]>
7+
-- Stability: experimental
8+
-- Portability: portable
9+
--
10+
-- Efficiently serialize an integral value as a lazy 'L.ByteString'.
11+
12+
module Data.Text.Format.Int
13+
(
14+
digit
15+
, integral
16+
, minus
17+
) where
18+
19+
import Data.Char (chr)
20+
import Data.Int (Int8, Int16, Int32, Int64)
21+
import Data.Monoid (mappend, mempty)
22+
import Data.Text.Lazy.Builder
23+
import Data.Word (Word, Word8, Word16, Word32, Word64)
24+
import GHC.Base (quotInt, remInt)
25+
import GHC.Num (quotRemInteger)
26+
import GHC.Types (Int(..))
27+
28+
#ifdef __GLASGOW_HASKELL__
29+
# if __GLASGOW_HASKELL__ < 611
30+
import GHC.Integer.Internals
31+
# else
32+
import GHC.Integer.GMP.Internals
33+
# endif
34+
#endif
35+
36+
#ifdef INTEGER_GMP
37+
# define PAIR(a,b) (# a,b #)
38+
#else
39+
# define PAIR(a,b) (a,b)
40+
#endif
41+
42+
integral :: Integral a => a -> Builder
43+
{-# SPECIALIZE integral :: Int -> Builder #-}
44+
{-# SPECIALIZE integral :: Int8 -> Builder #-}
45+
{-# SPECIALIZE integral :: Int16 -> Builder #-}
46+
{-# SPECIALIZE integral :: Int32 -> Builder #-}
47+
{-# SPECIALIZE integral :: Int64 -> Builder #-}
48+
{-# SPECIALIZE integral :: Word -> Builder #-}
49+
{-# SPECIALIZE integral :: Word8 -> Builder #-}
50+
{-# SPECIALIZE integral :: Word16 -> Builder #-}
51+
{-# SPECIALIZE integral :: Word32 -> Builder #-}
52+
{-# SPECIALIZE integral :: Word64 -> Builder #-}
53+
{-# RULES "integral/Integer" integral = integer :: Integer -> Builder #-}
54+
integral i
55+
| i < 0 = minus `mappend` go (-i)
56+
| otherwise = go i
57+
where
58+
go n | n < 10 = digit n
59+
| otherwise = go (n `quot` 10) `mappend` digit (n `rem` 10)
60+
61+
digit :: Integral a => a -> Builder
62+
digit n = singleton $! chr (fromIntegral n + 48)
63+
{-# INLINE digit #-}
64+
65+
minus :: Builder
66+
minus = singleton '-'
67+
68+
int :: Int -> Builder
69+
int = integral
70+
{-# INLINE int #-}
71+
72+
integer :: Integer -> Builder
73+
integer (S# i#) = int (I# i#)
74+
integer i
75+
| i < 0 = minus `mappend` go (-i)
76+
| otherwise = go i
77+
where
78+
go n | n < maxInt = int (fromInteger n)
79+
| otherwise = putH (splitf (maxInt * maxInt) n)
80+
81+
splitf p n
82+
| p > n = [n]
83+
| otherwise = splith p (splitf (p*p) n)
84+
85+
splith p (n:ns) = case n `quotRemInteger` p of
86+
PAIR(q,r) | q > 0 -> q : r : splitb p ns
87+
| otherwise -> r : splitb p ns
88+
splith _ _ = error "splith: the impossible happened."
89+
90+
splitb p (n:ns) = case n `quotRemInteger` p of
91+
PAIR(q,r) -> q : r : splitb p ns
92+
splitb _ _ = []
93+
94+
data T = T !Integer !Int
95+
96+
fstT :: T -> Integer
97+
fstT (T a _) = a
98+
99+
maxInt :: Integer
100+
maxDigits :: Int
101+
T maxInt maxDigits =
102+
until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1)
103+
where mi = fromIntegral (maxBound :: Int)
104+
105+
putH :: [Integer] -> Builder
106+
putH (n:ns) = case n `quotRemInteger` maxInt of
107+
PAIR(x,y)
108+
| q > 0 -> int q `mappend` pblock r `mappend` putB ns
109+
| otherwise -> int r `mappend` putB ns
110+
where q = fromInteger x
111+
r = fromInteger y
112+
putH _ = error "putH: the impossible happened"
113+
114+
putB :: [Integer] -> Builder
115+
putB (n:ns) = case n `quotRemInteger` maxInt of
116+
PAIR(x,y) -> pblock q `mappend` pblock r `mappend` putB ns
117+
where q = fromInteger x
118+
r = fromInteger y
119+
putB _ = mempty
120+
121+
pblock :: Int -> Builder
122+
pblock = go maxDigits
123+
where
124+
go !d !n
125+
| d == 1 = digit n
126+
| otherwise = go (d-1) q `mappend` digit r
127+
where q = n `quotInt` 10
128+
r = n `remInt` 10

‎Data/Text/Format/Param.hs

+72
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,72 @@
1+
{-# LANGUAGE FlexibleInstances #-}
2+
3+
module Data.Text.Format.Param
4+
(
5+
Param(..)
6+
) where
7+
8+
import Data.Text.Lazy.Builder
9+
import Data.Text.Format.Int
10+
import qualified Data.Text.Lazy as LT
11+
import Data.Int (Int8, Int16, Int32, Int64)
12+
import Data.Word (Word, Word8, Word16, Word32, Word64)
13+
import qualified Data.Text as ST
14+
15+
class Param p where
16+
buildParam :: p -> Builder
17+
18+
instance Param LT.Text where
19+
buildParam = fromLazyText
20+
21+
instance Param ST.Text where
22+
buildParam = fromText
23+
24+
instance Param Char where
25+
buildParam = singleton
26+
27+
instance Param [Char] where
28+
buildParam = fromText . ST.pack
29+
30+
instance Param Int8 where
31+
buildParam = integral
32+
{-# INLINE buildParam #-}
33+
34+
instance Param Int16 where
35+
buildParam = integral
36+
{-# INLINE buildParam #-}
37+
38+
instance Param Int32 where
39+
buildParam = integral
40+
{-# INLINE buildParam #-}
41+
42+
instance Param Int where
43+
buildParam = integral
44+
{-# INLINE buildParam #-}
45+
46+
instance Param Int64 where
47+
buildParam = integral
48+
{-# INLINE buildParam #-}
49+
50+
instance Param Integer where
51+
buildParam = integral
52+
{-# INLINE buildParam #-}
53+
54+
instance Param Word8 where
55+
buildParam = integral
56+
{-# INLINE buildParam #-}
57+
58+
instance Param Word16 where
59+
buildParam = integral
60+
{-# INLINE buildParam #-}
61+
62+
instance Param Word32 where
63+
buildParam = integral
64+
{-# INLINE buildParam #-}
65+
66+
instance Param Word where
67+
buildParam = integral
68+
{-# INLINE buildParam #-}
69+
70+
instance Param Word64 where
71+
buildParam = integral
72+
{-# INLINE buildParam #-}

‎Data/Text/Format/Params.hs

+20
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,20 @@
1+
module Data.Text.Format.Params
2+
(
3+
Params(..)
4+
) where
5+
6+
import Data.Text.Format.Param
7+
import Data.Text.Format.Types
8+
import Data.Text.Lazy.Builder
9+
10+
class Params ps where
11+
buildParams :: ps -> [Builder]
12+
13+
instance (Param a) => Params (Only a) where
14+
buildParams (Only a) = [buildParam a]
15+
16+
instance (Param a) => Params [a] where
17+
buildParams = map buildParam
18+
19+
instance (Param a, Param b) => Params (a,b) where
20+
buildParams (a,b) = [buildParam a, buildParam b]

‎Data/Text/Format/Types.hs

+7
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
module Data.Text.Format.Types
2+
(
3+
Only(..)
4+
) where
5+
6+
newtype Only a = Only a
7+
deriving (Eq, Ord, Read, Show)

‎LICENSE

+26
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
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.

‎README.markdown

+28
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,28 @@
1+
# Welcome to text-format
2+
3+
text-format is a fast and easy-to-use Haskell library for formatting
4+
text strings.
5+
6+
# Join in!
7+
8+
We are happy to receive bug reports, fixes, documentation enhancements,
9+
and other improvements.
10+
11+
Please report bugs via the
12+
[github issue tracker](https://github.com/mailrank/text-format/issues).
13+
14+
Master [git repository](https://github.com/mailrank/text-format):
15+
16+
* `git clone git://github.com/mailrank/text-format.git`
17+
18+
There's also a [Mercurial mirror](https://bitbucket.org/bos/text-format):
19+
20+
* `hg clone https://bitbucket.org/bos/text-format`
21+
22+
(You can create and contribute changes using either git or Mercurial.)
23+
24+
Authors
25+
-------
26+
27+
This library is written and maintained by Bryan O'Sullivan,
28+
<[email protected]>.

‎Setup.lhs

+3
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
#!/usr/bin/env runhaskell
2+
> import Distribution.Simple
3+
> main = defaultMain

‎text-format.cabal

+62
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,62 @@
1+
name: text-format
2+
version: 0.1.0.0
3+
license: BSD3
4+
license-file: LICENSE
5+
homepage: https://github.com/mailrank/text-format
6+
bug-reports: https://github.com/mailrank/text-format/issues
7+
category: Text
8+
author: Bryan O'Sullivan <[email protected]>
9+
maintainer: Bryan O'Sullivan <[email protected]>
10+
stability: experimental
11+
tested-with: GHC == 7.0.3
12+
synopsis: Text formatting
13+
cabal-version: >= 1.8
14+
build-type: Simple
15+
description:
16+
A text formatting library optimized for ease of use and high
17+
performance.
18+
19+
extra-source-files:
20+
README.markdown
21+
22+
flag developer
23+
description: operate in developer mode
24+
default: False
25+
26+
library
27+
exposed-modules:
28+
Data.Text.Format
29+
Data.Text.Format.Param
30+
Data.Text.Format.Params
31+
Data.Text.Format.Types
32+
33+
other-modules:
34+
Data.Text.Format.Int
35+
36+
build-depends:
37+
base == 4.*,
38+
ghc-prim,
39+
integer-gmp,
40+
text >= 0.11.0.5
41+
42+
if flag(developer)
43+
ghc-options: -Werror
44+
ghc-prof-options: -auto-all
45+
46+
ghc-options: -Wall
47+
48+
cpp-options: -DINTEGER_GMP
49+
50+
if impl(ghc >= 6.11)
51+
build-depends: integer-gmp >= 0.2 && < 0.3
52+
53+
if impl(ghc >= 6.9) && impl(ghc < 6.11)
54+
build-depends: integer >= 0.1 && < 0.2
55+
56+
source-repository head
57+
type: git
58+
location: http://github.com/mailrank/aeson
59+
60+
source-repository head
61+
type: mercurial
62+
location: http://bitbucket.org/bos/aeson

0 commit comments

Comments
 (0)