lib/Hcompta/Model/Amount/Style.hs

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