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