]> Git — Sourcephile - comptalang.git/blob - lib/Hcompta/Model/Amount/Style.hs
Ajout : Hcompta.Format.Text : couleurs ANSI.
[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 -- 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 }