formattable 0.1 → 0.1.1

raw patch · 3 files changed

+162/−47 lines, 3 filesdep +QuickCheckdep ~HUnitdep ~bytestringdep ~double-conversionPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: QuickCheck

Dependency ranges changed: HUnit, bytestring, double-conversion, hspec, lens, text, time

API changes (from Hackage documentation)

Files

• formattable.cabal +4/−5
• src/Formattable.hs +34/−0
• src/Formattable/NumFormat.hs +124/−42

@@ -1,5 +1,5 @@ Name:                formattable-Version:             0.1+Version:             0.1.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@@ -28,8 +28,6 @@       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@@ -50,12 +48,13 @@    build-depends:       HUnit                    >= 1.2   && < 1.3+    , QuickCheck               >= 2.0   && < 2.9     , base     , bytestring     , data-default-class-    , double-conversion+    , double-conversion        >= 0.2   && < 2.1     , hspec                    >= 1.10  && < 2.2-    , lens+    , lens                     >= 4     && < 4.13     , old-locale     , text     , time

@@ -50,86 +50,120 @@     runFormat :: TheFormat a -> a -> Text  +------------------------------------------------------------------------------+-- | TheFormat = NumFormat instance Format Integer where     type TheFormat Integer = NumFormat     runFormat set a = formatIntegral set a  +------------------------------------------------------------------------------+-- | TheFormat = NumFormat instance Format Int where     type TheFormat Int = NumFormat     runFormat set a = formatIntegral set a  +------------------------------------------------------------------------------+-- | TheFormat = NumFormat instance Format Int8 where     type TheFormat Int8 = NumFormat     runFormat set a = formatIntegral set a  +------------------------------------------------------------------------------+-- | TheFormat = NumFormat instance Format Int16 where     type TheFormat Int16 = NumFormat     runFormat set a = formatIntegral set a  +------------------------------------------------------------------------------+-- | TheFormat = NumFormat instance Format Int32 where     type TheFormat Int32 = NumFormat     runFormat set a = formatIntegral set a  +------------------------------------------------------------------------------+-- | TheFormat = NumFormat instance Format Int64 where     type TheFormat Int64 = NumFormat     runFormat set a = formatIntegral set a  +------------------------------------------------------------------------------+-- | TheFormat = NumFormat instance Format Word where     type TheFormat Word = NumFormat     runFormat set a = formatIntegral set a  +------------------------------------------------------------------------------+-- | TheFormat = NumFormat instance Format Word8 where     type TheFormat Word8 = NumFormat     runFormat set a = formatIntegral set a  +------------------------------------------------------------------------------+-- | TheFormat = NumFormat instance Format Word16 where     type TheFormat Word16 = NumFormat     runFormat set a = formatIntegral set a  +------------------------------------------------------------------------------+-- | TheFormat = NumFormat instance Format Word32 where     type TheFormat Word32 = NumFormat     runFormat set a = formatIntegral set a  +------------------------------------------------------------------------------+-- | TheFormat = NumFormat instance Format Word64 where     type TheFormat Word64 = NumFormat     runFormat set a = formatIntegral set a  +------------------------------------------------------------------------------+-- | TheFormat = NumFormat instance Format Double where     type TheFormat Double = NumFormat     runFormat set a = formatNum set a  +------------------------------------------------------------------------------+-- | TheFormat = NumFormat instance Format Float where     type TheFormat Float = NumFormat     runFormat set a = formatNum set a  +------------------------------------------------------------------------------+-- | TheFormat = String instance Format Day where     type TheFormat Day = String     runFormat set a = T.pack $ formatTime defaultTimeLocale set a  +------------------------------------------------------------------------------+-- | TheFormat = String instance Format UTCTime where     type TheFormat UTCTime = String     runFormat set a = T.pack $ formatTime defaultTimeLocale set a  +------------------------------------------------------------------------------+-- | TheFormat = () instance Format Text where     type TheFormat Text = ()     runFormat _ a = a  +------------------------------------------------------------------------------+-- | TheFormat = () instance Format Bool where     type TheFormat Bool = ()     runFormat _ a = T.pack (show a)

