Question

想象一下，我正在编写一个网络服务器，我希望我的配置看起来像这样（从nginx中获取灵感）：

listen = "localhost"
set error_page = "fail.html"

vhost "hello" {
  set error_page = "oops.html"
  path = "/var/www/hello/public_html"
}

某些指令（如Listen）只能在全局范围内使用，其他指令仅在vhost范围内可用（Path），而某些指令（如Set）是通用的，意味着我不能使用这样的常规ADT：

data GlobalDirective = Listen Text | VirtualHost Text | Set Text Text
data LocalDirective = Path Text | Set Text Text

所以我写这段代码似乎反映了我的心理模型：

class Show a => Directive a 
class Directive a => GlobalDirective a
class Directive a => LocalDirective a

data GlobalConfig where
    GlobalDirectives :: forall a. GlobalDirective a => [a] -> GlobalConfig 
instance Show GlobalConfig where
    show (GlobalDirectives xs) = "Config" ++ show xs

data VirtualHost where  
    VirtualHostDirectives :: forall a. LocalDirective a => Text -> [a] -> VirtualHost 
instance Directive VirtualHost
instance GlobalDirective VirtualHost
instance Show VirtualHost where
    show (VirtualHostDirectives name xs) = "VirtualHost[" ++ show name ++ "]" ++ show xs

data Listen = Listen Text deriving (Show) 
instance Directive Listen
instance GlobalDirective Listen

data Set = Set Text Text deriving (Show)
instance Directive Set
instance GlobalDirective Set
instance LocalDirective Set

data Path = Path Text deriving (Show)
instance Directive Path
instance LocalDirective Path

问题是我实际上无法构造配置：

> VirtualHostDirectives (Text.pack "hello") [Set (Text.pack "error_page") (Text.pack "oops.html"), Path (Text.pack "/var/www") ]

<interactive>:139:98:
    Couldn't match expected type ‘Set’ with actual type ‘Path’
    In the expression: Path (Text.pack "/var/www")
    In the second argument of ‘VirtualHostDirectives’, namely
      ‘[Set (Text.pack "error_page") (Text.pack "oops.html"),
        Path (Text.pack "/var/www")]’

这看起来像是一个存在量化黑客的案例：

data AnyDirective a = forall a. Directive a => AnyDirective a
instance Directive (AnyDirective a)
instance Show (AnyDirective a) where
    show (AnyDirective a) = show a
instance GlobalDirective a => GlobalDirective (AnyDirective a)
instance LocalDirective a => LocalDirective (AnyDirective a)

...但它也不起作用：

*Main> VirtualHostDirectives (Text.pack "hello") [AnyDirective $ Set (Text.pack "error_page") (Text.pack "oops.html"), AnyDirective $ Path (Text.pack "/var/www") ]

<interactive>:134:1:
    No instance for (LocalDirective a0)
      arising from a use of ‘VirtualHostDirectives’
    The type variable ‘a0’ is ambiguous
    Note: there are several potential instances:
      instance LocalDirective Path -- Defined at src/Main.hs:167:10
      instance LocalDirective Set -- Defined at src/Main.hs:163:10
      instance LocalDirective a => LocalDirective (AnyDirective a)
        -- Defined at src/Main.hs:142:10
    In the expression:
      VirtualHostDirectives
        (Text.pack "hello")
        [AnyDirective
         $ Set (Text.pack "error_page") (Text.pack "oops.html"),
         AnyDirective $ Path (Text.pack "/var/www")]
    In an equation for ‘it’:
        it
          = VirtualHostDirectives
              (Text.pack "hello")
              [AnyDirective
               $ Set (Text.pack "error_page") (Text.pack "oops.html"),
               AnyDirective $ Path (Text.pack "/var/www")]

那么，我的选择是什么？

Answer 1

一种可能性是让GADT具有幻像参数：

{-# LANGUAGE GADTs, DataKinds #-}
import Data.Text
data Scope = Local | Global
data Directive a where
    Set         :: Text -> Text -> Directive a
    Path        :: Text -> Directive Local
    Listen      :: Text -> Directive Global
    VirtualHost :: Text -> Directive Global

你可以在ghci中看到这给出了一些非常好的推论：

> :set -XOverloadedStrings
> :t [Set "error_page" "oops.html", Path "/var/www"]
[Set "error_page" "oops.html", Path "/var/www"] :: [Directive 'Local]

Answer 2

你可以通过普通的ADT完美地做到这一点 - 你遇到麻烦的唯一原因是两个数据构造函数之间存在名称冲突：

Set :: Text -> Text -> GlobalDirective
Set :: Text -> Text -> LocalDirective

最简单的解决方案是给他们不同的名字：

data GlobalDirective = Listen Text | VirtualHost Text | GSet Text Text
data LocalDirective = Path Text | LSet Text Text

如果全局集在某种程度上与本地集不同，那么这甚至可能具有最大的语义意义。当然，您不能将通用Set传递给任何函数，因为它必须知道它是获取全局还是本地集。因此，您可以通过定义一个包含两个Set的可重用Text来清理它，然后传递它：

data Set = Set Text Text
data GlobalDirective = Listen Text | VirtualHost Text | GSet Set
data LocalDirective = Path Text | LSet Set

whatever :: Set -> Bool
whatever (Set name value) = True

handle :: LocalDirective -> Bool
handle (Path _) = False
handle (LSet s) = whatever s

鉴于这与普通的ADT有多么简单，我认为没有必要引入更多像存在类型或类型类的更好的东西。

重叠的总和类型

2 个答案: