safe-money 0.4 → 0.4.1

raw patch · 5 files changed

+74/−8 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

changelog.md +5/−0
safe-money.cabal +1/−1
src/Money.hs +4/−0
src/Money/Internal.hs +44/−6
test/Main.hs +20/−1

changelog.md view

@@ -1,3 +1,8 @@+# Version 0.4.1++* `ExchangeRate` is now a `Category`.++ # Version 0.4  * BREAKING CHANGE. COMPILER WON'T COMPLAIN. HUMAN INTERVENTION POTENTIALLY

safe-money.cabal view

@@ -1,5 +1,5 @@ name: safe-money-version: 0.4+version: 0.4.1 license: BSD3 license-file: LICENSE copyright: Copyright (c) Renzo Carbonara 2016-2017

src/Money.hs view

@@ -14,6 +14,10 @@ -- a new 'I.Scale' instance, and /voilà/. If you want to add a new currency to the -- out-of-the-box offer, please request so in -- https://github.com/k0001/safe-money/issues and the authors will see to it.+--+-- This module offers plenty of documentation, but for a deep explanation of+-- how all of the pieces fit together, please read+-- https://ren.zone/articles/safe-money module Money  ( -- * Dense monetary values    I.Dense

src/Money/Internal.hs view

@@ -71,6 +71,7 @@  ) where  import Control.Applicative ((<|>), empty)+import Control.Category (Category((.), id)) import Control.Monad ((<=<), guard, when) import Data.Constraint (Dict(Dict)) import Data.Monoid ((<>))@@ -82,7 +83,7 @@ import GHC.TypeLits   (Symbol, SomeSymbol(..), Nat, SomeNat(..), CmpNat, KnownSymbol, KnownNat,    natVal, someNatVal, symbolVal, someSymbolVal)-import Prelude hiding (round, ceiling, floor, truncate)+import Prelude hiding ((.), round, ceiling, floor, truncate) import qualified Prelude import qualified Text.ParserCombinators.ReadPrec as ReadPrec import qualified Text.ParserCombinators.ReadP as ReadP@@ -353,7 +354,7 @@ -- then the following holds: -- -- @--- 'ceiling' x == (y, 'Just' z)+-- 'ceiling' x == (y, z) -- @ -- -- @@@ -361,7 +362,7 @@ -- @ -- -- @--- z < 'zero'+-- z < 0 -- @ -- -- Proof that 'ceiling' doesn't lose money:@@ -391,7 +392,7 @@ -- then the following holds: -- -- @--- 'floor' x == (y, 'Just' z)+-- 'floor' x == (y, z) -- @ -- -- @@@ -399,7 +400,7 @@ -- @ -- -- @--- z > 'zero'+-- z > 0 -- @ -- -- Proof that 'floor' doesn't lose money:@@ -582,6 +583,42 @@ newtype ExchangeRate (src :: Symbol) (dst :: Symbol) = ExchangeRate Rational   deriving (Eq, Ord, GHC.Generic) ++-- | Composition of 'ExchangeRate's multiplies exchange rates together:+--+-- @+-- 'fromExchangeRate' x * 'fromExchangeRate' y  ==  'fromExchangeRate' (x . y)+-- @+--+-- Identity:+--+-- @+-- x  ==  x . id  ==  id . x+-- @+--+-- Associativity:+--+-- @+-- x . y . z  ==  x . (y . z)  ==  (x . y) . z+-- @+--+-- Conmutativity (provided the types allow for composition):+--+-- @+-- x . y  ==  y . x+-- @+--+-- Multiplicative inverse:+--+-- @+-- 1  ==  'fromExchangeRate' (x . 'flipExchangeRate' x)+-- @+instance Category ExchangeRate where+  id = ExchangeRate 1+  {-# INLINE id #-}+  ExchangeRate a . ExchangeRate b = ExchangeRate (a * b)+  {-# INLINE (.) #-}+ instance forall src dst.   ( KnownSymbol src, KnownSymbol dst   ) => Show (ExchangeRate src dst) where@@ -624,7 +661,8 @@  -- | Flip the direction of an 'ExchangeRate'. ----- Identity law:+-- This function retuns the multiplicative inverse of the given 'ExchangeRate',+-- leading to the following identity law: -- -- @ -- 'flipExchangeRate' . 'flipExchangeRate'   ==  'id'

test/Main.hs view

@@ -8,11 +8,13 @@  module Main where +import Control.Category (Category((.), id)) import qualified Data.ByteString.Lazy as BSL import Data.Maybe (catMaybes, isJust, isNothing) import Data.Proxy (Proxy(Proxy)) import Data.Ratio (numerator, denominator) import GHC.TypeLits (Nat, Symbol, KnownSymbol, symbolVal)+import Prelude hiding ((.), id) import qualified Test.Tasty as Tasty import qualified Test.Tasty.Runners as Tasty import Test.Tasty.QuickCheck ((===), (==>), (.&&.))@@ -446,7 +448,24 @@ testExchangeRate ps pd =   Tasty.testGroup ("ExchangeRate " ++ show (symbolVal ps) ++ " "                                    ++ show (symbolVal pd))-  [ QC.testProperty "read . show == id" $+  [ QC.testProperty "Category: left identity" $+      QC.forAll QC.arbitrary $ \(xr :: Money.ExchangeRate src dst) ->+         xr === id . xr+  , QC.testProperty "Category: right identity" $+      QC.forAll QC.arbitrary $ \(xr :: Money.ExchangeRate src dst) ->+         xr === xr . id+  , QC.testProperty "Category: composition with inverse" $+      QC.forAll QC.arbitrary $ \(xr1 :: Money.ExchangeRate src dst) ->+         (1 === Money.fromExchangeRate (xr1 . Money.flipExchangeRate xr1)) .&&.+         (1 === Money.fromExchangeRate (Money.flipExchangeRate xr1 . xr1))+  , QC.testProperty "Category: composition with other" $+      QC.forAll QC.arbitrary $ \(xr1 :: Money.ExchangeRate src dst,+                                 xr2 :: Money.ExchangeRate dst src) ->+         let a = Money.fromExchangeRate xr1 * Money.fromExchangeRate xr2+         in (a === Money.fromExchangeRate (xr1 . xr2)) .&&.+            (a === Money.fromExchangeRate (xr2 . xr1))++  , QC.testProperty "read . show == id" $       QC.forAll QC.arbitrary $ \(xr :: Money.ExchangeRate src dst) ->          xr === read (show xr)   , QC.testProperty "read . show . Just == Just" $