lib/Hcompta/Amount.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE TypeFamilies #-}
   4 module Hcompta.Amount where
   5
   6 import Data.Data (Data)
   7 import Data.Function ((.))
   8 import Data.Map.Strict (Map)
   9 import qualified Data.MonoTraversable as MT
  10 import Data.Ord (Ord(..), Ordering)
  11 import Data.Tuple (fst, snd)
  12 import Data.Proxy (Proxy(..))
  13
  14 import Hcompta.Quantity
  15 import Hcompta.Unit (Unit(..))
  16 import Hcompta.Has
  17
  18 class
  19  ( HasI Quantity a
  20  , HasI Unit a
  21  ) => Amount a
  22
  23 _Amount :: Proxy Amount
  24 _Amount = Proxy
  25
  26 class Amount (MT.Element as) => Amounts as
  27
  28 _Amounts :: Proxy Amounts
  29 _Amounts = Proxy
  30
  31 {-
  32 -- * Class 'Amount'
  33 class
  34  ( Data a
  35  -- , Eq   (Amount_Quantity a)
  36  , Zero (Amount_Quantity a)
  37  , Unit (Amount_Unit     a)
  38  ) =>  Amount          a where
  39         type Amount_Quantity a
  40         type Amount_Unit     a
  41         amount_quantity :: a -> Amount_Quantity a
  42         amount_unit     :: a -> Amount_Unit     a
  43 instance -- (unit, qty)
  44  ( Zero qty
  45  , Unit unit
  46  ) => Amount (unit, qty) where
  47         type Amount_Quantity (unit, qty) = qty
  48         type Amount_Unit     (unit, qty) = unit
  49         amount_quantity = snd
  50         amount_unit     = fst
  51 amount_sign ::
  52  ( Amount a
  53  , Ord (Amount_Quantity a)
  54  ) => a -> Ordering
  55 amount_sign = quantity_sign . amount_quantity
  56
  57 -- * Class 'Amounts'
  58 class Amount (Amounts_Amount amts) => Amounts amts where
  59         type Amounts_Amount amts
  60 instance
  61  ( Zero qty
  62  , Unit unit
  63  ) => Amounts (Map unit qty) where
  64         type Amounts_Amount (Map unit qty) = (unit, qty)
  65 -}