money currency in haskell

money-currency.hs

-- | A currency-less integral monetary value which cannot be further
-- subdivided. E.g. cent, penny, satoshi.
--
-- For lack of a better name:
-- <https://money.stackexchange.com/questions/85562/generic-name-for-the-smallest-unit-of-currency>
newtype IntegralMoney = IntegralMoney Int
  deriving (Eq, Ord, Integral, Num, Enum, Real, Show)
instance PersistFieldSql IntegralMoney where
  sqlType _ = SqlString
instance PersistField IntegralMoney where
  toPersistValue (IntegralMoney i) = toPersistValue i
  fromPersistValue = fmap IntegralMoney . fromPersistValue

-- | Currency for an integral unit. E.g. cents, pennies, Ugandan shilling.
data IntegralCurrency = USDCent | UGX
  deriving (Eq, Ord, Enum, Bounded, Show)
instance PersistFieldSql IntegralCurrency where
  sqlType _ = SqlInt64
instance PersistField IntegralCurrency where
  toPersistValue = toPersistValue . fromEnum
  fromPersistValue = fmap toEnum . fromPersistValue

-- | Money with respect to a currency.
data Money (c :: IntegralCurrency) where
   USDCentMoney :: IntegralMoney -> Money 'USDCent
   UGXMoney :: IntegralMoney -> Money 'UGX

-- | Show instances choose the current standard non-integral super
-- currency.
instance Show (Money currency) where
  show (USDCentMoney (IntegralMoney subunit)) = "$" ++ show (MkFixed (fromIntegral subunit) :: Centi)
  show (UGXMoney (IntegralMoney subunit)) = show subunit ++ "USh"

-- | With a well-typed money value.
withMoney :: IntegralCurrency -> IntegralMoney -> (forall c. Money c -> r) -> r
withMoney currency money cont =
  case currency of
    USDCent -> cont (USDCentMoney money)
    UGX -> cont (UGXMoney money)