假设您有一个应用程序配置，其结构已经更改了几次。为了方便用户使用，您希望允许从每个版本自动迁移到下一个版本。
下面的代码展示了这样一个场景，将配置表示为
VersionedConfig鉴于可以在任何两个连续版本（
V1 -> V2V2 -> V3MigrateableFromTo{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
-- | Represents different versions of a config file
data ConfigVersion = V1 | V2 | V3
-- | Represents the config itself, at different versions
data VersionedConfig (v :: ConfigVersion) where
CV1 :: Int -> VersionedConfig V1
CV2 :: Integer -> VersionedConfig V2
CV3 :: String -> VersionedConfig V3
deriving instance Show (VersionedConfig v)
-- | Proof term for migration between versions
data MigrateableProof (from :: ConfigVersion) (to :: ConfigVersion) where
MigrateableProof :: (VersionedConfig from -> VersionedConfig to) -> MigrateableProof from to
class MigrateableFromTo (from :: ConfigVersion) (to :: ConfigVersion) where
migrateFromTo :: MigrateableProof from to
instance MigrateableFromTo V1 V2 where
migrateFromTo = MigrateableProof (\(CV1 a) -> CV2 (toEnum a))
instance MigrateableFromTo V2 V3 where
migrateFromTo = MigrateableProof (\(CV2 a) -> CV3 (show a))
instance forall from intermediate to.
(MigrateableFromTo from intermediate, MigrateableFromTo intermediate to)
=> MigrateableFromTo from to where
migrateFromTo = MigrateableProof (applyMigration @intermediate . applyMigration)
applyMigration :: MigrateableFromTo from to => VersionedConfig from -> VersionedConfig to
applyMigration = let MigrateableProof f = migrateFromTo in f
main :: IO ()
main = do
let
cv1 = CV1 5
cv3 = (applyMigration cv1) :: VersionedConfig V3
print cv3
此代码无法编译，因为归纳实例中的
fromintermediateto目前结果如下：
Main.hs:44:12: error:
• Overlapping instances for MigrateableFromTo intermediate0 'V3
arising from a use of ‘applyMigration’
Matching instances:
instance (MigrateableFromTo from intermediate,
MigrateableFromTo intermediate to) =>
MigrateableFromTo from to
-- Defined at Main.hs:32:10
instance MigrateableFromTo 'V2 'V3 -- Defined at Main.hs:29:10
(The choice depends on the instantiation of ‘intermediate0’
To pick the first instance above, use IncoherentInstances
when compiling the other instance declarations)
• In the expression: (applyMigration cv1) :: VersionedConfig V3
In an equation for ‘cv3’:
cv3 = (applyMigration cv1) :: VersionedConfig V3
In the expression:
do let cv1 = CV1 5
cv3 = ...
print cv3
|
44 | cv3 = (applyMigration cv1) :: VersionedConfig V3
| ^^^^^^^^^^^^^^
此代码可在Haskell Playground中获得。
是的，这是可能的。深呼吸：
{-# Language AllowAmbiguousTypes #-}
{-# Language DataKinds #-}
{-# Language FlexibleContexts #-}
{-# Language FlexibleInstances #-}
{-# Language MultiParamTypeClasses #-}
{-# Language ScopedTypeVariables #-}
{-# Language TypeApplications #-}
{-# Language TypeFamilies #-}
{-# Language TypeOperators #-}
{-# Language UndecidableInstances #-}
import Data.Kind
这是您需要为其编写实例的一步类：
class DirectlyConvertible a where
type DirectConversion a
convertDirectly :: a -> DirectConversion a
这里是只需要做一次的配套机械：
class ConvertibleVia (path :: [*]) tgt where
type From path tgt
convert_ :: From path tgt -> tgt
instance ConvertibleVia '[] a where
type From '[] a = a
convert_ = id
instance (DirectlyConvertible a, DirectConversion a ~ From path c, ConvertibleVia path c) => ConvertibleVia (a:path) c where
type From (a:path) c = a
convert_ = convert_ @path . convertDirectly
type family ConversionPath a b where
ConversionPath a a = '[]
ConversionPath a b = a : ConversionPath (DirectConversion a) b
-- tiny wrapper to make the type applications a bit more convenient
convert :: forall src tgt path. (path ~ ConversionPath src tgt, ConvertibleVia path tgt, From path tgt ~ src) => src -> tgt
convert = convert_ @path
有了这个，我们可以在一些模拟实例中折腾：
data V1
data V2
data V3
data V4
instance DirectlyConvertible V1 where type DirectConversion V1 = V2
instance DirectlyConvertible V2 where type DirectConversion V2 = V3
instance DirectlyConvertible V3 where type DirectConversion V3 = V4
现在你可以写例如
convert @V1 @V4convert @V1V4AllowAmbiguousTypes你可以这样写
class DirectlyConvertible a b | a -> b, b -> a
具有函数依赖性，然后我怀疑你可以写
instance a ~ b => Convertible a b
instance (Convertible a b, DirectlyConvertible b c) => Convertible a c
明确左关联转换。然而，我希望它仍然需要重叠的实例，因为它仍然可以编写循环。
这是一种方法。为此不需要类型类。我只在最后给出了一个类型类，让它更容易使用。不仅如此，那个类型类恰好做了一些非常熟悉的事情。
这种方法基于这样的观察，即迁移完全由 连续 版本（1 -> 2、2 -> 3 等）之间发生的事情定义。我们如何谈论“版本继承者？”
我会首先概括这样的版本类型：
data Natural = Z | S Natural
deriving (Show)
-- | Represents different versions of a config file
type ConfigVersion = Natural
type V1 = Z
type V2 = S V1
type V3 = S V2
这有好处也有坏处。一个好处是您现在可以谈论任何未来的版本。缺点是您可能只想谈论已经存在的版本。我不认为这是一个太大的缺点。我们接下来会谈到这一点。
接下来，我们重新实现
VersionedConfig-- | Represents the config itself, at different versions
data VersionedConfig (v :: ConfigVersion) where
CV1 :: Int -> VersionedConfig V1
CV2 :: Integer -> VersionedConfig V2
CV3 :: String -> VersionedConfig V3
这只使用实际存在的版本。这就是为什么我认为我们现在可以表示不存在的版本并不是什么大问题。
现在，我们可以实现一个函数，它（只）将一个版本迁移到它的后续版本：
migrateToSuccessor :: MigrateableProof from (S from)
migrateToSuccessor = MigrateableProof $ \case
CV1 a -> -- 1 -> 2
CV2 (toEnum a)
CV2 a -> -- 2 -> 3
CV3 (show a)
在我们概括之前，我们需要一种方法来表达一个版本小于或等于另一个版本的证明：
data (:<=) :: Natural -> Natural -> Type where
Refl :: a :<= a
LtS :: a :<= b -> a :<= S b
deriving instance Show (a :<= b)
由此，我们可以得到通用的迁移函数：
migrate :: from :<= to -> MigrateableProof from to
migrate Refl = id
migrate (LtS prf) = migrateToSuccessor . migrate prf
请注意，我为
CategoryMigrateableProofinstance Category MigrateableProof where
id = MigrateableProof id
MigrateableProof p . MigrateableProof q = MigrateableProof (p . q)
为了简化这个的使用，我们可以制作一个类型类，它会在适当的地方自动生成
:<=class Le a b where
le :: a :<= b
instance Le Z Z where
le = Refl
instance forall a. Le Z a => Le Z (S a) where
le = LtS $ le @Z @a
instance forall a b. Le (S a) b => Le (S a) (S b) where
le = LtS $ le @(S a) @b
最后，我们可以这样重写
mainmain :: IO ()
main = do
let
cv1 = CV1 5
cv3 = applyMigration le cv1 :: VersionedConfig V3
print cv3
这样做的一个好处是我们最大限度地减少了多态递归类型类的使用，否则这可能会有些复杂。我认为像这样把事情分开会更清楚。
另一方面，我们正在使用
:<=