Question

是否可以按照以下精神编写代码：

data EventTable = "table1" | "table2" | "some_other_table"

case eventTable of 
  "table1" -> -- do something
  "table2" -> -- do something else
  "some_other_table" -> -- do something else
  "unknown_table"-> -- SHOULD NOT COMPILE

我试图直接使用远程API提供的字符串文字，而不是首先将它们映射到常规Haskell sum-type / ADT，并且必须为它编写序列化和反序列化函数。

Answer 1

Haskell没有类似TypeScript的string literal types（它们是单例类型：TypeScript只允许你使用给定的字符串，如果它可以告诉你已经检查过字符串确实符合该类型），最好的方法可能是手动滚动常规数据类型和简单的智能构造函数。但正如@chi在评论中指出的那样，如果你有很多字符串需要处理，这可能是代码生成的工作。

我们将编写一个模板Haskell帮助程序来转换

之类的拼接

stringLitTy "Foo" ["bar", "baz"]

进入data声明，智能构造函数和toString函数：

data Foo = Bar | Baz deriving (Eq, Ord, Bounded, Enum, Show, Read)

mkFoo :: String -> Maybe Foo
mkFoo "bar" = Just Bar
mkFoo "baz" = Just Baz
mkFoo _ = Nothing

fooToString :: Foo -> String
fooToString Bar = "bar"
fooToString Baz = "baz"

这样做的代码很简单，所以如果你不熟悉TH，这将是一个很好的速成课程。

首先让我们为类型和函数创建一些名称，并从字符串文字到一些构造函数名称进行映射。

{-# LANGUAGE TemplateHaskell #-}

module StringLit where

import Data.Char
import Language.Haskell.TH

legaliseCon :: String -> String
legaliseCon (x:xs) = toUpper x : map (\c -> if not (isAlphaNum c) then '_' else c) xs

legaliseFun :: String -> String
legaliseFun (x:xs) = toLower x : map (\c -> if not (isAlphaNum c) then '_' else c) xs

stringLitTy :: String -> [String] -> Q [Dec]
stringLitTy typeName strs =
    let tyName = mkName $ legaliseCon typeName
        constrName = mkName $ legaliseFun ("mk" ++ typeName)
        toStringName = mkName $ legaliseFun (typeName ++ "ToString")
        conNames = [(n, mkName $ legaliseCon n) | n <- strs]
    in sequenceA [
        mkDataDecl tyName (map snd conNames),
        mkConstrDecl constrName conNames,
        mkToStringDecl toStringName conNames
        ]

legaliseCon和legaliseFun是将字符串转换为对构造函数或函数有效的表单的直接工具。（那里肯定有改进空间！）stringLitTy调用下面的mkDataDecl，mkConstrDecl和mkToStringDecl来生成顶级声明。它们都非常简单：mkDataDecl调用dataD来构造具有适当deriving子句的数据类型声明。

enumClasses = sequenceA [
    [t| Eq |],
    [t| Ord |],
    [t| Bounded |],
    [t| Enum |],
    [t| Show |],
    [t| Read |]
    ]

mkDataDecl :: Name -> [Name] -> Q Dec
mkDataDecl tyName conNames =
    dataD
        (return [])                     -- datatype context
        tyName                          -- name
        []                              -- type parameters
        Nothing                         -- kind annotation
        [normalC n [] | n <- conNames]  -- constructors, none of which have any parameters
        enumClasses                     -- "deriving" classes

mkConstrDecl使用funD生成智能构造函数（mkFoo）的代码，基于从字符串到生成的构造函数名称的映射。

mkConstrDecl :: Name -> [(String, Name)] -> Q Dec
mkConstrDecl name map = funD name $ [
    clause
        [litP $ stringL str]                          -- the string literal pattern on the LHS
        (normalB $ appE [| Just |] (conE con))        -- Just Con on the RHS
        []                                            -- where clauses
    | (str, con) <- map]
    ++ [clause [wildP] (normalB $ [| Nothing |]) []]  -- mkFoo _ = Nothing

并且mkToStringDecl的功能大致相同，除了构造函数在左侧，字符串文字在右侧。并且需要通配符子句或Maybe。

mkToStringDecl :: Name -> [(String, Name)] -> Q Dec
mkToStringDecl name map = funD name [
    clause
        [conP con []]
        (normalB $ litE $ stringL str)
        []
    | (str, con) <- map]

因此，如果我在另一个模块中导入StringLit并编写拼接，

{-# LANGUAGE TemplateHaskell #-}

module Test where

import StringLitTy

stringLitTy "EventTable" ["table1", "table2", "some_other_table"]

我可以对生成的EventTable类型的构造函数执行大小写分析。这不是你在问题中所要求的，但我认为它可以让你获得90％的目标。

tableNumber Table1 = Just 1
tableNumber Table2 = Just 2
tableNumber Some_other_table = Nothing

-- for good measure:
ghci> :l Test
[1 of 2] Compiling StringLitTy      ( StringLitTy.hs, interpreted )
[2 of 2] Compiling Test             ( Test.hs, interpreted )
Ok, modules loaded: Test, StringLitTy.

ghci> :bro
data EventTable = Table1 | Table2 | Some_other_table
mkEventTable :: [Char] -> Maybe EventTable
eventTableToString :: EventTable -> [Char]

ghci> tableNumber Table1
Just 1

哦，还有一件事：自从你的拼接中的Q monad allows you to run IO actions，你可以（比方说）查询数据库以获取你的表名。模板Haskell编程是“只是编程”，因此您可以使用Monad（如Q）执行所有常见的traverse内容：

getTablesFromDb :: IO [(String, [String])]
getTablesFromDb = {- ... -}
mkTables :: Q [Dec]
mkTables = do
    tables <- runIO getTablesFromDb
    concat <$> traverse (uncurry stringLitTy) tables

如何使用已知的字符串文字集合进行求和（ADT）？

1 个答案: