lib/Hcompta/Amount/Style.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 module Hcompta.Amount.Style where
   3
   4 import Control.DeepSeq
   5 import Data.Data
   6 import Data.Word (Word8)
   7 import Data.Typeable ()
   8
   9 -- * Type 'Style'
  10
  11 data Style
  12  =   Style
  13  { fractioning         :: Maybe Fractioning
  14  , grouping_integral   :: Maybe Grouping
  15  , grouping_fractional :: Maybe Grouping
  16  , precision           :: Precision
  17  -- TODO: , sign_plus           :: Maybe Bool
  18  , unit_side           :: Maybe Side
  19  , unit_spaced         :: Maybe Spacing
  20  } deriving (Data, Eq, Ord, Read, Show, Typeable)
  21 instance NFData Style where
  22         rnf (Style f gi gf p ui up) =
  23                 rnf f `seq`
  24                 rnf gi `seq`
  25                 rnf gf `seq`
  26                 rnf p `seq`
  27                 rnf ui `seq`
  28                 rnf up
  29
  30 type Fractioning
  31  = Char
  32
  33 data Grouping
  34  =   Grouping Char [Int]
  35  deriving (Data, Eq, Ord, Read, Show, Typeable)
  36 instance NFData Grouping where
  37         rnf (Grouping s d) = rnf s `seq` rnf d
  38
  39 type Precision
  40  = Word8
  41
  42 type Spacing
  43  = Bool
  44
  45 data Side
  46  =   Side_Left
  47  |   Side_Right
  48  deriving (Data, Eq, Ord, Read, Show, Typeable)
  49 instance NFData Side where
  50         rnf Side_Left = ()
  51         rnf Side_Right = ()
  52
  53 -- * Constructors
  54
  55 nil :: Style
  56 nil =
  57         Style
  58          { fractioning = Nothing
  59          , grouping_integral = Nothing
  60          , grouping_fractional = Nothing
  61          , precision = 0
  62          , unit_side = Nothing
  63          , unit_spaced = Nothing
  64          }
  65
  66 -- * Operators
  67
  68 union :: Style -> Style -> Style
  69 union
  70  style@Style
  71  { fractioning=fractioning_
  72  , grouping_integral=grouping_integral_
  73  , grouping_fractional=grouping_fractional_
  74  , precision=precision_
  75  , unit_side=side
  76  , unit_spaced=spaced
  77  }
  78  style'@Style
  79  { fractioning=fractioning'
  80  , grouping_integral=grouping_integral_'
  81  , grouping_fractional=grouping_fractional_'
  82  , precision=precision'
  83  , unit_side=side'
  84  , unit_spaced=spaced'
  85  } =
  86         if style == style'
  87         then style'
  88         else
  89                 Style
  90                  { fractioning=maybe fractioning' (const fractioning_) fractioning_
  91                  , grouping_integral=maybe grouping_integral_' (const grouping_integral_) grouping_integral_
  92                  , grouping_fractional=maybe grouping_fractional_' (const grouping_fractional_) grouping_fractional_
  93                  , precision=max precision_ precision'
  94                  , unit_side=maybe side' (const side) side
  95                  , unit_spaced=maybe spaced' (const spaced) spaced
  96                  }