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  -- TODO: , sign_plus           :: Maybe Bool
  17  , unit_side           :: Maybe Side
  18  , unit_spaced         :: Maybe Spacing
  19  } deriving (Data, Eq, Ord, Read, Show, Typeable)
  20
  21 type Fractioning
  22  = Char
  23
  24 data Grouping
  25  =   Grouping Char [Int]
  26  deriving (Data, Eq, Ord, Read, Show, Typeable)
  27
  28 type Precision
  29  = Word8
  30
  31 type Spacing
  32  = Bool
  33
  34 data Side
  35  =   Side_Left
  36  |   Side_Right
  37  deriving (Data, Eq, Ord, Read, Show, Typeable)
  38
  39 -- * Constructors
  40
  41 nil :: Style
  42 nil =
  43         Style
  44          { fractioning = Nothing
  45          , grouping_integral = Nothing
  46          , grouping_fractional = Nothing
  47          , precision = 0
  48          , unit_side = Nothing
  49          , unit_spaced = Nothing
  50          }
  51
  52 -- * Operators
  53
  54 union :: Style -> Style -> Style
  55 union
  56  style@Style
  57  { fractioning=fractioning_
  58  , grouping_integral=grouping_integral_
  59  , grouping_fractional=grouping_fractional_
  60  , precision=precision_
  61  , unit_side=side
  62  , unit_spaced=spaced
  63  }
  64  style'@Style
  65  { fractioning=fractioning'
  66  , grouping_integral=grouping_integral_'
  67  , grouping_fractional=grouping_fractional_'
  68  , precision=precision'
  69  , unit_side=side'
  70  , unit_spaced=spaced'
  71  } =
  72         if style == style'
  73         then style'
  74         else
  75                 Style
  76                  { fractioning=maybe fractioning' (const fractioning_) fractioning_
  77                  , grouping_integral=maybe grouping_integral_' (const grouping_integral_) grouping_integral_
  78                  , grouping_fractional=maybe grouping_fractional_' (const grouping_fractional_) grouping_fractional_
  79                  , precision=max precision_ precision'
  80                  , unit_side=maybe side' (const side) side
  81                  , unit_spaced=maybe spaced' (const spaced) spaced
  82                  }