]> Git — Sourcephile - comptalang.git/blob - lib/Hcompta/Model/Amount/Style.hs
WIP : Format.Ledger.Read : Model.Transaction.Posting
[comptalang.git] / 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 }