如何解决是否可以为 Blazes 的“Html”派生一个“Lift”或“Data”实例？
我试图在编译时解析一些 markdown 并保留它生成的 Html 实例。
通常我会使用派生的 Language.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 |]
但是，当我使用包含 Blaze.Html 字段的类型尝试此模式时：
（我正在使用扩展 TemplateHaskell DeriveLift DeriveGeneric，以及包 template-haskell th-lift 和 blaze-html）
data MyBadType = MyBadType { f1 :: Html } deriving (Lift)
我收到此错误：
• 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）。
有什么办法可以避免吗？ 或者我在这里缺少的不同方法？ 或者是通过一些我不知道的技巧来实现这些实例吗？
我知道我可以在编译时将 markdown 源存储为 Text 并在运行时呈现它，但我想知道是否有替代方法。
解决方法
您可以尝试按照以下概念验证定义手动实例。但是，我建议先做一些客观的基准测试，然后再假设这种“预编译”标记的性能比仅在运行时进行渲染要好。
定义一个通用的 Lift (String -> String) 实例会“具有挑战性”，但我们可以像这样提升一个 StaticString，通过获取它的字符串值，然后使用 IsString 实例来构造一个重新：
instance Lift StaticString where
lift ss = let ss' = getString ss "" in [| fromString ss' :: StaticString |]
一旦定义，除了 ChoiceString 之外，ByteString 实例是乏味但简单的。您可以考虑使用 Lift ByteString 中的 th-lift-instances 实例，或者也许有一个我不知道的更好的实例。
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 ()。 Append 的 MarkupM 构造函数带来了一个问题，因为它引入了一个新的 MarkupM b 类型，该类型对任何 b 进行了量化。这意味着一个实例：
instance Lift a => Lift (MarkupM a)
不起作用，因为我们永远无法保证 Lift b 所需的 Append。我们可以通过编写一个仅适用于 Lift 的非法 MarkupM () 实例来作弊。请注意，构造函数中 a 类型的任何值都将被忽略并假定为 () :: ()。
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 () |]
这似乎适用于以下示例：
-- 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)
版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。