通过 Type 类 将 Sum 类型转换为 Phantom 类型

Convert Sum Type to Phantom Type via Type Classes

我在 Haskell 中试验幻像类型。我的目标是通过类型 类 将 LangCode 类型转换为相应的 Phantom 类型表示,例如 DELang DE

module Main (main) where

import Data.Proxy (Proxy(..))

data DE
data EN

data LangCode
  = DE
  | EN
  deriving (Eq, Show)

type Lang a = Proxy a

de :: Lang DE
de = Proxy

en :: Lang EN
en = Proxy

class ToLangCode a where
  toLangCode :: Lang a -> LangCode

instance ToLangCode DE where
  toLangCode _ = DE
instance ToLangCode EN where
  toLangCode _ = EN

class FromLangCode a where
  fromLangCode :: LangCode -> Lang a

instance FromLangCode DE where
  fromLangCode DE = Proxy
instance FromLangCode EN where
  fromLangCode EN = Proxy

main :: IO ()
main = do
  print $ de -- Output => Proxy
  print $ en -- Output => Proxy

  print $ toLangCode de -- Output => DE
  print $ toLangCode en -- Output => EN

  -- works
  print $ (fromLangCode DE :: Lang DE) -- Output => Proxy
  print $ (fromLangCode EN :: Lang EN) -- Output => Proxy

  -- throws an error
  print $ fromLangCode DE -- Output => Proxy
  print $ fromLangCode EN -- Output => Proxy

使用类型注释它工作正常。但是没有它我会得到这个错误。

[1 of 1] Compiling Main             ( main.hs, main.o )

main.hs:50:11: error:
    * Ambiguous type variable `a0' arising from a use of `fromLangCode'
      prevents the constraint `(FromLangCode a0)' from being solved.
      Probable fix: use a type annotation to specify what `a0' should be.
      These potential instances exist:
        instance FromLangCode DE -- Defined at main.hs:32:10
        instance FromLangCode EN -- Defined at main.hs:34:10
    * In the second argument of `($)', namely `fromLangCode DE'
      In a stmt of a 'do' block: print $ fromLangCode DE
      In the expression:
        do print $ de
           print $ en
           print $ toLangCode de
           print $ toLangCode en
           ....
   |
50 |   print $ fromLangCode DE -- Output => Proxy
   |           ^^^^^^^^^^^^^^^

main.hs:51:11: error:
    * Ambiguous type variable `a1' arising from a use of `fromLangCode'
      prevents the constraint `(FromLangCode a1)' from being solved.
      Probable fix: use a type annotation to specify what `a1' should be.
      These potential instances exist:
        instance FromLangCode DE -- Defined at main.hs:32:10
        instance FromLangCode EN -- Defined at main.hs:34:10
    * In the second argument of `($)', namely `fromLangCode EN'
      In a stmt of a 'do' block: print $ fromLangCode EN
      In the expression:
        do print $ de
           print $ en
           print $ toLangCode de
           print $ toLangCode en
           ....
   |
51 |   print $ fromLangCode EN -- Output => Proxy
   |           ^^^^^^^^^^^^^^^
exit status 1

我的问题是。是否有可能以不再需要类型注释的方式实现它?

更新版本

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleInstances #-}

module Main (main) where

data LangCode = DE | EN deriving (Eq, Show)

data SLangCode a where
    SDE :: SLangCode DE
    SEN :: SLangCode EN

data Lang (a :: LangCode) where
  LangDE :: Lang 'DE
  LangEN :: Lang 'EN

