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