src/Literate/Accounting/Amount.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE UndecidableInstances #-}
   3
   4 module Literate.Accounting.Amount where
   5
   6 import Control.Monad.Trans.Except as MT
   7 import GHC.Real (Ratio ((:%)))
   8 import GHC.TypeLits (Nat)
   9 import Literate.Accounting.Quantity
  10 import Literate.Accounting.Unit
  11 import Literate.Prelude
  12 import Text.Read (Read)
  13
  14 newtype Amount (qf :: Nat) (unit :: Unit) = Amount
  15   { amountQuantity :: Quantity qf
  16   }
  17   deriving (Show, Read, Eq, Ord, Generic, NFData)
  18 instance QuantFact qf => FromInteger (MT.Except ErrorQuantity (Amount qf unit)) where
  19   fromInteger i = fromRational (i :% 1)
  20 instance QuantFact qf => FromInteger (Amount qf unit) where
  21   fromInteger = fromInteger >>> Amount
  22 instance Addable (Amount qf unit) where
  23   Amount x + Amount y = Amount (x + y)
  24 sumAmounts :: forall qf unit f. Functor f => Foldable f => f (Amount qf unit) -> Maybe (Amount qf unit)
  25 sumAmounts l = l <&> amountQuantity & sumQuantities <&> Amount
  26 instance QuantFact qf => FromRational (MT.Except ErrorQuantity (Amount qf unit)) where
  27   fromRational r = Amount <$> fromRational r
  28 instance QuantFact qf => FromRational (Amount qf unit) where
  29   fromRational = Amount . fromRational
  30
  31 -- instance QuantFact qf => FromRational (Amount qf unit) where
  32 --   fromRational = either (throw @_ @_ @ErrorQuantity) id . MT.runExcept . fromRational
  33
  34 {-
  35 sum :: forall f. Foldable f => f Amount -> Maybe Amount
  36 sum l =
  37   let maxBoundI :: Integer
  38       maxBoundI = fromIntegral (maxBound :: Word64)
  39       r :: Integer
  40       r = foldl' (\acc a -> (toInteger :: Word64 -> Integer) (amountQuantity a) + acc) 0 l
  41    in if r > maxBoundI
  42         then Nothing
  43         else Just (Amount ((fromInteger :: Integer -> Word64) r))
  44 -}