]> Git — Sourcephile - comptalang.git/blob - lib/Hcompta/Filter/Amount.hs
Correction : rétro support de GHC 7.6.3 (Debian/jessie).
[comptalang.git] / lib / Hcompta / Filter / Amount.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE FlexibleContexts #-}
3 {-# LANGUAGE FlexibleInstances #-}
4 {-# LANGUAGE StandaloneDeriving #-}
5 {-# LANGUAGE TypeFamilies #-}
6 {-# OPTIONS_GHC -fno-warn-orphans #-}
7 module Hcompta.Filter.Amount where
8 import Data.Data
9 import Data.Decimal (Decimal, DecimalRaw(..), roundTo)
10 import Data.Eq (Eq(..))
11 import Data.Maybe (Maybe(..))
12 import Data.Ord (Ord(..))
13 import Data.Text (Text)
14 import qualified Data.Text as Text
15 import Data.Typeable ()
16 import Data.Word (Word8)
17 import Prelude ((.), Integral, Num(..), fromIntegral)
18 import Text.Show (Show(..))
19
20 import Hcompta.Quantity
21 import qualified Hcompta.Filter as Filter
22 import Hcompta.Polarize
23 import qualified Hcompta.Unit as Unit
24
25 -- * Type 'Quantity'
26 type Quantity = Decimal
27 deriving instance Data Quantity
28
29 -- | Round the two 'DecimalRaw' values to the smallest exponent.
30 round_min :: Integral i => DecimalRaw i -> DecimalRaw i -> (Word8, i, i)
31 round_min d1@(Decimal e1 _) d2@(Decimal e2 _) = (e, n1, n2)
32 where
33 e = min e1 e2
34 Decimal _ n1 = roundTo e d1
35 Decimal _ n2 = roundTo e d2
36
37 instance Zero Quantity where
38 quantity_zero = 0
39 quantity_null = (==) 0
40 instance Addable Quantity where
41 quantity_add d1 d2 =
42 Decimal e (fromIntegral (n1 + n2))
43 where (e, n1, n2) = round_min d1 d2
44 instance Negable Quantity where
45 quantity_neg = negate
46 instance Polarizable Quantity where
47 polarizable_negative q =
48 case q of
49 _ | q < 0 -> Just q
50 _ -> Nothing
51 polarizable_positive q =
52 case q of
53 _ | q <= 0 -> Nothing
54 _ -> Just q
55
56 -- * Type 'Unit'
57 newtype Unit
58 = Unit Text
59 deriving (Data, Eq, Ord, Show, Typeable)
60
61 instance Unit.Unit Unit where
62 unit_empty = Unit (Text.pack "")
63 unit_text (Unit t) = t
64
65 -- * Type 'Amount'
66 data Amount
67 = Amount
68 { amount_unit :: Unit
69 , amount_quantity :: Quantity
70 } deriving (Data, Eq, Show, Typeable)
71 instance Filter.Amount Amount where
72 type Amount_Unit Amount = Unit
73 type Amount_Quantity Amount = Quantity
74 amount_quantity = polarize . amount_quantity
75 amount_unit = amount_unit