deriving instance Show (Lang 'DE)
deriving instance Show (Lang 'EN)

slcDE :: SLangCode a -> Lang 'DE -> Lang a
slcDE SDE t = t
slcDE SEN _ = LangEN

slcEN :: SLangCode a -> Lang 'EN -> Lang a
slcEN SEN t = t
slcEN SDE _ = LangDE

class ToLangCode a where
  toLangCode :: Lang a -> LangCode

instance ToLangCode 'DE where
  toLangCode _ = DE
instance ToLangCode 'EN where
  toLangCode _ = EN

class FromLangCode a where
  fromLangCode :: SLangCode a -> LangCode -> Lang a

instance FromLangCode 'DE where
  fromLangCode SDE DE = LangDE
instance FromLangCode 'EN where
  fromLangCode SEN EN = LangEN

main :: IO ()
main = do
  print $ toLangCode LangDE -- Output => DE
  print $ toLangCode LangEN -- Output => EN

  print $ fromLangCode SDE DE -- Output => LangDE
  print $ fromLangCode SEN EN -- Output => LangEN

问题来了。这是类型的基本 属性,如果术语级表达式 e1e2 具有相同的类型 t,则将 e1 替换为 e2 在程序中不会更改任何程序的类型。这就是使他们成为类型的原因。

你想要表达式(没有显式类型签名):

fromLangCode EN

输入Lang EN,这很容易。但是,如果项级表达式 ENDE 是来自相同总和类型 LangCode 的构造函数,则用一个替换另一个不会改变任何类型,因此表达式:

fromLangCode DE

具有类型Lang EN,这显然不是您想要的。

因此,如果您想要两种不同的推断类型:

fromLangCode EN :: Lang EN
fromLangCode DE :: Lang DE

那么任何解决方案都需要术语级表达式 ENDE 具有不同的类型,这意味着您 不能 有:

data LangCode = EN | DE

所以,这就是简短的回答——您不能在求和类型LangCode和代理类型Lang lang之间自由转换。或者更确切地说,您可以使用类型 class(如 ToLangCode)轻松地从类型 Lang lang 转换为术语 LangCode,但您无法真正转换回来。

这个“问题”有很多解决方案,但这在某种程度上取决于你想做什么,这就是为什么评论中的人会问你关于“用例”和“预期行为”的问题.

一个什么都不做的简单解决方案

一个简单的解决方案是写:

data EN = EN
data DE = DE

这里,术语级别的表达式 ENDE 具有不同的类型(分别为 ENDE)。这使您可以逐字使用 main 函数轻松实现所需的接口:

import Data.Proxy

data EN = EN deriving (Show)
data DE = DE deriving (Show)

type Lang a = Proxy a

de :: Lang DE
de = Proxy

en :: Lang EN
en = Proxy

class ToLangCode a where
  toLangCode :: Lang a -> a

instance ToLangCode DE where
  toLangCode _ = DE
instance ToLangCode EN where
  toLangCode _ = EN

class FromLangCode a where
  fromLangCode :: a -> Lang a

instance FromLangCode DE where
  fromLangCode DE = Proxy
instance FromLangCode EN where
  fromLangCode EN = Proxy

main :: IO ()
main = do
  print $ de -- Output => Proxy
  print $ en -- Output => Proxy

  print $ toLangCode de -- Output => DE
  print $ toLangCode en -- Output => EN

  -- works
  print $ (fromLangCode DE :: Lang DE) -- Output => Proxy
  print $ (fromLangCode EN :: Lang EN) -- Output => Proxy

  -- works fine now
  print $ fromLangCode DE -- Output => Proxy
  print $ fromLangCode EN -- Output => Proxy

如果您对这个“解决方案”持怀疑态度,那您是对的。它并没有真正完成任何事情,因为术语级别的表达式 ENDE 在类型级别已经不同,并且该程序实际上只是在一种类型级别表示(类型 ENDE) 和另一个(类型 Lang ENLang DE)。

使用 GADT

一种做你想做的事情的方法是使用 GADT。如果我们将 LangCode 定义为“广义”求和类型:

{-# LANGUAGE GADTs #-}

data EN
data DE

data LangCode lang where
  EN :: LangCode EN
  DE :: LangCode DE

一切都或多或少像我之前的例子,对类型签名做了一些小改动,main保持不变,如下所示:

{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}

import Data.Proxy

data EN
data DE

data LangCode lang where
  EN :: LangCode EN
  DE :: LangCode DE
deriving instance Show (LangCode a)

type Lang a = Proxy a

de :: Lang DE
de = Proxy

en :: Lang EN
en = Proxy

class ToLangCode a where
  toLangCode :: Lang a -> LangCode a

instance ToLangCode DE where
  toLangCode _ = DE
instance ToLangCode EN where
  toLangCode _ = EN

class FromLangCode a where
  fromLangCode :: LangCode a -> Lang a

instance FromLangCode DE where
  fromLangCode DE = Proxy
instance FromLangCode EN where
  fromLangCode EN = Proxy

main :: IO ()
main = do
  print $ de -- Output => Proxy
  print $ en -- Output => Proxy

  print $ toLangCode de -- Output => DE
  print $ toLangCode en -- Output => EN

  -- works
  print $ (fromLangCode DE :: Lang DE) -- Output => Proxy
  print $ (fromLangCode EN :: Lang EN) -- Output => Proxy

  -- works fine now
  print $ fromLangCode DE -- Output => Proxy
  print $ fromLangCode EN -- Output => Proxy

因此,我们可以在这种广义求和类型和幻像类型表示之间自由转换。

与前面的示例相比,这确实没有太大改进。这两个构造函数现在正式成为广义求和类型的一部分,但是项级表达式 ENDE 在类型级别已经不同,我们只是在一种类型级别表示之间进行转换(类型 LangCode ENLangCode DE)和另一个(类型 Lang ENLang DE)。

但是,您的“更新示例”可能会受到同样的批评。通过引入单例(一种广义求和类型),您也已经在第一个单例参数中使表达式 fromLangCode SDE DEfromLangCode SEN EN 在类型级别上有所不同。第二个术语级参数在这里没有用处,可以消除,因此您只是从一种类型级表示(SLangCode DESLangCode EN)转换为另一种(Lang DELang EN).

存在类型

实际有用术语和类型级表示之间的转换通常涉及混合某处的存在类型。考虑一个更现实的例子会有所帮助。假设您可能希望能够使用类型系统来帮助避免不恰当地混合语言。例如:

import Data.List.Extra

data EN
data DE
newtype Text lang = Text String deriving (Show)

item :: Text EN
item = Text "The big elephant"

artikel :: Text DE
artikel = Text "Die großen Elefanten"

fixß :: Text DE -> Text DE
fixß (Text x) = Text $ replace "ß" "ss" x

pluralize :: Text EN -> Text EN
pluralize (Text noun) | "s" `isSuffixOf` noun = Text $ noun ++ "ses"
                      | otherwise = Text $ noun ++ "s"

message_en :: Text EN
message_en = pluralize item

message_de :: Text DE
message_de = fixß artikel

-- type system prevents applying german manipulations to english text
type_error_1 = fixß item

但是,您可能还想在 运行 时间内决定在特定表达式中使用哪种语言:

data LangCode = EN | DE

main :: IO ()
main = do
  let language = EN  -- assume this comes from args or user input
  -- type error: `mytext` can't be both `Text EN` and `Text DE`
  let mytext = case language of
        EN -> message_en
        DE -> message_de
  print mytext

这不起作用,因为 mytext 的类型不能依赖于 运行 时间计算。也就是说,没有简单的方法可以将 运行time term-level value language :: LangCode(sum 类型)转换为 type-level value Lang language,所需类型 mytext.

通常的解决方案是使用存在类型:

{-# LANGUAGE ExistentialQuantification #-}
data SomeText = forall lang. SomeText (Text lang)

这里,类型 SomeText 表示某种未指定语言的文本(即,类型 Text lang 的值表示某些未指定的类型 lang)。现在,mytext 可以用 运行 时间确定的语言分配文本,方法是用 SomeText 构造函数包装它。

let mytext = case language of
      EN -> SomeText message_en
      DE -> SomeText message_de

我们在使用 SomeText 值(例如 mytext)时所能做的事情有限——我们不能做任何依赖于了解语言的事情,例如应用 pluralizefixß 或其他。但是,我们可以做的一件事是提取字符串,因为它适用于任何语言:

getText :: SomeText -> String
getText (SomeText (Text str)) = str

这让我们可以写出有用的 main:

main :: IO ()
main = do
  let language = EN
  let mytext = case language of
        EN -> SomeText message_en
        DE -> SomeText message_de
  print $ getText mytext

这是完整的工作示例:

{-# LANGUAGE ExistentialQuantification #-}

import Data.List.Extra

data EN
data DE
data LangCode = EN | DE
newtype Text lang = Text String deriving (Show)

data SomeText = forall lang. SomeText (Text lang)

item :: Text EN
item = Text "The big elephant"

artikel :: Text DE
artikel = Text "Die großen Elefanten"

fixß :: Text DE -> Text DE
fixß (Text x) = Text $ replace "ß" "ss" x

pluralize :: Text EN -> Text EN
pluralize (Text noun) | "s" `isSuffixOf` noun = Text $ noun ++ "ses"
                      | otherwise = Text $ noun ++ "s"

message_en :: Text EN
message_en = pluralize item

message_de :: Text DE
message_de = fixß artikel

getText :: SomeText -> String
getText (SomeText (Text str)) = str

main :: IO ()
main = do
  let language = DE
  let mytext = case language of
        EN -> SomeText message_en
        DE -> SomeText message_de
  print $ getText mytext

我们在这里所做的是通过将术语级值从总和类型 (language) 包装在 SomeText 中成功转换为类型级值 Text language ]构造函数。

应用于您的示例

我们可以使用相同的技术在 sum 类型和类型级代理之间自由转换,通过屏蔽 existential 中的类型级代理。它可能看起来像这样。请注意我如何使用自定义 Show 实例来区分不同类型的代理,以证明我们正在做一些有用的事情。

{-# LANGUAGE ExistentialQuantification #-}

import Data.Proxy

data DE
data EN

-- sum type
data LangCode
  = DE
  | EN
  deriving (Eq, Show)

-- existential for type-level proxies
type Lang = Proxy
data SomeLang = forall a. ToLangCode a => SomeLang (Lang a)
instance Show SomeLang where
  show (SomeLang lang) = "SomeLang Proxy<" ++ show (toLangCode' lang) ++ ">"

-- convert from LangCode to SomeLang
fromLangCode :: LangCode -> SomeLang
fromLangCode EN = SomeLang (Proxy :: Lang EN)
fromLangCode DE = SomeLang (Proxy :: Lang DE)

-- convert from SomeLang to LangCode
class ToLangCode lang where
  toLangCode' :: Lang lang -> LangCode
instance ToLangCode EN where
  toLangCode' Proxy = EN
instance ToLangCode DE where
  toLangCode' Proxy = DE
toLangCode :: SomeLang -> LangCode
toLangCode (SomeLang lang) = toLangCode' lang

de :: SomeLang
de = SomeLang (Proxy :: Lang DE)

en :: SomeLang
en = SomeLang (Proxy :: Lang EN)

main :: IO ()
main = do
  print $ de -- Output => SomeLang Proxy<DE>
  print $ en -- Output => SomeLang Proxy<EN>

  print $ toLangCode de -- Output => DE
  print $ toLangCode en -- Output => EN

  print $ fromLangCode DE -- Output => SomeLang Proxy<DE>
  print $ fromLangCode EN -- Output => SomeLang Proxy<EN>