Correction : LambdaCase n’est pas dans ghc-7.4 (Debian/wheezy)

[comptalang.git] / lib / Hcompta / Model / Amount / Style.hs

diff --git a/lib/Hcompta/Model/Amount/Style.hs b/lib/Hcompta/Model/Amount/Style.hs
index 31005a06f2455f74c04ee9db6f6d0ec7fb3338f1..52e5998d1830b56aee665c85fe49ecfa2a8c6d3f 100644 (file)
--- a/lib/Hcompta/Model/Amount/Style.hs
+++ b/lib/Hcompta/Model/Amount/Style.hs
@@ -2,22 +2,81 @@
 module Hcompta.Model.Amount.Style where
 
 import Data.Data
+import Data.Word (Word8)
 import Data.Typeable ()
 
-data T
- = T
- { commodity_side :: Maybe Side
- , commodity_spaced :: Maybe Bool
- , precision :: Int
- , decimal_point :: Maybe Char
- , digit_group :: Maybe DigitGroup
+-- * The 'Style' type
+
+data Style
+ =   Style
+ { fractioning         :: Maybe Fractioning
+ , grouping_integral   :: Maybe Grouping
+ , grouping_fractional :: Maybe Grouping
+ , precision           :: Precision
+ -- TODO: , sign_plus           :: Maybe Bool
+ , unit_side           :: Maybe Side
+ , unit_spaced         :: Maybe Spacing
  } deriving (Data, Eq, Ord, Read, Show, Typeable)
 
-data Side
- = L
- | R
+type Fractioning
+ = Char
+
+data Grouping
+ =   Grouping Char [Int]
  deriving (Data, Eq, Ord, Read, Show, Typeable)
 
-data DigitGroup
- = DigitGroup Char [Int]
+type Precision
+ = Word8
+
+type Spacing
+ = Bool
+
+data Side
+ =   Side_Left
+ |   Side_Right
  deriving (Data, Eq, Ord, Read, Show, Typeable)
+
+-- * Constructors
+
+nil :: Style
+nil =
+       Style
+        { fractioning = Nothing
+        , grouping_integral = Nothing
+        , grouping_fractional = Nothing
+        , precision = 0
+        , unit_side = Nothing
+        , unit_spaced = Nothing
+        }
+
+-- * Operators
+
+union :: Style -> Style -> Style
+union
+ style@Style
+ { fractioning=fractioning_
+ , grouping_integral=grouping_integral_
+ , grouping_fractional=grouping_fractional_
+ , precision=precision_
+ , unit_side=side
+ , unit_spaced=spaced
+ }
+ style'@Style
+ { fractioning=fractioning'
+ , grouping_integral=grouping_integral_'
+ , grouping_fractional=grouping_fractional_'
+ , precision=precision'
+ , unit_side=side'
+ , unit_spaced=spaced'
+ } =
+       if style == style'
+       then style'
+       else
+               Style
+                { fractioning=maybe fractioning' (const fractioning_) fractioning_
+                , grouping_integral=maybe grouping_integral_' (const grouping_integral_) grouping_integral_
+                , grouping_fractional=maybe grouping_fractional_' (const grouping_fractional_) grouping_fractional_
+                , precision=max precision_ precision'
+                , unit_side=maybe side' (const side) side
+                , unit_spaced=maybe spaced' (const spaced) spaced
+                }