需要配置数据的类型类实例。我有哪些选择？

Question

使用 yesod 和 persistent，我做了一个我认为很方便的类型来处理 Markdown 数据：

{-# LANGUAGE OverloadedStrings #-}

module Utils.MarkdownText where

import Prelude
import Data.Text.Lazy
import Data.Text as T
import Database.Persist
import Database.Persist.Sql
import Text.Blaze
import Text.Markdown

newtype MarkdownText = MarkdownText { rawMarkdown :: T.Text }

instance PersistField MarkdownText  where
    toPersistValue = PersistText . rawMarkdown

    fromPersistValue (PersistText val) = Right $ MarkdownText { rawMarkdown = val }
    fromPersistValue _ = Left "invalid type"

instance PersistFieldSql MarkdownText where
    sqlType _ = SqlString

instance ToMarkup MarkdownText where
    toMarkup = (markdown def) . fromStrict . rawMarkdown

    preEscapedToMarkup = toMarkup . rawMarkdown

您可能会注意到在 ToMarkup 实例中我使用 def 来获取降价参数。如果我想更改这些设置，而不是在此模块中进行硬编码，我有哪些选择？

我考虑过让 MarkdownText 将设置信息作为参数的选项，但还有哪些其他选项（如果有）？

Answer 1

我打算简化问题，这样我们只需要核心库。我们想根据包含 prefix 和 suffix.

的 ExampleSettings 来更改 Show MarkdownText 的方式

{-# LANGUAGE OverloadedStrings #-}

import Data.Text as T
import Data.Monoid
import Data.String

newtype MarkdownText = MarkdownText { rawMarkdown :: T.Text}

instance IsString MarkdownText where
    fromString = MarkdownText . fromString

data ExampleSettings = ExampleSettings { prefix :: T.Text, suffix :: T.Text }
def = ExampleSettings "" ""

emphasise = def { prefix = "*", suffix = "*" }

showWithSettings :: ExampleSettings -> T.Text -> String
showWithSettings set = show . (\x -> prefix set <> x <> suffix set)

instance Show MarkdownText where
    show = showWithSettings def . rawMarkdown

main = print $ MarkdownText "Hello World"

对于如何解决这个问题有很多选择，首先是值级别，然后是类型级别，最后是类型级别的全局。

添加字段

对于如何进行，我们有几个选择。最简单的选项是在值级别添加设置。我们将使用 MarkdownText.

结束设置

data ConfiguredMarkdownText = ConfiguredMarkdownText {
                                  markdownText :: MarkdownText,
                                  settings :: ExampleSettings }

instance Show ConfiguredMarkdownText where
    show t = showWithSettings (settings t) (rawMarkdown . markdownText $ t)

main = print $ ConfiguredMarkdownText "Hello World" emphasise

为方便起见，我们在第一部分中为 MarkdownText 添加了一个 IsString 实例。

添加类型参数

我们可以在类型级别而不是值级别携带我们需要的额外数据。我们将类型参数添加到 MarkdownText 以指示要使用的设置。

newtype MarkdownText s = MarkdownText { rawMarkdown :: T.Text}

我们制作类型来表示可能的设置

data Def = Def
data Emphasise = Emphasise

我们可以为确定设置的类型添加类型 class，为可能的设置添加实例。

{-# LANGUAGE FunctionalDependencies #-}

class Setting v k | k -> v where
    setting :: proxy k -> v

instance Setting ExampleSettings Def where
    setting _ = def

instance Setting ExampleSettings Emphasise where
    setting _ = emphasise

我们可以 Show 任何 MarkdownText s 只要 s 提供 Setting.

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}

instance (Setting ExampleSettings s) => Show (MarkdownText s) where
    show t = showWithSettings (setting t) (rawMarkdown t)

main = print ("Hello World" :: MarkdownText Emphasise)

MarkdownText :: * -> * 需要一个稍微不同的 IsString 实例。

instance IsString (MarkdownText s) where
    fromString = MarkdownText . fromString

反映类型参数的值

reflection 包提供了一种将值与类型临时关联的方法。这让我们可以做与前面示例相同的事情，但不需要创建我们自己的类型来表示设置。

import Data.Reflection

我们首先向 MarkdownText 添加一个额外的类型参数，与上一节相同。

newtype MarkdownText s = MarkdownText { rawMarkdown :: T.Text}

反射包定义了一个class、Reifies，和我们上一节做的Settingclass几乎一模一样。这让我们直接跳到定义 Show 实例。

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}

instance (Reifies s ExampleSettings) => Show (MarkdownText s) where
    show t = showWithSettings (reflect t) (rawMarkdown t)

我们将定义一个小函数来标记 MarkdownTexts

的类型参数

markdownText :: proxy s -> T.Text -> MarkdownText s
markdownText _ = MarkdownText

并完成设置显示 MarkdownText 时要使用的 ExampleSettings 的示例。我们使用 reify :: a -> (forall s. Reifies s a => Proxy s -> r) -> r 提供具体化的值，它传回该值已具体化到的类型的代理。

main = reify emphasise (\p -> print (markdownText p "Hello World"))

这比下一节中的简单版本有优势；具有不同类型参数的 MarkdownText 可以使用多个设置。

main = reify emphasise $ \p1 ->
       reify def $ \p2 ->
       do
           print (markdownText p1 "Hello World")
           print (markdownText p2 "Goodbye")

反映全局配置

反射包还定义了更简单的class、Given。它被定义为 class Given a where given :: a。它表示可以根据值本身的类型确定的值。这允许我们为特定类型提供单个全局配置值，例如 ExampleSettings。我们可以直接跳到为 MarkdownText.

编写 show 实例

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}

instance (Given ExampleSettings) => Show (MarkdownText) where
    show = showWithSettings given . rawMarkdown

我们提供 given ExampleSettings 和 give :: a -> (Given a => r) -> r。

main = give emphasise $ print (MarkdownText "Hello World")

需要配置数据的类型类实例。我有哪些选择？

A typeclass instance that needs configuration data. What are my options?

configuration

haskell

typeclass

yesod

添加字段

添加类型参数

反映类型参数的值

反映全局配置