Skip to content
Browse files

Initial super-basic commit

  • Loading branch information...
0 parents commit 5ef090fb47b9662dd8fd2251be7b0aed2511e9a8 @bos committed May 19, 2011
Showing with 374 additions and 0 deletions.
  1. +5 −0 .hgignore
  2. +23 −0 Data/Text/Format.hs
  3. +128 −0 Data/Text/Format/Int.hs
  4. +72 −0 Data/Text/Format/Param.hs
  5. +20 −0 Data/Text/Format/Params.hs
  6. +7 −0 Data/Text/Format/Types.hs
  7. +26 −0 LICENSE
  8. +28 −0 README.markdown
  9. +3 −0 Setup.lhs
  10. +62 −0 text-format.cabal
5 .hgignore
@@ -0,0 +1,5 @@
+^(?:cabal-dev|dist)$
+\.(?:aux|eventlog|h[ip]|log|[oa]|orig|prof|ps|rej|swp)$
+~$
+syntax: glob
+.\#*
23 Data/Text/Format.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Data.Text.Format
+ where
+
+import Data.Monoid
+import qualified Data.Text.Lazy as LT
+import qualified Data.Text as ST
+import Data.Text.Lazy.Builder
+import Data.Text.Format.Param
+import Data.Text.Format.Params
+
+build :: Params ps => ST.Text -> ps -> Builder
+build fmt ps
+ | null xs && not ("{}" `ST.isInfixOf` fmt) = fromText fmt
+ | otherwise = zipParams (map fromText . ST.splitOn "{}" $ fmt) xs
+ where xs = buildParams ps
+ zipParams (f:fs) (y:ys) = f `mappend` y `mappend` zipParams fs ys
+ zipParams [f] [] = f
+ zipParams _ _ = error "oops"
+
+format :: Params ps => ST.Text -> ps -> LT.Text
+format fmt ps = toLazyText $ build fmt ps
128 Data/Text/Format/Int.hs
@@ -0,0 +1,128 @@
+{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}
+
+-- Module: Blaze.Text.Int
+-- Copyright: (c) 2011 MailRank, Inc.
+-- License: BSD3
+-- Maintainer: Bryan O'Sullivan <bos@mailrank.com>
+-- Stability: experimental
+-- Portability: portable
+--
+-- Efficiently serialize an integral value as a lazy 'L.ByteString'.
+
+module Data.Text.Format.Int
+ (
+ digit
+ , integral
+ , minus
+ ) where
+
+import Data.Char (chr)
+import Data.Int (Int8, Int16, Int32, Int64)
+import Data.Monoid (mappend, mempty)
+import Data.Text.Lazy.Builder
+import Data.Word (Word, Word8, Word16, Word32, Word64)
+import GHC.Base (quotInt, remInt)
+import GHC.Num (quotRemInteger)
+import GHC.Types (Int(..))
+
+#ifdef __GLASGOW_HASKELL__
+# if __GLASGOW_HASKELL__ < 611
+import GHC.Integer.Internals
+# else
+import GHC.Integer.GMP.Internals
+# endif
+#endif
+
+#ifdef INTEGER_GMP
+# define PAIR(a,b) (# a,b #)
+#else
+# define PAIR(a,b) (a,b)
+#endif
+
+integral :: Integral a => a -> Builder
+{-# SPECIALIZE integral :: Int -> Builder #-}
+{-# SPECIALIZE integral :: Int8 -> Builder #-}
+{-# SPECIALIZE integral :: Int16 -> Builder #-}
+{-# SPECIALIZE integral :: Int32 -> Builder #-}
+{-# SPECIALIZE integral :: Int64 -> Builder #-}
+{-# SPECIALIZE integral :: Word -> Builder #-}
+{-# SPECIALIZE integral :: Word8 -> Builder #-}
+{-# SPECIALIZE integral :: Word16 -> Builder #-}
+{-# SPECIALIZE integral :: Word32 -> Builder #-}
+{-# SPECIALIZE integral :: Word64 -> Builder #-}
+{-# RULES "integral/Integer" integral = integer :: Integer -> Builder #-}
+integral i
+ | i < 0 = minus `mappend` go (-i)
+ | otherwise = go i
+ where
+ go n | n < 10 = digit n
+ | otherwise = go (n `quot` 10) `mappend` digit (n `rem` 10)
+
+digit :: Integral a => a -> Builder
+digit n = singleton $! chr (fromIntegral n + 48)
+{-# INLINE digit #-}
+
+minus :: Builder
+minus = singleton '-'
+
+int :: Int -> Builder
+int = integral
+{-# INLINE int #-}
+
+integer :: Integer -> Builder
+integer (S# i#) = int (I# i#)
+integer i
+ | i < 0 = minus `mappend` go (-i)
+ | otherwise = go i
+ where
+ go n | n < maxInt = int (fromInteger n)
+ | otherwise = putH (splitf (maxInt * maxInt) n)
+
+ splitf p n
+ | p > n = [n]
+ | otherwise = splith p (splitf (p*p) n)
+
+ splith p (n:ns) = case n `quotRemInteger` p of
+ PAIR(q,r) | q > 0 -> q : r : splitb p ns
+ | otherwise -> r : splitb p ns
+ splith _ _ = error "splith: the impossible happened."
+
+ splitb p (n:ns) = case n `quotRemInteger` p of
+ PAIR(q,r) -> q : r : splitb p ns
+ splitb _ _ = []
+
+data T = T !Integer !Int
+
+fstT :: T -> Integer
+fstT (T a _) = a
+
+maxInt :: Integer
+maxDigits :: Int
+T maxInt maxDigits =
+ until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1)
+ where mi = fromIntegral (maxBound :: Int)
+
+putH :: [Integer] -> Builder
+putH (n:ns) = case n `quotRemInteger` maxInt of
+ PAIR(x,y)
+ | q > 0 -> int q `mappend` pblock r `mappend` putB ns
+ | otherwise -> int r `mappend` putB ns
+ where q = fromInteger x
+ r = fromInteger y
+putH _ = error "putH: the impossible happened"
+
+putB :: [Integer] -> Builder
+putB (n:ns) = case n `quotRemInteger` maxInt of
+ PAIR(x,y) -> pblock q `mappend` pblock r `mappend` putB ns
+ where q = fromInteger x
+ r = fromInteger y
+putB _ = mempty
+
+pblock :: Int -> Builder
+pblock = go maxDigits
+ where
+ go !d !n
+ | d == 1 = digit n
+ | otherwise = go (d-1) q `mappend` digit r
+ where q = n `quotInt` 10
+ r = n `remInt` 10
72 Data/Text/Format/Param.hs
@@ -0,0 +1,72 @@
+{-# LANGUAGE FlexibleInstances #-}
+
+module Data.Text.Format.Param
+ (
+ Param(..)
+ ) where
+
+import Data.Text.Lazy.Builder
+import Data.Text.Format.Int
+import qualified Data.Text.Lazy as LT
+import Data.Int (Int8, Int16, Int32, Int64)
+import Data.Word (Word, Word8, Word16, Word32, Word64)
+import qualified Data.Text as ST
+
+class Param p where
+ buildParam :: p -> Builder
+
+instance Param LT.Text where
+ buildParam = fromLazyText
+
+instance Param ST.Text where
+ buildParam = fromText
+
+instance Param Char where
+ buildParam = singleton
+
+instance Param [Char] where
+ buildParam = fromText . ST.pack
+
+instance Param Int8 where
+ buildParam = integral
+ {-# INLINE buildParam #-}
+
+instance Param Int16 where
+ buildParam = integral
+ {-# INLINE buildParam #-}
+
+instance Param Int32 where
+ buildParam = integral
+ {-# INLINE buildParam #-}
+
+instance Param Int where
+ buildParam = integral
+ {-# INLINE buildParam #-}
+
+instance Param Int64 where
+ buildParam = integral
+ {-# INLINE buildParam #-}
+
+instance Param Integer where
+ buildParam = integral
+ {-# INLINE buildParam #-}
+
+instance Param Word8 where
+ buildParam = integral
+ {-# INLINE buildParam #-}
+
+instance Param Word16 where
+ buildParam = integral
+ {-# INLINE buildParam #-}
+
+instance Param Word32 where
+ buildParam = integral
+ {-# INLINE buildParam #-}
+
+instance Param Word where
+ buildParam = integral
+ {-# INLINE buildParam #-}
+
+instance Param Word64 where
+ buildParam = integral
+ {-# INLINE buildParam #-}
20 Data/Text/Format/Params.hs
@@ -0,0 +1,20 @@
+module Data.Text.Format.Params
+ (
+ Params(..)
+ ) where
+
+import Data.Text.Format.Param
+import Data.Text.Format.Types
+import Data.Text.Lazy.Builder
+
+class Params ps where
+ buildParams :: ps -> [Builder]
+
+instance (Param a) => Params (Only a) where
+ buildParams (Only a) = [buildParam a]
+
+instance (Param a) => Params [a] where
+ buildParams = map buildParam
+
+instance (Param a, Param b) => Params (a,b) where
+ buildParams (a,b) = [buildParam a, buildParam b]
7 Data/Text/Format/Types.hs
@@ -0,0 +1,7 @@
+module Data.Text.Format.Types
+ (
+ Only(..)
+ ) where
+
+newtype Only a = Only a
+ deriving (Eq, Ord, Read, Show)
26 LICENSE
@@ -0,0 +1,26 @@
+Copyright (c) 2011 MailRank, Inc.
+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.
+
+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.
28 README.markdown
@@ -0,0 +1,28 @@
+# Welcome to text-format
+
+text-format is a fast and easy-to-use Haskell library for formatting
+text strings.
+
+# Join in!
+
+We are happy to receive bug reports, fixes, documentation enhancements,
+and other improvements.
+
+Please report bugs via the
+[github issue tracker](https://github.com/mailrank/text-format/issues).
+
+Master [git repository](https://github.com/mailrank/text-format):
+
+* `git clone git://github.com/mailrank/text-format.git`
+
+There's also a [Mercurial mirror](https://bitbucket.org/bos/text-format):
+
+* `hg clone https://bitbucket.org/bos/text-format`
+
+(You can create and contribute changes using either git or Mercurial.)
+
+Authors
+-------
+
+This library is written and maintained by Bryan O'Sullivan,
+<bos@mailrank.com>.
3 Setup.lhs
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
62 text-format.cabal
@@ -0,0 +1,62 @@
+name: text-format
+version: 0.1.0.0
+license: BSD3
+license-file: LICENSE
+homepage: https://github.com/mailrank/text-format
+bug-reports: https://github.com/mailrank/text-format/issues
+category: Text
+author: Bryan O'Sullivan <bos@mailrank.com>
+maintainer: Bryan O'Sullivan <bos@mailrank.com>
+stability: experimental
+tested-with: GHC == 7.0.3
+synopsis: Text formatting
+cabal-version: >= 1.8
+build-type: Simple
+description:
+ A text formatting library optimized for ease of use and high
+ performance.
+
+extra-source-files:
+ README.markdown
+
+flag developer
+ description: operate in developer mode
+ default: False
+
+library
+ exposed-modules:
+ Data.Text.Format
+ Data.Text.Format.Param
+ Data.Text.Format.Params
+ Data.Text.Format.Types
+
+ other-modules:
+ Data.Text.Format.Int
+
+ build-depends:
+ base == 4.*,
+ ghc-prim,
+ integer-gmp,
+ text >= 0.11.0.5
+
+ if flag(developer)
+ ghc-options: -Werror
+ ghc-prof-options: -auto-all
+
+ ghc-options: -Wall
+
+ cpp-options: -DINTEGER_GMP
+
+ if impl(ghc >= 6.11)
+ build-depends: integer-gmp >= 0.2 && < 0.3
+
+ if impl(ghc >= 6.9) && impl(ghc < 6.11)
+ build-depends: integer >= 0.1 && < 0.2
+
+source-repository head
+ type: git
+ location: http://github.com/mailrank/aeson
+
+source-repository head
+ type: mercurial
+ location: http://bitbucket.org/bos/aeson

0 comments on commit 5ef090f

Please sign in to comment.
Something went wrong with that request. Please try again.