@@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE RankNTypes         #-} {-# LANGUAGE RecordWildCards    #-} {-# LANGUAGE TemplateHaskell    #-} {-# LANGUAGE TypeFamilies       #-}@@ -17,12 +18,24 @@ ----------------------------------------------------------------------------  module Formattable.NumFormat-    ( NumFormat(..)+    (+    -- * Main number formatting functions and data types+      formatNum+    , formatIntegral+    , formatPct+    , NumFormat(..)     , NumStyle(..)     , autoStyle     , PrecisionType(..)     , NegativeStyle(..) +    -- * Common formats+    , rawIntFmt+    , intFmt+    , percentFmt+    , numFmt+    , usdFmt+     -- * Lenses     , nfUnits     , nfPrefix@@ -33,32 +46,30 @@     , nfPrec     , nfNegStyle -    -- * Common formats-    , rawIntFmt-    , intFmt-    , percentFmt-    , numFmt-    , usdFmt--    -- * Formatting functions-    , formatPct-    , formatNum-    , formatIntegral+    -- * Other formatting functions+    , formatNumGeneric     ) where   --------------------------------------------------------------------------------import           Control.Lens+import           Control.Applicative import           Data.Char import           Data.Default.Class-import           Data.Double.Conversion.Text+import           Data.Maybe import           Data.Monoid import           Data.Text                   (Text) import qualified Data.Text                   as T import           Data.Typeable+import           Numeric -------------------------------------------------------------------------------  +type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t+lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b+lens sa sbt afb s = sbt s <$> afb (sa s)+++ ------------------------------------------------------------------------------- -- | Data structure describing available styles of number formatting. data NumStyle@@ -110,7 +121,7 @@   --------------------------------------------------------------------------------- The main data structure with all the necessary information for formatting+-- | The main data structure with all the necessary information for formatting -- numbers. data NumFormat = NumFormat     { _nfUnits    :: Double@@ -133,9 +144,48 @@     , _nfNegStyle :: NegativeStyle       -- ^ Styles for negative numbers     } deriving (Eq,Show,Typeable)-makeLenses ''NumFormat +nfUnits :: Lens NumFormat NumFormat Double Double+nfUnits = lens _nfUnits setter+  where+    setter sc v = sc { _nfUnits = v } +nfPrefix :: Lens NumFormat NumFormat Text Text+nfPrefix = lens _nfPrefix setter+  where+    setter sc v = sc { _nfPrefix = v }++nfSuffix :: Lens NumFormat NumFormat Text Text+nfSuffix = lens _nfSuffix setter+  where+    setter sc v = sc { _nfSuffix = v }++nfThouSep :: Lens NumFormat NumFormat Text Text+nfThouSep = lens _nfThouSep setter+  where+    setter sc v = sc { _nfThouSep = v }++nfDecSep :: Lens NumFormat NumFormat Text Text+nfDecSep = lens _nfDecSep setter+  where+    setter sc v = sc { _nfDecSep = v }++nfStyle :: Lens NumFormat NumFormat NumStyle NumStyle+nfStyle = lens _nfStyle setter+  where+    setter sc v = sc { _nfStyle = v }++nfPrec :: Lens NumFormat NumFormat (Maybe (Int, PrecisionType)) (Maybe (Int, PrecisionType))+nfPrec = lens _nfPrec setter+  where+    setter sc v = sc { _nfPrec = v }++nfNegStyle :: Lens NumFormat NumFormat NegativeStyle NegativeStyle+nfNegStyle = lens _nfNegStyle setter+  where+    setter sc v = sc { _nfNegStyle = v }++ ------------------------------------------------------------------------------ instance Default NumFormat where     def = NumFormat 1 "" "" "" "." autoStyle@@ -183,50 +233,56 @@ ------------------------------------------------------------------------------- -- | Int format with no thousands separator. rawIntFmt :: NumFormat-rawIntFmt = def & nfPrec .~ Just (0, Decimals)+rawIntFmt = def { _nfPrec = Just (0, Decimals) }   ------------------------------------------------------------------------------- -- | Int format with comma as the thousands separator. intFmt :: NumFormat-intFmt = def & nfPrec .~ Just (0, Decimals)-             & nfThouSep .~ ","+intFmt = def { _nfPrec = Just (0, Decimals)+             , _nfThouSep = ","+             }   ------------------------------------------------------------------------------ -- | Common format for percentages.  Example: 75.000% percentFmt :: NumFormat-percentFmt = def & nfSuffix .~ "%"-                 & nfUnits .~ 0.01+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)+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+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))+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.+-- | Primary function for formatting integrals.  This was originally created to+-- avoid depending on the double-conversion package which uses a C library and+-- is therefore less portable.  We're keeping this as a separate function+-- because it should have the potential to be more efficient than the floating+-- point version. formatIntegral :: Integral a => NumFormat -> a -> Text formatIntegral NumFormat{..} noUnits =     whenNegative noUnits (addSign _nfNegStyle) $@@ -291,36 +347,62 @@   ---------------------------------------------------------------------------------- | 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.+-- | Primary function for formatting floating point numbers. formatNum :: Real a => NumFormat -> a -> Text-formatNum NumFormat{..} noUnits =+formatNum = formatNumGeneric (\p x -> T.pack $ showEFloat p x "")+                             (\p x -> T.pack $ showFFloat p x "")+++-------------------------------------------------------------------------------+-- | Generic floating point formatting function that allows you to specify your+-- own underlying functions for formatting exponential and fixed formats.  This+-- can allow you to use more efficient versions if available.  We also use it+-- the test suite to check behavior against the old double-conversion+-- implementation.+formatNumGeneric+    :: Real a+    => (Maybe Int -> Double -> Text)+    -- ^ Exponential formatter+    -> (Maybe Int -> Double -> Text)+    -- ^ Fixed formatter+    -> NumFormat+    -- ^ Format specification+    -> a+    -- ^ The number to format+    -> Text+formatNumGeneric fmtExp fmtFixed NumFormat{..} noUnits =     whenNegative noUnits (addSign _nfNegStyle) $     addPrefix $     addSuffix $     addDecimal _nfDecSep $     addThousands _nfThouSep $     maybe id limitPrecision _nfPrec $+    stripZeros precArg $     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+                  Exponent -> fmtExp precArg+                  Fixed -> fmtFixed precArg+                  SmartExponent lo hi -> smartStyle lo hi (fmtFixed precArg) (fmtExp precArg)+                  SIStyle -> fmtFixed precArg+                  SmartSI _ _ -> fmtFixed precArg     addPrefix x = _nfPrefix <> x     addSuffix x1 = let x2 = x1 <> siSuffix in x2 <> _nfSuffix-    precArg = maybe (-1) fst _nfPrec+    precArg = 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)+++stripZeros :: Maybe Int -> RawNum a -> RawNum a+stripZeros precArg rn@(RawNum x a b c) =+  if isNothing precArg && T.all (=='0') b+    then RawNum x a "" c+    else rn   siPrefixIntegral :: Integral a => a -> (Int, Text)