我假设你想用反序列化的门票做更多的事情而不是运行它们，因为如果不是你也可以要求用户提供一堆String -> IO()
或类似的东西，根本不需要任何聪明的东西。
如果是这样，万岁！我不经常觉得推荐这样的高级语言功能是合适的。
class Ticketable a where
show' :: a -> String
read' :: String -> Maybe a
runTicket :: a -> IO ()
-- other useful things to do with tickets
这一切都取决于read'. read' :: Ticket a => String -> a不是很有用，因为它对无效数据唯一能做的就是崩溃。如果我们将类型更改read' :: Ticket a => String -> Maybe a为此可以允许我们从磁盘读取并尝试所有可能性或完全失败。（或者，您可以使用解析器：parse :: Ticket a => String -> Maybe (a,String)。）
让我们使用 GADT 来为我们提供 ExistentialQuantification 而不使用语法和更好的错误消息：
{-# LANGUAGE GADTs #-}
data Ticket where
MkTicket :: Ticketable a => a -> Ticket
showT :: Ticket -> String
showT (MkTicket a) = show' a
runT :: Ticket -> IO()
runT (MkTicket a) = runTicket a
注意 MkTicket 构造器是如何Ticketable a免费提供上下文的！GADT 很棒。
制作 Ticket 和 Ticketable 的实例会很好，但这不起作用，因为其中a隐藏了一个模棱两可的类型。让我们使用读取 Ticketable 类型的函数并让它们读取门票。
ticketize :: Ticketable a => (String -> Maybe a) -> (String -> Maybe Ticket)
ticketize = ((.).fmap) MkTicket -- a little pointfree fun
您可以使用一些不寻常的标记字符串，例如
"\n-+-+-+-+-+-Ticket-+-+-+-Border-+-+-+-+-+-+-+-\n"分隔您的序列化数据，或者更好地使用单独的文件。对于这个例子，我将只使用“\n”作为分隔符。
readTickets :: [String -> Maybe Ticket] -> String -> [Maybe Ticket]
readTickets readers xs = map (foldr orelse (const Nothing) readers) (lines xs)
orelse :: (a -> Maybe b) -> (a -> Maybe b) -> (a -> Maybe b)
(f `orelse` g) x = case f x of
Nothing -> g x
just_y -> just_y
现在让我们摆脱Justs 并忽略Nothings：
runAll :: [String -> Maybe Ticket] -> String -> IO ()
runAll ps xs = mapM_ runT . catMaybes $ readTickets ps xs
让我们制作一张简单的票，它只打印某个目录的内容
newtype Dir = Dir {unDir :: FilePath} deriving Show
readDir xs = let (front,back) = splitAt 4 xs in
if front == "dir:" then Just $ Dir back else Nothing
instance Ticketable Dir where
show' (Dir p) = "dir:"++show p
read' = readDir
runTicket (Dir p) = doesDirectoryExist p >>= flip when
(getDirectoryContents >=> mapM_ putStrLn $ p)
还有一张更微不足道的票
data HelloWorld = HelloWorld deriving Show
readHW "HelloWorld" = Just HelloWorld
readHW _ = Nothing
instance Ticketable HelloWorld where
show' HelloWorld = "HelloWorld"
read' = readHW
runTicket HelloWorld = putStrLn "Hello World!"
然后把它们放在一起：
myreaders = [ticketize readDir,ticketize readHW]
main = runAll myreaders $ unlines ["HelloWorld",".","HelloWorld","..",",HelloWorld"]