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 Control.Monad.Trans.Reader as MT
   8 import Data.Data (Data)
   9 import Data.Ratio (Rational)
  10 import GHC.Real (FractionalExponentBase (Base10), Ratio ((:%)), (%))
  11 import GHC.TypeLits (KnownNat, Nat, Symbol, natVal, type (<=))
  12 import Literate.Accounting.Quantity
  13 import Literate.Accounting.Unit
  14 import Literate.Prelude
  15 import Text.Read (Read)
  16 import Text.Show (Show (..), ShowS, showParen, showString, showsPrec)
  17
  18 newtype Amount (qf :: Nat) (unit :: Unit) = Amount
  19   { amountQuantity :: Quantity qf
  20   }
  21   deriving (Show, Read, Eq, Ord, Data, Typeable, Generic)
  22 instance QuantFact qf => FromInteger (MT.Except ErrorQuantity (Amount qf unit)) where
  23   fromInteger i = fromRational (i :% 1)
  24 instance QuantFact qf => FromInteger (Amount qf unit) where
  25   fromInteger = fromInteger >>> Amount
  26 instance Addable (Amount qf unit) where
  27   Amount x + Amount y = Amount (x + y)
  28 sumAmounts :: forall qf unit f. Functor f => Foldable f => f (Amount qf unit) -> Maybe (Amount qf unit)
  29 sumAmounts l = l <&> amountQuantity & sumQuantities <&> Amount
  30 instance QuantFact qf => FromRational (MT.Except ErrorQuantity (Amount qf unit)) where
  31   fromRational r = Amount <$> fromRational r
  32 instance QuantFact qf => FromRational (Amount qf unit) where
  33   fromRational = Amount . fromRational
  34
  35 -- instance QuantFact qf => FromRational (Amount qf unit) where
  36 --   fromRational = either (throw @_ @_ @ErrorQuantity) id . MT.runExcept . fromRational
  37
  38 {-
  39 sum :: forall f. Foldable f => f Amount -> Maybe Amount
  40 sum l =
  41   let maxBoundI :: Integer
  42       maxBoundI = fromIntegral (maxBound :: Word64)
  43       r :: Integer
  44       r = foldl' (\acc a -> (toInteger :: Word64 -> Integer) (amountQuantity a) + acc) 0 l
  45    in if r > maxBoundI
  46         then Nothing
  47         else Just (Amount ((fromInteger :: Integer -> Word64) r))
  48 -}