{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Money.Cereal () where
import Control.Applicative (empty)
import Control.Monad (when)
import Data.Ratio ((%), numerator, denominator)
import qualified Data.Serialize as Cereal
import GHC.TypeLits (KnownSymbol)
import qualified Money
import qualified Money.Internal as MoneyI
instance (KnownSymbol currency) => Cereal.Serialize (Money.Dense currency) where
put = Cereal.put . Money.toSomeDense
get = maybe empty pure =<< fmap Money.fromSomeDense Cereal.get
instance
( KnownSymbol currency, Money.GoodScale scale
) => Cereal.Serialize (Money.Discrete' currency scale) where
put = Cereal.put . Money.toSomeDiscrete
get = maybe empty pure =<< fmap Money.fromSomeDiscrete Cereal.get
instance
( KnownSymbol src, KnownSymbol dst
) => Cereal.Serialize (Money.ExchangeRate src dst) where
put = Cereal.put . Money.toSomeExchangeRate
get = maybe empty pure =<< fmap Money.fromSomeExchangeRate Cereal.get
instance Cereal.Serialize Money.SomeDense where
put = \sd -> do
Cereal.put (MoneyI.someDenseCurrency' sd)
let r = Money.someDenseAmount sd
Cereal.put (numerator r)
Cereal.put (denominator r)
get = maybe empty pure =<< do
c :: String <- Cereal.get
n :: Integer <- Cereal.get
d :: Integer <- Cereal.get
when (d == 0) (fail "denominator is zero")
pure (MoneyI.mkSomeDense' c (n % d))
instance Cereal.Serialize Money.SomeDiscrete where
put = \sd -> do
Cereal.put (MoneyI.someDiscreteCurrency' sd)
let r = Money.someDiscreteScale sd
Cereal.put (numerator r)
Cereal.put (denominator r)
Cereal.put (Money.someDiscreteAmount sd)
get = maybe empty pure =<< do
c :: String <- Cereal.get
n :: Integer <- Cereal.get
d :: Integer <- Cereal.get
when (d == 0) (fail "denominator is zero")
a :: Integer <- Cereal.get
pure (MoneyI.mkSomeDiscrete' c (n % d) a)
instance Cereal.Serialize Money.SomeExchangeRate where
put = \ser -> do
Cereal.put (MoneyI.someExchangeRateSrcCurrency' ser)
Cereal.put (MoneyI.someExchangeRateDstCurrency' ser)
let r = Money.someExchangeRateRate ser
Cereal.put (numerator r)
Cereal.put (denominator r)
get = maybe empty pure =<< do
src :: String <- Cereal.get
dst :: String <- Cereal.get
n :: Integer <- Cereal.get
d :: Integer <- Cereal.get
when (d == 0) (fail "denominator is zero")
pure (MoneyI.mkSomeExchangeRate' src dst (n % d))