lib/Hcompta/Amount/Style.hs

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