在函数签名中强制使用不同的值构造函数

时间:2017-11-08 11:20:59

标签: haskell types ghc dependent-type data-kinds

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

这两个目标似乎发生了冲突。

我可以使用选项类型来实现它,但我没有在操作中获得类型安全性:

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获取。

1 个答案:

答案 0 :(得分:1)

我不能保证这是任何合理的“最佳”概念的“最佳”方法,但这是一次尝试。

{-# 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

我们还定义了一个辅助类来链接两种类型(基本和单例)。我们可以不用,但很方便。

-- 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)