lib/Hcompta/Amount.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE FlexibleInstances #-}
   4 {-# LANGUAGE StandaloneDeriving #-}
   5 {-# LANGUAGE TupleSections #-}
   6 {-# LANGUAGE TypeFamilies #-}
   7 {-# OPTIONS_GHC -fno-warn-orphans #-}
   8 module Hcompta.Amount where
   9
  10 import           Data.Data (Data)
  11 import           Data.Eq (Eq(..))
  12 import           Data.Functor (Functor(..))
  13 import           Data.Ord (Ord(..), Ordering)
  14 import           Data.Tuple (fst, snd)
  15 import           Prelude (($), (.))
  16
  17 import           Hcompta.Polarize
  18 import           Hcompta.Quantity
  19 import           Hcompta.Unit (Unit(..))
  20
  21 -- * Class 'Amount'
  22
  23 class
  24  ( Data a
  25  , Eq   (Amount_Quantity a)
  26  , Zero (Amount_Quantity a)
  27  , Unit (Amount_Unit     a)
  28  ) =>  Amount          a where
  29         type Amount_Quantity a
  30         type Amount_Unit     a
  31         amount_quantity :: a -> Amount_Quantity a
  32         amount_unit     :: a -> Amount_Unit     a
  33 instance
  34  ( Zero quantity
  35  , Eq   quantity
  36  , Unit unit
  37  ) => Amount (unit, quantity) where
  38         type Amount_Quantity (unit, quantity) = quantity
  39         type Amount_Unit     (unit, quantity) = unit
  40         amount_quantity = snd
  41         amount_unit     = fst
  42 instance
  43  ( Polarizable quantity
  44  ) => Polarizable (unit, quantity) where
  45         polarizable_positive (u, q) = fmap (u,) $ polarizable_positive q
  46         polarizable_negative (u, q) = fmap (u,) $ polarizable_negative q
  47
  48 amount_sign ::
  49  ( Amount a
  50  , Ord (Amount_Quantity a)
  51  ) => a -> Ordering
  52 amount_sign =
  53         quantity_sign . amount_quantity