1 {-# LANGUAGE DefaultSignatures #-}
2 module Literate.Accounting.Math where
5 import Data.Function ((.), flip)
6 import Data.Decimal (Decimal, DecimalRaw(..), roundTo)
7 import Data.Eq (Eq(..))
8 import Data.Map.Strict (Map)
9 import Data.Maybe (Maybe(..))
10 import Data.Functor ((<$>))
11 import Data.Monoid (Endo(..))
12 import Data.String (String)
13 import Data.Ord (Ord(..), Ordering(..))
14 import Data.Word (Word8)
16 import Prelude (Integral, Integer, fromIntegral)
17 import qualified Data.Map.Strict as Map
18 import qualified Prelude
20 import Literate.Accounting.Rebindable
23 class Zeroable a where
25 instance Zeroable String where
27 instance Zeroable Decimal where
29 instance Zeroable (Map.Map k a) where
33 instance Zeroable Decimal where
35 instance Zeroable (Map k a) where
40 class Nullable a where
42 default null :: Zeroable a => Eq a => a -> Bool
44 instance Nullable String
45 instance Nullable Decimal
48 instance Nullable Decimal where
50 instance Nullable a => Nullable (Map k a) where
51 null = Foldable.all null
55 class Signable a where
57 default sign :: Zeroable a => Nullable a => Ord a => a -> Ordering
63 --instance Signable Decimal
67 (+) :: a -> a -> a; infixl 6 +
68 default (+) :: Prelude.Num a => a -> a -> a
70 -- | For @'Addable' ('Map' k ())@.
71 instance Addable () where
73 instance (Ord k, Addable a) => Addable (Map k a) where
74 (+) = Map.unionWith (flip (+))
75 instance Addable a => Addable (Maybe a) where
76 Nothing + Nothing = Nothing
77 Just x + Nothing = Just x
78 Nothing + Just y = Just y
79 Just x + Just y = Just (x + y)
80 instance Addable Decimal where
81 (+) x y = Decimal e (fromIntegral (nx Prelude.+ ny))
82 where (e, nx, ny) = roundMinDecimal x y
83 -- | Round the two 'DecimalRaw' values to the smallest exponent.
84 roundMinDecimal :: Integral i => DecimalRaw i -> DecimalRaw i -> (Word8, i, i)
85 roundMinDecimal d1@(Decimal e1 _) d2@(Decimal e2 _) = (e, n1, n2)
88 Decimal _ n1 = roundTo e d1
89 Decimal _ n2 = roundTo e d2
94 default negate :: Prelude.Num a => a -> a
95 negate = Prelude.negate
96 -- | For @'Negable' ('Map' k ())@.
97 instance Negable () where
100 instance Negable Integer
101 instance Negable Decimal
102 instance Negable a => Negable (Map k a) where
103 negate = Map.map negate
104 instance Negable a => Negable (Endo a) where
105 negate (Endo f) = Endo (f . negate)
106 instance Negable a => Negable [a] where
107 negate = (negate <$>)
110 class Subable a where
111 (-) :: a -> a -> a; infixl 6 -
112 default (-) :: Prelude.Num a => a -> a -> a
114 -- | For @'Subable' ('Map' k ())@.
115 instance Subable () where
118 instance Subable Integer
119 instance Subable Decimal
120 instance (Ord k, Addable a, Negable a) => Subable (Map k a) where
121 (-) x y = Map.unionWith (flip (+)) x (negate y)