Haskell 是否可以为Blazes'Html'派生一个'Lift'（或'Data'）实例？

我试图在编译时解析一些标记，并保留它生成的Html实例。 通常，我会使用派生的

语言.Haskell.TH.Lift.Lift

实例执行类似操作：

-- Lib.hs                                                                                                                                                           
module Lib where                                                                                                                                                                              
import Language.Haskell.TH                                                                                                                                                                    
import Language.Haskell.TH.Lift                                                                                                                                                               
                                                                                                                                                                                              
data MyNiceType = MyNiceType { f0 :: Int } deriving (Lift, Show)                                                                                                                              
                                                                                                                                                                                              
preloadNiceType :: Q Exp                                                                                                                                                                      
preloadNiceType = do
  -- do some important work at compile time                                                                                                                                                                          
  let x = MyNiceType 0                                                                                                                                                                       
  [| x |]                                                                                    

instance Lift a => Lift (MarkupM a)

但是，当我使用包含Blaze.Html字段的类型尝试此模式时： （我正在使用扩展名

TemplateHaskell

DeriveLift

DeriveGeneric

，以及包

template haskell

th lift

和

blaze html

）

我得到这个错误：

    • No instance for (Lift Html)
        arising from the first field of ‘MyBadType’ (type ‘Html’)
      Possible fix:
        use a standalone 'deriving instance' declaration,
          so you can specify the instance context yourself
    • When deriving the instance for (Lift MyBadType)

现在，从这个错误中很清楚GHC希望我做什么。但我真的可以避免自己为Html类型实例化Lift（或Data）

有什么办法可以避免吗？ 还是我这里缺少的另一种方法？ 或者通过一些我不知道的技巧来实现这些实例是微不足道的吗

---

我知道我可以在编译时将标记源代码存储为文本，并在运行时呈现，但我想知道是否有其他方法。

您可以尝试在以下概念验证中定义手动实例。但是，我建议在假设这种“预编译”标记的性能比仅在运行时进行渲染更好之前，先进行一些客观的基准测试

一般的

Lift（String->String）

实例定义起来很“困难”，但是我们可以像这样提升

StaticString

，方法是获取其字符串值，然后使用

IsString

实例重新构造一个：

instance Lift StaticString where
  lift ss = let ss' = getString ss "" in [| fromString ss' :: StaticString |]

一旦定义了它，一个

ChoiceString

实例就变得单调而简单，除了

ByteString

之外。你可以考虑使用<代码> Load ByTeStord实例来代替代码>提升实例< /代码>，或者也许还有一个更好的，我不知道。

instance Lift ChoiceString where
  lift (Static a) = [| Static a |]
  lift (String a) = [| String a |]
  lift (Text a) = [| Text a |]
  lift (ByteString bs) = let ws = BS.unpack bs in [| BS.pack ws |]
  lift (PreEscaped a) = [| PreEscaped a |]
  lift (External a) = [| External a |]
  lift (AppendChoiceString a b) = [| AppendChoiceString a b |]
  lift EmptyChoiceString = [| EmptyChoiceString |]

这就剩下了

HTML=MarkupM（）

。

MarkupM

的

Append

构造函数带来了一个问题，因为它引入了一个新的

MarkupM b

类型，在任何

b

上进行量化。这意味着一个实例：

-- Lib.hs                                                                                                                                                           
module Lib where                                                                                                                                                                              
import Language.Haskell.TH                                                                                                                                                                    
import Language.Haskell.TH.Lift                                                                                                                                                               
                                                                                                                                                                                              
data MyNiceType = MyNiceType { f0 :: Int } deriving (Lift, Show)                                                                                                                              
                                                                                                                                                                                              
preloadNiceType :: Q Exp                                                                                                                                                                      
preloadNiceType = do
  -- do some important work at compile time                                                                                                                                                                          
  let x = MyNiceType 0                                                                                                                                                                       
  [| x |]                                                                                    

instance Lift a => Lift (MarkupM a)

不会起作用，因为我们永远无法保证

