#if MIN_VERSION_base(4,9,0)
#endif
module Data.Money.Internal
(
Dense
, dense
, Discrete
, Discrete'
, fromDiscrete
, round
, ceiling
, floor
, truncate
, Scale
, GoodScale
, ErrScaleNonCanonical
, scale
, ExchangeRate
, exchangeRate
, fromExchangeRate
, flipExchangeRate
, exchange
, DenseRep
, denseRep
, denseRepCurrency
, denseRepAmount
, denseRepAmountNumerator
, denseRepAmountDenominator
, mkDenseRep
, fromDenseRep
, withDenseRep
, DiscreteRep
, discreteRep
, discreteRepCurrency
, discreteRepScale
, discreteRepScaleNumerator
, discreteRepScaleDenominator
, discreteRepAmount
, mkDiscreteRep
, fromDiscreteRep
, withDiscreteRep
, ExchangeRateRep
, exchangeRateRep
, exchangeRateRepSrcCurrency
, exchangeRateRepDstCurrency
, exchangeRateRepRate
, exchangeRateRepRateNumerator
, exchangeRateRepRateDenominator
, mkExchangeRateRep
, fromExchangeRateRep
, withExchangeRateRep
) where
import Control.Applicative (empty)
import Control.Monad ((<=<))
import Data.Constraint (Dict(Dict))
import Data.Proxy (Proxy(..))
import Data.Ratio ((%), numerator, denominator)
import qualified GHC.Generics as GHC
import GHC.Real (infinity, notANumber)
import GHC.TypeLits
(Symbol, SomeSymbol(..), Nat, SomeNat(..), CmpNat, KnownSymbol, KnownNat,
natVal, someNatVal, symbolVal, someSymbolVal)
import Prelude hiding (round, ceiling, floor, truncate)
import qualified Prelude
import qualified Text.ParserCombinators.ReadPrec as ReadPrec
import qualified Text.ParserCombinators.ReadP as ReadP
import Text.Read (readPrec)
import Unsafe.Coerce (unsafeCoerce)
#ifdef VERSION_aeson
import qualified Data.Aeson as Ae
#endif
#ifdef VERSION_binary
import qualified Data.Binary as Binary
#endif
#ifdef VERSION_cereal
import qualified Data.Serialize as Cereal
#endif
#ifdef VERSION_deepseq
import Control.DeepSeq (NFData)
#endif
#ifdef VERSION_hashable
import Data.Hashable (Hashable)
#endif
#ifdef VERSION_store
import qualified Data.Store as Store
#endif
#if MIN_VERSION_base(4,9,0)
import qualified GHC.TypeLits as GHC
#endif
newtype Dense (currency :: Symbol) = Dense Rational
deriving (Eq, Ord, Num, Real, Fractional, GHC.Generic)
instance forall currency. KnownSymbol currency => Show (Dense currency) where
show = \(Dense r0) ->
let c = symbolVal (Proxy :: Proxy currency)
in concat [ "Dense ", show c, " (", show r0, ")" ]
instance forall currency. KnownSymbol currency => Read (Dense currency) where
readPrec = do
let c = symbolVal (Proxy :: Proxy currency)
_ <- ReadPrec.lift (ReadP.string ("Dense " ++ show c ++ " "))
maybe empty pure =<< fmap dense readPrec
dense :: Rational -> Maybe (Dense currency)
dense = \r0 ->
if (infinity == r0 || notANumber == r0)
then Nothing else Just (Dense r0)
type Discrete (currency :: Symbol) (unit :: Symbol)
= Discrete' currency (Scale currency unit)
newtype Discrete' (currency :: Symbol) (scale :: (Nat, Nat))
= Discrete Integer
deriving instance GoodScale scale => Eq (Discrete' currency scale)
deriving instance GoodScale scale => Ord (Discrete' currency scale)
deriving instance GoodScale scale => Enum (Discrete' currency scale)
deriving instance GoodScale scale => Num (Discrete' currency scale)
deriving instance GoodScale scale => Real (Discrete' currency scale)
deriving instance GoodScale scale => Integral (Discrete' currency scale)
deriving instance GoodScale scale => GHC.Generic (Discrete' currency scale)
instance forall currency scale.
( KnownSymbol currency, GoodScale scale
) => Show (Discrete' currency scale) where
show = \d0@(Discrete i0) ->
let c = symbolVal (Proxy :: Proxy currency)
in concat [ "Discrete ", show c, " (", show (scale d0), ") ", show i0 ]
instance forall currency scale.
( KnownSymbol currency, GoodScale scale
) => Read (Discrete' currency scale) where
readPrec = do
let c = symbolVal (Proxy :: Proxy currency)
s = scale (Proxy :: Proxy scale)
_ <- ReadPrec.lift (ReadP.string
("Discrete " ++ show c ++ " (" ++ show s ++ ") ") )
Discrete <$> readPrec
#if MIN_VERSION_base(4,9,0)
instance
( GHC.TypeError
(('GHC.Text "The ") 'GHC.:<>:
('GHC.ShowType Discrete') 'GHC.:<>:
('GHC.Text " type is deliberately not a ") 'GHC.:<>:
('GHC.ShowType Fractional) 'GHC.:$$:
('GHC.Text "instance. Convert the ") 'GHC.:<>:
('GHC.ShowType Discrete') 'GHC.:<>:
('GHC.Text " value to a ") 'GHC.:<>:
('GHC.ShowType Dense) 'GHC.:$$:
('GHC.Text "value and use the ") 'GHC.:<>:
('GHC.ShowType Fractional) 'GHC.:<>:
('GHC.Text " features on it instead."))
, GoodScale scale
) => Fractional (Discrete' currency scale) where
fromRational = undefined
recip = undefined
#endif
fromDiscrete
:: GoodScale scale
=> Discrete' currency scale
-> Dense currency
fromDiscrete = \c@(Discrete i) -> Dense (fromInteger i / scale c)
roundf
:: forall currency scale
. GoodScale scale
=> (Rational -> Integer)
-> Dense currency
-> (Discrete' currency scale, Maybe (Dense currency))
roundf f = \c0 ->
let !r0 = toRational c0 :: Rational
!r1 = scale (Proxy :: Proxy scale)
!i2 = f (r0 * r1) :: Integer
!r2 = fromInteger i2 / r1 :: Rational
!ycrest | r0 == r2 = Nothing
| otherwise = Just (Dense (r0 r2))
!d2 = Discrete i2
in (d2, ycrest)
round
:: GoodScale scale
=> Dense currency
-> (Discrete' currency scale, Maybe (Dense currency))
round = roundf Prelude.round
ceiling
:: GoodScale scale
=> Dense currency
-> (Discrete' currency scale, Maybe (Dense currency))
ceiling = roundf Prelude.ceiling
floor
:: GoodScale scale
=> Dense currency
-> (Discrete' currency scale, Maybe (Dense currency))
floor = roundf Prelude.floor
truncate
:: GoodScale scale
=> Dense currency
-> (Discrete' currency scale, Maybe (Dense currency))
truncate = roundf Prelude.truncate
type family Scale (currency :: Symbol) (unit :: Symbol) :: (Nat, Nat)
#if MIN_VERSION_base(4,9,0)
type family ErrScaleNonCanonical (currency :: Symbol) :: k where
ErrScaleNonCanonical c = GHC.TypeError
( 'GHC.Text c 'GHC.:<>:
'GHC.Text " is not a currency with a canonical smallest unit," 'GHC.:$$:
'GHC.Text "be explicit about the currency unit you want to use." )
#else
type ErrScaleNonCanonical (currency :: Symbol) = '(0, 0)
#endif
type GoodScale (scale :: (Nat, Nat))
= ( CmpNat 0 (Fst scale) ~ 'LT
, CmpNat 0 (Snd scale) ~ 'LT
, KnownNat (Fst scale)
, KnownNat (Snd scale)
)
mkGoodScale
:: forall num den
. (KnownNat num, KnownNat den)
=> Maybe (Dict (GoodScale '(num, den)))
mkGoodScale =
let n = natVal (Proxy :: Proxy num)
d = natVal (Proxy :: Proxy den)
in if (n > 0) && (d > 0)
then Just (unsafeCoerce (Dict :: Dict ('LT ~ 'LT, 'LT ~ 'LT,
KnownNat num, KnownNat den)))
else Nothing
scale :: forall proxy scale. GoodScale scale => proxy scale -> Rational
scale = \_ ->
natVal (Proxy :: Proxy (Fst scale)) %
natVal (Proxy :: Proxy (Snd scale))
newtype ExchangeRate (src :: Symbol) (dst :: Symbol) = ExchangeRate Rational
deriving (Eq, Ord, GHC.Generic)
instance forall src dst.
( KnownSymbol src, KnownSymbol dst
) => Show (ExchangeRate src dst) where
show = \(ExchangeRate r0) ->
let s = symbolVal (Proxy :: Proxy src)
d = symbolVal (Proxy :: Proxy dst)
in concat [ "ExchangeRate ", show s, " ", show d, " (", show r0, ")" ]
instance forall src dst.
( KnownSymbol src, KnownSymbol dst
) => Read (ExchangeRate (src :: Symbol) (dst :: Symbol)) where
readPrec = do
let s = symbolVal (Proxy :: Proxy src)
d = symbolVal (Proxy :: Proxy dst)
_ <- ReadPrec.lift (ReadP.string
("ExchangeRate " ++ show s ++ " " ++ show d ++ " "))
maybe empty pure =<< fmap exchangeRate readPrec
fromExchangeRate :: ExchangeRate src dst -> Rational
fromExchangeRate = \(ExchangeRate r0) -> r0
exchangeRate :: Rational -> Maybe (ExchangeRate src dst)
exchangeRate = \r0 ->
if (r0 <= 0 || infinity == r0 || notANumber == r0)
then Nothing else Just (ExchangeRate r0)
flipExchangeRate :: ExchangeRate a b -> ExchangeRate b a
flipExchangeRate = \(ExchangeRate x) -> ExchangeRate (1 / x)
exchange :: ExchangeRate src dst -> Dense src -> Dense dst
exchange = \(ExchangeRate r) -> \(Dense s) -> Dense (r * s)
data DenseRep = DenseRep
{ _denseRepCurrency :: !String
, _denseRepAmountNumerator :: !Integer
, _denseRepAmountDenominator :: !Integer
} deriving (Eq, Show, GHC.Generic)
deriving instance Ord DenseRep
denseRepCurrency :: DenseRep -> String
denseRepCurrency = _denseRepCurrency
denseRepAmount :: DenseRep -> Rational
denseRepAmount = \dr ->
denseRepAmountNumerator dr % denseRepAmountDenominator dr
denseRepAmountNumerator :: DenseRep -> Integer
denseRepAmountNumerator = _denseRepAmountNumerator
denseRepAmountDenominator :: DenseRep -> Integer
denseRepAmountDenominator = _denseRepAmountDenominator
mkDenseRep
:: String
-> Integer
-> Integer
-> Maybe DenseRep
mkDenseRep = \c n d -> case d > 0 of
False -> Nothing
True -> Just (DenseRep c n d)
denseRep :: KnownSymbol currency => Dense currency -> DenseRep
denseRep = \(Dense r0 :: Dense currency) ->
let c = symbolVal (Proxy :: Proxy currency)
in DenseRep c (numerator r0) (denominator r0)
fromDenseRep
:: forall currency
. KnownSymbol currency
=> DenseRep
-> Maybe (Dense currency)
fromDenseRep = \dr ->
case denseRepCurrency dr == symbolVal (Proxy :: Proxy currency) of
False -> Nothing
True -> Just (Dense (denseRepAmount dr))
withDenseRep
:: DenseRep
-> (forall currency. KnownSymbol currency => Dense currency -> r)
-> r
withDenseRep dr = \f ->
case someSymbolVal (denseRepCurrency dr) of
SomeSymbol (Proxy :: Proxy currency) ->
f (Dense (denseRepAmount dr) :: Dense currency)
data DiscreteRep = DiscreteRep
{ _discreteRepCurrency :: !String
, _discreteRepScaleNumerator :: !Integer
, _discreteRepScaleDenominator :: !Integer
, _discreteRepAmount :: !Integer
} deriving (Eq, Show, GHC.Generic)
deriving instance Ord DiscreteRep
discreteRepCurrency :: DiscreteRep -> String
discreteRepCurrency = _discreteRepCurrency
discreteRepScale :: DiscreteRep -> Rational
discreteRepScale = \dr ->
discreteRepScaleNumerator dr % discreteRepScaleDenominator dr
discreteRepScaleNumerator :: DiscreteRep -> Integer
discreteRepScaleNumerator = _discreteRepScaleNumerator
discreteRepScaleDenominator :: DiscreteRep -> Integer
discreteRepScaleDenominator = _discreteRepScaleDenominator
discreteRepAmount :: DiscreteRep -> Integer
discreteRepAmount = _discreteRepAmount
mkDiscreteRep
:: String
-> Integer
-> Integer
-> Integer
-> Maybe DiscreteRep
mkDiscreteRep = \c n d a -> case (n > 0) && (d > 0) of
False -> Nothing
True -> Just (DiscreteRep c n d a)
discreteRep
:: (KnownSymbol currency, GoodScale scale)
=> Discrete' currency scale
-> DiscreteRep
discreteRep = \(Discrete i0 :: Discrete' currency scale) ->
let c = symbolVal (Proxy :: Proxy currency)
n = natVal (Proxy :: Proxy (Fst scale))
d = natVal (Proxy :: Proxy (Snd scale))
in DiscreteRep c n d i0
fromDiscreteRep
:: forall currency scale
. (KnownSymbol currency, GoodScale scale)
=> DiscreteRep
-> Maybe (Discrete' currency scale)
fromDiscreteRep = \dr ->
if (discreteRepCurrency dr == symbolVal (Proxy :: Proxy currency)) &&
(discreteRepScaleNumerator dr == natVal (Proxy :: Proxy (Fst scale))) &&
(discreteRepScaleDenominator dr == natVal (Proxy :: Proxy (Snd scale)))
then Just (Discrete (discreteRepAmount dr))
else Nothing
withDiscreteRep
:: forall r
. DiscreteRep
-> ( forall currency scale.
( KnownSymbol currency
, GoodScale scale
) => Discrete' currency scale
-> r )
-> r
withDiscreteRep dr = \f ->
case someSymbolVal (discreteRepCurrency dr) of
SomeSymbol (Proxy :: Proxy currency) ->
case someNatVal (discreteRepScaleNumerator dr) of
Nothing -> error "withDiscreteRep: impossible: numerator < 0"
Just (SomeNat (Proxy :: Proxy num)) ->
case someNatVal (discreteRepScaleDenominator dr) of
Nothing -> error "withDiscreteRep: impossible: denominator < 0"
Just (SomeNat (Proxy :: Proxy den)) ->
case mkGoodScale of
Nothing -> error "withDiscreteRep: impossible: mkGoodScale"
Just (Dict :: Dict (GoodScale '(num, den))) ->
f (Discrete (discreteRepAmount dr)
:: Discrete' currency '(num, den))
data ExchangeRateRep = ExchangeRateRep
{ _exchangeRateRepSrcCurrency :: !String
, _exchangeRateRepDstCurrency :: !String
, _exchangeRateRepRateNumerator :: !Integer
, _exchangeRateRepRateDenominator :: !Integer
} deriving (Eq, Show, GHC.Generic)
deriving instance Ord ExchangeRateRep
exchangeRateRepSrcCurrency :: ExchangeRateRep -> String
exchangeRateRepSrcCurrency = _exchangeRateRepSrcCurrency
exchangeRateRepDstCurrency :: ExchangeRateRep -> String
exchangeRateRepDstCurrency = _exchangeRateRepDstCurrency
exchangeRateRepRate :: ExchangeRateRep -> Rational
exchangeRateRepRate = \x ->
exchangeRateRepRateNumerator x % _exchangeRateRepRateDenominator x
exchangeRateRepRateNumerator :: ExchangeRateRep -> Integer
exchangeRateRepRateNumerator = _exchangeRateRepRateNumerator
exchangeRateRepRateDenominator :: ExchangeRateRep -> Integer
exchangeRateRepRateDenominator = _exchangeRateRepRateDenominator
mkExchangeRateRep
:: String
-> String
-> Integer
-> Integer
-> Maybe ExchangeRateRep
mkExchangeRateRep = \src dst n d -> case (n > 0) && (d > 0) of
False -> Nothing
True -> Just (ExchangeRateRep src dst n d)
exchangeRateRep
:: (KnownSymbol src, KnownSymbol dst)
=> ExchangeRate src dst
-> ExchangeRateRep
exchangeRateRep = \(ExchangeRate r0 :: ExchangeRate src dst) ->
let src = symbolVal (Proxy :: Proxy src)
dst = symbolVal (Proxy :: Proxy dst)
in ExchangeRateRep src dst (numerator r0) (denominator r0)
fromExchangeRateRep
:: forall src dst
. (KnownSymbol src, KnownSymbol dst)
=> ExchangeRateRep
-> Maybe (ExchangeRate src dst)
fromExchangeRateRep = \x ->
if (exchangeRateRepSrcCurrency x == symbolVal (Proxy :: Proxy src)) &&
(exchangeRateRepDstCurrency x == symbolVal (Proxy :: Proxy dst))
then Just (ExchangeRate (exchangeRateRepRate x))
else Nothing
withExchangeRateRep
:: ExchangeRateRep
-> ( forall src dst.
( KnownSymbol src
, KnownSymbol dst
) => ExchangeRate src dst
-> r )
-> r
withExchangeRateRep x = \f ->
case someSymbolVal (exchangeRateRepSrcCurrency x) of
SomeSymbol (Proxy :: Proxy src) ->
case someSymbolVal (exchangeRateRepDstCurrency x) of
SomeSymbol (Proxy :: Proxy dst) ->
f (ExchangeRate (exchangeRateRepRate x) :: ExchangeRate src dst)
type family Fst (ab :: (ka, kb)) :: ka where Fst '(a,b) = a
type family Snd (ab :: (ka, kb)) :: ka where Snd '(a,b) = b
#ifdef VERSION_hashable
instance Hashable (Dense currency)
instance Hashable DenseRep
instance GoodScale scale => Hashable (Discrete' currency scale)
instance Hashable DiscreteRep
instance Hashable (ExchangeRate src dst)
instance Hashable ExchangeRateRep
#endif
#ifdef VERSION_deepseq
instance NFData (Dense currency)
instance NFData DenseRep
instance GoodScale scale => NFData (Discrete' currency scale)
instance NFData DiscreteRep
instance NFData (ExchangeRate src dst)
instance NFData ExchangeRateRep
#endif
#ifdef VERSION_cereal
instance (KnownSymbol currency) => Cereal.Serialize (Dense currency) where
put = Cereal.put . denseRep
get = maybe empty pure =<< fmap fromDenseRep Cereal.get
instance
( KnownSymbol currency, GoodScale scale
) => Cereal.Serialize (Discrete' currency scale) where
put = Cereal.put . discreteRep
get = maybe empty pure =<< fmap fromDiscreteRep Cereal.get
instance
( KnownSymbol src, KnownSymbol dst
) => Cereal.Serialize (ExchangeRate src dst) where
put = Cereal.put . exchangeRateRep
get = maybe empty pure =<< fmap fromExchangeRateRep Cereal.get
instance Cereal.Serialize DenseRep where
put = \(DenseRep c n d) -> Cereal.put c >> Cereal.put n >> Cereal.put d
get = maybe empty pure =<< mkDenseRep
<$> Cereal.get <*> Cereal.get <*> Cereal.get
instance Cereal.Serialize DiscreteRep where
put = \(DiscreteRep c n d a) ->
Cereal.put c >> Cereal.put n >> Cereal.put d >> Cereal.put a
get = maybe empty pure =<< mkDiscreteRep
<$> Cereal.get <*> Cereal.get <*> Cereal.get <*> Cereal.get
instance Cereal.Serialize ExchangeRateRep where
put = \(ExchangeRateRep src dst n d) ->
Cereal.put src >> Cereal.put dst >> Cereal.put n >> Cereal.put d
get = maybe empty pure =<< mkExchangeRateRep
<$> Cereal.get <*> Cereal.get <*> Cereal.get <*> Cereal.get
#endif
#ifdef VERSION_binary
instance (KnownSymbol currency) => Binary.Binary (Dense currency) where
put = Binary.put . denseRep
get = maybe empty pure =<< fmap fromDenseRep Binary.get
instance
( KnownSymbol currency, GoodScale scale
) => Binary.Binary (Discrete' currency scale) where
put = Binary.put . discreteRep
get = maybe empty pure =<< fmap fromDiscreteRep Binary.get
instance
( KnownSymbol src, KnownSymbol dst
) => Binary.Binary (ExchangeRate src dst) where
put = Binary.put . exchangeRateRep
get = maybe empty pure =<< fmap fromExchangeRateRep Binary.get
instance Binary.Binary DenseRep where
put = \(DenseRep c n d) -> Binary.put c >> Binary.put n >> Binary.put d
get = maybe empty pure =<< mkDenseRep
<$> Binary.get <*> Binary.get <*> Binary.get
instance Binary.Binary DiscreteRep where
put = \(DiscreteRep c n d a) ->
Binary.put c >> Binary.put n >> Binary.put d >> Binary.put a
get = maybe empty pure =<< mkDiscreteRep
<$> Binary.get <*> Binary.get <*> Binary.get <*> Binary.get
instance Binary.Binary ExchangeRateRep where
put = \(ExchangeRateRep src dst n d) ->
Binary.put src >> Binary.put dst >> Binary.put n >> Binary.put d
get = maybe empty pure =<< mkExchangeRateRep
<$> Binary.get <*> Binary.get <*> Binary.get <*> Binary.get
#endif
#ifdef VERSION_aeson
instance KnownSymbol currency => Ae.ToJSON (Dense currency) where
toJSON = Ae.toJSON . denseRep
instance KnownSymbol currency => Ae.FromJSON (Dense currency) where
parseJSON = maybe empty pure <=< fmap fromDenseRep . Ae.parseJSON
instance Ae.ToJSON DenseRep where
toJSON = \(DenseRep c n d) -> Ae.toJSON ("Dense", c, n, d)
instance Ae.FromJSON DenseRep where
parseJSON = \v -> do
("Dense", c, n, d) <- Ae.parseJSON v
maybe empty pure (mkDenseRep c n d)
instance
( KnownSymbol currency, GoodScale scale
) => Ae.ToJSON (Discrete' currency scale) where
toJSON = Ae.toJSON . discreteRep
instance
( KnownSymbol currency, GoodScale scale
) => Ae.FromJSON (Discrete' currency scale) where
parseJSON = maybe empty pure <=< fmap fromDiscreteRep . Ae.parseJSON
instance Ae.ToJSON DiscreteRep where
toJSON = \(DiscreteRep c n d a) -> Ae.toJSON ("Discrete", c, n, d, a)
instance Ae.FromJSON DiscreteRep where
parseJSON = \v -> do
("Discrete", c, n, d, a) <- Ae.parseJSON v
maybe empty pure (mkDiscreteRep c n d a)
instance
( KnownSymbol src, KnownSymbol dst
) => Ae.ToJSON (ExchangeRate src dst) where
toJSON = Ae.toJSON . exchangeRateRep
instance
( KnownSymbol src, KnownSymbol dst
) => Ae.FromJSON (ExchangeRate src dst) where
parseJSON = maybe empty pure <=< fmap fromExchangeRateRep . Ae.parseJSON
instance Ae.ToJSON ExchangeRateRep where
toJSON = \(ExchangeRateRep src dst n d) ->
Ae.toJSON ("ExchangeRate", src, dst, n, d)
instance Ae.FromJSON ExchangeRateRep where
parseJSON = \v -> do
("ExchangeRate", src, dst, n, d) <- Ae.parseJSON v
maybe empty pure (mkExchangeRateRep src dst n d)
#endif
#ifdef VERSION_store
instance (KnownSymbol currency) => Store.Store (Dense currency) where
size = storeContramapSize denseRep Store.size
poke = Store.poke . denseRep
peek = maybe (fail "peek") pure =<< fmap fromDenseRep Store.peek
instance Store.Store DenseRep where
poke = \(DenseRep c n d) -> Store.poke c >> Store.poke n >> Store.poke d
peek = maybe (fail "peek") pure =<< do
mkDenseRep <$> Store.peek <*> Store.peek <*> Store.peek
instance
( KnownSymbol currency, GoodScale scale
) => Store.Store (Discrete' currency scale) where
size = storeContramapSize discreteRep Store.size
poke = Store.poke . discreteRep
peek = maybe (fail "peek") pure =<< fmap fromDiscreteRep Store.peek
instance Store.Store DiscreteRep where
poke = \(DiscreteRep c n d a) ->
Store.poke c >> Store.poke n >> Store.poke d >> Store.poke a
peek = maybe (fail "peek") pure =<< do
mkDiscreteRep <$> Store.peek <*> Store.peek <*> Store.peek <*> Store.peek
instance
( KnownSymbol src, KnownSymbol dst
) => Store.Store (ExchangeRate src dst) where
size = storeContramapSize exchangeRateRep Store.size
poke = Store.poke . exchangeRateRep
peek = maybe (fail "peek") pure =<< fmap fromExchangeRateRep Store.peek
instance Store.Store ExchangeRateRep where
poke = \(ExchangeRateRep src dst n d) ->
Store.poke src >> Store.poke dst >> Store.poke n >> Store.poke d
peek = maybe (fail "peek") pure =<< mkExchangeRateRep
<$> Store.peek <*> Store.peek <*> Store.peek <*> Store.peek
storeContramapSize :: (a -> b) -> Store.Size b -> Store.Size a
storeContramapSize f = \case
Store.VarSize g -> Store.VarSize (g . f)
Store.ConstSize x -> Store.ConstSize x
#endif