jcc/Hcompta/Format/JCC/Amount.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE FlexibleInstances #-}
   4 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
   5 {-# LANGUAGE OverloadedStrings #-}
   6 {-# LANGUAGE StandaloneDeriving #-}
   7 {-# LANGUAGE TypeFamilies #-}
   8 {-# OPTIONS_GHC -fno-warn-orphans #-}
   9 module Hcompta.Format.JCC.Amount where
  10
  11 import           Control.DeepSeq
  12 import           Data.Bool
  13 import           Data.Data
  14 import           Data.Eq (Eq(..))
  15 -- import qualified Data.Foldable
  16 -- import qualified Data.List
  17 -- import           Data.Map.Strict (Map)
  18 import           Data.Ord (Ord(..), Ordering(..))
  19 -- import           Data.String (IsString)
  20 -- import           Data.Text (Text)
  21 -- import qualified Data.Text as Text
  22 import           Data.Typeable ()
  23 import           Prelude ((.), seq)
  24 -- import           Prelude (($), (.), Bounded(..), Int, Num(..), flip, seq, error)
  25 import           Text.Show (Show(..))
  26
  27 import qualified Hcompta.Amount as Amount
  28 import qualified Hcompta.Filter as Filter
  29 import qualified Hcompta.Polarize as Polarize
  30 import qualified Hcompta.Quantity as Quantity
  31 import qualified Hcompta.Unit as Unit
  32 import qualified Hcompta.Format.JCC.Amount.Style as Style
  33 import           Hcompta.Format.JCC.Quantity (Quantity)
  34 import           Hcompta.Format.JCC.Unit (Unit(..))
  35
  36 -- * Type 'Style'
  37
  38 type Style    = Style.Style
  39 type Styles   = Style.Styles
  40 type Styled t = Style.Styled t
  41
  42 -- * Type 'Amount'
  43
  44 data Amount
  45  =   Amount
  46  { amount_unit     :: !Unit
  47  , amount_quantity :: !Quantity
  48  } deriving (Data, Show, Typeable)
  49 instance Amount.Amount Amount where
  50         type Amount_Quantity Amount = Quantity
  51         type Amount_Unit     Amount = Unit
  52         amount_quantity = amount_quantity
  53         amount_unit     = amount_unit
  54 instance Filter.Amount Amount where
  55         type Amount_Quantity Amount = Quantity
  56         type Amount_Unit     Amount = Unit
  57         amount_quantity = Polarize.polarize . amount_quantity
  58         amount_unit     = amount_unit
  59 instance NFData Amount where
  60         rnf (Amount q u) = rnf q `seq` rnf u
  61 instance Quantity.Zero Amount where
  62         quantity_zero = Amount Unit.unit_empty Quantity.quantity_zero
  63         quantity_null = (==) Quantity.quantity_zero . amount_quantity
  64
  65 amount_style :: Styles -> Amount -> Style
  66 amount_style styles = Style.style styles . amount_unit
  67
  68 style :: Styles -> Amount -> Styled Amount
  69 style styles amt = (amount_style styles amt, amt)
  70
  71 sign :: Amount -> Ordering
  72 sign a =
  73         case amount_quantity a of
  74          0         -> EQ
  75          q | q < 0 -> LT
  76          _         -> GT
  77
  78 -- ** Constructors
  79
  80 amount :: Amount
  81 amount =
  82         Amount
  83          { amount_quantity = Quantity.quantity_zero
  84          , amount_unit     = ""
  85          }
  86
  87 -- ** Tests
  88
  89 -- | Return 'True' if and only if 'Amount'’s 'Quantity' is zero.
  90 --
  91 --  NOTE: the 'Amount'’s 'amount_quantity' MUST have been rounded
  92 --        at 'Amount'’s 'amount_style'’s 'Style.precision'.
  93 null :: Amount -> Bool
  94 null = Quantity.quantity_null . amount_quantity