在函数签名中强制执行不同的值构造函数

Enforce different value constructors in functions signature

我正在处理货币和货币操作。我希望操作是类型安全的,但我还需要将不同的货币一起存储在一个集合中,以便我可以搜索它们。

这两个目标似乎有冲突。

我可以用一个选项类型来实现它,但是我在操作中没有得到类型安全:

type Number = Rational

data Currency = USD | EUR | GBP

data Value = Value Number Currency

-- I can have this
type ConversionRate = (Currency, Currency, Number)

conversionRates :: [ConversionRate]
conversionRates = [(GBP, EUR, 1.2)]

-- This is not typesafe and would allow summing different currencies
sumValue :: Value -> Value -> Value
sumValue = undefined

-- This is also not typesafe
convert :: ConversionRate -> Value -> Currency -> Maybe Value
convert = undefined

或者我可以为每种货币使用一个类型,但我无法轻松创建和处理它们的汇率。

{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE ExistentialQuantification #-}

type Number = Rational

data USD = USD
data EUR = EUR
data GBP = GBP

class Currency a

instance Currency USD
instance Currency EUR
instance Currency GBP

data Value a where
    Value :: Currency a => a -> Value a

data ConversionRate a b where
    ConversionRate :: (Currency a, Currency b) => Number -> ConversionRate a b

-- Now I can have type-safe currency operations
sumValue :: Currency a => Value a -> Value a
sumValue = undefined

-- And I can make sure my conversions make sense
convert :: ConversionRate a b -> Value a -> b
convert = undefined

-- But I can't hold a list of conversion rates that I can easily manipulate
type ConversionRates = ??

我目前的表现如何

我目前的解决方案是在作为不同类型的货币和货币期权类型之间进行同构,希望在程序的不同部分获得两全其美的效果。但这是一团糟。

{-# LANGUAGE ExistentialQuantification #-}
type Number = Rational

data Symbol = USD | EUR | GBP

data Dollar = Dollar
data Euro = Euro
data Pound = Pound

class Currency a where
    toSymbol :: a -> Symbol

instance Currency Dollar where toSymbol _ = USD
instance Currency Euro where toSymbol _ = EUR
instance Currency Pound where toSymbol _ = GBP

data Wrapper = forall a. Currency a => Wrapper a

toCurrency :: Symbol -> Wrapper

如何在某些函数中实现类型安全,而在其他函数中实现相同类型值的便利性?。看起来像是 DataKinds 的工作,但我看不出它有什么帮助。

请记住,我在编码时没有所有数据。它将从 API 中获取。

我不能保证这是 "best" 任何合理概念的 "best" 方法,但可以尝试一下。

{-# LANGUAGE GADTs, DataKinds, KindSignatures, ScopedTypeVariables,
  AllowAmbiguousTypes, TypeApplications #-}
{-# OPTIONS -Wall #-}

module Currency where

type Number = Rational

我们首先定义一个 Currency 类型和一些相关的辅助机械。

data Currency = USD | EUR | GBP

我们添加一个关联的单例 GADT。

-- Singleton type for Currency
data SCurrency (cur :: Currency) where
    S_USD :: SCurrency 'USD
    S_EUR :: SCurrency 'EUR
    S_GBP :: SCurrency 'GBP

我们还定义了一个助手 class 到 link 两种类型(基本和单例)。我们可以没有,但它很方便。

-- Helper class
class CCurrency (cur :: Currency) where
    sing :: SCurrency cur
instance CCurrency 'USD where sing = S_USD
instance CCurrency 'EUR where sing = S_EUR
instance CCurrency 'GBP where sing = S_GBP

我们需要一个针对单例类型的异构相等运算符。

-- Like (==), but working on potentially different types
sameCur :: SCurrency cur1 -> SCurrency cur2 -> Bool
sameCur S_USD S_USD = True
sameCur S_EUR S_EUR = True
sameCur S_GBP S_GBP = True
sameCur _     _     = False

理想情况下我们应该有 sameCur :: SCurrency cur1 -> SCurrency cur2 -> Either (cur1 :~: cur2) ((cur1 :~: cur2) -> Void) 但一个布尔值就足够了。

预赛结束。我们现在可以为编译时已知货币的值定义类型。

data Value (cur :: Currency) =  Value Number

我们还有一种值类型,其货币仅在运行时已知

data AnyValue where
    AnyValue :: CCurrency cur => Value cur -> AnyValue

转化率与原代码相似,只是带有单例。

data ConversionRate where
    CR :: SCurrency cur1 -> SCurrency cur2 -> Number -> ConversionRate

conversionRates :: [ConversionRate]
conversionRates = [CR S_GBP S_EUR 1.2]

我们现在可以定义一个类型安全的和。

sumValue :: Value cur -> Value cur -> Value cur
sumValue (Value x) (Value y) = Value (x+y)

我们还可以编写类型安全的转换,有两种形式。

convert :: forall newCur. CCurrency newCur =>
           ConversionRate
        -> AnyValue
        -> Maybe (Value newCur)
convert (CR old new rate) (AnyValue (Value val :: Value cur)) =
    if sameCur old (sing @ cur) && sameCur new (sing @ newCur)
    then Just $ Value $ val*rate
    else Nothing

convert' :: forall oldCur newCur. (CCurrency oldCur, CCurrency newCur) =>
            ConversionRate
         -> Value oldCur
         -> Maybe (Value newCur)
convert' cr val = convert cr (AnyValue val)