formattable (empty) → 0.1
raw patch · 6 files changed
+715/−0 lines, 6 filesdep +HUnitdep +basedep +bytestringsetup-changed
Dependencies added: HUnit, base, bytestring, data-default-class, double-conversion, hspec, lens, old-locale, text, time
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- formattable.cabal +65/−0
- src/Formattable.hs +135/−0
- src/Formattable/NumFormat.hs +479/−0
- test/Spec.hs +4/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2014, Soostone 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.++ * Neither the name of Ozgun Ataman 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ formattable.cabal view
@@ -0,0 +1,65 @@+Name: formattable+Version: 0.1+Synopsis: Business-quality formatting of numbers, dates, and other things+Description: This package defines data structures for describing+ business-quality formatting for numbers, dates, etc in a+ way that can be serialized and transported. Comes with+ excellent built-in support for formatting numbers. It+ also provides a generic interface for formatting other+ types as well.+License: BSD3+License-file: LICENSE+Author: Ozgun Ataman, Doug Beardsley+Maintainer: oz@soostone.com+Homepage: https://github.com/Soostone/formattable+Bug-reports: https://github.com/Soostone/formattable/issues+Category: Text+Build-type: Simple+Cabal-version: >= 1.10+++Library+ Exposed-modules: + Formattable+ Formattable.NumFormat++ hs-source-dirs: src+ Build-depends:+ base >= 4 && < 5+ , bytestring >= 0.9 && < 0.11+ , data-default-class < 0.1+ , double-conversion >= 0.2 && < 2.1+ , lens >= 4 && < 4.13+ , old-locale >= 1.0 && < 1.1+ , text >= 0.11 && < 1.3+ , time >= 1.4 && < 1.6++ ghc-options: -Wall -fwarn-tabs+ default-language: Haskell2010+++Test-Suite testsuite+ type: exitcode-stdio-1.0+ hs-Source-Dirs: src test+ ghc-Options: -Wall -fhpc -threaded -fbreak-on-exception+ main-Is: Spec.hs++ other-modules:+ Formattable+ Formattable.NumFormat++ build-depends:+ HUnit >= 1.2 && < 1.3+ , base+ , bytestring+ , data-default-class+ , double-conversion+ , hspec >= 1.10 && < 2.2+ , lens+ , old-locale+ , text+ , time++source-repository head+ type: git+ location: https://github.com/Soostone/formattable.git
+ src/Formattable.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++-----------------------------------------------------------------------------+-- |+-- Module : Formattable+-- Copyright : Soostone Inc+-- License : BSD3+--+-- Maintainer : libs@soostone.com+-- Stability : experimental+--+-- Practical formatting interface for output values intended for human+-- consumption. We try to support several variants often required by+-- real-world applications.+----------------------------------------------------------------------------++module Formattable+ ( module Formattable+ , module Formattable.NumFormat+ ) where++-------------------------------------------------------------------------------+import Data.Int+import Data.Text (Text)+import qualified Data.Text as T+import Data.Word+#if MIN_VERSION_time(1,5,0)+import Data.Time+#else+import Data.Time+import System.Locale (TimeLocale, defaultTimeLocale)+#endif+-------------------------------------------------------------------------------+import Formattable.NumFormat+-------------------------------------------------------------------------------+++------------------------------------------------------------------------------+-- | Provides a uniform interface for formatting all kinds of types.+class Format a where++ -- | A format settings type specific to the object type.+ type TheFormat a++ -- | Render into text using format settings+ runFormat :: TheFormat a -> a -> Text+++instance Format Integer where+ type TheFormat Integer = NumFormat+ runFormat set a = formatIntegral set a+++instance Format Int where+ type TheFormat Int = NumFormat+ runFormat set a = formatIntegral set a+++instance Format Int8 where+ type TheFormat Int8 = NumFormat+ runFormat set a = formatIntegral set a+++instance Format Int16 where+ type TheFormat Int16 = NumFormat+ runFormat set a = formatIntegral set a+++instance Format Int32 where+ type TheFormat Int32 = NumFormat+ runFormat set a = formatIntegral set a+++instance Format Int64 where+ type TheFormat Int64 = NumFormat+ runFormat set a = formatIntegral set a+++instance Format Word where+ type TheFormat Word = NumFormat+ runFormat set a = formatIntegral set a+++instance Format Word8 where+ type TheFormat Word8 = NumFormat+ runFormat set a = formatIntegral set a+++instance Format Word16 where+ type TheFormat Word16 = NumFormat+ runFormat set a = formatIntegral set a+++instance Format Word32 where+ type TheFormat Word32 = NumFormat+ runFormat set a = formatIntegral set a+++instance Format Word64 where+ type TheFormat Word64 = NumFormat+ runFormat set a = formatIntegral set a+++instance Format Double where+ type TheFormat Double = NumFormat+ runFormat set a = formatNum set a+++instance Format Float where+ type TheFormat Float = NumFormat+ runFormat set a = formatNum set a+++instance Format Day where+ type TheFormat Day = String+ runFormat set a = T.pack $ formatTime defaultTimeLocale set a+++instance Format UTCTime where+ type TheFormat UTCTime = String+ runFormat set a = T.pack $ formatTime defaultTimeLocale set a+++instance Format Text where+ type TheFormat Text = ()+ runFormat _ a = a+++instance Format Bool where+ type TheFormat Bool = ()+ runFormat _ a = T.pack (show a)
+ src/Formattable/NumFormat.hs view
@@ -0,0 +1,479 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++-----------------------------------------------------------------------------+-- |+-- Module : Formattable.NumFormat+-- Copyright : Soostone Inc+-- License : BSD3+--+-- Maintainer : libs@soostone.com+-- Stability : experimental+--+-- Formatting for numeric values.+----------------------------------------------------------------------------++module Formattable.NumFormat+ ( NumFormat(..)+ , NumStyle(..)+ , autoStyle+ , PrecisionType(..)+ , NegativeStyle(..)++ -- * Lenses+ , nfUnits+ , nfPrefix+ , nfSuffix+ , nfThouSep+ , nfDecSep+ , nfStyle+ , nfPrec+ , nfNegStyle++ -- * Common formats+ , rawIntFmt+ , intFmt+ , percentFmt+ , numFmt+ , usdFmt++ -- * Formatting functions+ , formatPct+ , formatNum+ , formatIntegral+ ) where+++-------------------------------------------------------------------------------+import Control.Lens+import Data.Char+import Data.Default.Class+import Data.Double.Conversion.Text+import Data.Monoid+import Data.Text (Text)+import qualified Data.Text as T+import Data.Typeable+-------------------------------------------------------------------------------+++-------------------------------------------------------------------------------+-- | Data structure describing available styles of number formatting.+data NumStyle+ = Exponent+ -- ^ Format with scientific notation+ | Fixed+ -- ^ Format with standard decimal notation+ | SmartExponent Int Int+ -- ^ The aruments a and b define bounds. If the absolute value of the+ -- number is in the interval [10 ^ a, 10 ^ b], then it uses the Fixed+ -- style. If the number is outside this interval, then use the Exponent+ -- style.+ | SIStyle+ -- ^ Adds the symbol for the closest smaller SI prefix as the suffix to+ -- the formatted number. This suffix appears before any other suffix+ -- you designate.+ | SmartSI Double Double+ -- ^ Like SIStyle but only applies the SI prefix if the number to be+ -- formatted falls within the range [a,b] given by the SmartSI+ -- arguments.+ deriving (Eq,Show)+++------------------------------------------------------------------------------+-- | A reasonable default value for NumStyle.+autoStyle :: NumStyle+autoStyle = SmartExponent (-2) 10+++------------------------------------------------------------------------------+-- | Data structure for different methods of specifying precision.+data PrecisionType+ = SigFigs+ -- ^ Specifies precision as a fixed number of significant digits+ | Decimals+ -- ^ Specifies precision with a fixed number of digits after the decimal+ -- place.+ deriving (Eq,Show)+++------------------------------------------------------------------------------+-- | Different styles for representing negative numbers.+data NegativeStyle+ = NegMinusSign+ -- ^ Shows negative numbers as -123.000+ | NegParens+ -- ^ Shows negative numbers as (123.000)+ deriving (Eq,Show)+++------------------------------------------------------------------------------+-- The main data structure with all the necessary information for formatting+-- numbers.+data NumFormat = NumFormat+ { _nfUnits :: Double+ -- ^ Units of measure to use in formatting the number. This is useful+ -- for things like percentages where you would use (units of 0.01) or+ -- financial statements (units of 1000 for example).+ , _nfPrefix :: Text+ -- ^ A prefix to add to the number, commonly used for currency+ -- designation.+ , _nfSuffix :: Text+ -- ^ A suffix for the number. Percent, for example.+ , _nfThouSep :: Text+ -- ^ The character to use as thousands separator if applicable.+ , _nfDecSep :: Text+ -- ^ Character to use for the decimal separator.+ , _nfStyle :: NumStyle+ -- ^ The formatting style+ , _nfPrec :: Maybe (Int, PrecisionType)+ -- ^ Amount of precision to display+ , _nfNegStyle :: NegativeStyle+ -- ^ Styles for negative numbers+ } deriving (Eq,Show,Typeable)+makeLenses ''NumFormat+++------------------------------------------------------------------------------+instance Default NumFormat where+ def = NumFormat 1 "" "" "" "." autoStyle+ (Just $ (3, Decimals)) NegMinusSign+++------------------------------------------------------------------------------+-- | A type wrapper to make it easier to handle the pipeline of+-- transformations that happen after we have split the number at the decimal+-- place.+data RawNum a = RawNum a Text Text Text+-- { rawNumX :: a+-- -- ^ The original number so we can check for zero+-- , rawNumN :: Text+-- -- ^ Integral part (left of the decimal place)+-- , rawNumD :: Text+-- -- ^ Decimal part (right of the decimal place)+-- , rawNumE :: Text+-- -- ^ Exponent part if there is one+-- }+ deriving (Eq,Show)+++------------------------------------------------------------------------------+-- | Take the raw output from the double-precision conversion functions and+-- split into individual components.+--+-- We need to split on dot because that's what double-conversion uses as the+-- decimal separator.+mkRawNum :: Real a => a -> Text -> RawNum a+mkRawNum x t =+ case (T.findIndex (== '.') t, T.findIndex (== 'e') t) of+ (Nothing, Nothing) -> mk t "" ""+ (Just i, Nothing) -> let (n,d) = T.splitAt i t+ in mk n (T.drop 1 d) ""+ (Nothing, Just i) -> let (n,e) = T.splitAt i t+ in mk n "" (T.drop 1 e)+ (Just i, Just j) -> let (n,rest) = T.splitAt i t+ (d,e) = T.splitAt (j-i-1) (T.drop 1 rest)+ in mk n d (T.drop 1 e)+ where+ mk = RawNum x+++-------------------------------------------------------------------------------+-- | Int format with no thousands separator.+rawIntFmt :: NumFormat+rawIntFmt = def & nfPrec .~ Just (0, Decimals)+++-------------------------------------------------------------------------------+-- | Int format with comma as the thousands separator.+intFmt :: NumFormat+intFmt = def & nfPrec .~ Just (0, Decimals)+ & nfThouSep .~ ","+++------------------------------------------------------------------------------+-- | Common format for percentages. Example: 75.000%+percentFmt :: NumFormat+percentFmt = def & nfSuffix .~ "%"+ & nfUnits .~ 0.01+++------------------------------------------------------------------------------+-- | Common format for generic numeric quantities of the form 123,456.99.+numFmt :: NumFormat+numFmt = def & nfThouSep .~ ","+ & nfPrec .~ Just (2, Decimals)+++------------------------------------------------------------------------------+-- | Common format for US dollar quantities of the form $123,456.99.+usdFmt :: NumFormat+usdFmt = def & nfPrefix .~ "$"+ & nfThouSep .~ ","+ & nfPrec .~ Just (2, Decimals)+ & nfStyle .~ Fixed+++-------------------------------------------------------------------------------+-- | Convenience wrapper for percentages that lets you easily control the+-- number of decimal places.+formatPct :: Real a => Int -> a -> Text+formatPct p = formatNum (percentFmt & nfPrec .~ Just (p, Decimals))+++-------------------------------------------------------------------------------+-- | This function checks to see if the number is smaller than the number of+-- digits of precision being displayed and if so, switches to scientific+-- notation.+formatIntegral :: Integral a => NumFormat -> a -> Text+formatIntegral NumFormat{..} noUnits =+ whenNegative noUnits (addSign _nfNegStyle) $+ addPrefix $+ addSuffix $+ addDecimal _nfDecSep $+ addThousands _nfThouSep $+ maybe id limitPrecision _nfPrec $+ formatted siUnitized+ where+ a = abs $ noUnits `div` round _nfUnits+ formatted = case _nfStyle of+ Exponent -> exponentialInt precArg+ Fixed -> fixedInt precArg+ SmartExponent lo hi -> smartStyleIntegral lo hi+ (fixedInt precArg)+ (exponentialInt precArg)+ SIStyle -> fixedInt precArg+ SmartSI _ _ -> fixedInt precArg+ addPrefix x = _nfPrefix <> x+ addSuffix x1 = let x2 = x1 <> siSuffix in x2 <> _nfSuffix+ precArg = maybe (-1) fst _nfPrec+ (e, siSuffix) = case _nfStyle of+ SIStyle -> siPrefixIntegral a+ SmartSI lo hi -> if fromIntegral a > lo && fromIntegral a < hi then siPrefixIntegral a else (0, "")+ _ -> (0, "")+ siUnitized = a `div` 10^e+++-- The following two functions skip the double-conversion library and let us+-- go straight to RawNum when we're working with Integrals. This avoids a C+-- dependency and hopefully should also be faster.+++fixedInt :: Integral a => Int -> a -> RawNum a+fixedInt (-1) n =+ RawNum n (T.pack $ showIntegralBase 10 n) "" ""+fixedInt decimals n =+ RawNum n (T.pack $ showIntegralBase 10 n) (T.replicate decimals "0") ""+++exponentialInt :: Integral a => Int -> a -> RawNum a+exponentialInt (-1) n = RawNum n (T.pack a) (T.pack b) (T.pack $ show (len-1))+ where+ str = showIntegralBase 10 n+ len = length str+ (a,b) = splitAt 1 str+exponentialInt numDecimals n =+ RawNum n (T.pack a) (T.pack b) (T.pack $ show e)+ where+ str = showIntegralBase 10 n+ len = length str+ (keep,junk) = splitAt (numDecimals+1) (str ++ repeat '0')+ rounded = if head junk >= '5'+ then reverse $ roundStr $ reverse keep+ else keep+ e = if length rounded > length keep then len else len-1+ (a,b) = splitAt 1 rounded++ roundStr [] = "1"+ roundStr (x:xs) = if x == '9' then '0' : roundStr xs else succ x : xs+++-------------------------------------------------------------------------------+-- | This function checks to see if the number is smaller than the number of+-- digits of precision being displayed and if so, switches to scientific+-- notation.+formatNum :: Real a => NumFormat -> a -> Text+formatNum NumFormat{..} noUnits =+ whenNegative noUnits (addSign _nfNegStyle) $+ addPrefix $+ addSuffix $+ addDecimal _nfDecSep $+ addThousands _nfThouSep $+ maybe id limitPrecision _nfPrec $+ mkRawNum noUnits $+ formatted siUnitized++ where+ a = abs $ realToFrac noUnits / _nfUnits+ formatted = case _nfStyle of+ Exponent -> toExponential precArg+ Fixed -> toFixed precArg+ SmartExponent lo hi -> smartStyle lo hi (toFixed precArg) (toExponential precArg)+ SIStyle -> toFixed precArg+ SmartSI _ _ -> toFixed precArg+ addPrefix x = _nfPrefix <> x+ addSuffix x1 = let x2 = x1 <> siSuffix in x2 <> _nfSuffix+ precArg = maybe (-1) fst _nfPrec+ (e, siSuffix) = case _nfStyle of+ SIStyle -> siPrefix a+ SmartSI lo hi -> if a > lo && a < hi then siPrefix a else (0, "")+ _ -> (0, "")+ siUnitized = a / 10**(fromIntegral e)+++siPrefixIntegral :: Integral a => a -> (Int, Text)+siPrefixIntegral x+ | abs x > 10^(24::Int) = (24, "Y")+ | abs x > 10^(21::Int) = (21, "Z")+ | abs x > 10^(18::Int) = (18, "E")+ | abs x > 10^(15::Int) = (15, "P")+ | abs x > 10^(12::Int) = (12, "T")+ | abs x > 10^(9::Int) = (9, "G")+ | abs x > 10^(6::Int) = (6, "M")+ | abs x > 10^(3::Int) = (3, "k")+ | otherwise = (0, "")+++siPrefix :: Double -> (Int, Text)+siPrefix x+ | abs x > 1e24 = (24, "Y")+ | abs x > 1e21 = (21, "Z")+ | abs x > 1e18 = (18, "E")+ | abs x > 1e15 = (15, "P")+ | abs x > 1e12 = (12, "T")+ | abs x > 1e9 = (9, "G")+ | abs x > 1e6 = (6, "M")+ | abs x > 1e3 = (3, "k")+ | abs x > 1 = (0, "")+ | abs x > (1.0 / 1e3) = (-3, "m")+ | abs x > (1.0 / 1e6) = (-6, "μ")+ | abs x > (1.0 / 1e9) = (-9, "n")+ | abs x > (1.0 / 1e12) = (-12, "p")+ | abs x > (1.0 / 1e15) = (-15, "f")+ | abs x > (1.0 / 1e18) = (-18, "a")+ | abs x > (1.0 / 1e21) = (-21, "z")+ | otherwise = (-24, "y")+++------------------------------------------------------------------------------+-- | A "pre-format" function that intelligently chooses between fixed and+-- exponential format+smartStyleIntegral+ :: (Num a, Ord a)+ => Int+ -- ^ Lower bound exponent+ -> Int+ -- ^ Upper bound exponent+ -> (a -> b)+ -- ^ Function to call if within range+ -> (a -> b)+ -- ^ Function to call if out of range+ -> a+ -> b+smartStyleIntegral l h f g x =+ if lo < x' && x' < hi+ then f x+ else g x+ where+ x' = abs x+ lo = 10 ^ (max l 0)+ hi = 10 ^ (max h 0)+++------------------------------------------------------------------------------+-- | A "pre-format" function that intelligently chooses between fixed and+-- exponential format+smartStyle+ :: (Floating a, Ord a)+ => Int+ -- ^ Lower bound exponent+ -> Int+ -- ^ Upper bound exponent+ -> (a -> b)+ -- ^ Function to call if within range+ -> (a -> b)+ -- ^ Function to call if out of range+ -> a+ -> b+smartStyle l h f g x =+ if lo < x' && x' < hi+ then f x+ else g x+ where+ x' = abs x+ lo = 10 ** fromIntegral l+ hi = 10 ** fromIntegral h+++------------------------------------------------------------------------------+limitPrecision :: (Int, PrecisionType) -> RawNum a -> RawNum a+limitPrecision (c,p) r@(RawNum x n d e) =+ case p of+ SigFigs ->+ if c < T.length n+ then RawNum x (T.take c n <> T.replicate (T.length n - c) "0") "" e+ else RawNum x n (T.take (c - T.length n) d) e+ Decimals -> if c == (-1) then r else RawNum x n (T.take c d) e+++------------------------------------------------------------------------------+whenNegative :: (Num n, Ord n) => n -> (a -> a) -> a -> a+whenNegative n f = if n < 0 then f else id+++------------------------------------------------------------------------------+addSign :: NegativeStyle -> Text -> Text+addSign NegMinusSign t = T.cons '-' t+addSign NegParens t = T.concat ["(", t, ")"]+++-------------------------------------------------------------------------------+addThousands :: Text -> RawNum a -> RawNum a+addThousands "" raw = raw+addThousands sep (RawNum x n d e) = RawNum x n' d e+ where+ n' = T.reverse . T.intercalate sep . T.chunksOf 3 . T.reverse $ n+++------------------------------------------------------------------------------+addDecimal :: (Eq a, Num a) => Text -> RawNum a -> Text+addDecimal t (RawNum x n d e) = T.concat [n, d', e']+ where+ d' = if T.null d then "" else T.append t d+ e' = if T.null e || x == 0 then "" else T.cons 'e' e+++------------------------------------------------------------------------------+-- | An integral show function without the Show constraint. It works for+-- bases in the range [0,36].+showIntegralBase+ :: Integral a+ => a+ -- ^ The base+ -> a+ -- ^ The number to convert to string+ -> String+showIntegralBase b n+ -- It's ok to negate b because we only support bases in the range [0,36]+ | n < b && n > negate b = go n ""+ -- We unroll the go loop once because you can't negate minBound+ | otherwise =+ let (q,r) = n `quotRem` b in go q (go (abs r) "")+ where+ go m str+ | m < 0 = '-' : go (-m) str+ | m < b = integralDigit m : str+ | otherwise = let (q,r) = m `quotRem` b+ in go q (integralDigit r : str)+++------------------------------------------------------------------------------+integralDigit :: Integral a => a -> Char+integralDigit n+ | n < 10 = chr $ ord '0' + fromIntegral n+ | n < 36 = chr $ ord 'a' + fromIntegral n - 10+ | otherwise = error "integralDigit: not a digit"++
+ test/Spec.hs view
@@ -0,0 +1,4 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}++module Spec where+ test = 1