lib/Hcompta/Quantity.hs

   1 module Hcompta.Quantity where
   2
   3 import           Data.Bool
   4 import           Data.Data (Data)
   5 import           Data.Eq (Eq(..))
   6 import           Data.Foldable (all)
   7 import           Data.Map.Strict (Map)
   8 import qualified Data.Map.Strict as Map
   9 import           Data.Ord (Ord(..), Ordering(..))
  10 import           Prelude (Integer, Num(..))
  11 import           Text.Show (Show)
  12
  13 -- * Class 'Zero'
  14 class
  15  ( Data a
  16  , Show a
  17  ) => Zero a where
  18         quantity_zero :: a
  19         quantity_null :: a -> Bool
  20 instance
  21  ( Data unit
  22  , Show q
  23  , Show unit
  24  , Ord  unit
  25  , Zero q
  26  ) => Zero (Map unit q) where
  27         quantity_zero = Map.empty
  28         quantity_null = all quantity_null
  29 instance Zero Integer where
  30         quantity_zero = 0
  31         quantity_null = (==) 0
  32
  33 quantity_sign :: (Zero q, Ord q) => q -> Ordering
  34 quantity_sign q =
  35         case q of
  36          _ | quantity_null q -> EQ
  37          _ | q < quantity_zero -> LT
  38          _ -> GT
  39
  40 -- * Class 'Addable'
  41 class
  42  ( Data a
  43  , Show a
  44  ) =>
  45  Addable a where
  46         quantity_add :: a -> a -> a
  47 instance Addable Integer where
  48         quantity_add = (+)
  49 instance
  50  ( Addable quantity
  51  , Data unit
  52  , Ord  unit
  53  , Show unit
  54  ) => Addable (Map unit quantity) where
  55         quantity_add = Map.unionWith quantity_add
  56
  57 -- * Class 'Negable'
  58 class
  59  ( Data a
  60  , Show a
  61  ) =>
  62  Negable a where
  63         quantity_neg  :: a -> a
  64 instance Negable Integer where
  65         quantity_neg = negate
  66 instance
  67  ( Negable quantity
  68  , Data    unit
  69  , Ord     unit
  70  , Show    unit
  71  ) => Negable (Map unit quantity) where
  72         quantity_neg = Map.map quantity_neg
  73
  74 -- * Class 'Subable'
  75 class
  76  ( Data a
  77  , Show a
  78  ) =>
  79  Subable a where
  80         quantity_sub :: a -> a -> a
  81 instance Subable Integer where
  82         quantity_sub = (-)
  83 instance
  84  ( Subable quantity
  85  , Data    unit
  86  , Ord     unit
  87  , Show    unit
  88  ) => Subable (Map unit quantity) where
  89         quantity_sub = Map.unionWith quantity_sub