追加所需的
提升b
。我们可以通过编写一个非法的
Lift
实例来作弊，该实例只适用于
MarkupM（）
。请注意，构造函数中的
a
类型的任何值都将被忽略，并假定为
（）：（）

这似乎适用于以下示例：

-- LiftBlaze.hs
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wall -Wno-orphans #-}

module LiftBlaze where

import Data.String
import qualified Data.ByteString as BS
import Language.Haskell.TH
import Language.Haskell.TH.Lift
import Text.Blaze.Internal
import Text.Blaze.Html5 hiding (a, b, head)
import qualified Text.Blaze.Html5 as H

instance Lift (MarkupM a) where
  lift (Parent a b c d)   = [| Parent a b c d |]
  lift (CustomParent a b) = [| CustomParent a b |]
  lift (Leaf a b c _)     = [| Leaf a b c () |]
  lift (CustomLeaf a b _) = [| CustomLeaf a b () |]
  lift (Content a _)      = [| Content a () |]
  lift (Comment a _)      = [| Comment a () |]
  lift (Append a b)       = [| Append a b |]
  lift (AddAttribute a b c d) = [| AddAttribute a b c d |]
  lift (AddCustomAttribute a b c) = [| AddCustomAttribute a b c |]
  lift (Empty _) = [| Append Empty () |]
instance Lift StaticString where
  lift ss = let ss' = getString ss "" in [| fromString ss' :: StaticString |]
instance Lift ChoiceString where
  lift (Static a) = [| Static a |]
  lift (String a) = [| String a |]
  lift (Text a) = [| Text a |]
  lift (ByteString bs) = let ws = BS.unpack bs in [| BS.pack ws |]
  lift (PreEscaped a) = [| PreEscaped a |]
  lift (External a) = [| External a |]
  lift (AppendChoiceString a b) = [| AppendChoiceString a b |]
  lift EmptyChoiceString = [| EmptyChoiceString |]

data MyHTMLType = MyHTMLType { f0 :: Html } deriving (Lift)

preloadNiceType :: Q [Dec]
preloadNiceType = do
  -- do some important work at compile time
  let x = MyHTMLType $ docTypeHtml $ do
        H.head $ do
          H.title "Compiled HTML"
        body $ do
          stringComment "not sure this is a good idea"
          p "I can't believe we're doing this!"
  [d| thing = x |]

-- Main.hs
{-# LANGUAGE TemplateHaskell #-}

import LiftBlaze
import Text.Blaze.Html.Renderer.Pretty

-- preload "thing"
preloadNiceType

main = do
  putStrLn $ renderHtml (f0 thing)

您是否尝试了导出实例Lift Html=>Lift MyBadType

@DavidFox谢谢您的评论。不幸的是，这并没有改变我得到的错误（在启用了一些扩展之后）。顺便说一下，如果我使用LucidHTML，我也会遇到同样的问题。我的直觉告诉我这将是非常困难的，也许不是正确的事情。我在尝试编写

实例提升（String->String）

时遇到了困难，我认为这没有意义。该类型可能不适合以这种方式编码数据。@DavidBox从文档中，我怀疑

StaticString

的

String->String

字段是一个差异列表，因此

String

的

Lift

实例可能足够好了。（特别是，不要提起

f:：String->String

；而是提起

f”“：：String

，并部分应用

（++）

）谢谢！当我回到这个问题并让你知道的时候，我会努力处理它。您是对的，在运行时解释降价对性能的影响可能很低。我想这样做的主要原因是在编译时做一些进一步的处理和检查，以确保标记生成的HTML是正确的（例如，链接的格式是否正确）。如果我能在编译时做到这一点，它将使应用程序不那么容易出错（我希望如此）。您也可以考虑在编译时绘制错误，但只需将结果扔掉，然后在运行时重新渲染。“代码>追加< /代码>的第一个字段中的类型变量是存在量化的，因此没有观察者可以对它做任何有趣的事情。这意味着您应该能够通过编写

Lift（Append a b）=[| Append（void a）b |]

左右（使用

void:：Functor f=>fa->f（）

）来编写实际有效的

Lift a=>Lift（MarkupM a）

实例，而不会实际丢失任何有用的信息。