]> Git — Sourcephile - comptalang.git/blob - lib/Hcompta/Amount/Style.hs
Correction : compatiblité avec GHC-7.6 en limitant l’usage de Prelude.
[comptalang.git] / 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 }